{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Machine.Type
-- Copyright   :  (C) 2012 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  rank-2, GADTs
--
----------------------------------------------------------------------------
module Data.Machine.Type
  (
  -- * Machines
    MachineT(..)
  , Step(..)
  , Machine
  , runT_
  , runT
  , run
  , runMachine
  , encased

  -- ** Building machines from plans
  , construct
  , repeatedly
  , unfoldPlan
  , before
  , preplan
--  , sink

  -- ** Deconstructing machines back into plans
  , deconstruct
  , tagDone
  , finishWith

  -- * Reshaping machines
  , fit
  , fitM
  , pass

  , starve

  , stopped

  , stepMachine

  -- * Applicative Machines
  , Appliance(..)
  ) where

import Control.Applicative
import Control.Category
import Control.Monad (liftM)
import Data.Foldable
import Data.Functor.Identity
import Data.Machine.Plan
import Data.Monoid hiding ((<>))
import Data.Pointed
import Data.Profunctor.Unsafe ((#.))
import Data.Semigroup
import Prelude hiding ((.),id)

-------------------------------------------------------------------------------
-- Transduction Machines
-------------------------------------------------------------------------------

-- | This is the base functor for a 'Machine' or 'MachineT'.
--
-- Note: A 'Machine' is usually constructed from 'Plan', so it does not need to be CPS'd.
data Step k o r
  = Stop
  | Yield o r
  | forall t. Await (t -> r) (k t) r

instance Functor (Step k o) where
  fmap :: (a -> b) -> Step k o a -> Step k o b
fmap a -> b
_ Step k o a
Stop = Step k o b
forall (k :: * -> *) o r. Step k o r
Stop
  fmap a -> b
f (Yield o
o a
k) = o -> b -> Step k o b
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (a -> b
f a
k)
  fmap a -> b
f (Await t -> a
g k t
kg a
fg) = (t -> b) -> k t -> b -> Step k o b
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (a -> b
f (a -> b) -> (t -> a) -> t -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> a
g) k t
kg (a -> b
f a
fg)

-- | A 'MachineT' reads from a number of inputs and may yield results before stopping
-- with monadic side-effects.
newtype MachineT m k o = MachineT { MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT :: m (Step k o (MachineT m k o)) }

-- | A 'Machine' reads from a number of inputs and may yield results before stopping.
--
-- A 'Machine' can be used as a @'MachineT' m@ for any @'Monad' m@.
type Machine k o = forall m. Monad m => MachineT m k o

-- | @'runMachine' = 'runIdentity' . 'runMachineT'@
runMachine :: MachineT Identity k o -> Step k o (MachineT Identity k o)
runMachine :: MachineT Identity k o -> Step k o (MachineT Identity k o)
runMachine = Identity (Step k o (MachineT Identity k o))
-> Step k o (MachineT Identity k o)
forall a. Identity a -> a
runIdentity (Identity (Step k o (MachineT Identity k o))
 -> Step k o (MachineT Identity k o))
-> (MachineT Identity k o
    -> Identity (Step k o (MachineT Identity k o)))
-> MachineT Identity k o
-> Step k o (MachineT Identity k o)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MachineT Identity k o
-> Identity (Step k o (MachineT Identity k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT

-- | Pack a 'Step' of a 'Machine' into a 'Machine'.
encased :: Monad m => Step k o (MachineT m k o) -> MachineT m k o
encased :: Step k o (MachineT m k o) -> MachineT m k o
encased = m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> (Step k o (MachineT m k o) -> m (Step k o (MachineT m k o)))
-> Step k o (MachineT m k o)
-> MachineT m k o
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Transform a 'Machine' by looking at a single step of that machine.
stepMachine :: Monad m => MachineT m k o -> (Step k o (MachineT m k o) -> MachineT m k' o') -> MachineT m k' o'
stepMachine :: MachineT m k o
-> (Step k o (MachineT m k o) -> MachineT m k' o')
-> MachineT m k' o'
stepMachine MachineT m k o
m Step k o (MachineT m k o) -> MachineT m k' o'
f = m (Step k' o' (MachineT m k' o')) -> MachineT m k' o'
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (MachineT m k' o' -> m (Step k' o' (MachineT m k' o'))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k' o' -> m (Step k' o' (MachineT m k' o')))
-> (Step k o (MachineT m k o) -> MachineT m k' o')
-> Step k o (MachineT m k o)
-> m (Step k' o' (MachineT m k' o'))
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. Step k o (MachineT m k o) -> MachineT m k' o'
f (Step k o (MachineT m k o) -> m (Step k' o' (MachineT m k' o')))
-> m (Step k o (MachineT m k o))
-> m (Step k' o' (MachineT m k' o'))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MachineT m k o -> m (Step k o (MachineT m k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k o
m)

instance Monad m => Functor (MachineT m k) where
  fmap :: (a -> b) -> MachineT m k a -> MachineT m k b
fmap a -> b
f (MachineT m (Step k a (MachineT m k a))
m) = m (Step k b (MachineT m k b)) -> MachineT m k b
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT ((Step k a (MachineT m k a) -> Step k b (MachineT m k b))
-> m (Step k a (MachineT m k a)) -> m (Step k b (MachineT m k b))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Step k a (MachineT m k a) -> Step k b (MachineT m k b)
f' m (Step k a (MachineT m k a))
m) where
    f' :: Step k a (MachineT m k a) -> Step k b (MachineT m k b)
f' (Yield a
o MachineT m k a
xs)    = b -> MachineT m k b -> Step k b (MachineT m k b)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield (a -> b
f a
o) (a -> b
f (a -> b) -> MachineT m k a -> MachineT m k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MachineT m k a
xs)
    f' (Await t -> MachineT m k a
k k t
kir MachineT m k a
e) = (t -> MachineT m k b)
-> k t -> MachineT m k b -> Step k b (MachineT m k b)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await ((a -> b) -> MachineT m k a -> MachineT m k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (MachineT m k a -> MachineT m k b)
-> (t -> MachineT m k a) -> t -> MachineT m k b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> MachineT m k a
k) k t
kir (a -> b
f (a -> b) -> MachineT m k a -> MachineT m k b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MachineT m k a
e)
    f' Step k a (MachineT m k a)
Stop            = Step k b (MachineT m k b)
forall (k :: * -> *) o r. Step k o r
Stop

instance Monad m => Pointed (MachineT m k) where
  point :: a -> MachineT m k a
point a
x = PlanT k a m () -> MachineT m k a
forall (m :: * -> *) (k :: * -> *) o a.
Monad m =>
PlanT k o m a -> MachineT m k o
repeatedly (PlanT k a m () -> MachineT m k a)
-> PlanT k a m () -> MachineT m k a
forall a b. (a -> b) -> a -> b
$ a -> Plan k a ()
forall o (k :: * -> *). o -> Plan k o ()
yield a
x

instance Monad m => Semigroup (MachineT m k o) where
  MachineT m k o
a <> :: MachineT m k o -> MachineT m k o -> MachineT m k o
<> MachineT m k o
b = MachineT m k o
-> (Step k o (MachineT m k o) -> MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o (k' :: * -> *) o'.
Monad m =>
MachineT m k o
-> (Step k o (MachineT m k o) -> MachineT m k' o')
-> MachineT m k' o'
stepMachine MachineT m k o
a ((Step k o (MachineT m k o) -> MachineT m k o) -> MachineT m k o)
-> (Step k o (MachineT m k o) -> MachineT m k o) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ \Step k o (MachineT m k o)
step -> case Step k o (MachineT m k o)
step of
    Yield o
o MachineT m k o
a'    -> Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (MachineT m k o -> MachineT m k o -> MachineT m k o
forall a. Monoid a => a -> a -> a
mappend MachineT m k o
a' MachineT m k o
b))
    Await t -> MachineT m k o
k k t
kir MachineT m k o
e -> Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((t -> MachineT m k o)
-> k t -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\t
x -> t -> MachineT m k o
k t
x MachineT m k o -> MachineT m k o -> MachineT m k o
forall a. Semigroup a => a -> a -> a
<> MachineT m k o
b) k t
kir (MachineT m k o
e MachineT m k o -> MachineT m k o -> MachineT m k o
forall a. Semigroup a => a -> a -> a
<> MachineT m k o
b))
    Step k o (MachineT m k o)
Stop          -> MachineT m k o
b

instance Monad m => Monoid (MachineT m k o) where
  mempty :: MachineT m k o
mempty        = MachineT m k o
forall (k :: * -> *) b. Machine k b
stopped
  mappend :: MachineT m k o -> MachineT m k o -> MachineT m k o
mappend       = MachineT m k o -> MachineT m k o -> MachineT m k o
forall a. Semigroup a => a -> a -> a
(<>)

-- | An input type that supports merging requests from multiple machines.
class Appliance k where
  applied :: Monad m => MachineT m k (a -> b) -> MachineT m k a -> MachineT m k b

instance (Monad m, Appliance k) => Applicative (MachineT m k) where
  pure :: a -> MachineT m k a
pure = a -> MachineT m k a
forall (p :: * -> *) a. Pointed p => a -> p a
point
  <*> :: MachineT m k (a -> b) -> MachineT m k a -> MachineT m k b
(<*>) = MachineT m k (a -> b) -> MachineT m k a -> MachineT m k b
forall (k :: * -> *) (m :: * -> *) a b.
(Appliance k, Monad m) =>
MachineT m k (a -> b) -> MachineT m k a -> MachineT m k b
applied

{-
-- TODO

instance Appliance (Is i) where
  applied = appliedTo (Just mempty) (Just mempty) id (flip id) where

-- applied
appliedTo
  :: Maybe (Seq i)
  -> Maybe (i -> MachineT m (Is i) b, MachineT m (Is i) b)
  -> Either (Seq a) (Seq b)
  -> (a -> b -> c)
  -> (b -> a -> c)
  -> MachineT m (Is i) a
  -> MachineT m (Is i) b
  -> MachineT m (Is i) c
appliedTo mis blocking ss f g m n = MachineT $ runMachineT m >>= \v -> case v of
  Stop -> return Stop
  Yield a k -> case ss of
    Left as ->
    Right bs -> case viewl bs of
      b :< bs' -> return $ Yield (f a b) (appliedTo mis bs' f g m n)
      EmptyL   -> runMachine $ appliedTo mis blocking (singleton a) g f n m
  Await ak Refl e -> case mis of
    Nothing -> runMachine $ appliedTo Nothing blocking bs f g e n
    Just is -> case viewl is of
      i :< is' -> runMachine $ appliedTo (Just is') blocking bs f g (ak i) m
      EmptyL -> case blocking of
        Just (bk, be) ->
        Nothing -> runMachine $ appliedTo mis (Just (ak, e))
        | blocking  -> return $ Await (\i -> appliedTo (Just (singleton i)) False f g (ak i) n) Refl $
        | otherwise ->
-}

-- | Stop feeding input into model, taking only the effects.
{-# INLINABLE runT_ #-}
runT_ :: Monad m => MachineT m k b -> m ()
runT_ :: MachineT m k b -> m ()
runT_ MachineT m k b
m = MachineT m k b -> m (Step k b (MachineT m k b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k b
m m (Step k b (MachineT m k b))
-> (Step k b (MachineT m k b) -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step k b (MachineT m k b)
v -> case Step k b (MachineT m k b)
v of
  Step k b (MachineT m k b)
Stop        -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Yield b
_ MachineT m k b
k   -> MachineT m k b -> m ()
forall (m :: * -> *) (k :: * -> *) b.
Monad m =>
MachineT m k b -> m ()
runT_ MachineT m k b
k
  Await t -> MachineT m k b
_ k t
_ MachineT m k b
e -> MachineT m k b -> m ()
forall (m :: * -> *) (k :: * -> *) b.
Monad m =>
MachineT m k b -> m ()
runT_ MachineT m k b
e

-- | Stop feeding input into model and extract an answer
{-# INLINABLE runT #-}
runT :: Monad m => MachineT m k b -> m [b]
runT :: MachineT m k b -> m [b]
runT (MachineT m (Step k b (MachineT m k b))
m) = m (Step k b (MachineT m k b))
m m (Step k b (MachineT m k b))
-> (Step k b (MachineT m k b) -> m [b]) -> m [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step k b (MachineT m k b)
v -> case Step k b (MachineT m k b)
v of
  Step k b (MachineT m k b)
Stop        -> [b] -> m [b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  Yield b
o MachineT m k b
k   -> ([b] -> [b]) -> m [b] -> m [b]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (b
ob -> [b] -> [b]
forall a. a -> [a] -> [a]
:) (MachineT m k b -> m [b]
forall (m :: * -> *) (k :: * -> *) b.
Monad m =>
MachineT m k b -> m [b]
runT MachineT m k b
k)
  Await t -> MachineT m k b
_ k t
_ MachineT m k b
e -> MachineT m k b -> m [b]
forall (m :: * -> *) (k :: * -> *) b.
Monad m =>
MachineT m k b -> m [b]
runT MachineT m k b
e

-- | Run a pure machine and extract an answer.
run :: MachineT Identity k b -> [b]
run :: MachineT Identity k b -> [b]
run = Identity [b] -> [b]
forall a. Identity a -> a
runIdentity (Identity [b] -> [b])
-> (MachineT Identity k b -> Identity [b])
-> MachineT Identity k b
-> [b]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MachineT Identity k b -> Identity [b]
forall (m :: * -> *) (k :: * -> *) b.
Monad m =>
MachineT m k b -> m [b]
runT

-- | This permits toList to be used on a Machine.
instance (m ~ Identity) => Foldable (MachineT m k) where
  foldMap :: (a -> m) -> MachineT m k a -> m
foldMap a -> m
f (MachineT (Identity m)) = Step k a (MachineT m k a) -> m
go Step k a (MachineT m k a)
m where
    go :: Step k a (MachineT m k a) -> m
go Step k a (MachineT m k a)
Stop = m
forall a. Monoid a => a
mempty
    go (Yield a
o MachineT m k a
k) = a -> m
f a
o m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> MachineT m k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f MachineT m k a
k
    go (Await t -> MachineT m k a
_ k t
_ MachineT m k a
fg) = (a -> m) -> MachineT m k a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f MachineT m k a
fg

-- |
-- Connect different kinds of machines.
--
-- @'fit' 'id' = 'id'@
fit :: Monad m => (forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
fit :: (forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
fit forall a. k a -> k' a
f (MachineT m (Step k o (MachineT m k o))
m) = m (Step k' o (MachineT m k' o)) -> MachineT m k' o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT ((Step k o (MachineT m k o) -> Step k' o (MachineT m k' o))
-> m (Step k o (MachineT m k o)) -> m (Step k' o (MachineT m k' o))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Step k o (MachineT m k o) -> Step k' o (MachineT m k' o)
f' m (Step k o (MachineT m k o))
m) where
  f' :: Step k o (MachineT m k o) -> Step k' o (MachineT m k' o)
f' (Yield o
o MachineT m k o
k)     = o -> MachineT m k' o -> Step k' o (MachineT m k' o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o ((forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
forall (m :: * -> *) (k :: * -> *) (k' :: * -> *) o.
Monad m =>
(forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
fit forall a. k a -> k' a
f MachineT m k o
k)
  f' Step k o (MachineT m k o)
Stop            = Step k' o (MachineT m k' o)
forall (k :: * -> *) o r. Step k o r
Stop
  f' (Await t -> MachineT m k o
g k t
kir MachineT m k o
h) = (t -> MachineT m k' o)
-> k' t -> MachineT m k' o -> Step k' o (MachineT m k' o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await ((forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
forall (m :: * -> *) (k :: * -> *) (k' :: * -> *) o.
Monad m =>
(forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
fit forall a. k a -> k' a
f (MachineT m k o -> MachineT m k' o)
-> (t -> MachineT m k o) -> t -> MachineT m k' o
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> MachineT m k o
g) (k t -> k' t
forall a. k a -> k' a
f k t
kir) ((forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
forall (m :: * -> *) (k :: * -> *) (k' :: * -> *) o.
Monad m =>
(forall a. k a -> k' a) -> MachineT m k o -> MachineT m k' o
fit forall a. k a -> k' a
f MachineT m k o
h)
{-# INLINE fit #-}

--- | Connect machine transformers over different monads using a monad
--- morphism.
fitM :: (Monad m, Monad m')
     => (forall a. m a -> m' a) -> MachineT m k o -> MachineT m' k o
fitM :: (forall a. m a -> m' a) -> MachineT m k o -> MachineT m' k o
fitM forall a. m a -> m' a
f (MachineT m (Step k o (MachineT m k o))
m) = m' (Step k o (MachineT m' k o)) -> MachineT m' k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m' (Step k o (MachineT m' k o)) -> MachineT m' k o)
-> m' (Step k o (MachineT m' k o)) -> MachineT m' k o
forall a b. (a -> b) -> a -> b
$ m (Step k o (MachineT m' k o)) -> m' (Step k o (MachineT m' k o))
forall a. m a -> m' a
f ((Step k o (MachineT m k o) -> Step k o (MachineT m' k o))
-> m (Step k o (MachineT m k o)) -> m (Step k o (MachineT m' k o))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Step k o (MachineT m k o) -> Step k o (MachineT m' k o)
aux m (Step k o (MachineT m k o))
m)
  where aux :: Step k o (MachineT m k o) -> Step k o (MachineT m' k o)
aux Step k o (MachineT m k o)
Stop = Step k o (MachineT m' k o)
forall (k :: * -> *) o r. Step k o r
Stop
        aux (Yield o
o MachineT m k o
k) = o -> MachineT m' k o -> Step k o (MachineT m' k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o ((forall a. m a -> m' a) -> MachineT m k o -> MachineT m' k o
forall (m :: * -> *) (m' :: * -> *) (k :: * -> *) o.
(Monad m, Monad m') =>
(forall a. m a -> m' a) -> MachineT m k o -> MachineT m' k o
fitM forall a. m a -> m' a
f MachineT m k o
k)
        aux (Await t -> MachineT m k o
g k t
kg MachineT m k o
gg) = (t -> MachineT m' k o)
-> k t -> MachineT m' k o -> Step k o (MachineT m' k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await ((forall a. m a -> m' a) -> MachineT m k o -> MachineT m' k o
forall (m :: * -> *) (m' :: * -> *) (k :: * -> *) o.
(Monad m, Monad m') =>
(forall a. m a -> m' a) -> MachineT m k o -> MachineT m' k o
fitM forall a. m a -> m' a
f (MachineT m k o -> MachineT m' k o)
-> (t -> MachineT m k o) -> t -> MachineT m' k o
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> MachineT m k o
g) k t
kg ((forall a. m a -> m' a) -> MachineT m k o -> MachineT m' k o
forall (m :: * -> *) (m' :: * -> *) (k :: * -> *) o.
(Monad m, Monad m') =>
(forall a. m a -> m' a) -> MachineT m k o -> MachineT m' k o
fitM forall a. m a -> m' a
f MachineT m k o
gg)
{-# INLINE fitM #-}

-- | Compile a machine to a model.
construct :: Monad m => PlanT k o m a -> MachineT m k o
construct :: PlanT k o m a -> MachineT m k o
construct PlanT k o m a
m = m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> m (Step k o (MachineT m k o)) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ PlanT k o m a
-> (a -> m (Step k o (MachineT m k o)))
-> (o
    -> m (Step k o (MachineT m k o)) -> m (Step k o (MachineT m k o)))
-> (forall z.
    (z -> m (Step k o (MachineT m k o)))
    -> k z
    -> m (Step k o (MachineT m k o))
    -> m (Step k o (MachineT m k o)))
-> m (Step k o (MachineT m k o))
-> m (Step k o (MachineT m k o))
forall (k :: * -> *) o (m :: * -> *) a.
PlanT k o m a
-> forall r.
   (a -> m r)
   -> (o -> m r -> m r)
   -> (forall z. (z -> m r) -> k z -> m r -> m r)
   -> m r
   -> m r
runPlanT PlanT k o m a
m
  (m (Step k o (MachineT m k o)) -> a -> m (Step k o (MachineT m k o))
forall a b. a -> b -> a
const (Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k o (MachineT m k o)
forall (k :: * -> *) o r. Step k o r
Stop))
  (\o
o m (Step k o (MachineT m k o))
k -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
k)))
  (\z -> m (Step k o (MachineT m k o))
f k z
k m (Step k o (MachineT m k o))
g -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return ((z -> MachineT m k o)
-> k z -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> (z -> m (Step k o (MachineT m k o))) -> z -> MachineT m k o
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. z -> m (Step k o (MachineT m k o))
f) k z
k (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
g)))
  (Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k o (MachineT m k o)
forall (k :: * -> *) o r. Step k o r
Stop)
{-# INLINE construct #-}

-- | Generates a model that runs a machine until it stops, then start it up again.
--
-- @'repeatedly' m = 'construct' ('Control.Monad.forever' m)@
repeatedly :: Monad m => PlanT k o m a -> MachineT m k o
repeatedly :: PlanT k o m a -> MachineT m k o
repeatedly PlanT k o m a
m = MachineT m k o
r where
  r :: MachineT m k o
r = m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> m (Step k o (MachineT m k o)) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ PlanT k o m a
-> (a -> m (Step k o (MachineT m k o)))
-> (o
    -> m (Step k o (MachineT m k o)) -> m (Step k o (MachineT m k o)))
-> (forall z.
    (z -> m (Step k o (MachineT m k o)))
    -> k z
    -> m (Step k o (MachineT m k o))
    -> m (Step k o (MachineT m k o)))
-> m (Step k o (MachineT m k o))
-> m (Step k o (MachineT m k o))
forall (k :: * -> *) o (m :: * -> *) a.
PlanT k o m a
-> forall r.
   (a -> m r)
   -> (o -> m r -> m r)
   -> (forall z. (z -> m r) -> k z -> m r -> m r)
   -> m r
   -> m r
runPlanT PlanT k o m a
m
    (m (Step k o (MachineT m k o)) -> a -> m (Step k o (MachineT m k o))
forall a b. a -> b -> a
const (MachineT m k o -> m (Step k o (MachineT m k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k o
r))
    (\o
o m (Step k o (MachineT m k o))
k -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
k)))
    (\z -> m (Step k o (MachineT m k o))
f k z
k m (Step k o (MachineT m k o))
g -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return ((z -> MachineT m k o)
-> k z -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> (z -> m (Step k o (MachineT m k o))) -> z -> MachineT m k o
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. z -> m (Step k o (MachineT m k o))
f) k z
k (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
g)))
    (Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k o (MachineT m k o)
forall (k :: * -> *) o r. Step k o r
Stop)
{-# INLINE repeatedly #-}

-- | Unfold a stateful PlanT into a MachineT.
unfoldPlan :: Monad m => s -> (s -> PlanT k o m s) -> MachineT m k o
unfoldPlan :: s -> (s -> PlanT k o m s) -> MachineT m k o
unfoldPlan s
s0 s -> PlanT k o m s
sp = s -> MachineT m k o
r s
s0 where
  r :: s -> MachineT m k o
r s
s = m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> m (Step k o (MachineT m k o)) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ PlanT k o m s
-> (s -> m (Step k o (MachineT m k o)))
-> (o
    -> m (Step k o (MachineT m k o)) -> m (Step k o (MachineT m k o)))
-> (forall z.
    (z -> m (Step k o (MachineT m k o)))
    -> k z
    -> m (Step k o (MachineT m k o))
    -> m (Step k o (MachineT m k o)))
-> m (Step k o (MachineT m k o))
-> m (Step k o (MachineT m k o))
forall (k :: * -> *) o (m :: * -> *) a.
PlanT k o m a
-> forall r.
   (a -> m r)
   -> (o -> m r -> m r)
   -> (forall z. (z -> m r) -> k z -> m r -> m r)
   -> m r
   -> m r
runPlanT (s -> PlanT k o m s
sp s
s)
      (\s
sx -> MachineT m k o -> m (Step k o (MachineT m k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k o -> m (Step k o (MachineT m k o)))
-> MachineT m k o -> m (Step k o (MachineT m k o))
forall a b. (a -> b) -> a -> b
$ s -> MachineT m k o
r s
sx)
      (\o
o m (Step k o (MachineT m k o))
k -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
k)))
      (\z -> m (Step k o (MachineT m k o))
f k z
k m (Step k o (MachineT m k o))
g -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return ((z -> MachineT m k o)
-> k z -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> (z -> m (Step k o (MachineT m k o))) -> z -> MachineT m k o
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. z -> m (Step k o (MachineT m k o))
f) k z
k (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
g)))
      (Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k o (MachineT m k o)
forall (k :: * -> *) o r. Step k o r
Stop)
{-# INLINE unfoldPlan #-}

-- | Evaluate a machine until it stops, and then yield answers according to the supplied model.
before :: Monad m => MachineT m k o -> PlanT k o m a -> MachineT m k o
before :: MachineT m k o -> PlanT k o m a -> MachineT m k o
before (MachineT m (Step k o (MachineT m k o))
n) PlanT k o m a
m = m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> m (Step k o (MachineT m k o)) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ PlanT k o m a
-> (a -> m (Step k o (MachineT m k o)))
-> (o
    -> m (Step k o (MachineT m k o)) -> m (Step k o (MachineT m k o)))
-> (forall z.
    (z -> m (Step k o (MachineT m k o)))
    -> k z
    -> m (Step k o (MachineT m k o))
    -> m (Step k o (MachineT m k o)))
-> m (Step k o (MachineT m k o))
-> m (Step k o (MachineT m k o))
forall (k :: * -> *) o (m :: * -> *) a.
PlanT k o m a
-> forall r.
   (a -> m r)
   -> (o -> m r -> m r)
   -> (forall z. (z -> m r) -> k z -> m r -> m r)
   -> m r
   -> m r
runPlanT PlanT k o m a
m
  (m (Step k o (MachineT m k o)) -> a -> m (Step k o (MachineT m k o))
forall a b. a -> b -> a
const m (Step k o (MachineT m k o))
n)
  (\o
o m (Step k o (MachineT m k o))
k -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
k)))
  (\z -> m (Step k o (MachineT m k o))
f k z
k m (Step k o (MachineT m k o))
g -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return ((z -> MachineT m k o)
-> k z -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> (z -> m (Step k o (MachineT m k o))) -> z -> MachineT m k o
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. z -> m (Step k o (MachineT m k o))
f) k z
k (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
g)))
  (Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k o (MachineT m k o)
forall (k :: * -> *) o r. Step k o r
Stop)
{-# INLINE before #-}

-- | Incorporate a 'Plan' into the resulting machine.
preplan :: Monad m => PlanT k o m (MachineT m k o) -> MachineT m k o
preplan :: PlanT k o m (MachineT m k o) -> MachineT m k o
preplan PlanT k o m (MachineT m k o)
m = m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> m (Step k o (MachineT m k o)) -> MachineT m k o
forall a b. (a -> b) -> a -> b
$ PlanT k o m (MachineT m k o)
-> (MachineT m k o -> m (Step k o (MachineT m k o)))
-> (o
    -> m (Step k o (MachineT m k o)) -> m (Step k o (MachineT m k o)))
-> (forall z.
    (z -> m (Step k o (MachineT m k o)))
    -> k z
    -> m (Step k o (MachineT m k o))
    -> m (Step k o (MachineT m k o)))
-> m (Step k o (MachineT m k o))
-> m (Step k o (MachineT m k o))
forall (k :: * -> *) o (m :: * -> *) a.
PlanT k o m a
-> forall r.
   (a -> m r)
   -> (o -> m r -> m r)
   -> (forall z. (z -> m r) -> k z -> m r -> m r)
   -> m r
   -> m r
runPlanT PlanT k o m (MachineT m k o)
m
  MachineT m k o -> m (Step k o (MachineT m k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT
  (\o
o m (Step k o (MachineT m k o))
k -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
k)))
  (\z -> m (Step k o (MachineT m k o))
f k z
k m (Step k o (MachineT m k o))
g -> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return ((z -> MachineT m k o)
-> k z -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k o (MachineT m k o)) -> MachineT m k o)
-> (z -> m (Step k o (MachineT m k o))) -> z -> MachineT m k o
forall (p :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor p, Coercible c b) =>
q b c -> p a b -> p a c
#. z -> m (Step k o (MachineT m k o))
f) k z
k (m (Step k o (MachineT m k o)) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT m (Step k o (MachineT m k o))
g)))
  (Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k o (MachineT m k o)
forall (k :: * -> *) o r. Step k o r
Stop)
{-# INLINE preplan #-}

-- | Given a handle, ignore all other inputs and just stream input from that handle.
--
-- @
-- 'pass' 'id' :: 'Data.Machine.Process.Process' a a
-- 'pass' 'Data.Machine.Tee.L'  :: 'Data.Machine.Tee.Tee' a b a
-- 'pass' 'Data.Machine.Tee.R'  :: 'Data.Machine.Tee.Tee' a b b
-- 'pass' 'Data.Machine.Wye.X'  :: 'Data.Machine.Wye.Wye' a b a
-- 'pass' 'Data.Machine.Wye.Y'  :: 'Data.Machine.Wye.Wye' a b b
-- 'pass' 'Data.Machine.Wye.Z'  :: 'Data.Machine.Wye.Wye' a b (Either a b)
-- @
--
pass :: k o -> Machine k o
pass :: k o -> Machine k o
pass k o
k =
    MachineT m k o
loop
  where
    loop :: MachineT m k o
loop = Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased ((o -> MachineT m k o)
-> k o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await (\o
t -> Step k o (MachineT m k o) -> MachineT m k o
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased (o -> MachineT m k o -> Step k o (MachineT m k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
t MachineT m k o
loop)) k o
k MachineT m k o
forall (k :: * -> *) b. Machine k b
stopped)
{-# INLINE pass #-}



-- | Run a machine with no input until it stops, then behave as another machine.
starve :: Monad m => MachineT m k0 b -> MachineT m k b -> MachineT m k b
starve :: MachineT m k0 b -> MachineT m k b -> MachineT m k b
starve MachineT m k0 b
m MachineT m k b
cont = m (Step k b (MachineT m k b)) -> MachineT m k b
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (m (Step k b (MachineT m k b)) -> MachineT m k b)
-> m (Step k b (MachineT m k b)) -> MachineT m k b
forall a b. (a -> b) -> a -> b
$ MachineT m k0 b -> m (Step k0 b (MachineT m k0 b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k0 b
m m (Step k0 b (MachineT m k0 b))
-> (Step k0 b (MachineT m k0 b) -> m (Step k b (MachineT m k b)))
-> m (Step k b (MachineT m k b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step k0 b (MachineT m k0 b)
v -> case Step k0 b (MachineT m k0 b)
v of
  Step k0 b (MachineT m k0 b)
Stop            -> MachineT m k b -> m (Step k b (MachineT m k b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k b
cont -- Continue with cont instead of stopping
  Yield b
o MachineT m k0 b
r       -> Step k b (MachineT m k b) -> m (Step k b (MachineT m k b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k b (MachineT m k b) -> m (Step k b (MachineT m k b)))
-> Step k b (MachineT m k b) -> m (Step k b (MachineT m k b))
forall a b. (a -> b) -> a -> b
$ b -> MachineT m k b -> Step k b (MachineT m k b)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield b
o (MachineT m k0 b -> MachineT m k b -> MachineT m k b
forall (m :: * -> *) (k0 :: * -> *) b (k :: * -> *).
Monad m =>
MachineT m k0 b -> MachineT m k b -> MachineT m k b
starve MachineT m k0 b
r MachineT m k b
cont)
  Await t -> MachineT m k0 b
_ k0 t
_ MachineT m k0 b
r     -> MachineT m k b -> m (Step k b (MachineT m k b))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT m k0 b -> MachineT m k b -> MachineT m k b
forall (m :: * -> *) (k0 :: * -> *) b (k :: * -> *).
Monad m =>
MachineT m k0 b -> MachineT m k b -> MachineT m k b
starve MachineT m k0 b
r MachineT m k b
cont)
{-# INLINE starve #-}

-- | This is a stopped 'Machine'
stopped :: Machine k b
stopped :: MachineT m k b
stopped = Step k b (MachineT m k b) -> MachineT m k b
forall (m :: * -> *) (k :: * -> *) o.
Monad m =>
Step k o (MachineT m k o) -> MachineT m k o
encased Step k b (MachineT m k b)
forall (k :: * -> *) o r. Step k o r
Stop
{-# INLINE stopped #-}

--------------------------------------------------------------------------------
-- Deconstruction
--------------------------------------------------------------------------------

--- | Convert a 'Machine' back into a 'Plan'. The first value the
--- machine yields that is tagged with the 'Left' data constructor is
--- used as the return value of the resultant 'Plan'. Machine-yielded
--- values tagged with 'Right' are yielded -- sans tag -- by the
--- result 'Plan'. This may be used when monadic binding of results is
--- required.
deconstruct :: Monad m => MachineT m k (Either a o) -> PlanT k o m a
deconstruct :: MachineT m k (Either a o) -> PlanT k o m a
deconstruct MachineT m k (Either a o)
m = (forall r.
 (a -> m r)
 -> (o -> m r -> m r)
 -> (forall z. (z -> m r) -> k z -> m r -> m r)
 -> m r
 -> m r)
-> PlanT k o m a
forall (k :: * -> *) o (m :: * -> *) a.
(forall r.
 (a -> m r)
 -> (o -> m r -> m r)
 -> (forall z. (z -> m r) -> k z -> m r -> m r)
 -> m r
 -> m r)
-> PlanT k o m a
PlanT ((forall r.
  (a -> m r)
  -> (o -> m r -> m r)
  -> (forall z. (z -> m r) -> k z -> m r -> m r)
  -> m r
  -> m r)
 -> PlanT k o m a)
-> (forall r.
    (a -> m r)
    -> (o -> m r -> m r)
    -> (forall z. (z -> m r) -> k z -> m r -> m r)
    -> m r
    -> m r)
-> PlanT k o m a
forall a b. (a -> b) -> a -> b
$ \a -> m r
r o -> m r -> m r
y forall z. (z -> m r) -> k z -> m r -> m r
a m r
f ->
  let aux :: MachineT m k (Either a o) -> m r
aux MachineT m k (Either a o)
k = PlanT k o m a
-> (a -> m r)
-> (o -> m r -> m r)
-> (forall z. (z -> m r) -> k z -> m r -> m r)
-> m r
-> m r
forall (k :: * -> *) o (m :: * -> *) a.
PlanT k o m a
-> forall r.
   (a -> m r)
   -> (o -> m r -> m r)
   -> (forall z. (z -> m r) -> k z -> m r -> m r)
   -> m r
   -> m r
runPlanT (MachineT m k (Either a o) -> PlanT k o m a
forall (m :: * -> *) (k :: * -> *) a o.
Monad m =>
MachineT m k (Either a o) -> PlanT k o m a
deconstruct MachineT m k (Either a o)
k) a -> m r
r o -> m r -> m r
y forall z. (z -> m r) -> k z -> m r -> m r
a m r
f
  in MachineT m k (Either a o)
-> m (Step k (Either a o) (MachineT m k (Either a o)))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT m k (Either a o)
m m (Step k (Either a o) (MachineT m k (Either a o)))
-> (Step k (Either a o) (MachineT m k (Either a o)) -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Step k (Either a o) (MachineT m k (Either a o))
v -> case Step k (Either a o) (MachineT m k (Either a o))
v of
       Step k (Either a o) (MachineT m k (Either a o))
Stop -> m r
f
       Yield (Left a
o) MachineT m k (Either a o)
_ -> a -> m r
r a
o
       Yield (Right o
o) MachineT m k (Either a o)
k -> o -> m r -> m r
y o
o (MachineT m k (Either a o) -> m r
aux MachineT m k (Either a o)
k)
       Await t -> MachineT m k (Either a o)
g k t
fk MachineT m k (Either a o)
h -> (t -> m r) -> k t -> m r -> m r
forall z. (z -> m r) -> k z -> m r -> m r
a (MachineT m k (Either a o) -> m r
aux (MachineT m k (Either a o) -> m r)
-> (t -> MachineT m k (Either a o)) -> t -> m r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t -> MachineT m k (Either a o)
g) k t
fk (MachineT m k (Either a o) -> m r
aux MachineT m k (Either a o)
h)

-- | Use a predicate to mark a yielded value as the terminal value of
-- this 'Machine'. This is useful in combination with 'deconstruct' to
-- combine 'Plan's.
tagDone :: Monad m => (o -> Bool) -> MachineT m k o -> MachineT m k (Either o o)
tagDone :: (o -> Bool) -> MachineT m k o -> MachineT m k (Either o o)
tagDone o -> Bool
f = (o -> Either o o) -> MachineT m k o -> MachineT m k (Either o o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap o -> Either o o
aux
  where aux :: o -> Either o o
aux o
x = if o -> Bool
f o
x then o -> Either o o
forall a b. a -> Either a b
Left o
x else o -> Either o o
forall a b. b -> Either a b
Right o
x

-- | Use a function to produce and mark a yielded value as the
-- terminal value of a 'Machine'. All yielded values for which the
-- given function returns 'Nothing' are yielded down the pipeline, but
-- the first value for which the function returns a 'Just' value will
-- be returned by a 'Plan' created via 'deconstruct'.
finishWith :: Monad m
           => (o -> Maybe r) -> MachineT m k o -> MachineT m k (Either r o)
finishWith :: (o -> Maybe r) -> MachineT m k o -> MachineT m k (Either r o)
finishWith o -> Maybe r
f = (o -> Either r o) -> MachineT m k o -> MachineT m k (Either r o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap o -> Either r o
aux
  where aux :: o -> Either r o
aux o
x = Either r o -> (r -> Either r o) -> Maybe r -> Either r o
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (o -> Either r o
forall a b. b -> Either a b
Right o
x) r -> Either r o
forall a b. a -> Either a b
Left (Maybe r -> Either r o) -> Maybe r -> Either r o
forall a b. (a -> b) -> a -> b
$ o -> Maybe r
f o
x


-------------------------------------------------------------------------------
-- Sink
-------------------------------------------------------------------------------

{-
-- |
-- A Sink in this model is a 'Data.Machine.Process.Process'
-- (or 'Data.Machine.Tee.Tee', etc) that produces a single answer.
--
-- \"Is that your final answer?\"
sink :: Monad m => (forall o. PlanT k o m a) -> MachineT m k a
sink m = runPlanT m (\a -> Yield a Stop) id (Await id) Stop
-}