{-# LANGUAGE GADTs #-}
module Text.Regex.Applicative.Object
( ReObject
, compile
, emptyObject
, Thread
, threads
, failed
, isResult
, getResult
, results
, ThreadId
, threadId
, step
, stepThread
, fromThreads
, addThread
) where
import Text.Regex.Applicative.Types
import qualified Text.Regex.Applicative.StateQueue as SQ
import qualified Text.Regex.Applicative.Compile as Compile
import Data.Maybe
import Data.Foldable as F
import Control.Monad.Trans.State
import Control.Applicative hiding (empty)
newtype ReObject s r = ReObject (SQ.StateQueue (Thread s r))
threads :: ReObject s r -> [Thread s r]
threads :: ReObject s r -> [Thread s r]
threads (ReObject sq :: StateQueue (Thread s r)
sq) = StateQueue (Thread s r) -> [Thread s r]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList StateQueue (Thread s r)
sq
fromThreads :: [Thread s r] -> ReObject s r
fromThreads :: [Thread s r] -> ReObject s r
fromThreads ts :: [Thread s r]
ts = (ReObject s r -> Thread s r -> ReObject s r)
-> ReObject s r -> [Thread s r] -> ReObject s r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((Thread s r -> ReObject s r -> ReObject s r)
-> ReObject s r -> Thread s r -> ReObject s r
forall a b c. (a -> b -> c) -> b -> a -> c
flip Thread s r -> ReObject s r -> ReObject s r
forall s r. Thread s r -> ReObject s r -> ReObject s r
addThread) ReObject s r
forall s r. ReObject s r
emptyObject [Thread s r]
ts
isResult :: Thread s r -> Bool
isResult :: Thread s r -> Bool
isResult Accept {} = Bool
True
isResult _ = Bool
False
getResult :: Thread s r -> Maybe r
getResult :: Thread s r -> Maybe r
getResult (Accept r :: r
r) = r -> Maybe r
forall a. a -> Maybe a
Just r
r
getResult _ = Maybe r
forall a. Maybe a
Nothing
failed :: ReObject s r -> Bool
failed :: ReObject s r -> Bool
failed obj :: ReObject s r
obj = [Thread s r] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Thread s r] -> Bool) -> [Thread s r] -> Bool
forall a b. (a -> b) -> a -> b
$ ReObject s r -> [Thread s r]
forall s r. ReObject s r -> [Thread s r]
threads ReObject s r
obj
emptyObject :: ReObject s r
emptyObject :: ReObject s r
emptyObject = StateQueue (Thread s r) -> ReObject s r
forall s r. StateQueue (Thread s r) -> ReObject s r
ReObject (StateQueue (Thread s r) -> ReObject s r)
-> StateQueue (Thread s r) -> ReObject s r
forall a b. (a -> b) -> a -> b
$ StateQueue (Thread s r)
forall a. StateQueue a
SQ.empty
results :: ReObject s r -> [r]
results :: ReObject s r -> [r]
results obj :: ReObject s r
obj =
(Thread s r -> Maybe r) -> [Thread s r] -> [r]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Thread s r -> Maybe r
forall s r. Thread s r -> Maybe r
getResult ([Thread s r] -> [r]) -> [Thread s r] -> [r]
forall a b. (a -> b) -> a -> b
$ ReObject s r -> [Thread s r]
forall s r. ReObject s r -> [Thread s r]
threads ReObject s r
obj
step :: s -> ReObject s r -> ReObject s r
step :: s -> ReObject s r -> ReObject s r
step s :: s
s (ReObject sq :: StateQueue (Thread s r)
sq) =
let accum :: ReObject s r -> Thread s r -> ReObject s r
accum q :: ReObject s r
q t :: Thread s r
t =
case Thread s r
t of
Accept {} -> ReObject s r
q
Thread _ c :: s -> [Thread s r]
c ->
(ReObject s r -> Thread s r -> ReObject s r)
-> ReObject s r -> [Thread s r] -> ReObject s r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' (\q :: ReObject s r
q x :: Thread s r
x -> Thread s r -> ReObject s r -> ReObject s r
forall s r. Thread s r -> ReObject s r -> ReObject s r
addThread Thread s r
x ReObject s r
q) ReObject s r
q ([Thread s r] -> ReObject s r) -> [Thread s r] -> ReObject s r
forall a b. (a -> b) -> a -> b
$ s -> [Thread s r]
c s
s
newQueue :: ReObject s r
newQueue = (ReObject s r -> Thread s r -> ReObject s r)
-> ReObject s r -> StateQueue (Thread s r) -> ReObject s r
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ReObject s r -> Thread s r -> ReObject s r
accum ReObject s r
forall s r. ReObject s r
emptyObject StateQueue (Thread s r)
sq
in ReObject s r
newQueue
stepThread :: s -> Thread s r -> [Thread s r]
stepThread :: s -> Thread s r -> [Thread s r]
stepThread s :: s
s t :: Thread s r
t =
case Thread s r
t of
Thread _ c :: s -> [Thread s r]
c -> s -> [Thread s r]
c s
s
Accept {} -> [Char] -> [Thread s r]
forall a. HasCallStack => [Char] -> a
error "stepThread on a result"
addThread :: Thread s r -> ReObject s r -> ReObject s r
addThread :: Thread s r -> ReObject s r -> ReObject s r
addThread t :: Thread s r
t (ReObject q :: StateQueue (Thread s r)
q) =
case Thread s r
t of
Accept {} -> StateQueue (Thread s r) -> ReObject s r
forall s r. StateQueue (Thread s r) -> ReObject s r
ReObject (StateQueue (Thread s r) -> ReObject s r)
-> StateQueue (Thread s r) -> ReObject s r
forall a b. (a -> b) -> a -> b
$ Thread s r -> StateQueue (Thread s r) -> StateQueue (Thread s r)
forall a. a -> StateQueue a -> StateQueue a
SQ.insert Thread s r
t StateQueue (Thread s r)
q
Thread { threadId_ :: forall s r. Thread s r -> ThreadId
threadId_ = ThreadId i :: Int
i } -> StateQueue (Thread s r) -> ReObject s r
forall s r. StateQueue (Thread s r) -> ReObject s r
ReObject (StateQueue (Thread s r) -> ReObject s r)
-> StateQueue (Thread s r) -> ReObject s r
forall a b. (a -> b) -> a -> b
$ Int
-> Thread s r -> StateQueue (Thread s r) -> StateQueue (Thread s r)
forall a. Int -> a -> StateQueue a -> StateQueue a
SQ.insertUnique Int
i Thread s r
t StateQueue (Thread s r)
q
compile :: RE s r -> ReObject s r
compile :: RE s r -> ReObject s r
compile =
[Thread s r] -> ReObject s r
forall s r. [Thread s r] -> ReObject s r
fromThreads ([Thread s r] -> ReObject s r)
-> (RE s r -> [Thread s r]) -> RE s r -> ReObject s r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(RE s r -> (r -> [Thread s r]) -> [Thread s r])
-> (r -> [Thread s r]) -> RE s r -> [Thread s r]
forall a b c. (a -> b -> c) -> b -> a -> c
flip RE s r -> (r -> [Thread s r]) -> [Thread s r]
forall s a r. RE s a -> (a -> [Thread s r]) -> [Thread s r]
Compile.compile (\x :: r
x -> [r -> Thread s r
forall s r. r -> Thread s r
Accept r
x]) (RE s r -> [Thread s r])
-> (RE s r -> RE s r) -> RE s r -> [Thread s r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
RE s r -> RE s r
forall s a. RE s a -> RE s a
renumber
renumber :: RE s a -> RE s a
renumber :: RE s a -> RE s a
renumber e :: RE s a
e = (State ThreadId (RE s a) -> ThreadId -> RE s a)
-> ThreadId -> State ThreadId (RE s a) -> RE s a
forall a b c. (a -> b -> c) -> b -> a -> c
flip State ThreadId (RE s a) -> ThreadId -> RE s a
forall s a. State s a -> s -> a
evalState (Int -> ThreadId
ThreadId 1) (State ThreadId (RE s a) -> RE s a)
-> State ThreadId (RE s a) -> RE s a
forall a b. (a -> b) -> a -> b
$ RE s a -> State ThreadId (RE s a)
forall s a. RE s a -> State ThreadId (RE s a)
go RE s a
e
where
go :: RE s a -> State ThreadId (RE s a)
go :: RE s a -> State ThreadId (RE s a)
go e :: RE s a
e =
case RE s a
e of
Eps -> RE s () -> StateT ThreadId Identity (RE s ())
forall (m :: * -> *) a. Monad m => a -> m a
return RE s ()
forall s. RE s ()
Eps
Symbol _ p :: s -> Maybe a
p -> ThreadId -> (s -> Maybe a) -> RE s a
forall s a. ThreadId -> (s -> Maybe a) -> RE s a
Symbol (ThreadId -> (s -> Maybe a) -> RE s a)
-> StateT ThreadId Identity ThreadId
-> StateT ThreadId Identity ((s -> Maybe a) -> RE s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT ThreadId Identity ThreadId
fresh StateT ThreadId Identity ((s -> Maybe a) -> RE s a)
-> StateT ThreadId Identity (s -> Maybe a)
-> State ThreadId (RE s a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s -> Maybe a) -> StateT ThreadId Identity (s -> Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure s -> Maybe a
p
Alt a1 :: RE s a
a1 a2 :: RE s a
a2 -> RE s a -> RE s a -> RE s a
forall s a. RE s a -> RE s a -> RE s a
Alt (RE s a -> RE s a -> RE s a)
-> State ThreadId (RE s a)
-> StateT ThreadId Identity (RE s a -> RE s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a -> State ThreadId (RE s a)
forall s a. RE s a -> State ThreadId (RE s a)
go RE s a
a1 StateT ThreadId Identity (RE s a -> RE s a)
-> State ThreadId (RE s a) -> State ThreadId (RE s a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a -> State ThreadId (RE s a)
forall s a. RE s a -> State ThreadId (RE s a)
go RE s a
a2
App a1 :: RE s (a -> a)
a1 a2 :: RE s a
a2 -> RE s (a -> a) -> RE s a -> RE s a
forall s a b. RE s (a -> b) -> RE s a -> RE s b
App (RE s (a -> a) -> RE s a -> RE s a)
-> StateT ThreadId Identity (RE s (a -> a))
-> StateT ThreadId Identity (RE s a -> RE s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s (a -> a) -> StateT ThreadId Identity (RE s (a -> a))
forall s a. RE s a -> State ThreadId (RE s a)
go RE s (a -> a)
a1 StateT ThreadId Identity (RE s a -> RE s a)
-> StateT ThreadId Identity (RE s a) -> State ThreadId (RE s a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE s a -> StateT ThreadId Identity (RE s a)
forall s a. RE s a -> State ThreadId (RE s a)
go RE s a
a2
Fail -> RE s a -> State ThreadId (RE s a)
forall (m :: * -> *) a. Monad m => a -> m a
return RE s a
forall s a. RE s a
Fail
Fmap f :: a -> a
f a :: RE s a
a -> (a -> a) -> RE s a -> RE s a
forall a b s. (a -> b) -> RE s a -> RE s b
Fmap a -> a
f (RE s a -> RE s a)
-> StateT ThreadId Identity (RE s a) -> State ThreadId (RE s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a -> StateT ThreadId Identity (RE s a)
forall s a. RE s a -> State ThreadId (RE s a)
go RE s a
a
Rep g :: Greediness
g f :: a -> a -> a
f b :: a
b a :: RE s a
a -> Greediness -> (a -> a -> a) -> a -> RE s a -> RE s a
forall b a s. Greediness -> (b -> a -> b) -> b -> RE s a -> RE s b
Rep Greediness
g a -> a -> a
f a
b (RE s a -> RE s a)
-> StateT ThreadId Identity (RE s a) -> State ThreadId (RE s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a -> StateT ThreadId Identity (RE s a)
forall s a. RE s a -> State ThreadId (RE s a)
go RE s a
a
Void a :: RE s a
a -> RE s a -> RE s ()
forall s a. RE s a -> RE s ()
Void (RE s a -> RE s ())
-> StateT ThreadId Identity (RE s a)
-> StateT ThreadId Identity (RE s ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RE s a -> StateT ThreadId Identity (RE s a)
forall s a. RE s a -> State ThreadId (RE s a)
go RE s a
a
fresh :: State ThreadId ThreadId
fresh :: StateT ThreadId Identity ThreadId
fresh = do
t :: ThreadId
t@(ThreadId i :: Int
i) <- StateT ThreadId Identity ThreadId
forall (m :: * -> *) s. Monad m => StateT s m s
get
ThreadId -> StateT ThreadId Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (ThreadId -> StateT ThreadId Identity ())
-> ThreadId -> StateT ThreadId Identity ()
forall a b. (a -> b) -> a -> b
$! Int -> ThreadId
ThreadId (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1)
ThreadId -> StateT ThreadId Identity ThreadId
forall (m :: * -> *) a. Monad m => a -> m a
return ThreadId
t