{-# LANGUAGE GADTs #-}
module Text.Regex.Applicative.Reference (reference) where
import Prelude hiding (getChar)
import Text.Regex.Applicative.Types
import Control.Applicative
import Control.Monad
newtype P s a = P { forall s a. P s a -> [s] -> [(a, [s])]
unP :: [s] -> [(a, [s])] }
instance Monad (P s) where
return :: forall a. a -> P s a
return a
x = ([s] -> [(a, [s])]) -> P s a
forall s a. ([s] -> [(a, [s])]) -> P s a
P (([s] -> [(a, [s])]) -> P s a) -> ([s] -> [(a, [s])]) -> P s a
forall a b. (a -> b) -> a -> b
$ \[s]
s -> [(a
x, [s]
s)]
(P [s] -> [(a, [s])]
a) >>= :: forall a b. P s a -> (a -> P s b) -> P s b
>>= a -> P s b
k = ([s] -> [(b, [s])]) -> P s b
forall s a. ([s] -> [(a, [s])]) -> P s a
P (([s] -> [(b, [s])]) -> P s b) -> ([s] -> [(b, [s])]) -> P s b
forall a b. (a -> b) -> a -> b
$ \[s]
s ->
[s] -> [(a, [s])]
a [s]
s [(a, [s])] -> ((a, [s]) -> [(b, [s])]) -> [(b, [s])]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x,[s]
s) -> P s b -> [s] -> [(b, [s])]
forall s a. P s a -> [s] -> [(a, [s])]
unP (a -> P s b
k a
x) [s]
s
instance Functor (P s) where
fmap :: forall a b. (a -> b) -> P s a -> P s b
fmap = (a -> b) -> P s a -> P s b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance Applicative (P s) where
<*> :: forall a b. P s (a -> b) -> P s a -> P s b
(<*>) = P s (a -> b) -> P s a -> P s b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
pure :: forall a. a -> P s a
pure = a -> P s a
forall a. a -> P s a
forall (m :: * -> *) a. Monad m => a -> m a
return
instance Alternative (P s) where
empty :: forall a. P s a
empty = ([s] -> [(a, [s])]) -> P s a
forall s a. ([s] -> [(a, [s])]) -> P s a
P (([s] -> [(a, [s])]) -> P s a) -> ([s] -> [(a, [s])]) -> P s a
forall a b. (a -> b) -> a -> b
$ [(a, [s])] -> [s] -> [(a, [s])]
forall a b. a -> b -> a
const []
P [s] -> [(a, [s])]
a1 <|> :: forall a. P s a -> P s a -> P s a
<|> P [s] -> [(a, [s])]
a2 = ([s] -> [(a, [s])]) -> P s a
forall s a. ([s] -> [(a, [s])]) -> P s a
P (([s] -> [(a, [s])]) -> P s a) -> ([s] -> [(a, [s])]) -> P s a
forall a b. (a -> b) -> a -> b
$ \[s]
s ->
[s] -> [(a, [s])]
a1 [s]
s [(a, [s])] -> [(a, [s])] -> [(a, [s])]
forall a. [a] -> [a] -> [a]
++ [s] -> [(a, [s])]
a2 [s]
s
getChar :: P s s
getChar :: forall s. P s s
getChar = ([s] -> [(s, [s])]) -> P s s
forall s a. ([s] -> [(a, [s])]) -> P s a
P (([s] -> [(s, [s])]) -> P s s) -> ([s] -> [(s, [s])]) -> P s s
forall a b. (a -> b) -> a -> b
$ \[s]
s ->
case [s]
s of
[] -> []
s
c:[s]
cs -> [(s
c,[s]
cs)]
re2monad :: RE s a -> P s a
re2monad :: forall s a. RE s a -> P s a
re2monad RE s a
r =
case RE s a
r of
RE s a
Eps -> a -> P s a
forall a. a -> P s a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> P s a) -> a -> P s a
forall a b. (a -> b) -> a -> b
$ [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"eps"
Symbol ThreadId
_ s -> Maybe a
p -> do
s
c <- P s s
forall s. P s s
getChar
case s -> Maybe a
p s
c of
Just a
r -> a -> P s a
forall a. a -> P s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
Maybe a
Nothing -> P s a
forall a. P s a
forall (f :: * -> *) a. Alternative f => f a
empty
Alt RE s a
a1 RE s a
a2 -> RE s a -> P s a
forall s a. RE s a -> P s a
re2monad RE s a
a1 P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RE s a -> P s a
forall s a. RE s a -> P s a
re2monad RE s a
a2
App RE s (a1 -> a)
a1 RE s a1
a2 -> RE s (a1 -> a) -> P s (a1 -> a)
forall s a. RE s a -> P s a
re2monad RE s (a1 -> a)
a1 P s (a1 -> a) -> P s a1 -> P s a
forall a b. P s (a -> b) -> P s a -> P s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a1 -> P s a1
forall s a. RE s a -> P s a
re2monad RE s a1
a2
Fmap a1 -> a
f RE s a1
a -> (a1 -> a) -> P s a1 -> P s a
forall a b. (a -> b) -> P s a -> P s b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a1 -> a
f (P s a1 -> P s a) -> P s a1 -> P s a
forall a b. (a -> b) -> a -> b
$ RE s a1 -> P s a1
forall s a. RE s a -> P s a
re2monad RE s a1
a
CatMaybes RE s (Maybe a)
a -> P s a -> (a -> P s a) -> Maybe a -> P s a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe P s a
forall a. P s a
forall (f :: * -> *) a. Alternative f => f a
empty a -> P s a
forall a. a -> P s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> P s a) -> P s (Maybe a) -> P s a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RE s (Maybe a) -> P s (Maybe a)
forall s a. RE s a -> P s a
re2monad RE s (Maybe a)
a
Rep Greediness
g a -> a1 -> a
f a
b RE s a1
a -> a -> P s a
rep a
b
where
am :: P s a1
am = RE s a1 -> P s a1
forall s a. RE s a -> P s a
re2monad RE s a1
a
rep :: a -> P s a
rep a
b = P s a -> P s a -> P s a
combine (do a1
a <- P s a1
am; a -> P s a
rep (a -> P s a) -> a -> P s a
forall a b. (a -> b) -> a -> b
$ a -> a1 -> a
f a
b a1
a) (a -> P s a
forall a. a -> P s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b)
combine :: P s a -> P s a -> P s a
combine P s a
a P s a
b = case Greediness
g of Greediness
Greedy -> P s a
a P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P s a
b; Greediness
NonGreedy -> P s a
b P s a -> P s a -> P s a
forall a. P s a -> P s a -> P s a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P s a
a
Void RE s a1
a -> RE s a1 -> P s a1
forall s a. RE s a -> P s a
re2monad RE s a1
a P s a1 -> P s a -> P s a
forall a b. P s a -> P s b -> P s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> P s a
forall a. a -> P s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
RE s a
Fail -> P s a
forall a. P s a
forall (f :: * -> *) a. Alternative f => f a
empty
runP :: P s a -> [s] -> Maybe a
runP :: forall s a. P s a -> [s] -> Maybe a
runP P s a
m [s]
s = case ((a, [s]) -> Bool) -> [(a, [s])] -> [(a, [s])]
forall a. (a -> Bool) -> [a] -> [a]
filter ([s] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([s] -> Bool) -> ((a, [s]) -> [s]) -> (a, [s]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, [s]) -> [s]
forall a b. (a, b) -> b
snd) ([(a, [s])] -> [(a, [s])]) -> [(a, [s])] -> [(a, [s])]
forall a b. (a -> b) -> a -> b
$ P s a -> [s] -> [(a, [s])]
forall s a. P s a -> [s] -> [(a, [s])]
unP P s a
m [s]
s of
(a
r, [s]
_) : [(a, [s])]
_ -> a -> Maybe a
forall a. a -> Maybe a
Just a
r
[(a, [s])]
_ -> Maybe a
forall a. Maybe a
Nothing
reference :: RE s a -> [s] -> Maybe a
reference :: forall s a. RE s a -> [s] -> Maybe a
reference RE s a
r [s]
s = P s a -> [s] -> Maybe a
forall s a. P s a -> [s] -> Maybe a
runP (RE s a -> P s a
forall s a. RE s a -> P s a
re2monad RE s a
r) [s]
s