--
-- RegexPR.hs
--
-- Author: Yoshikuni Jujo <PAF01143@nifty.ne.jp>
--
-- This file is part of regexpr library
--
-- regexpr is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as
-- published by the Free Software Foundation, either version 3 of the
-- License, or any later version.
--
-- regexpr is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANGY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this program. If not, see
-- <http://www.gnu.org/licenses/>.

module Text.RegexPR (

  matchRegexPR
, multiMatchRegexPR
, gmatchRegexPR

, getbrsRegexPR
, ggetbrsRegexPR

, subRegexPR
, subRegexPRBy
, gsubRegexPR
, gsubRegexPRBy

, splitRegexPR

) where

import Hidden.RegexPRCore  ( matchRegexPRVerbose,
                             multiMatchRegexPRVerbose          )
import Hidden.RegexPRTypes ( MatchFun   , VerboseMatchFun,
                             RegexResult, VerboseResult  ,
			     MatchList                         )
import Data.Char           ( isDigit                           )
import Data.List           ( sort, nubBy                       )
import Data.Function       ( on                                )
import Data.Maybe          ( fromMaybe                         )
import Control.Arrow       ( first                             )

------------------------------------------------------------

matchRegexPR      :: MatchFun Maybe
matchRegexPR :: MatchFun Maybe
matchRegexPR      = forall (f :: * -> *). Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun String
-> (String, String)
-> Maybe ((String, String, (String, String)), MatchList)
matchRegexPRVerbose

multiMatchRegexPR :: MatchFun []
multiMatchRegexPR :: MatchFun []
multiMatchRegexPR = forall (f :: * -> *). Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun String
-> (String, String)
-> [((String, String, (String, String)), MatchList)]
multiMatchRegexPRVerbose

gmatchRegexPR :: MatchFun []
gmatchRegexPR :: MatchFun []
gmatchRegexPR String
reg = (String, String) -> [(RegexResult, MatchList)]
baseFun forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
""
  where
  baseFun :: (String, String) -> [(RegexResult, MatchList)]
baseFun ( String
_, String
"" ) = []
  baseFun (String, String)
pos       = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
justFun forall a b. (a -> b) -> a -> b
$ String
-> (String, String)
-> Maybe ((String, String, (String, String)), MatchList)
matchRegexPRVerbose String
reg (String, String)
pos
  justFun :: ((String, String, (String, String)), MatchList)
-> [(RegexResult, MatchList)]
justFun mr :: ((String, String, (String, String)), MatchList)
mr@( ( String
_, String
r, (String, String)
pos ), MatchList
_ )
    = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String, String, (String, String)) -> RegexResult
simplifyResult ((String, String, (String, String)), MatchList)
mr forall a. a -> [a] -> [a]
:
      (String, String) -> [(RegexResult, MatchList)]
baseFun ( if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then forall {a}. ([a], [a]) -> ([a], [a])
next (String, String)
pos else (String, String)
pos )
  next :: ([a], [a]) -> ([a], [a])
next ( [a]
p, a
x:[a]
xs ) = ( a
xforall a. a -> [a] -> [a]
:[a]
p, [a]
xs )
  next ([a], [a])
_           = forall a. HasCallStack => String -> a
error String
"can not go to next"

simplifyMatchFun :: Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun :: forall (f :: * -> *). Functor f => VerboseMatchFun f -> MatchFun f
simplifyMatchFun VerboseMatchFun f
mf String
reg
  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (String, String, (String, String)) -> RegexResult
simplifyResult ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerboseMatchFun f
mf String
reg forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
""

simplifyResult :: VerboseResult -> RegexResult
simplifyResult :: (String, String, (String, String)) -> RegexResult
simplifyResult ( String
pre, String
ret, (String
_, String
rest) ) = ( String
ret, (String
pre, String
rest) )

------------------------------------------------------------

getbrsRegexPR :: String -> String -> [ String ]
getbrsRegexPR :: String -> String -> [String]
getbrsRegexPR String
reg String
str
  = case MatchFun Maybe
matchRegexPR String
reg String
str of
         Maybe (RegexResult, MatchList)
Nothing
	   -> []
	 Just ( ( String
ret, (String
_, String
_) ), MatchList
ml )
	   -> String
ret forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd ( forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy ( forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) forall a b. (a, b) -> a
fst ) MatchList
ml )

ggetbrsRegexPR :: String -> String -> [ [ String ] ]
ggetbrsRegexPR :: String -> String -> [[String]]
ggetbrsRegexPR String
reg
  = forall a b. (a -> b) -> [a] -> [b]
map ( \( (String
m, (String, String)
_), MatchList
bl ) ->
            String
m forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd ( forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) forall a b. (a, b) -> a
fst) MatchList
bl ) )
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchFun []
gmatchRegexPR String
reg

------------------------------------------------------------

splitRegexPR :: String -> String -> [String]
splitRegexPR :: String -> String -> [String]
splitRegexPR String
reg String
str
  = case [(RegexResult, MatchList)]
gmatched of
         [ ] -> [ ]
         [(RegexResult, MatchList)]
