module Hidden.ParseRegexStr (
RegexAction(..)
, parseRegexStr
) where
import Hidden.RegexPRTypes ( RegexAction(..),
RegexSrcParser, runRegexSrcParser,
getBR, modifyBR,
setMode, setModes, getModes,
isModeI, isModeM, isModeX )
import Text.ParserCombinators.MTLParse
( runParse, spot, token, tokens, mzero, mplus,
still, parseNot, endOfInput, MonadParse,
MonadPlus,
list, neList, greedyNeList, optional )
import Hidden.Tools ( isSymbol, ignoreCase, skipRet, (>..>), ifM,
applyIf, (&&&), headOrErr, modifyFst )
import Data.Char ( isAlphaNum, isDigit, isSpace )
import Data.Ix ( inRange )
import Hidden.SrcRegActList( selfTest, oneCharList, backSlashesList, plusesList,
parensesList, charClassList )
import Control.Applicative ((<$>))
parseRegexStr :: String -> [RegexAction]
parseRegexStr :: Modes -> [RegexAction]
parseRegexStr Modes
src =
forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Modes -> [a] -> a
headOrErr (Modes
"parse error: regex " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> Modes
show Modes
src forall a. [a] -> [a] -> [a]
++ Modes
" is uncorrect") forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse ( forall a. RegexSrcParser a -> Parse Char (a, (Int, Modes))
runRegexSrcParser RegexSrcParser [RegexAction]
parseRegexStrParser) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) [] forall a b. (a -> b) -> a -> b
$ Modes
src
parseRegexStrParser, parseTokensOr, parseTokens :: RegexSrcParser [RegexAction]
parseRegexStrParser :: RegexSrcParser [RegexAction]
parseRegexStrParser = RegexSrcParser [RegexAction]
parseTokensOr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a b. (MonadPlus m, MonadParse a m) => b -> m b
endOfInput
parseTokensOr :: RegexSrcParser [RegexAction]
parseTokensOr = RegexSrcParser [RegexAction]
parseTokens
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
do { [RegexAction]
ra1 <- RegexSrcParser [RegexAction]
parseTokens; Char
_ <- forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'|'; [RegexAction]
ra2 <- RegexSrcParser [RegexAction]
parseTokensOr;
forall (m :: * -> *) a. Monad m => a -> m a
return [ [RegexAction] -> [RegexAction] -> RegexAction
RegexOr [RegexAction]
ra1 [RegexAction]
ra2 ] }
parseTokens :: RegexSrcParser [RegexAction]
parseTokens = forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
list RegexSrcParser RegexAction
parseTokenPlus
parseTokenPlus, parseToken :: RegexSrcParser RegexAction
parseTokenPlus :: RegexSrcParser RegexAction
parseTokenPlus = do RegexAction
ra <- RegexSrcParser RegexAction
parseToken
RegexAction -> RegexAction
plus <- [(Modes, RegexAction -> RegexAction)]
-> StateT (Int, Modes) (Parse Char) (RegexAction -> RegexAction)
parsePluses [(Modes, RegexAction -> RegexAction)]
plusesList forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` StateT (Int, Modes) (Parse Char) (RegexAction -> RegexAction)
parseQuantifier
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ RegexAction -> RegexAction
plus RegexAction
ra
parseQuantifier :: RegexSrcParser (RegexAction -> RegexAction)
parseQuantifier :: StateT (Int, Modes) (Parse Char) (RegexAction -> RegexAction)
parseQuantifier
= do { Char
_ <- forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'{';
Modes
mn <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
neList forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
isDigit;
Maybe Modes
mx <- do { Modes
cma <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
optional forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
',';
case Modes
cma of
Modes
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Modes
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
list (forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
isDigit) };
Char
_ <- forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'}';
Bool
nd <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
optional (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'?');
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (if Bool
nd then Int -> Maybe Int -> RegexAction -> RegexAction
Repeat else Int -> Maybe Int -> RegexAction -> RegexAction
RepeatNotGreedy) (forall a. Read a => Modes -> a
read Modes
mn) forall a b. (a -> b) -> a -> b
$
case Maybe Modes
mx of
Maybe Modes
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Read a => Modes -> a
read Modes
mn
Just Modes
"" -> forall a. Maybe a
Nothing
Just Modes
n -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Read a => Modes -> a
read Modes
n }
parseToken :: RegexSrcParser RegexAction
parseToken
= forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM StateT (Int, Modes) (Parse Char) Bool
isModeX RegexSrcParser RegexAction
parseTokenX forall (m :: * -> *) a. MonadPlus m => m a
mzero
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
( StateT (Int, Modes) (Parse Char) Bool
isModeI forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
ic ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> RegexAction
Select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bool -> (a -> a) -> a -> a
applyIf Bool
ic (Char -> Bool) -> Char -> Bool
ignoreCase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==)) (forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
selfTest) )
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
RegexSrcParser RegexAction
parseOpenBrace
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM StateT (Int, Modes) (Parse Char) Bool
isModeM ( forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'.' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ((Char -> Bool) -> RegexAction
Select forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Bool
True) ) forall (m :: * -> *) a. MonadPlus m => m a
mzero
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> RegexAction
Select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==)) (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
isSymbol)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
RegexSrcParser RegexAction
parseBackReference
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ( forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'[' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
optional (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'^') ) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
isNot ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> RegexAction
Select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bool -> (a -> a) -> a -> a
applyIf Bool
isNot (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.)) (
StateT (Int, Modes) (Parse Char) (Char -> Bool)
parseCharList forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) b a. Monad m => m b -> a -> m a
skipRet (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
']')
) )
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
( RegexSrcParser Int
getBR forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [RegexAction] -> RegexAction
Note Int
i) forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'(' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> Int) -> StateT (Int, Modes) (Parse Char) ()
modifyBR (forall a. Num a => a -> a -> a
+Int
1) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RegexSrcParser [RegexAction]
parseTokensOr
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) b a. Monad m => m b -> a -> m a
skipRet (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
')') )
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
( forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens Modes
"(?" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
list RegexSrcParser (Char, Bool)
parseMode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Bool -> StateT (Int, Modes) (Parse Char) ()
setMode) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
')'
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return RegexAction
NopRegex )
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
( StateT (Int, Modes) (Parse Char) Modes
getModes forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Modes
preModes ->
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [RegexAction] -> RegexAction
Parens forall a b. (a -> b) -> a -> b
$
forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens Modes
"(?" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
list RegexSrcParser (Char, Bool)
parseMode forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Bool -> StateT (Int, Modes) (Parse Char) ()
setMode) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
RegexSrcParser [RegexAction]
parseTokensOr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) b a. Monad m => m b -> a -> m a
skipRet (Modes -> StateT (Int, Modes) (Parse Char) ()
setModes Modes
preModes forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
')')
)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
[(Char, RegexAction)] -> RegexSrcParser RegexAction
parseOneChar [(Char, RegexAction)]
oneCharList
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
[(Char, RegexAction)] -> RegexSrcParser RegexAction
parseBackSlashes [(Char, RegexAction)]
backSlashesList
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
[(Modes, [RegexAction] -> RegexAction)]
-> RegexSrcParser RegexAction
parseParenses [(Modes, [RegexAction] -> RegexAction)]
parensesList
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Modes -> RegexAction
Comment
( forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens Modes
"(?#" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
list (forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot (forall a. Eq a => a -> a -> Bool
/=Char
')')) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) b a. Monad m => m b -> a -> m a
skipRet (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
')') )
parseMode :: RegexSrcParser (Char, Bool)
parseMode :: RegexSrcParser (Char, Bool)
parseMode =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b c. (a -> b -> c) -> b -> a -> c
flip (,)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (a, b) -> (c, b)
modifyFst forall (t :: * -> *) a. Foldable t => t a -> Bool
null ) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
optional (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'-') forall (m :: * -> *) a b. Monad m => m a -> m b -> m (a, b)
>..> forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Modes
"imx")
parseTokenX :: RegexSrcParser RegexAction
parseTokenX :: RegexSrcParser RegexAction
parseTokenX
= ( forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
isSpace forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return RegexAction
NopRegex ) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Modes -> RegexAction
Comment
( forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'#' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
list (forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot (forall a. Eq a => a -> a -> Bool
/=Char
'\n')) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) b a. Monad m => m b -> a -> m a
skipRet (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'\n' forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) a b. (MonadPlus m, MonadParse a m) => b -> m b
endOfInput Char
'\n') )
parsePluses ::
[ (String, RegexAction -> RegexAction) ] ->
RegexSrcParser (RegexAction -> RegexAction)
parsePluses :: [(Modes, RegexAction -> RegexAction)]
-> StateT (Int, Modes) (Parse Char) (RegexAction -> RegexAction)
parsePluses = forall (m :: * -> *) b a. MonadPlus m => (b -> m a) -> [b] -> m a
concatMapParse (\(Modes
t, RegexAction -> RegexAction
act) -> forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens Modes
t forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return RegexAction -> RegexAction
act)
parseOneChar :: [ (Char, RegexAction) ] -> RegexSrcParser RegexAction
parseOneChar :: [(Char, RegexAction)] -> RegexSrcParser RegexAction
parseOneChar
= forall (m :: * -> *) b a. MonadPlus m => (b -> m a) -> [b] -> m a
concatMapParse (\(Char
t, RegexAction
act) -> forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
t forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return RegexAction
act)
parseBackSlashes :: [ (Char, RegexAction) ] -> RegexSrcParser RegexAction
parseBackSlashes :: [(Char, RegexAction)] -> RegexSrcParser RegexAction
parseBackSlashes
= forall (m :: * -> *) b a. MonadPlus m => (b -> m a) -> [b] -> m a
concatMapParse (\(Char
t, RegexAction
act) -> forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens [Char
'\\', Char
t] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return RegexAction
act)
parseParenses ::
[ (String, [RegexAction] -> RegexAction) ] -> RegexSrcParser RegexAction
parseParenses :: [(Modes, [RegexAction] -> RegexAction)]
-> RegexSrcParser RegexAction
parseParenses
= forall (m :: * -> *) b a. MonadPlus m => (b -> m a) -> [b] -> m a
concatMapParse ( \(Modes
t, [RegexAction] -> RegexAction
act) ->
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [RegexAction] -> RegexAction
act forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens (Char
'('forall a. a -> [a] -> [a]
:Modes
t) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RegexSrcParser [RegexAction]
parseTokensOr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) b a. Monad m => m b -> a -> m a
skipRet (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
')') ))
parseCharList :: RegexSrcParser (Char -> Bool)
parseCharList :: StateT (Int, Modes) (Parse Char) (Char -> Bool)
parseCharList = do
Bool
modei <- StateT (Int, Modes) (Parse Char) Bool
isModeI
Char -> Bool
cl1 <- StateT (Int, Modes) (Parse Char) (Char -> Bool)
parseOne forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (m :: * -> *) b a. MonadPlus m => (b -> m a) -> [b] -> m a
concatMapParse ((forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(==)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token) Modes
"-]"
[Char -> Bool]
cl2 <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
list forall a b. (a -> b) -> a -> b
$ StateT (Int, Modes) (Parse Char) (Char -> Bool)
parseOne forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Eq a => a -> a -> Bool
(==) (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'^')
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Bool -> (a -> a) -> a -> a
applyIf Bool
modei (Char -> Bool) -> Char -> Bool
ignoreCase forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. (a -> b) -> a -> b
($) (Char -> Bool
cl1 forall a. a -> [a] -> [a]
: [Char -> Bool]
cl2) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a]
repeat
where parseOne :: StateT (Int, Modes) (Parse Char) (Char -> Bool)
parseOne = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Eq a => a -> a -> Bool
(==) StateT (Int, Modes) (Parse Char) Char
parseChar forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` StateT (Int, Modes) (Parse Char) (Char -> Bool)
parseCharArea
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` StateT (Int, Modes) (Parse Char) (Char -> Bool)
parseCharClass
parseChar :: StateT (Int, Modes) (Parse Char) Char
parseChar = forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
isAlphaNum forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
( forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'\\' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
isSymbol ) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot (Char -> Bool
selfTest forall a. (a -> Bool) -> (a -> Bool) -> a -> Bool
&&& forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Modes
"-]" ) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Modes
".+$" ) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
( forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'[' forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) b a. Monad m => m b -> a -> m a
skipRet (forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot ()
forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
':') )
parseCharArea :: StateT (Int, Modes) (Parse Char) (Char -> Bool)
parseCharArea = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Ix a => (a, a) -> a -> Bool
inRange forall a b. (a -> b) -> a -> b
$ (StateT (Int, Modes) (Parse Char) Char
parseChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) b a. Monad m => m b -> a -> m a
skipRet (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'-')) forall (m :: * -> *) a b. Monad m => m a -> m b -> m (a, b)
>..> StateT (Int, Modes) (Parse Char) Char
parseChar
parseCharClass :: StateT (Int, Modes) (Parse Char) (Char -> Bool)
parseCharClass = forall (m :: * -> *) b a. MonadPlus m => (b -> m a) -> [b] -> m a
concatMapParse
(\(Modes
s, Char -> Bool
p) -> forall a (m :: * -> *). (Eq a, MonadParse a m) => [a] -> m [a]
tokens (Modes
"[:"forall a. [a] -> [a] -> [a]
++Modes
sforall a. [a] -> [a] -> [a]
++Modes
":]") forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Char -> Bool
p)
[(Modes, Char -> Bool)]
charClassList
concatMapParse :: MonadPlus m => (b -> m a) -> [b] -> m a
concatMapParse :: forall (m :: * -> *) b a. MonadPlus m => (b -> m a) -> [b] -> m a
concatMapParse b -> m a
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m a
f) forall (m :: * -> *) a. MonadPlus m => m a
mzero
parseOpenBrace :: RegexSrcParser RegexAction
parseOpenBrace :: RegexSrcParser RegexAction
parseOpenBrace = do forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot () StateT (Int, Modes) (Parse Char) (RegexAction -> RegexAction)
parseQuantifier
forall a (m :: * -> *) b. MonadParse a m => m b -> m b
still forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) c b. MonadParse a m => c -> m b -> m c
parseNot () RegexSrcParser RegexAction
parseBackReference
Char
ret <- forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'{'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> RegexAction
Select (forall a. Eq a => a -> a -> Bool
==Char
ret)
parseBackReference :: RegexSrcParser RegexAction
parseBackReference :: RegexSrcParser RegexAction
parseBackReference = do
Bool
brace <- forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
optional (forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'{')
Char
_ <- forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'\\'
Modes
dgt <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
greedyNeList (forall a (m :: * -> *). MonadParse a m => (a -> Bool) -> m a
spot Char -> Bool
isDigit)
Char
_ <- if Bool
brace then forall (m :: * -> *) a. Monad m => a -> m a
return Char
' ' else forall a (m :: * -> *). (Eq a, MonadParse a m) => a -> m a
token Char
'}'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> RegexAction
BackReference forall a b. (a -> b) -> a -> b
$ forall a. Read a => Modes -> a
read Modes
dgt