-- RegexPRCore.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.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)