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 (forall a.
StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
-> (String, String)
-> [(((a, String), MatchList), (String, String))]
runRegexParserTrials forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegexAction]
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
mkRegexParserTrials forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [RegexAction]
parseRegexStr) String
reg (String, String)
str of
[] -> forall a. Maybe a
Nothing
(((String
ret, String
pre), MatchList
ml), (String, String)
sp):[(((String, String), MatchList), (String, String))]
_ -> forall a. a -> Maybe a
Just ( (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
= forall a b. (a -> b) -> [a] -> [b]
map (\(((String
ret, String
pre), MatchList
ml), (String, String)
sp) -> ((forall a. [a] -> [a]
reverse String
pre, String
ret, (String, String)
sp), MatchList
ml)) forall a b. (a -> b) -> a -> b
$
(forall a.
StateT
String (ReaderT (String, String) (StateT MatchList (Parse Char))) a
-> (String, String)
-> [(((a, String), MatchList), (String, String))]
runRegexParserTrials forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RegexAction]
-> StateT
String
(ReaderT (String, String) (StateT MatchList (Parse Char)))
String
mkRegexParserTrials 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 = forall a.
(String, String)
-> RegexParser a
-> (String, String)
-> [((a, MatchList), (String, String))]
runRegexParser (String, String)
point (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
= forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
False [RegexAction]
ras) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
do Char
x <- forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
True
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Char
xforall 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
_ [] = 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 -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
greedyRepeatParse Int
mn Maybe Int
mx forall a b. (a -> b) -> a -> b
$
Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction
rb]
RepeatNotGreedy Int
mn Maybe Int
mx RegexAction
rb
-> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) b.
MonadPlus m =>
Int -> Maybe Int -> m b -> m [b]
repeatParse Int
mn Maybe Int
mx 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 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 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
ra2
RegexAction
EndOfInput -> forall (m :: * -> *) a b. (MonadPlus m, MonadParse a m) => b -> m b
endOfInput String
""
RegexAction
BeginningOfInput -> forall (m :: * -> *) a b. (MonadPlus m, MonadParse a m) => b -> m b
beginningOfInput String
""
Still [Backword [RegexAction]
acts]
-> forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still (Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
True [RegexAction]
acts) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isBack (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a. [a] -> [a]
reverse) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Still [RegexAction]
acts -> forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still (Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
False [RegexAction]
acts) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 -> forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot String
"" forall a b. (a -> b) -> a -> b
$ Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
acts
RegexAction
PreMatchPoint -> forall (m :: * -> *) a. (MonadPlus m, Eq a) => m a -> m a -> m ()
guardEqual forall r (m :: * -> *). MonadReader r m => m r
ask (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
Parens [RegexAction]
acts -> Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
acts
Comment String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
RegexAction
NopRegex -> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
NoBacktrack [RegexAction]
acts -> forall a (m :: * -> *) b. MonadParse a m => m b -> m b
noBacktrack forall a b. (a -> b) -> a -> b
$ Bool -> [RegexAction] -> RegexParser String
mkRegexParser Bool
isBack [RegexAction]
acts
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 = forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
s forall (m :: * -> *) a b. Monad m => m a -> (a -> b) -> m b
`build` (forall a. a -> [a] -> [a]
:[])
selectParserBack :: (Char -> Bool) -> RegexParser String
selectParserBack Char -> Bool
s = forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spotBack Char -> Bool
s forall (m :: * -> *) a b. Monad m => m a -> (a -> b) -> m b
`build` (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
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Int
i, (if Bool
isBack then forall a. [a] -> [a]
reverse else forall a. a -> a
id) String
x)forall a. a -> [a] -> [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
= forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Int
i) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero (if Bool
isBack then forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokensBack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse else forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens)