{-# 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 = forall s a. ([s] -> [(a, [s])]) -> P s a
P 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 = forall s a. ([s] -> [(a, [s])]) -> P s a
P forall a b. (a -> b) -> a -> b
$ \[s]
s ->
[s] -> [(a, [s])]
a [s]
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(a
x,[s]
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 = 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
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
pure :: forall a. a -> P s a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
instance Alternative (P s) where
empty :: forall a. P s a
empty = forall s a. ([s] -> [(a, [s])]) -> P s a
P forall a b. (a -> b) -> a -> b
$ 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 = forall s a. ([s] -> [(a, [s])]) -> P s a
P forall a b. (a -> b) -> a -> b
$ \[s]
s ->
[s] -> [(a, [s])]
a1 [s]
s forall a. [a] -> [a] -> [a]
++ [s] -> [(a, [s])]
a2 [s]
s
getChar :: P s s
getChar :: forall s. P s s
getChar = forall s a. ([s] -> [(a, [s])]) -> P s a
P 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"eps"
Symbol ThreadId
_ s -> Maybe a
p -> do
s
c <- forall s. P s s
getChar
case s -> Maybe a
p s
c of
Just a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return a
r
Maybe a
Nothing -> forall (f :: * -> *) a. Alternative f => f a
empty
Alt RE s a
a1 RE s a
a2 -> forall s a. RE s a -> P s a
re2monad RE s a
a1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s a. RE s a -> P s a
re2monad RE s a
a2
App RE s (a -> a)
a1 RE s a
a2 -> forall s a. RE s a -> P s a
re2monad RE s (a -> a)
a1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a. RE s a -> P s a
re2monad RE s a
a2
Fmap a -> a
f RE s a
a -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f forall a b. (a -> b) -> a -> b
$ forall s a. RE s a -> P s a
re2monad RE s a
a
CatMaybes RE s (Maybe a)
a -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s a. RE s a -> P s a
re2monad RE s (Maybe a)
a
Rep Greediness
g a -> a -> a
f a
b RE s a
a -> a -> P s a
rep a
b
where
am :: P s a
am = forall s a. RE s a -> P s a
re2monad RE s a
a
rep :: a -> P s a
rep a
b = P s a -> P s a -> P s a
combine (do a
a <- P s a
am; a -> P s a
rep forall a b. (a -> b) -> a -> b
$ a -> a -> a
f a
b a
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 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P s a
b; Greediness
NonGreedy -> P s a
b forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> P s a
a
Void RE s a
a -> forall s a. RE s a -> P s a
re2monad RE s a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
RE s a
Fail -> 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 forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall s a. P s a -> [s] -> [(a, [s])]
unP P s a
m [s]
s of
(a
r, [s]
_) : [(a, [s])]
_ -> forall a. a -> Maybe a
Just a
r
[(a, [s])]
_ -> 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 = forall s a. P s a -> [s] -> Maybe a
runP (forall s a. RE s a -> P s a
re2monad RE s a
r) [s]
s