-- RegexPRTypes.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.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]   |
		   Comment 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 (Still ras)
--  = Still $ reverse $ map reverseRegexAction ras
-- reverseRegexAction (Backword ras)
--  = Backword $ reverse $ map reverseRegexAction ras
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 )