    --------------------------------------------------------------------
    -- |
    -- Module    : Text.Regex.Applicative.Object
    -- Copyright : (c) Roman Cheplyaka
    -- License   : MIT
    --
    -- Maintainer: Roman Cheplyaka <roma@ro-che.info>
    -- Stability : experimental
    --
    -- This is a low-level interface to the regex engine.
    --------------------------------------------------------------------
    {-# 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

    -- | The state of the engine is represented as a \"regex object\" of type
    -- @'ReObject' s r@, where @s@ is the type of symbols and @r@ is the
    -- result type (as in the 'RE' type). Think of 'ReObject' as a collection of
    -- 'Thread's ordered by priority. E.g. threads generated by the left part of
    -- '<|>' come before the threads generated by the right part.
    newtype ReObject s r = ReObject (SQ.StateQueue (Thread s r))

    -- | List of all threads of an object. Each non-result thread has a unique id.
    threads :: ReObject s r -> [Thread s r]
    threads :: forall s r. ReObject s r -> [Thread s r]
    threads (ReObject StateQueue (Thread s r)
    sq) = StateQueue (Thread s r) -> [Thread s r]
    forall a. StateQueue a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList StateQueue (Thread s r)
    sq

    -- | Create an object from a list of threads. It is recommended that all
    -- threads come from the same 'ReObject', unless you know what you're doing.
    -- However, it should be safe to filter out or rearrange threads.
    fromThreads :: [Thread s r] -> ReObject s r
    fromThreads :: forall s r. [Thread s r] -> ReObject s r
    fromThreads [Thread s r]
    ts = (ReObject s r -> Thread s r -> ReObject s r)
    -> ReObject s r -> [Thread s r] -> ReObject s r
    forall b a. (b -> a -> b) -> b -> [a] -> b
    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

    -- | Check whether a thread is a result thread
    isResult :: Thread s r -> Bool
    isResult :: forall s r. Thread s r -> Bool
    isResult Accept {} = Bool
    True
    isResult Thread s r
    _ = Bool
    False

    -- | Return the result of a result thread, or 'Nothing' if it's not a result
    -- thread
    getResult :: Thread s r -> Maybe r
    getResult :: forall s r. Thread s r -> Maybe r
    getResult (Accept r
    r) = r -> Maybe r
    forall a. a -> Maybe a
    Just r
    r
    getResult Thread s r
    _ = Maybe r
    forall a. Maybe a
    Nothing

    -- | Check if the object has no threads. In that case it never will
    -- produce any new threads as a result of 'step'.
    failed :: ReObject s r -> Bool
    failed :: forall s r. ReObject s r -> Bool
    failed ReObject s r
    obj = [Thread s r] -> Bool
    forall a. [a] -> 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

    -- | Empty object (with no threads)
    emptyObject :: ReObject s r
    emptyObject :: forall s r. 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

    -- | Extract the result values from all the result threads of an object
    results :: ReObject s r -> [r]
    results :: forall s r. ReObject s r -> [r]
    results 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

    -- | Feed a symbol into a regex object
    step :: s -> ReObject s r -> ReObject s r
    step :: forall s r. s -> ReObject s r -> ReObject s r
    step s
    s (ReObject StateQueue (Thread s r)
    sq) =
        let accum :: ReObject s r -> Thread s r -> ReObject s r
    accum ReObject s r
    q Thread s r
    t =
                case Thread s r
    t of
                    Accept {} -> ReObject s r
    q
                    Thread ThreadId
    _ s -> [Thread s r]
    c ->
                        (ReObject s r -> Thread s r -> ReObject s r)
    -> ReObject s r -> [Thread s r] -> ReObject s r
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    F.foldl' (\ReObject s r
    q 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 b a. (b -> a -> b) -> b -> StateQueue a -> b
    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

    -- | Feed a symbol into a non-result thread. It is an error to call 'stepThread'
    -- on a result thread.
    stepThread :: s -> Thread s r -> [Thread s r]
    stepThread :: forall s r. s -> Thread s r -> [Thread s r]
    stepThread s
    s Thread s r
    t =
        case Thread s r
    t of
            Thread ThreadId
    _ s -> [Thread s r]
    c -> s -> [Thread s r]
    c s
    s
            Accept {} -> [Char] -> [Thread s r]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "stepThread on a result"

    -- | Add a thread to an object. The new thread will have lower priority than the
    -- threads which are already in the object.
    --
    -- If a (non-result) thread with the same id already exists in the object, the
    -- object is not changed.
    addThread :: Thread s r -> ReObject s r -> ReObject s r
    addThread :: forall s r. Thread s r -> ReObject s r -> ReObject s r
    addThread Thread s r
    t (ReObject 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 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 a regular expression into a regular expression object
    compile :: RE s r -> ReObject s r
    compile :: forall s r. 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 (\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 :: forall s a. RE s a -> RE s a
    renumber =
        (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 Int
    1) (State ThreadId (RE s a) -> RE s a)
    -> (RE s a -> State ThreadId (RE s a)) -> RE s a -> RE s a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
        (forall a1. RE s a1 -> StateT ThreadId Identity (RE s a1))
    -> RE s a -> State ThreadId (RE s a)
    forall s a (m :: * -> *).
    Monad m =>
    (forall a1. RE s a1 -> m (RE s a1)) -> RE s a -> m (RE s a)
    traversePostorder (\ case Symbol ThreadId
    _ s -> Maybe a1
    p -> (ThreadId -> (s -> Maybe a1) -> RE s a1)
    -> (s -> Maybe a1) -> ThreadId -> RE s a1
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ThreadId -> (s -> Maybe a1) -> RE s a1
    forall s a. ThreadId -> (s -> Maybe a) -> RE s a
    Symbol s -> Maybe a1
    p (ThreadId -> RE s a1)
    -> StateT ThreadId Identity ThreadId
    -> StateT ThreadId Identity (RE s a1)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StateT ThreadId Identity ThreadId
    fresh; RE s a1
    a -> RE s a1 -> StateT ThreadId Identity (RE s a1)
    forall a. a -> StateT ThreadId Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure RE s a1
    a)

    fresh :: State ThreadId ThreadId
    fresh :: StateT ThreadId Identity ThreadId
    fresh = do
        t@(ThreadId i) <- StateT ThreadId Identity ThreadId
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
        put $! ThreadId (i+1)
        return t