module Hidden.RegexPRTypes (
reverseRegexAction
, RegexSrcParser
, getBR
, modifyBR
, isModeI
, isModeM
, isModeX
, setMode
, setModes
, getModes
, runRegexSrcParser
, RegexAction(..)
, RegexResult
, VerboseResult
, MatchList
, RegexParser
, runRegexParser
, MatchFun
, VerboseMatchFun
) where
import Text.ParserCombinators.MTLParse ( Parse, runParse )
import Control.Monad.State ( StateT, runStateT, gets, modify )
import Control.Monad.Reader ( ReaderT(runReaderT) )
import Control.Arrow ( first, second )
type RegexResult = ( String, (String, String) )
type MatchList = [ (Int, String) ]
type RegexParser = ReaderT (String, String) (StateT MatchList (Parse Char))
runRegexParser ::
(String, String) ->
RegexParser a -> (String, String) -> [((a, MatchList), (String, String))]
runRegexParser :: forall a.
([Char], [Char])
-> RegexParser a
-> ([Char], [Char])
-> [((a, MatchList), ([Char], [Char]))]
runRegexParser ([Char], [Char])
point = Parse Char (a, MatchList)
-> ([Char], [Char]) -> [((a, MatchList), ([Char], [Char]))]
forall a b. Parse a b -> ([a], [a]) -> [(b, ([a], [a]))]
runParse (Parse Char (a, MatchList)
-> ([Char], [Char]) -> [((a, MatchList), ([Char], [Char]))])
-> (RegexParser a -> Parse Char (a, MatchList))
-> RegexParser a
-> ([Char], [Char])
-> [((a, MatchList), ([Char], [Char]))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT MatchList (Parse Char) a
-> MatchList -> Parse Char (a, MatchList))
-> MatchList
-> StateT MatchList (Parse Char) a
-> Parse Char (a, MatchList)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT MatchList (Parse Char) a
-> MatchList -> Parse Char (a, MatchList)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT [] (StateT MatchList (Parse Char) a -> Parse Char (a, MatchList))
-> (RegexParser a -> StateT MatchList (Parse Char) a)
-> RegexParser a
-> Parse Char (a, MatchList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RegexParser a
-> ([Char], [Char]) -> StateT MatchList (Parse Char) a)
-> ([Char], [Char])
-> RegexParser a
-> StateT MatchList (Parse Char) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip RegexParser a
-> ([Char], [Char]) -> StateT MatchList (Parse Char) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ([Char], [Char])
point
type Modes = String
type RegexSrcParser = StateT (Int, Modes) (Parse Char)
getBR :: RegexSrcParser Int
getBR :: RegexSrcParser Int
getBR = ((Int, [Char]) -> Int) -> RegexSrcParser Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int, [Char]) -> Int
forall a b. (a, b) -> a
fst
modifyBR :: (Int -> Int) -> RegexSrcParser ()
modifyBR :: (Int -> Int) -> RegexSrcParser ()
modifyBR = ((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ())
-> ((Int -> Int) -> (Int, [Char]) -> (Int, [Char]))
-> (Int -> Int)
-> RegexSrcParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> (Int, [Char]) -> (Int, [Char])
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first
setMode :: Char -> Bool -> RegexSrcParser ()
setMode :: Char -> Bool -> RegexSrcParser ()
setMode Char
c Bool
True = ((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ())
-> ((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> (Int, [Char]) -> (Int, [Char])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (Char
cChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:)
setMode Char
c Bool
False = ((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ())
-> ((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> (Int, [Char]) -> (Int, [Char])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
c))
getModes :: RegexSrcParser Modes
getModes :: RegexSrcParser [Char]
getModes = ((Int, [Char]) -> [Char]) -> RegexSrcParser [Char]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int, [Char]) -> [Char]
forall a b. (a, b) -> b
snd
setModes :: Modes -> RegexSrcParser ()
setModes :: [Char] -> RegexSrcParser ()
setModes [Char]
ms = ((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ())
-> ((Int, [Char]) -> (Int, [Char])) -> RegexSrcParser ()
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> (Int, [Char]) -> (Int, [Char])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Char] -> [Char]) -> (Int, [Char]) -> (Int, [Char]))
-> ([Char] -> [Char]) -> (Int, [Char]) -> (Int, [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall a b. a -> b -> a
const [Char]
ms
isModeI, isModeM, isModeX :: RegexSrcParser Bool
isModeI :: RegexSrcParser Bool
isModeI = ((Int, [Char]) -> Bool) -> RegexSrcParser Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (((Int, [Char]) -> Bool) -> RegexSrcParser Bool)
-> ((Int, [Char]) -> Bool) -> RegexSrcParser Bool
forall a b. (a -> b) -> a -> b
$ Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
'i' ([Char] -> Bool)
-> ((Int, [Char]) -> [Char]) -> (Int, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Char]) -> [Char]
forall a b. (a, b) -> b
snd
isModeM :: RegexSrcParser Bool
isModeM = ((Int, [Char]) -> Bool) -> RegexSrcParser Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (((Int, [Char]) -> Bool) -> RegexSrcParser Bool)
-> ((Int, [Char]) -> Bool) -> RegexSrcParser Bool
forall a b. (a -> b) -> a -> b
$ Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
'm' ([Char] -> Bool)
-> ((Int, [Char]) -> [Char]) -> (Int, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Char]) -> [Char]
forall a b. (a, b) -> b
snd
isModeX :: RegexSrcParser Bool
isModeX = ((Int, [Char]) -> Bool) -> RegexSrcParser Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (((Int, [Char]) -> Bool) -> RegexSrcParser Bool)
-> ((Int, [Char]) -> Bool) -> RegexSrcParser Bool
forall a b. (a -> b) -> a -> b
$ Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
'x' ([Char] -> Bool)
-> ((Int, [Char]) -> [Char]) -> (Int, [Char]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [Char]) -> [Char]
forall a b. (a, b) -> b
snd
runRegexSrcParser :: RegexSrcParser a -> Parse Char (a, (Int,String))
runRegexSrcParser :: forall a. RegexSrcParser a -> Parse Char (a, (Int, [Char]))
runRegexSrcParser = (RegexSrcParser a
-> (Int, [Char]) -> Parse Char (a, (Int, [Char])))
-> (Int, [Char])
-> RegexSrcParser a
-> Parse Char (a, (Int, [Char]))
forall a b c. (a -> b -> c) -> b -> a -> c
flip RegexSrcParser a -> (Int, [Char]) -> Parse Char (a, (Int, [Char]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Int
1, [Char]
"")
data RegexAction = Select (Char -> Bool) |
Repeat Int (Maybe Int) RegexAction |
RepeatNotGreedy Int (Maybe Int) RegexAction |
RegexOr [RegexAction] [RegexAction] |
Note Int [RegexAction] | BackReference Int |
Still [RegexAction] | Backword [RegexAction] |
RegActNot [RegexAction] |
BeginningOfInput | EndOfInput |
PreMatchPoint | Parens [RegexAction] |
String | NopRegex |
NoBacktrack [RegexAction]
reverseRegexAction :: RegexAction -> RegexAction
reverseRegexAction :: RegexAction -> RegexAction
reverseRegexAction (Note Int
i [RegexAction]
ras)
= Int -> [RegexAction] -> RegexAction
Note Int
i ([RegexAction] -> RegexAction) -> [RegexAction] -> RegexAction
forall a b. (a -> b) -> a -> b
$ [RegexAction] -> [RegexAction]
forall a. [a] -> [a]
reverse ([RegexAction] -> [RegexAction]) -> [RegexAction] -> [RegexAction]
forall a b. (a -> b) -> a -> b
$ (RegexAction -> RegexAction) -> [RegexAction] -> [RegexAction]
forall a b. (a -> b) -> [a] -> [b]
map RegexAction -> RegexAction
reverseRegexAction [RegexAction]
ras
reverseRegexAction (Parens [RegexAction]
ras)
= [RegexAction] -> RegexAction
Parens ([RegexAction] -> RegexAction) -> [RegexAction] -> RegexAction
forall a b. (a -> b) -> a -> b
$ [RegexAction] -> [RegexAction]
forall a. [a] -> [a]
reverse ([RegexAction] -> [RegexAction]) -> [RegexAction] -> [RegexAction]
forall a b. (a -> b) -> a -> b
$ (RegexAction -> RegexAction) -> [RegexAction] -> [RegexAction]
forall a b. (a -> b) -> [a] -> [b]
map RegexAction -> RegexAction
reverseRegexAction [RegexAction]
ras
reverseRegexAction (RegexOr [RegexAction]
ras1 [RegexAction]
ras2)
= [RegexAction] -> [RegexAction] -> RegexAction
RegexOr ([RegexAction] -> [RegexAction]
forall a. [a] -> [a]
reverse ([RegexAction] -> [RegexAction]) -> [RegexAction] -> [RegexAction]
forall a b. (a -> b) -> a -> b
$ (RegexAction -> RegexAction) -> [RegexAction] -> [RegexAction]
forall a b. (a -> b) -> [a] -> [b]
map RegexAction -> RegexAction
reverseRegexAction [RegexAction]
ras1)
([RegexAction] -> [RegexAction]
forall a. [a] -> [a]
reverse ([RegexAction] -> [RegexAction]) -> [RegexAction] -> [RegexAction]
forall a b. (a -> b) -> a -> b
$ (RegexAction -> RegexAction) -> [RegexAction] -> [RegexAction]
forall a b. (a -> b) -> [a] -> [b]
map RegexAction -> RegexAction
reverseRegexAction [RegexAction]
ras2)
reverseRegexAction RegexAction
ra = RegexAction
ra
type MatchFun f
= String -> String -> f ( RegexResult, MatchList )
type VerboseResult = ( String, String, (String, String) )
type VerboseMatchFun f
= String -> (String, String) -> f ( VerboseResult, MatchList )