-- ParseRegexStr.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 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