    {-# LANGUAGE FlexibleInstances          #-}
    {-# LANGUAGE FunctionalDependencies     #-}
    {-# LANGUAGE GADTs                      #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE ScopedTypeVariables        #-}
    {-# LANGUAGE UndecidableInstances       #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE CPP                        #-}
    {-# OPTIONS_HADDOCK show-extensions #-}

    {-|
    Module      :  Yi.Interact
    License     :  GPL-2
    Maintainer  :  yi-devel@googlegroups.com
    Stability   :  experimental
    Portability :  portable

    This is a library of interactive processes combinators, usable to
    define extensible keymaps.

    (Inspired by the Parsec library, written by Koen Claessen)

    The processes are:

    * composable: in parallel using '<|>', in sequence using monadic bind.

    * extensible: it is always possible to override a behaviour by combination of
      'adjustPriority' and '<|>'. (See also '<||' for a convenient combination of the two.)

    * monadic: sequencing is done via monadic bind. (leveraging the whole
      battery of monadic tools that Haskell provides)

    The processes can parse input, and write output that depends on it.

    The semantics are quite obvious; only disjunction
    deserve a bit more explanation:

    in @p = (a '<|>' b)@, what happens if @a@ and @b@ recognize the same
    input (prefix), but produce conflicting output?

    * if the output is the same (as by the Eq class), then the processes (prefixes) are "merged"
    * if a Write is more prioritized than the other, the one with low priority will be discarded
    * otherwise, the output will be delayed until one of the branches can be discarded.
    * if there is no way to disambiguate, then no output will be generated anymore.
      This situation can be detected by using 'possibleActions' however.
    -}

    module Yi.Interact
        (
         I, P (Chain,End),
         InteractState (..),
         MonadInteract (..),
         deprioritize,
         important,
         (<||),
         (||>),
         option,
         oneOf,
         processOneEvent,
         computeState,
         event,
         events,
         choice,
         mkAutomaton, idAutomaton,
         runWrite,
         anyEvent,
         eventBetween,
         accepted
        ) where

    import           Control.Applicative (Alternative ((<|>), empty))
    import           Control.Arrow       (first)
    import           Lens.Micro.Platform          (_1, _2, view)
    import qualified Control.Monad.Fail as Fail
    import           Control.Monad.State (MonadTrans (lift), StateT)
    import           Control.Monad       (MonadPlus(..))
    import           Data.Function       (on)
    import           Data.List           (groupBy)
    import qualified Data.Text           as T (Text, append, pack)

    ------------------------------------------------
    -- Classes

    -- | Abstraction of monadic interactive processes
    class (Eq w, Monad m, Alternative m, Applicative m, MonadPlus m) => MonadInteract m w e | m -> w e where
        write :: w -> m ()
        -- ^ Outputs a result.
        eventBounds :: Ord e => Maybe e -> Maybe e -> m e
        -- ^ Consumes and returns the next character.
        --   Fails if there is no input left, or outside the given bounds.
        adjustPriority :: Int -> m ()

    -------------------------------------------------
    -- State transformation

    -- Needs -fallow-undecidable-instances
    -- TODO: abstract over MonadTransformer
    instance MonadInteract m w e => MonadInteract (StateT s m) w e where
        write :: w -> StateT s m ()
    write = m () -> StateT s m ()
    forall (m :: * -> *) a. Monad m => m a -> StateT s m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (m () -> StateT s m ()) -> (w -> m ()) -> w -> StateT s m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . w -> m ()
    forall (m :: * -> *) w e. MonadInteract m w e => w -> m ()
    write
        eventBounds :: Ord e => Maybe e -> Maybe e -> StateT s m e
    eventBounds Maybe e
    l Maybe e
    h = m e -> StateT s m e
    forall (m :: * -> *) a. Monad m => m a -> StateT s m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Maybe e -> Maybe e -> m e
    forall (m :: * -> *) w e.
    (MonadInteract m w e, Ord e) =>
    Maybe e -> Maybe e -> m e
    eventBounds Maybe e
    l Maybe e
    h)
        adjustPriority :: Int -> StateT s m ()
    adjustPriority Int
    p = m () -> StateT s m ()
    forall (m :: * -> *) a. Monad m => m a -> StateT s m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Int -> m ()
    forall (m :: * -> *) w e. MonadInteract m w e => Int -> m ()
    adjustPriority Int
    p)

    ---------------------------------------------------------------------------
    -- | Interactive process description

    -- TODO: Replace 'Doc:' by ^ when haddock supports GADTs
    data I ev w a where
        Returns :: a -> I ev w a
        Binds :: I ev w a -> (a -> I ev w b) -> I ev w b
        Gets :: Ord ev => Maybe ev -> Maybe ev -> I ev w ev
        -- Doc: Accept any character between given bounds. Bound is ignored if 'Nothing'.
        Fails :: I ev w a
        Writes :: w -> I ev w ()
        Priority :: Int -> I ev w ()
        Plus :: I ev w a -> I ev w a -> I ev w a

    instance Functor (I event w) where
      fmap :: forall a b. (a -> b) -> I event w a -> I event w b
    fmap a -> b
    f I event w a
    i = (a -> b) -> I event w (a -> b)
    forall a. a -> I event w a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a -> b
    f I event w (a -> b) -> I event w a -> I event w b
    forall a b. I event w (a -> b) -> I event w a -> I event w b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> I event w a
    i

    instance Applicative (I ev w) where
        pure :: forall a. a -> I ev w a
    pure = a -> I ev w a
    forall a. a -> I ev w a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        I ev w (a -> b)
    a <*> :: forall a b. I ev w (a -> b) -> I ev w a -> I ev w b
    <*> I ev w a
    b = do f <- I ev w (a -> b)
    a; x <- b; return (f x)

    instance Alternative (I ev w) where
        empty :: forall a. I ev w a
    empty = I ev w a
    forall ev w a. I ev w a
    Fails
        <|> :: forall a. I ev w a -> I ev w a -> I ev w a
    (<|>) = I ev w a -> I ev w a -> I ev w a
    forall ev w a. I ev w a -> I ev w a -> I ev w a
    Plus

    instance Monad (I event w) where
      return :: forall a. a -> I event w a
    return  = a -> I event w a
    forall a ev w. a -> I ev w a
    Returns
      >>= :: forall a b. I event w a -> (a -> I event w b) -> I event w b
    (>>=)   = I event w a -> (a -> I event w b) -> I event w b
    forall event w a b.
    I event w a -> (a -> I event w b) -> I event w b
    Binds
    #if (!MIN_VERSION_base(4,13,0))
      fail _ = Fails
    #endif

    instance Fail.MonadFail (I event w) where
      fail :: forall a. String -> I event w a
    fail String
    _  = I event w a
    forall ev w a. I ev w a
    Fails

    instance Eq w => MonadPlus (I event w) where
      mzero :: forall a. I event w a
    mzero = I event w a
    forall ev w a. I ev w a
    Fails
      mplus :: forall a. I event w a -> I event w a -> I event w a
    mplus = I event w a -> I event w a -> I event w a
    forall ev w a. I ev w a -> I ev w a -> I ev w a
    Plus

    instance Eq w => MonadInteract (I event w) w event where
        write :: w -> I event w ()
    write = w -> I event w ()
    forall w ev. w -> I ev w ()
    Writes
        eventBounds :: Ord event => Maybe event -> Maybe event -> I event w event
    eventBounds = Maybe event -> Maybe event -> I event w event
    forall ev w. Ord ev => Maybe ev -> Maybe ev -> I ev w ev
    Gets
        adjustPriority :: Int -> I event w ()
    adjustPriority = Int -> I event w ()
    forall ev w. Int -> I ev w ()
    Priority

    infixl 3 <||

    deprioritize :: (MonadInteract f w e) => f ()
    deprioritize :: forall (f :: * -> *) w e. MonadInteract f w e => f ()
    deprioritize = Int -> f ()
    forall (m :: * -> *) w e. MonadInteract m w e => Int -> m ()
    adjustPriority Int
    1

    (<||), (||>) :: (MonadInteract f w e) => f a -> f a -> f a
    f a
    a <|| :: forall (f :: * -> *) w e a.
    MonadInteract f w e =>
    f a -> f a -> f a
    <|| f a
    b = f a
    a f a -> f a -> f a
    forall a. f a -> f a -> f a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (f ()
    forall (f :: * -> *) w e. MonadInteract f w e => f ()
    deprioritize f () -> f a -> f a
    forall a b. f a -> f b -> f b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> f a
    b)

    ||> :: forall (f :: * -> *) w e a.
    MonadInteract f w e =>
    f a -> f a -> f a
    (||>) = (f a -> f a -> f a) -> f a -> f a -> f a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip f a -> f a -> f a
    forall (f :: * -> *) w e a.
    MonadInteract f w e =>
    f a -> f a -> f a
    (<||)

    -- | Just like '(<||)' but in prefix form. It 'deprioritize's the
    -- second argument.
    important :: MonadInteract f w e => f a -> f a -> f a
    important :: forall (f :: * -> *) w e a.
    MonadInteract f w e =>
    f a -> f a -> f a
    important f a
    a f a
    b = f a
    a f a -> f a -> f a
    forall (f :: * -> *) w e a.
    MonadInteract f w e =>
    f a -> f a -> f a
    <|| f a
    b

    -- | Convert a process description to an "executable" process.
    mkProcess :: Eq w => I ev w a -> (a -> P ev w) -> P ev w
    mkProcess :: forall w ev a. Eq w => I ev w a -> (a -> P ev w) -> P ev w
    mkProcess (Returns a
    x) = \a -> P ev w
    fut -> a -> P ev w
    fut a
    x
    mkProcess I ev w a
    Fails = P ev w -> (a -> P ev w) -> P ev w
    forall a b. a -> b -> a
    const P ev w
    forall event w. P event w
    Fail
    mkProcess (I ev w a
    m `Binds` a -> I ev w a
    f) = \a -> P ev w
    fut -> I ev w a -> (a -> P ev w) -> P ev w
    forall w ev a. Eq w => I ev w a -> (a -> P ev w) -> P ev w
    mkProcess I ev w a
    m (\a
    a -> I ev w a -> (a -> P ev w) -> P ev w
    forall w ev a. Eq w => I ev w a -> (a -> P ev w) -> P ev w
    mkProcess (a -> I ev w a
    f a
    a) a -> P ev w
    fut)
    mkProcess (Gets Maybe ev
    l Maybe ev
    h) = Maybe a -> Maybe a -> (a -> P a w) -> P a w
    forall event w.
    Ord event =>
    Maybe event -> Maybe event -> (event -> P event w) -> P event w
    Get Maybe ev
    Maybe a
    l Maybe ev
    Maybe a
    h
    mkProcess (Writes w
    w) = \a -> P ev w
    fut -> w -> P ev w -> P ev w
    forall event w. w -> P event w -> P event w
    Write w
    w (a -> P ev w
    fut ())
    mkProcess (Priority Int
    p) = \a -> P ev w
    fut -> Int -> P ev w -> P ev w
    forall event w. Int -> P event w -> P event w
    Prior Int
    p (a -> P ev w
    fut ())
    mkProcess (Plus I ev w a
    a I ev w a
    b) = \a -> P ev w
    fut -> P ev w -> P ev w -> P ev w
    forall event w. P event w -> P event w -> P event w
    Best (I ev w a -> (a -> P ev w) -> P ev w
    forall w ev a. Eq w => I ev w a -> (a -> P ev w) -> P ev w
    mkProcess I ev w a
    a a -> P ev w
    fut) (I ev w a -> (a -> P ev w) -> P ev w
    forall w ev a. Eq w => I ev w a -> (a -> P ev w) -> P ev w
    mkProcess I ev w a
    b a -> P ev w
    fut)

    ----------------------------------------------------------------------
    -- Process type

    -- | Operational representation of a process
    data P event w
        = Ord event => Get (Maybe event) (Maybe event) (event -> P event w)
        | Fail
        | Write w (P event w)
        | Prior Int (P event w) -- low numbers indicate high priority
        | Best (P event w) (P event w)
        | End
        | forall mid. (Show mid, Eq mid) => Chain (P event mid) (P mid w)

    accepted :: (Show ev) => Int -> P ev w -> [[T.Text]]
    accepted :: forall ev w. Show ev => Int -> P ev w -> [[Text]]
    accepted Int
    0 P ev w
    _ = [[]]
    accepted Int
    d (Get (Just ev
    low) (Just ev
    high) ev -> P ev w
    k) = do
        t <- Int -> P ev w -> [[Text]]
    forall ev w. Show ev => Int -> P ev w -> [[Text]]
    accepted (Int
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1) (ev -> P ev w
    k ev
    low)
        let h = if ev
    low ev -> ev -> Bool
    forall a. Eq a => a -> a -> Bool
    == ev
    high
                then ev -> Text
    forall a. Show a => a -> Text
    showT ev
    low
                else ev -> Text
    forall a. Show a => a -> Text
    showT ev
    low Text -> Text -> Text
    `T.append` Text
    ".." Text -> Text -> Text
    `T.append` ev -> Text
    forall a. Show a => a -> Text
    showT ev
    high
        return (h : t)
    accepted Int
    _ (Get Maybe ev
    Nothing Maybe ev
    Nothing ev -> P ev w
    _) = [[Text
    "<any>"]]
    accepted Int
    _ (Get Maybe ev
    Nothing (Just ev
    e) ev -> P ev w
    _) = [[Text
    ".." Text -> Text -> Text
    `T.append` ev -> Text
    forall a. Show a => a -> Text
    showT ev
    e]]
    accepted Int
    _ (Get (Just ev
    e) Maybe ev
    Nothing ev -> P ev w
    _) = [[ev -> Text
    forall a. Show a => a -> Text
    showT ev
    e Text -> Text -> Text
    `T.append` Text
    ".."]]
    accepted Int
    _ P ev w
    Fail = []
    accepted Int
    _ (Write w
    _ P ev w
    _) = [[]] -- this should show what action we get...
    accepted Int
    d (Prior Int
    _ P ev w
    p) = Int -> P ev w -> [[Text]]
    forall ev w. Show ev => Int -> P ev w -> [[Text]]
    accepted Int
    d P ev w
    p
    accepted Int
    d (Best P ev w
    p P ev w
    q) = Int -> P ev w -> [[Text]]
    forall ev w. Show ev => Int -> P ev w -> [[Text]]
    accepted Int
    d P ev w
    p [[Text]] -> [[Text]] -> [[Text]]
    forall a. [a] -> [a] -> [a]
    ++ Int -> P ev w -> [[Text]]
    forall ev w. Show ev => Int -> P ev w -> [[Text]]
    accepted Int
    d P ev w
    q
    accepted Int
    _ P ev w
    End = []
    accepted Int
    _ (Chain P ev mid
    _ P mid w
    _) = String -> [[Text]]
    forall a. HasCallStack => String -> a
    error String
    "accepted: chain not supported"

    -- Utility function
    showT :: Show a => a -> T.Text
    showT :: forall a. Show a => a -> Text
    showT = String -> Text
    T.pack (String -> Text) -> (a -> String) -> a -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    -- ---------------------------------------------------------------------------
    -- Operations over P

    runWrite :: Eq w => P event w -> [event] -> [w]
    runWrite :: forall w event. Eq w => P event w -> [event] -> [w]
    runWrite P event w
    _ [] = []
    runWrite P event w
    p (event
    c:[event]
    cs) = let ([w]
    ws, P event w
    p') = P event w -> event -> ([w], P event w)
    forall w event. Eq w => P event w -> event -> ([w], P event w)
    processOneEvent P event w
    p event
    c in [w]
    ws [w] -> [w] -> [w]
    forall a. [a] -> [a] -> [a]
    ++ P event w -> [event] -> [w]
    forall w event. Eq w => P event w -> [event] -> [w]
    runWrite P event w
    p' [event]
    cs

    processOneEvent :: Eq w => P event w -> event -> ([w], P event w)
    processOneEvent :: forall w event. Eq w => P event w -> event -> ([w], P event w)
    processOneEvent P event w
    p event
    e = P event w -> ([w], P event w)
    forall w event. Eq w => P event w -> ([w], P event w)
    pullWrites (P event w -> ([w], P event w)) -> P event w -> ([w], P event w)
    forall a b. (a -> b) -> a -> b
    $ P event w -> event -> P event w
    forall ev w. P ev w -> ev -> P ev w
    pushEvent P event w
    p event
    e

    -- | Push an event in the automaton
    pushEvent :: P ev w -> ev -> P ev w
    pushEvent :: forall ev w. P ev w -> ev -> P ev w
    pushEvent (Best P ev w
    c P ev w
    d) ev
    e = P ev w -> P ev w -> P ev w
    forall event w. P event w -> P event w -> P event w
    Best (P ev w -> ev -> P ev w
    forall ev w. P ev w -> ev -> P ev w
    pushEvent P ev w
    c ev
    e) (P ev w -> ev -> P ev w
    forall ev w. P ev w -> ev -> P ev w
    pushEvent P ev w
    d ev
    e)
    pushEvent (Write w
    w P ev w
    c) ev
    e = w -> P ev w -> P ev w
    forall event w. w -> P event w -> P event w
    Write w
    w (P ev w -> ev -> P ev w
    forall ev w. P ev w -> ev -> P ev w
    pushEvent P ev w
    c ev
    e)
    pushEvent (Prior Int
    p P ev w
    c) ev
    e = Int -> P ev w -> P ev w
    forall event w. Int -> P event w -> P event w
    Prior Int
    p (P ev w -> ev -> P ev w
    forall ev w. P ev w -> ev -> P ev w
    pushEvent P ev w
    c ev
    e)
    pushEvent (Get Maybe ev
    l Maybe ev
    h ev -> P ev w
    f) ev
    e = if (ev -> Bool) -> Maybe ev -> Bool
    forall {a}. (a -> Bool) -> Maybe a -> Bool
    test (ev
    e ev -> ev -> Bool
    forall a. Ord a => a -> a -> Bool
    >=) Maybe ev
    l Bool -> Bool -> Bool
    && (ev -> Bool) -> Maybe ev -> Bool
    forall {a}. (a -> Bool) -> Maybe a -> Bool
    test (ev
    e ev -> ev -> Bool
    forall a. Ord a => a -> a -> Bool
    <=) Maybe ev
    h then ev -> P ev w
    f ev
    e else P ev w
    forall event w. P event w
    Fail
        where test :: (a -> Bool) -> Maybe a -> Bool
    test = Bool -> (a -> Bool) -> Maybe a -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True
    pushEvent P ev w
    Fail ev
    _ = P ev w
    forall event w. P event w
    Fail
    pushEvent P ev w
    End ev
    _ = P ev w
    forall event w. P event w
    End
    pushEvent (Chain P ev mid
    p P mid w
    q) ev
    e = P ev mid -> P mid w -> P ev w
    forall event w mid.
    (Show mid, Eq mid) =>
    P event mid -> P mid w -> P event w
    Chain (P ev mid -> ev -> P ev mid
    forall ev w. P ev w -> ev -> P ev w
    pushEvent P ev mid
    p ev
    e) P mid w
    q

    -- | Abstraction of the automaton state.
    data InteractState event w =  Ambiguous [(Int,w,P event w)] | Waiting | Dead | Running w (P event w)

    #if __GLASGOW_HASKELL__ >= 804
    instance Semigroup (InteractState event w) where
      <> :: InteractState event w
    -> InteractState event w -> InteractState event w
    (<>) = InteractState event w
    -> InteractState event w -> InteractState event w
    forall a. Monoid a => a -> a -> a
    mappend
    #endif

    instance Monoid (InteractState event w) where
        -- not used at the moment:
        mappend :: InteractState event w
    -> InteractState event w -> InteractState event w
    mappend (Running w
    w P event w
    c) InteractState event w
    _ = w -> P event w -> InteractState event w
    forall event w. w -> P event w -> InteractState event w
    Running w
    w P event w
    c
        mappend InteractState event w
    _ (Running w
    w P event w
    c) = w -> P event w -> InteractState event w
    forall event w. w -> P event w -> InteractState event w
    Running w
    w P event w
    c
        -- don't die if that can be avoided
        mappend InteractState event w
    Dead InteractState event w
    p = InteractState event w
    p
        mappend InteractState event w
    p InteractState event w
    Dead = InteractState event w
    p
        -- If a branch is not determined, wait for it.
        mappend InteractState event w
    Waiting InteractState event w
    _ = InteractState event w
    forall event w. InteractState event w
    Waiting
        mappend InteractState event w
    _ InteractState event w
    Waiting = InteractState event w
    forall event w. InteractState event w
    Waiting
        -- ambiguity remains
        mappend (Ambiguous [(Int, w, P event w)]
    a) (Ambiguous [(Int, w, P event w)]
    b) = [(Int, w, P event w)] -> InteractState event w
    forall event w. [(Int, w, P event w)] -> InteractState event w
    Ambiguous ([(Int, w, P event w)]
    a [(Int, w, P event w)]
    -> [(Int, w, P event w)] -> [(Int, w, P event w)]
    forall a. [a] -> [a] -> [a]
    ++ [(Int, w, P event w)]
    b)
        mempty :: InteractState event w
    mempty = [(Int, w, P event w)] -> InteractState event w
    forall event w. [(Int, w, P event w)] -> InteractState event w
    Ambiguous []

    -- | find all the writes that are accessible.
    findWrites :: Int -> P event w -> InteractState event w
    findWrites :: forall event w. Int -> P event w -> InteractState event w
    findWrites Int
    p (Best P event w
    c P event w
    d) = Int -> P event w -> InteractState event w
    forall event w. Int -> P event w -> InteractState event w
    findWrites Int
    p P event w
    c InteractState event w
    -> InteractState event w -> InteractState event w
    forall a. Monoid a => a -> a -> a
    `mappend` Int -> P event w -> InteractState event w
    forall event w. Int -> P event w -> InteractState event w
    findWrites Int
    p P event w
    d
    findWrites Int
    p (Write w
    w P event w
    c) = [(Int, w, P event w)] -> InteractState event w
    forall event w. [(Int, w, P event w)] -> InteractState event w
    Ambiguous [(Int
    p,w
    w,P event w
    c)]
    findWrites Int
    p (Prior Int
    dp P event w
    c) = Int -> P event w -> InteractState event w
    forall event w. Int -> P event w -> InteractState event w
    findWrites (Int
    pInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    dp) P event w
    c
    findWrites Int
    _ P event w
    Fail = InteractState event w
    forall event w. InteractState event w
    Dead
    findWrites Int
    _ P event w
    End = InteractState event w
    forall event w. InteractState event w
    Dead
    findWrites Int
    _ (Get{})     = InteractState event w
    forall event w. InteractState event w
    Waiting
    findWrites Int
    p (Chain P event mid
    a P mid w
    b) = case P event mid -> InteractState event mid
    forall w event. Eq w => P event w -> InteractState event w
    computeState P event mid
    a of
        InteractState event mid
    Dead -> InteractState event w
    forall event w. InteractState event w
    Dead
        Ambiguous [(Int, mid, P event mid)]
    _ -> InteractState event w
    forall event w. InteractState event w
    Dead -- If ambiguity, don't try to do anything clever for now; die.
        Running mid
    w P event mid
    c -> Int -> P event w -> InteractState event w
    forall event w. Int -> P event w -> InteractState event w
    findWrites Int
    p (P event mid -> P mid w -> P event w
    forall event w mid.
    (Show mid, Eq mid) =>
    P event mid -> P mid w -> P event w
    Chain P event mid
    c (P mid w -> mid -> P mid w
    forall ev w. P ev w -> ev -> P ev w
    pushEvent P mid w
    b mid
    w)) -- pull as much as possible from the left automaton
        InteractState event mid
    Waiting -> case Int -> P mid w -> InteractState mid w
    forall event w. Int -> P event w -> InteractState event w
    findWrites Int
    p P mid w
    b of
            Ambiguous [(Int, w, P mid w)]
    choices -> [(Int, w, P event w)] -> InteractState event w
    forall event w. [(Int, w, P event w)] -> InteractState event w
    Ambiguous [(Int
    p',w
    w',P event mid -> P mid w -> P event w
    forall event w mid.
    (Show mid, Eq mid) =>
    P event mid -> P mid w -> P event w
    Chain P event mid
    a P mid w
    c') | (Int
    p',w
    w',P mid w
    c') <- [(Int, w, P mid w)]
    choices]
            Running w
    w' P mid w
    c' -> w -> P event w -> InteractState event w
    forall event w. w -> P event w -> InteractState event w
    Running w
    w' (P event mid -> P mid w -> P event w
    forall event w mid.
    (Show mid, Eq mid) =>
    P event mid -> P mid w -> P event w
    Chain P event mid
    a P mid w
    c') -- when it has nothing more, pull from the right.
            InteractState mid w
    Dead -> InteractState event w
    forall event w. InteractState event w
    Dead
            InteractState mid w
    Waiting -> InteractState event w
    forall event w. InteractState event w
    Waiting

    computeState :: Eq w => P event w -> InteractState event  w
    computeState :: forall w event. Eq w => P event w -> InteractState event w
    computeState P event w
    a = case Int -> P event w -> InteractState event w
    forall event w. Int -> P event w -> InteractState event w
    findWrites Int
    0 P event w
    a of
        Ambiguous [(Int, w, P event w)]
    actions ->
          let prior :: Int
    prior = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ ((Int, w, P event w) -> Int) -> [(Int, w, P event w)] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Getting Int (Int, w, P event w) Int -> (Int, w, P event w) -> Int
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting Int (Int, w, P event w) Int
    forall s t a b. Field1 s t a b => Lens s t a b
    Lens (Int, w, P event w) (Int, w, P event w) Int Int
    _1) [(Int, w, P event w)]
    actions
              bests :: [[(Int, w, P event w)]]
    bests = ((Int, w, P event w) -> (Int, w, P event w) -> Bool)
    -> [(Int, w, P event w)] -> [[(Int, w, P event w)]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy (w -> w -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (w -> w -> Bool)
    -> ((Int, w, P event w) -> w)
    -> (Int, w, P event w)
    -> (Int, w, P event w)
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Getting w (Int, w, P event w) w -> (Int, w, P event w) -> w
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting w (Int, w, P event w) w
    forall s t a b. Field2 s t a b => Lens s t a b
    Lens (Int, w, P event w) (Int, w, P event w) w w
    _2) ([(Int, w, P event w)] -> [[(Int, w, P event w)]])
    -> [(Int, w, P event w)] -> [[(Int, w, P event w)]]
    forall a b. (a -> b) -> a -> b
    $
                        ((Int, w, P event w) -> Bool)
    -> [(Int, w, P event w)] -> [(Int, w, P event w)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Int
    prior Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==) (Int -> Bool)
    -> ((Int, w, P event w) -> Int) -> (Int, w, P event w) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Getting Int (Int, w, P event w) Int -> (Int, w, P event w) -> Int
    forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
    view Getting Int (Int, w, P event w) Int
    forall s t a b. Field1 s t a b => Lens s t a b
    Lens (Int, w, P event w) (Int, w, P event w) Int Int
    _1) [(Int, w, P event w)]
    actions
          in case [[(Int, w, P event w)]]
    bests of
            [(Int
    _,w
    w,P event w
    c):[(Int, w, P event w)]
    _] -> w -> P event w -> InteractState event w
    forall event w. w -> P event w -> InteractState event w
    Running w
    w P event w
    c
            [[(Int, w, P event w)]]
    _ -> [(Int, w, P event w)] -> InteractState event w
    forall event w. [(Int, w, P event w)] -> InteractState event w
    Ambiguous ([(Int, w, P event w)] -> InteractState event w)
    -> [(Int, w, P event w)] -> InteractState event w
    forall a b. (a -> b) -> a -> b
    $ ([(Int, w, P event w)] -> (Int, w, P event w))
    -> [[(Int, w, P event w)]] -> [(Int, w, P event w)]
    forall a b. (a -> b) -> [a] -> [b]
    map [(Int, w, P event w)] -> (Int, w, P event w)
    forall a. HasCallStack => [a] -> a
    head [[(Int, w, P event w)]]
    bests
        InteractState event w
    s -> InteractState event w
    s

    pullWrites :: Eq w => P event w -> ([w], P event w)
    pullWrites :: forall w event. Eq w => P event w -> ([w], P event w)
    pullWrites P event w
    a = case P event w -> InteractState event w
    forall w event. Eq w => P event w -> InteractState event w
    computeState P event w
    a of
        Running w
    w P event w
    c -> ([w] -> [w]) -> ([w], P event w) -> ([w], P event w)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (w
    ww -> [w] -> [w]
    forall a. a -> [a] -> [a]
    :) (P event w -> ([w], P event w)
    forall w event. Eq w => P event w -> ([w], P event w)
    pullWrites P event w
    c)
        InteractState event w
    _ -> ([], P event w
    a)

    instance (Show w, Show ev) => Show (P ev w) where
        show :: P ev w -> String
    show (Get Maybe ev
    Nothing Maybe ev
    Nothing ev -> P ev w
    _) = String
    "?"
        show (Get (Just ev
    l) (Just ev
    h) ev -> P ev w
    _p) | ev
    l ev -> ev -> Bool
    forall a. Eq a => a -> a -> Bool
    == ev
    h = ev -> String
    forall a. Show a => a -> String
    show ev
    l -- ++ " " ++ show (p l)
        show (Get Maybe ev
    l Maybe ev
    h ev -> P ev w
    _) = String -> (ev -> String) -> Maybe ev -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" ev -> String
    forall a. Show a => a -> String
    show Maybe ev
    l String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ".." String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> (ev -> String) -> Maybe ev -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" ev -> String
    forall a. Show a => a -> String
    show Maybe ev
    h
        show (Prior Int
    p P ev w
    c) = String
    ":" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    p String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ P ev w -> String
    forall a. Show a => a -> String
    show P ev w
    c
        show (Write w
    w P ev w
    c) = String
    "!" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ w -> String
    forall a. Show a => a -> String
    show w
    w String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "->" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ P ev w -> String
    forall a. Show a => a -> String
    show P ev w
    c
        show (P ev w
    End) = String
    "."
        show (P ev w
    Fail) = String
    "*"
        show (Best P ev w
    p P ev w
    q) = String
    "{" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ P ev w -> String
    forall a. Show a => a -> String
    show P ev w
    p String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "|" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ P ev w -> String
    forall a. Show a => a -> String
    show P ev w
    q String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "}"
        show (Chain P ev mid
    a P mid w
    b) = P ev mid -> String
    forall a. Show a => a -> String
    show P ev mid
    a String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ">>>" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ P mid w -> String
    forall a. Show a => a -> String
    show P mid w
    b

    -- ---------------------------------------------------------------------------
    -- Derived operations
    oneOf :: (Ord event, MonadInteract m w event, Fail.MonadFail m) => [event] -> m event
    oneOf :: forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event, MonadFail m) =>
    [event] -> m event
    oneOf [event]
    s = [m event] -> m event
    forall (m :: * -> *) w e a.
    (MonadInteract m w e, MonadFail m) =>
    [m a] -> m a
    choice ([m event] -> m event) -> [m event] -> m event
    forall a b. (a -> b) -> a -> b
    $ (event -> m event) -> [event] -> [m event]
    forall a b. (a -> b) -> [a] -> [b]
    map event -> m event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    event -> m event
    event [event]
    s

    anyEvent :: (Ord event, MonadInteract m w event) => m event
    anyEvent :: forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    m event
    anyEvent = Maybe event -> Maybe event -> m event
    forall (m :: * -> *) w e.
    (MonadInteract m w e, Ord e) =>
    Maybe e -> Maybe e -> m e
    eventBounds Maybe event
    forall a. Maybe a
    Nothing Maybe event
    forall a. Maybe a
    Nothing

    eventBetween :: (Ord e, MonadInteract m w e) => e -> e -> m e
    eventBetween :: forall e (m :: * -> *) w.
    (Ord e, MonadInteract m w e) =>
    e -> e -> m e
    eventBetween e
    l e
    h = Maybe e -> Maybe e -> m e
    forall (m :: * -> *) w e.
    (MonadInteract m w e, Ord e) =>
    Maybe e -> Maybe e -> m e
    eventBounds (e -> Maybe e
    forall a. a -> Maybe a
    Just e
    l) (e -> Maybe e
    forall a. a -> Maybe a
    Just e
    h)

    event :: (Ord event, MonadInteract m w event) => event -> m event
    -- ^ Parses and returns the specified character.
    event :: forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    event -> m event
    event event
    e = event -> event -> m event
    forall e (m :: * -> *) w.
    (Ord e, MonadInteract m w e) =>
    e -> e -> m e
    eventBetween event
    e event
    e

    events :: (Ord event, MonadInteract m w event) => [event] -> m [event]
    -- ^ Parses and returns the specified list of events (lazily).
    events :: forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    [event] -> m [event]
    events = (event -> m event) -> [event] -> m [event]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM event -> m event
    forall event (m :: * -> *) w.
    (Ord event, MonadInteract m w event) =>
    event -> m event
    event

    choice :: (MonadInteract m w e, Fail.MonadFail m) => [m a] -> m a
    -- ^ Combines all parsers in the specified list.
    choice :: forall (m :: * -> *) w e a.
    (MonadInteract m w e, MonadFail m) =>
    [m a] -> m a
    choice []     = String -> m a
    forall a. String -> m a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "No choice succeeds"
    choice [m a
    p]    = m a
    p
    choice (m a
    p:[m a]
    ps) = m a
    p m a -> m a -> m a
    forall a. m a -> m a -> m a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` [m a] -> m a
    forall (m :: * -> *) w e a.
    (MonadInteract m w e, MonadFail m) =>
    [m a] -> m a
    choice [m a]
    ps

    option :: (MonadInteract m w e) => a -> m a -> m a
    -- ^ @option x p@ will either parse @p@ or return @x@ without consuming
    --   any input.
    option :: forall (m :: * -> *) w e a. MonadInteract m w e => a -> m a -> m a
    option a
    x m a
    p = m a
    p m a -> m a -> m a
    forall a. m a -> m a -> m a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x

    mkAutomaton :: Eq w => I ev w a -> P ev w
    mkAutomaton :: forall w ev a. Eq w => I ev w a -> P ev w
    mkAutomaton I ev w a
    i = I ev w a -> (a -> P ev w) -> P ev w
    forall w ev a. Eq w => I ev w a -> (a -> P ev w) -> P ev w
    mkProcess I ev w a
    i (P ev w -> a -> P ev w
    forall a b. a -> b -> a
    const P ev w
    forall event w. P event w
    End)

    -- An automaton that produces its input
    idAutomaton :: (Ord a, Eq a) => P a a
    idAutomaton :: forall a. (Ord a, Eq a) => P a a
    idAutomaton = Maybe a -> Maybe a -> (a -> P a a) -> P a a
    forall event w.
    Ord event =>
    Maybe event -> Maybe event -> (event -> P event w) -> P event w
    Get Maybe a
    forall a. Maybe a
    Nothing Maybe a
    forall a. Maybe a
    Nothing ((a -> P a a) -> P a a) -> (a -> P a a) -> P a a
    forall a b. (a -> b) -> a -> b
    $ \a
    e -> a -> P a a -> P a a
    forall event w. w -> P event w -> P event w
    Write a
    e P a a
    forall a. (Ord a, Eq a) => P a a
    idAutomaton
    -- It would be much nicer to write:
    --    mkAutomaton (forever 0 (anyEvent >>= write))
    -- however this creates a memory leak. Unfortunately I don't understand why.
    -- To witness:
    --    dist/build/yi/yi +RTS -hyI -hd
    -- Then type some characters. (Binds grows linearly)