-- | Utilities for working with machines that run in transformed monads,
-- inspired by @Pipes.Lift@.
module Data.Machine.Lift (execStateM, catchExcept, runReaderM) where

import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Except
import Data.Machine.Type

-- | Given an initial state and a 'MachineT' that runs in @'StateT' s m@,
-- produce a 'MachineT' that runs in @m@.
execStateM :: Monad m => s -> MachineT (StateT s m) k o -> MachineT m k o
execStateM :: s -> MachineT (StateT s m) k o -> MachineT m k o
execStateM s
s MachineT (StateT s 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
$ do
  (Step k o (MachineT (StateT s m) k o)
stp, s
s') <- StateT s m (Step k o (MachineT (StateT s m) k o))
-> s -> m (Step k o (MachineT (StateT s m) k o), s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MachineT (StateT s m) k o
-> StateT s m (Step k o (MachineT (StateT s m) k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT (StateT s m) k o
m) s
s
  case Step k o (MachineT (StateT s m) k o)
stp of
    Step k o (MachineT (StateT s m) k o)
Stop -> 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
    Yield o
o MachineT (StateT s m) k o
m' -> 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) -> m (Step k o (MachineT m k o)))
-> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall a b. (a -> b) -> a -> b
$ 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 (s -> MachineT (StateT s m) k o -> MachineT m k o
forall (m :: * -> *) s (k :: * -> *) o.
Monad m =>
s -> MachineT (StateT s m) k o -> MachineT m k o
execStateM s
s' MachineT (StateT s m) k o
m')
    Await t -> MachineT (StateT s m) k o
f k t
k MachineT (StateT s m) k o
q -> 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) -> m (Step k o (MachineT m k o)))
-> Step k o (MachineT m k o) -> m (Step k o (MachineT m k o))
forall a b. (a -> b) -> a -> b
$ (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 (s -> MachineT (StateT s m) k o -> MachineT m k o
forall (m :: * -> *) s (k :: * -> *) o.
Monad m =>
s -> MachineT (StateT s m) k o -> MachineT m k o
execStateM s
s' (MachineT (StateT s m) k o -> MachineT m k o)
-> (t -> MachineT (StateT s m) k o) -> t -> MachineT m k o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> MachineT (StateT s m) k o
f) k t
k (s -> MachineT (StateT s m) k o -> MachineT m k o
forall (m :: * -> *) s (k :: * -> *) o.
Monad m =>
s -> MachineT (StateT s m) k o -> MachineT m k o
execStateM s
s' MachineT (StateT s m) k o
q)

-- | 'catchExcept' allows a broken machine to be replaced without stopping the
-- assembly line.
catchExcept :: Monad m
               => MachineT (ExceptT e m) k o
               -> (e -> MachineT (ExceptT e m) k o)
               -> MachineT (ExceptT e m) k o
catchExcept :: MachineT (ExceptT e m) k o
-> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o
catchExcept MachineT (ExceptT e m) k o
m e -> MachineT (ExceptT e m) k o
c = ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
-> MachineT (ExceptT e m) k o
forall (m :: * -> *) (k :: * -> *) o.
m (Step k o (MachineT m k o)) -> MachineT m k o
MachineT (ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
 -> MachineT (ExceptT e m) k o)
-> ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
-> MachineT (ExceptT e m) k o
forall a b. (a -> b) -> a -> b
$ do
  Step k o (MachineT (ExceptT e m) k o)
step <- MachineT (ExceptT e m) k o
-> ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT MachineT (ExceptT e m) k o
m ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
-> (e -> ExceptT e m (Step k o (MachineT (ExceptT e m) k o)))
-> ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchE` \e
e -> MachineT (ExceptT e m) k o
-> ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
forall (m :: * -> *) (k :: * -> *) o.
MachineT m k o -> m (Step k o (MachineT m k o))
runMachineT (MachineT (ExceptT e m) k o
-> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o
forall (m :: * -> *) e (k :: * -> *) o.
Monad m =>
MachineT (ExceptT e m) k o
-> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o
catchExcept (e -> MachineT (ExceptT e m) k o
c e
e) e -> MachineT (ExceptT e m) k o
c)
  case Step k o (MachineT (ExceptT e m) k o)
step of
    Step k o (MachineT (ExceptT e m) k o)
Stop -> Step k o (MachineT (ExceptT e m) k o)
-> ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
forall (m :: * -> *) a. Monad m => a -> m a
return Step k o (MachineT (ExceptT e m) k o)
forall (k :: * -> *) o r. Step k o r
Stop
    Yield o
o MachineT (ExceptT e m) k o
m' -> Step k o (MachineT (ExceptT e m) k o)
-> ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k o (MachineT (ExceptT e m) k o)
 -> ExceptT e m (Step k o (MachineT (ExceptT e m) k o)))
-> Step k o (MachineT (ExceptT e m) k o)
-> ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
forall a b. (a -> b) -> a -> b
$ o
-> MachineT (ExceptT e m) k o
-> Step k o (MachineT (ExceptT e m) k o)
forall (k :: * -> *) o r. o -> r -> Step k o r
Yield o
o (MachineT (ExceptT e m) k o
-> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o
forall (m :: * -> *) e (k :: * -> *) o.
Monad m =>
MachineT (ExceptT e m) k o
-> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o
catchExcept MachineT (ExceptT e m) k o
m' e -> MachineT (ExceptT e m) k o
c)
    Await t -> MachineT (ExceptT e m) k o
f k t
k MachineT (ExceptT e m) k o
m' -> Step k o (MachineT (ExceptT e m) k o)
-> ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step k o (MachineT (ExceptT e m) k o)
 -> ExceptT e m (Step k o (MachineT (ExceptT e m) k o)))
-> Step k o (MachineT (ExceptT e m) k o)
-> ExceptT e m (Step k o (MachineT (ExceptT e m) k o))
forall a b. (a -> b) -> a -> b
$ (t -> MachineT (ExceptT e m) k o)
-> k t
-> MachineT (ExceptT e m) k o
-> Step k o (MachineT (ExceptT e m) k o)
forall (k :: * -> *) o r t. (t -> r) -> k t -> r -> Step k o r
Await ((MachineT (ExceptT e m) k o
 -> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o)
-> (e -> MachineT (ExceptT e m) k o)
-> MachineT (ExceptT e m) k o
-> MachineT (ExceptT e m) k o
forall a b c. (a -> b -> c) -> b -> a -> c
flip MachineT (ExceptT e m) k o
-> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o
forall (m :: * -> *) e (k :: * -> *) o.
Monad m =>
MachineT (ExceptT e m) k o
-> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o
catchExcept e -> MachineT (ExceptT e m) k o
c (MachineT (ExceptT e m) k o -> MachineT (ExceptT e m) k o)
-> (t -> MachineT (ExceptT e m) k o)
-> t
-> MachineT (ExceptT e m) k o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> MachineT (ExceptT e m) k o
f) k t
k (MachineT (ExceptT e m) k o
-> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o
forall (m :: * -> *) e (k :: * -> *) o.
Monad m =>
MachineT (ExceptT e m) k o
-> (e -> MachineT (ExceptT e m) k o) -> MachineT (ExceptT e m) k o
catchExcept MachineT (ExceptT e m) k o
m' e -> MachineT (ExceptT e m) k o
c)

-- | Given an environment and a 'MachineT' that runs in @'ReaderT' e m@,
-- produce a 'MachineT' that runs in @m@.
runReaderM :: Monad m => e -> MachineT (ReaderT e m) k o -> MachineT m k o
runReaderM :: e -> MachineT (ReaderT e m) k o -> MachineT m k o
runReaderM e
e = (forall a. ReaderT e m a -> m a)
-> MachineT (ReaderT e 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 ((ReaderT e m a -> e -> m a) -> e -> ReaderT e m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT e m a -> e -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT e
e)