_   -> forall a b. (a -> b) -> [a] -> [b]
map ( forall a b. (a, b) -> a
fstforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
sndforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst ) [(RegexResult, MatchList)]
gmatched forall a. [a] -> [a] -> [a]
++ [ (forall a b. (a, b) -> b
sndforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> b
sndforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fstforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. [a] -> a
last) [(RegexResult, MatchList)]
gmatched ]
  where gmatched :: [(RegexResult, MatchList)]
gmatched = MatchFun []
gmatchRegexPR String
reg String
str

------------------------------------------------------------

subRegexPR :: String -> String -> String -> String
subRegexPR :: String -> String -> String -> String
subRegexPR String
reg String
sub = String -> (String -> String) -> String -> String
subRegexPRBy String
reg (forall a b. a -> b -> a
const String
sub)

subRegexPRBy :: String -> (String -> String) -> String -> String
subRegexPRBy :: String -> (String -> String) -> String -> String
subRegexPRBy String
reg String -> String
subf String
src
  = case String
-> (String, String)
-> Maybe ((String, String, (String, String)), MatchList)
matchRegexPRVerbose String
reg (String
"",String
src) of
         Just al :: ((String, String, (String, String)), MatchList)
al@((String
pre, String
m, (String, String)
sp), MatchList
_) -> String
pre forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (String -> String
subf String
m) forall a. [a] -> [a] -> [a]
++ forall a b. (a, b) -> b
snd (String, String)
sp
         Maybe ((String, String, (String, String)), MatchList)
Nothing                   -> String
src

gsubRegexPR :: String -> String -> String -> String
gsubRegexPR :: String -> String -> String -> String
gsubRegexPR String
reg String
sub String
src = Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen forall a. Maybe a
Nothing String
reg (forall a b. a -> b -> a
const String
sub) (String
"", String
src)

gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy :: String -> (String -> String) -> String -> String
gsubRegexPRBy String
reg String -> String
subf String
src = Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen forall a. Maybe a
Nothing String
reg String -> String
subf (String
"", String
src)

gsubRegexPRGen ::
  Maybe (String, String) -> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen :: Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen Maybe (String, String)
pmp String
reg String -> String
fsub (String, String)
src
  = case String
-> (String, String)
-> Maybe ((String, String, (String, String)), MatchList)
matchRegexPRVerbose String
reg (String, String)
src of
      Just al :: ((String, String, (String, String)), MatchList)
al@((String
pre, String
match, sp :: (String, String)
sp@(~(String
p,Char
x:String
xs))), MatchList
_)
        -> case (Maybe (String, String)
pmp, (String, String)
sp) of
                (Just (String
_, String
""), (String, String)
_)  -> String
""
                (Maybe (String, String), (String, String))
_ | forall a. a -> Maybe a
Just (String, String)
sp forall a. Eq a => a -> a -> Bool
== Maybe (String, String)
pmp -> String
pre forall a. [a] -> [a] -> [a]
++ [Char
x] forall a. [a] -> [a] -> [a]
++
                                      Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen (forall a. a -> Maybe a
Just (String, String)
sp) String
reg String -> String
fsub (Char
xforall a. a -> [a] -> [a]
:String
p, String
xs)
                  | Bool
otherwise      -> String
pre forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (String -> String
fsub String
match) forall a. [a] -> [a] -> [a]
++
                                      Maybe (String, String)
-> String -> (String -> String) -> (String, String) -> String
gsubRegexPRGen (forall a. a -> Maybe a
Just (String, String)
sp) String
reg String -> String
fsub (String, String)
sp
      Maybe ((String, String, (String, String)), MatchList)
Nothing -> forall a b. (a, b) -> b
snd (String, String)
src

subBackRef ::
  ((String, String, (String, String)), MatchList) -> String -> String
subBackRef :: ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String))
_, MatchList
_) String
"" = String
""
subBackRef al :: ((String, String, (String, String)), MatchList)
al@((String
_, String
match, (String
hasRead,String
post)), MatchList
ml) (Char
'\\':str :: String
str@(Char
c:String
rest))
  | Char
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"&0" = String
match                                 forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'`'    = forall a. [a] -> [a]
reverse (forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
match) String
hasRead) forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''   = String
post                                  forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'+'    = forall a b. (a, b) -> b
snd (forall a. [a] -> a
head MatchList
ml)                         forall a. [a] -> [a] -> [a]
++ ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
rest
  | Char
c forall a. Eq a => a -> a -> Bool
== Char
'{'    = forall a. a -> Maybe a -> a
fromMaybe String
"" (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'}') String
rest) MatchList
ml) forall a. [a] -> [a] -> [a]
++
                  ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=Char
'}') String
str)
  | Bool
otherwise   = forall a. a -> Maybe a -> a
fromMaybe String
"" (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a. Read a => String -> a
read forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit String
str) MatchList
ml) forall a. [a] -> [a] -> [a]
++
                  ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isDigit String
str)
subBackRef ((String, String, (String, String)), MatchList)
al (Char
c:String
cs) = Char
c forall a. a -> [a] -> [a]
: ((String, String, (String, String)), MatchList) -> String -> String
subBackRef ((String, String, (String, String)), MatchList)
al String
cs