module Hidden.RegexPRCore (
matchRegexPRVerbose
, multiMatchRegexPRVerbose
) where
import Hidden.RegexPRTypes ( RegexParser, MatchList, runRegexParser )
import Text.ParserCombinators.MTLParse
( spot, spotBack, still, noBacktrack, parseNot,
build, tokens, tokensBack,
repeatParse, greedyRepeatParse,
beginningOfInput, endOfInput,
MonadPlus(..), (>++>) )
import Hidden.ParseRegexStr ( RegexAction(..), parseRegexStr )
import Control.Monad.State ( StateT, runStateT, gets, modify, lift, liftM )
import Control.Monad.Reader ( ask )
import Hidden.Tools ( guardEqual )
import Control.Monad ( unless )
matchRegexPRVerbose ::
String -> (String, String)
-> Maybe ( (String, String, (String, String)), MatchList )
matchRegexPRVerbose :: String
-> (String, String)
-> Maybe ((String, String, (String, String)), MatchList)
matchRegexPRVerbose String
reg (String, String)
str
= case (StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
-> (String, String)
-> [(((String, String), MatchList), (String, String))]
forall a.
StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
-> (String, String)
-> [(((a, String), MatchList), (String, String))]
runRegexParserTrials (StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
-> (String, String)
-> [(((String, String), MatchList), (String, String))])
-> (String
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String)
-> String
-> (String, String)
-> [(((String, String), MatchList), (String, String))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegexAction]
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
mkRegexParserTrials ([RegexAction]
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String)
-> (String -> [RegexAction])
-> String
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [RegexAction]
parseRegexStr) String
reg (String, String)
str of
[] -> Maybe ((String, String, (String, String)), MatchList)
forall a. Maybe a
Nothing
(((String
ret, String
pre), MatchList
ml), (String, String)
sp):[(((String, String), MatchList), (String, String))]
_ -> ((String, String, (String, String)), MatchList)
-> Maybe ((String, String, (String, String)), MatchList)
forall a. a -> Maybe a
Just ( (String -> String
forall a. [a] -> [a]
reverse String
pre, String
ret, (String, String)
sp), MatchList
ml )
multiMatchRegexPRVerbose ::
String -> (String, String)
-> [ ( (String, String, (String, String)), MatchList ) ]
multiMatchRegexPRVerbose :: String
-> (String, String)
-> [((String, String, (String, String)), MatchList)]
multiMatchRegexPRVerbose String
reg (String, String)
str
= ((((String, String), MatchList), (String, String))
-> ((String, String, (String, String)), MatchList))
-> [(((String, String), MatchList), (String, String))]
-> [((String, String, (String, String)), MatchList)]
forall a b. (a -> b) -> [a] -> [b]
map (\(((String
ret, String
pre), MatchList
ml), (String, String)
sp) -> ((String -> String
forall a. [a] -> [a]
reverse String
pre, String
ret, (String, String)
sp), MatchList
ml)) ([(((String, String), MatchList), (String, String))]
-> [((String, String, (String, String)), MatchList)])
-> [(((String, String), MatchList), (String, String))]
-> [((String, String, (String, String)), MatchList)]
forall a b. (a -> b) -> a -> b
$
(StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
-> (String, String)
-> [(((String, String), MatchList), (String, String))]
forall a.
StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
-> (String, String)
-> [(((a, String), MatchList), (String, String))]
runRegexParserTrials (StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
-> (String, String)
-> [(((String, String), MatchList), (String, String))])
-> (String
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String)
-> String
-> (String, String)
-> [(((String, String), MatchList), (String, String))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegexAction]
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
mkRegexParserTrials ([RegexAction]
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String)
-> (String -> [RegexAction])
-> String
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [RegexAction]
parseRegexStr) String
reg (String, String)
str
runRegexParserTrials ::
StateT String RegexParser a ->
(String, String) -> [(((a, String), MatchList), (String, String))]
runRegexParserTrials :: forall a.
StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
-> (String, String)
-> [(((a, String), MatchList), (String, String))]
runRegexParserTrials StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
p (String, String)
point = (String, String)
-> RegexParser (a, String)
-> (String, String)
-> [(((a, String), MatchList), (String, String))]
forall a.
(String, String)
-> RegexParser a
-> (String, String)
-> [((a, MatchList), (String, String))]
runRegexParser (String, String)
point (StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
-> String -> RegexParser (a, String)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
p String
"") (String, String)
point
mkRegexParserTrials :: [RegexAction] -> StateT String RegexParser String
mkRegexParserTrials :: [RegexAction]
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
mkRegexParserTrials [RegexAction]
ras
= RegexParser String
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
forall (m :: * -> *) a. Monad m => m a -> StateT String m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
False [RegexAction]
ras) StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
forall a.
StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
-> StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
-> StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
do Char
x <- (Char -> Bool)
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
Char
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot ((Char -> Bool)
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
Char)
-> (Char -> Bool)
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
Char
forall a b. (a -> b) -> a -> b
$ Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True
(String -> String)
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:)
[RegexAction]
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
mkRegexParserTrials [RegexAction]
ras
mkRegexParser :: Bool -> [RegexAction] -> RegexParser String
mkRegexParser :: Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
_ [] = String -> RegexParser String
forall a.
a -> ReaderT (String, String) (StateT MatchList (Parse Char)) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
mkRegexParser Bool
isBack (RegexAction
ra:[RegexAction]
ras)
= case RegexAction
ra of
Select Char -> Bool
s -> (Char -> Bool) -> RegexParser String
selectParserFB Char -> Bool
s
Repeat Int
mn Maybe Int
mx RegexAction
rb -> ([String] -> String)
-> ReaderT
(String, String) (StateT MatchList (Parse Char)) [String]
-> RegexParser String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ReaderT (String, String) (StateT MatchList (Parse Char)) [String]
-> RegexParser String)
-> (RegexParser String
-> ReaderT
(String, String) (StateT MatchList (Parse Char)) [String])
-> RegexParser String
-> RegexParser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Maybe Int
-> RegexParser String
-> ReaderT
(String, String) (StateT MatchList (Parse Char)) [String]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
mn Maybe Int
mx (RegexParser String -> RegexParser String)
-> RegexParser String -> RegexParser String
forall a b. (a -> b) -> a -> b
$
Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction
rb]
RepeatNotGreedy Int
mn Maybe Int
mx RegexAction
rb
-> ([String] -> String)
-> ReaderT
(String, String) (StateT MatchList (Parse Char)) [String]
-> RegexParser String
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ReaderT (String, String) (StateT MatchList (Parse Char)) [String]
-> RegexParser String)
-> (RegexParser String
-> ReaderT
(String, String) (StateT MatchList (Parse Char)) [String])
-> RegexParser String
-> RegexParser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> Maybe Int
-> RegexParser String
-> ReaderT
(String, String) (StateT MatchList (Parse Char)) [String]
forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse Int
mn Maybe Int
mx (RegexParser String -> RegexParser String)
-> RegexParser String -> RegexParser String
forall a b. (a -> b) -> a -> b
$
Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction
rb]
Note Int
i [RegexAction]
acts -> Bool -> Int -> RegexParser String -> RegexParser String
noteParens Bool
isBack Int
i (RegexParser String -> RegexParser String)
-> RegexParser String -> RegexParser String
forall a b. (a -> b) -> a -> b
$ Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
acts
BackReference Int
ri -> Bool -> Int -> RegexParser String
backReference Bool
isBack Int
ri
RegexOr [RegexAction]
ra1 [RegexAction]
ra2 -> Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
ra1 RegexParser String -> RegexParser String -> RegexParser String
forall a.
ReaderT (String, String) (StateT MatchList (Parse Char)) a
-> ReaderT (String, String) (StateT MatchList (Parse Char)) a
-> ReaderT (String, String) (StateT MatchList (Parse Char)) a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
ra2
RegexAction
EndOfInput -> String -> RegexParser String
forall (m :: * -> *) a b. (MonadPlus m, MonadParse a m) => b -> m b
endOfInput String
""
RegexAction
BeginningOfInput -> String -> RegexParser String
forall (m :: * -> *) a b. (MonadPlus m, MonadParse a m) => b -> m b
beginningOfInput String
""
Still [Backword [RegexAction]
acts]
-> RegexParser String -> RegexParser String
forall b.
ReaderT (String, String) (StateT MatchList (Parse Char)) b
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still (Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
True [RegexAction]
acts) RegexParser String
-> ReaderT (String, String) (StateT MatchList (Parse Char)) ()
-> ReaderT (String, String) (StateT MatchList (Parse Char)) ()
forall a b.
ReaderT (String, String) (StateT MatchList (Parse Char)) a
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Bool
-> ReaderT (String, String) (StateT MatchList (Parse Char)) ()
-> ReaderT (String, String) (StateT MatchList (Parse Char)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBack ((MatchList -> MatchList)
-> ReaderT (String, String) (StateT MatchList (Parse Char)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify MatchList -> MatchList
forall a. [a] -> [a]
reverse) ReaderT (String, String) (StateT MatchList (Parse Char)) ()
-> RegexParser String -> RegexParser String
forall a b.
ReaderT (String, String) (StateT MatchList (Parse Char)) a
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> RegexParser String
forall a.
a -> ReaderT (String, String) (StateT MatchList (Parse Char)) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Still [RegexAction]
acts -> RegexParser String -> RegexParser String
forall b.
ReaderT (String, String) (StateT MatchList (Parse Char)) b
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still (Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
False [RegexAction]
acts) RegexParser String -> RegexParser String -> RegexParser String
forall a b.
ReaderT (String, String) (StateT MatchList (Parse Char)) a
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> RegexParser String
forall a.
a -> ReaderT (String, String) (StateT MatchList (Parse Char)) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Backword [RegexAction]
acts -> Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
True [RegexAction]
acts
RegActNot [RegexAction]
acts -> String -> RegexParser String -> RegexParser String
forall c b.
c
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
-> ReaderT (String, String) (StateT MatchList (Parse Char)) c
forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot String
"" (RegexParser String -> RegexParser String)
-> RegexParser String -> RegexParser String
forall a b. (a -> b) -> a -> b
$ Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
acts
RegexAction
PreMatchPoint -> ReaderT
(String, String) (StateT MatchList (Parse Char)) (String, String)
-> ReaderT
(String, String) (StateT MatchList (Parse Char)) (String, String)
-> ReaderT (String, String) (StateT MatchList (Parse Char)) ()
forall (m :: * -> *) a. (MonadPlus m, Eq a) => m a -> m a -> m ()
guardEqual ReaderT
(String, String) (StateT MatchList (Parse Char)) (String, String)
forall r (m :: * -> *). MonadReader r m => m r
ask (StateT MatchList (Parse Char) (String, String)
-> ReaderT
(String, String) (StateT MatchList (Parse Char)) (String, String)
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (String, String) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT MatchList (Parse Char) (String, String)
forall r (m :: * -> *). MonadReader r m => m r
ask) ReaderT (String, String) (StateT MatchList (Parse Char)) ()
-> RegexParser String -> RegexParser String
forall a b.
ReaderT (String, String) (StateT MatchList (Parse Char)) a
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> RegexParser String
forall a.
a -> ReaderT (String, String) (StateT MatchList (Parse Char)) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Parens [RegexAction]
acts -> Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
acts
Comment String
_ -> String -> RegexParser String
forall a.
a -> ReaderT (String, String) (StateT MatchList (Parse Char)) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
RegexAction
NopRegex -> String -> RegexParser String
forall a.
a -> ReaderT (String, String) (StateT MatchList (Parse Char)) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
NoBacktrack [RegexAction]
acts -> RegexParser String -> RegexParser String
forall b.
ReaderT (String, String) (StateT MatchList (Parse Char)) b
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
forall a (m :: * -> *) b. MonadParse a m => m b -> m b
noBacktrack (RegexParser String -> RegexParser String)
-> RegexParser String -> RegexParser String
forall a b. (a -> b) -> a -> b
$ Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
acts
RegexParser String -> RegexParser String -> RegexParser String
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
>++> Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
ras
where selectParserFB :: (Char -> Bool) -> RegexParser String
selectParserFB = if Bool
isBack then (Char -> Bool) -> RegexParser String
selectParserBack else (Char -> Bool) -> RegexParser String
selectParser
selectParser, selectParserBack :: (Char -> Bool) -> RegexParser String
selectParser :: (Char -> Bool) -> RegexParser String
selectParser Char -> Bool
s = (Char -> Bool)
-> ReaderT (String, String) (StateT MatchList (Parse Char)) Char
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
s ReaderT (String, String) (StateT MatchList (Parse Char)) Char
-> (Char -> String) -> RegexParser String
forall (m :: * -> *) a b. Monad m => m a -> (a -> b) -> m b
`build` (Char -> String -> String
forall a. a -> [a] -> [a]
:[])
selectParserBack :: (Char -> Bool) -> RegexParser String
selectParserBack Char -> Bool
s = (Char -> Bool)
-> ReaderT (String, String) (StateT MatchList (Parse Char)) Char
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack Char -> Bool
s ReaderT (String, String) (StateT MatchList (Parse Char)) Char
-> (Char -> String) -> RegexParser String
forall (m :: * -> *) a b. Monad m => m a -> (a -> b) -> m b
`build` (Char -> String -> String
forall a. a -> [a] -> [a]
:[])
noteParens :: Bool -> Int -> RegexParser String -> RegexParser String
noteParens :: Bool -> Int -> RegexParser String -> RegexParser String
noteParens Bool
isBack Int
i RegexParser String
p = do String
x <- RegexParser String
p
(MatchList -> MatchList)
-> ReaderT (String, String) (StateT MatchList (Parse Char)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Int
i, (if Bool
isBack then String -> String
forall a. [a] -> [a]
reverse else String -> String
forall a. a -> a
id) String
x)(Int, String) -> MatchList -> MatchList
forall a. a -> [a] -> [a]
:)
String -> RegexParser String
forall a.
a -> ReaderT (String, String) (StateT MatchList (Parse Char)) a
forall (m :: * -> *) a. Monad m => a -> m a
return String
x
backReference :: Bool -> Int -> RegexParser String
backReference :: Bool -> Int -> RegexParser String
backReference Bool
isBack Int
i
= (MatchList -> Maybe String)
-> ReaderT
(String, String) (StateT MatchList (Parse Char)) (Maybe String)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> MatchList -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i) ReaderT
(String, String) (StateT MatchList (Parse Char)) (Maybe String)
-> (Maybe String -> RegexParser String) -> RegexParser String
forall a b.
ReaderT (String, String) (StateT MatchList (Parse Char)) a
-> (a
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b)
-> ReaderT (String, String) (StateT MatchList (Parse Char)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
RegexParser String
-> (String -> RegexParser String)
-> Maybe String
-> RegexParser String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RegexParser String
forall a.
ReaderT (String, String) (StateT MatchList (Parse Char)) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero (if Bool
isBack then String -> RegexParser String
forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokensBack (String -> RegexParser String)
-> (String -> String) -> String -> RegexParser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse else String -> RegexParser String
forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens)