{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Text.Regex.Applicative.Types where
import Control.Applicative
import Control.Monad ((<=<))
import Data.Filtrable (Filtrable (..))
import Data.Functor.Identity (Identity (..))
import Data.String
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#endif
newtype ThreadId = ThreadId Int
data Thread s r
= Thread
{ forall s r. Thread s r -> ThreadId
threadId_ :: ThreadId
, forall s r. Thread s r -> s -> [Thread s r]
_threadCont :: s -> [Thread s r]
}
| Accept r
threadId :: Thread s r -> Maybe ThreadId
threadId :: forall s r. Thread s r -> Maybe ThreadId
threadId Thread { threadId_ :: forall s r. Thread s r -> ThreadId
threadId_ = ThreadId
i } = forall a. a -> Maybe a
Just ThreadId
i
threadId Thread s r
_ = forall a. Maybe a
Nothing
data Greediness = Greedy | NonGreedy
deriving (Int -> Greediness -> ShowS
[Greediness] -> ShowS
Greediness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Greediness] -> ShowS
$cshowList :: [Greediness] -> ShowS
show :: Greediness -> String
$cshow :: Greediness -> String
showsPrec :: Int -> Greediness -> ShowS
$cshowsPrec :: Int -> Greediness -> ShowS
Show, ReadPrec [Greediness]
ReadPrec Greediness
Int -> ReadS Greediness
ReadS [Greediness]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Greediness]
$creadListPrec :: ReadPrec [Greediness]
readPrec :: ReadPrec Greediness
$creadPrec :: ReadPrec Greediness
readList :: ReadS [Greediness]
$creadList :: ReadS [Greediness]
readsPrec :: Int -> ReadS Greediness
$creadsPrec :: Int -> ReadS Greediness
Read, Greediness -> Greediness -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Greediness -> Greediness -> Bool
$c/= :: Greediness -> Greediness -> Bool
== :: Greediness -> Greediness -> Bool
$c== :: Greediness -> Greediness -> Bool
Eq, Eq Greediness
Greediness -> Greediness -> Bool
Greediness -> Greediness -> Ordering
Greediness -> Greediness -> Greediness
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Greediness -> Greediness -> Greediness
$cmin :: Greediness -> Greediness -> Greediness
max :: Greediness -> Greediness -> Greediness
$cmax :: Greediness -> Greediness -> Greediness
>= :: Greediness -> Greediness -> Bool
$c>= :: Greediness -> Greediness -> Bool
> :: Greediness -> Greediness -> Bool
$c> :: Greediness -> Greediness -> Bool
<= :: Greediness -> Greediness -> Bool
$c<= :: Greediness -> Greediness -> Bool
< :: Greediness -> Greediness -> Bool
$c< :: Greediness -> Greediness -> Bool
compare :: Greediness -> Greediness -> Ordering
$ccompare :: Greediness -> Greediness -> Ordering
Ord, Int -> Greediness
Greediness -> Int
Greediness -> [Greediness]
Greediness -> Greediness
Greediness -> Greediness -> [Greediness]
Greediness -> Greediness -> Greediness -> [Greediness]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Greediness -> Greediness -> Greediness -> [Greediness]
$cenumFromThenTo :: Greediness -> Greediness -> Greediness -> [Greediness]
enumFromTo :: Greediness -> Greediness -> [Greediness]
$cenumFromTo :: Greediness -> Greediness -> [Greediness]
enumFromThen :: Greediness -> Greediness -> [Greediness]
$cenumFromThen :: Greediness -> Greediness -> [Greediness]
enumFrom :: Greediness -> [Greediness]
$cenumFrom :: Greediness -> [Greediness]
fromEnum :: Greediness -> Int
$cfromEnum :: Greediness -> Int
toEnum :: Int -> Greediness
$ctoEnum :: Int -> Greediness
pred :: Greediness -> Greediness
$cpred :: Greediness -> Greediness
succ :: Greediness -> Greediness
$csucc :: Greediness -> Greediness
Enum)
data RE s a where
Eps :: RE s ()
Symbol :: ThreadId -> (s -> Maybe a) -> RE s a
Alt :: RE s a -> RE s a -> RE s a
App :: RE s (a -> b) -> RE s a -> RE s b
Fmap :: (a -> b) -> RE s a -> RE s b
CatMaybes :: RE s (Maybe a) -> RE s a
Fail :: RE s a
Rep :: Greediness
-> (b -> a -> b)
-> b
-> RE s a
-> RE s b
Void :: RE s a -> RE s ()
traversePostorder :: forall s a m . Monad m => (forall a . RE s a -> m (RE s a)) -> RE s a -> m (RE s a)
traversePostorder :: forall s a (m :: * -> *).
Monad m =>
(forall a. RE s a -> m (RE s a)) -> RE s a -> m (RE s a)
traversePostorder forall a. RE s a -> m (RE s a)
f = forall a. RE s a -> m (RE s a)
go
where
go :: forall a . RE s a -> m (RE s a)
go :: forall a. RE s a -> m (RE s a)
go = forall a. RE s a -> m (RE s a)
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< \ case
RE s a
Eps -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall s. RE s ()
Eps
Symbol ThreadId
i s -> Maybe a
p -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall s a. ThreadId -> (s -> Maybe a) -> RE s a
Symbol ThreadId
i s -> Maybe a
p)
Alt RE s a
a RE s a
b -> forall s a. RE s a -> RE s a -> RE s a
Alt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RE s a -> m (RE s a)
go RE s a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. RE s a -> m (RE s a)
go RE s a
b
App RE s (a -> a)
a RE s a
b -> forall s a b. RE s (a -> b) -> RE s a -> RE s b
App forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RE s a -> m (RE s a)
go RE s (a -> a)
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. RE s a -> m (RE s a)
go RE s a
b
Fmap a -> a
g RE s a
a -> forall a b s. (a -> b) -> RE s a -> RE s b
Fmap a -> a
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RE s a -> m (RE s a)
go RE s a
a
CatMaybes RE s (Maybe a)
a -> forall s a. RE s (Maybe a) -> RE s a
CatMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RE s a -> m (RE s a)
go RE s (Maybe a)
a
RE s a
Fail -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall s a. RE s a
Fail
Rep Greediness
greed a -> a -> a
g a
b RE s a
a -> forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
Rep Greediness
greed a -> a -> a
g a
b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RE s a -> m (RE s a)
go RE s a
a
Void RE s a
a -> forall s a. RE s a -> RE s ()
Void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RE s a -> m (RE s a)
go RE s a
a
foldMapPostorder :: Monoid b => (forall a . RE s a -> b) -> RE s a -> b
foldMapPostorder :: forall b s a. Monoid b => (forall a. RE s a -> b) -> RE s a -> b
foldMapPostorder forall a. RE s a -> b
f = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a (m :: * -> *).
Monad m =>
(forall a. RE s a -> m (RE s a)) -> RE s a -> m (RE s a)
traversePostorder ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RE s a -> b
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> a
id)
mapRE :: (forall a . RE s a -> RE s a) -> RE s a -> RE s a
mapRE :: forall s a. (forall a. RE s a -> RE s a) -> RE s a -> RE s a
mapRE forall a. RE s a -> RE s a
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a (m :: * -> *).
Monad m =>
(forall a. RE s a -> m (RE s a)) -> RE s a -> m (RE s a)
traversePostorder (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RE s a -> RE s a
f)
instance Functor (RE s) where
fmap :: forall a b. (a -> b) -> RE s a -> RE s b
fmap a -> b
f RE s a
x = forall a b s. (a -> b) -> RE s a -> RE s b
Fmap a -> b
f RE s a
x
a
f <$ :: forall a b. a -> RE s b -> RE s a
<$ RE s b
x = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
f forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* RE s b
x
instance Applicative (RE s) where
pure :: forall a. a -> RE s a
pure a
x = forall a b. a -> b -> a
const a
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. RE s ()
Eps
RE s (a -> b)
a1 <*> :: forall a b. RE s (a -> b) -> RE s a -> RE s b
<*> RE s a
a2 = forall s a b. RE s (a -> b) -> RE s a -> RE s b
App RE s (a -> b)
a1 RE s a
a2
RE s a
a *> :: forall a b. RE s a -> RE s b -> RE s b
*> RE s b
b = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> b -> a
const forall a. a -> a
id) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a. RE s a -> RE s ()
Void RE s a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s b
b
RE s a
a <* :: forall a b. RE s a -> RE s b -> RE s a
<* RE s b
b = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. a -> b -> a
const forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a. RE s a -> RE s ()
Void RE s b
b
instance Alternative (RE s) where
RE s a
a1 <|> :: forall a. RE s a -> RE s a -> RE s a
<|> RE s a
a2 = forall s a. RE s a -> RE s a -> RE s a
Alt RE s a
a1 RE s a
a2
empty :: forall a. RE s a
empty = forall s a. RE s a
Fail
many :: forall a. RE s a -> RE s [a]
many RE s a
a = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
Rep Greediness
Greedy (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] RE s a
a
some :: forall a. RE s a -> RE s [a]
some RE s a
a = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE s a
a
instance Filtrable (RE s) where
catMaybes :: forall a. RE s (Maybe a) -> RE s a
catMaybes = forall s a. RE s (Maybe a) -> RE s a
CatMaybes
instance (char ~ Char, string ~ String) => IsString (RE char string) where
fromString :: String -> RE char string
fromString = forall a. Eq a => [a] -> RE a [a]
string
instance Semigroup a => Semigroup (RE s a) where
RE s a
x <> :: RE s a -> RE s a -> RE s a
<> RE s a
y = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a
y
instance Monoid a => Monoid (RE s a) where
mempty :: RE s a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
string :: Eq a => [a] -> RE a [a]
string :: forall a. Eq a => [a] -> RE a [a]
string = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall s. Eq s => s -> RE s s
sym
psym :: (s -> Bool) -> RE s s
psym :: forall s. (s -> Bool) -> RE s s
psym s -> Bool
p = forall s a. (s -> Maybe a) -> RE s a
msym (\s
s -> if s -> Bool
p s
s then forall a. a -> Maybe a
Just s
s else forall a. Maybe a
Nothing)
msym :: (s -> Maybe a) -> RE s a
msym :: forall s a. (s -> Maybe a) -> RE s a
msym s -> Maybe a
p = forall s a. ThreadId -> (s -> Maybe a) -> RE s a
Symbol (forall a. HasCallStack => String -> a
error String
"Not numbered symbol") s -> Maybe a
p
sym :: Eq s => s -> RE s s
sym :: forall s. Eq s => s -> RE s s
sym s
s = forall s. (s -> Bool) -> RE s s
psym (s
s forall a. Eq a => a -> a -> Bool
==)