{-# LANGUAGE GADTSyntax, ExistentialQuantification, Rank2Types, ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances, MultiParamTypeClasses, FlexibleInstances #-}
-- Search for UndecidableInstances to see why this is needed

module Control.Monad.Operational (
    -- * Synopsis
    -- $synopsis

    -- * Overview
    -- $intro

    -- * Monad
    Program, singleton, ProgramView, view,
    -- $example
    interpretWithMonad,

    -- * Monad transformer
    ProgramT, ProgramViewT(..), viewT,
    -- $exampleT
    liftProgram, mapInstr,
    unviewT, interpretWithMonadT,

    ) where

import Control.Monad.Identity
import Control.Monad.Trans

    -- mtl  classes to instantiate.
    -- Those commented out cannot be instantiated. For reasons see below.
-- import Control.Monad.Cont.Class
-- import Control.Monad.Error.Class
import Control.Monad.Reader.Class
import Control.Monad.State.Class
-- import Control.Monad.Writer.Class

{------------------------------------------------------------------------------
    Introduction
------------------------------------------------------------------------------}
{-$synopsis
To write a monad, use the 'Program' type.

To write a monad transformer, use the 'ProgramT' type.

For easier interoperability,
the 'Program' type is actually a type synonym
and defined in terms of 'ProgramT'.
-}

{-$intro

The basic idea for implementing monads with this libary
is to think of monads as /sequences of primitive instructions/.
For instance, imagine that you want to write a web application
with a custom monad that features an instruction

> askUserInput :: CustomMonad UserInput

which sends a form to the remote user and waits for the user
to send back his input

To implement this monad, you decide that this instruction is
a primitive, i.e. should not be implemented in terms of other,
more basic instructions.
Once you have chosen your primitives, collect them in a data type

@
data CustomMonadInstruction a where
    AskUserInput :: CustomMonadInstruction UserInput
@

Then, obtain your custom monad simply by applying the 'Program'
type constructor

> type CustomMonad a = Program CustomMonadInstruction a

The library makes sure that it is an instance of the 'Monad' class
and fulfills all the required laws.

Essentially, the monad you now obtained is just a
fancy list of primitive instructions.
In particular, you can pattern match on the first element of this "list".
This is how you implement an @interpret@ or @run@ function for your monad.
Note that pattern matching is done using the 'view' function

@
runCustomMonad :: CustomMonad a -> IO a
runCustomMonad m = case view m of
    Return a            -> return a -- done, return the result
    AskUserInput :>>= k -> do
        b <- waitForUserInput       -- wait for external user input
        runCustomMonad (k b)        -- proceed with next instruction
@

The point is that you can now proceed in any way you like:
you can wait for the user to return input as shown,
or you store the continuation @k@ and retrieve it when
your web application receives another HTTP request,
or you can keep a log of all user inputs on the client side and replay them,
and so on. Moreover, you can implement different @run@ functions
for one and the same custom monad, which is useful for testing.
Also note that the result type of the @run@ function does not need to
be a monad at all.

In essence, your custom monad allows you to express
your web application as a simple imperative program,
while the underlying implementation can freely map this to
an event-drived model or some other control flow architecture
of your choice.

The possibilities are endless.
More usage examples can be found here:
<https://github.com/HeinrichApfelmus/operational/tree/master/doc/examples#readme>

-}

{------------------------------------------------------------------------------
   Program
------------------------------------------------------------------------------}
{-| The abstract data type @'Program' instr a@ represents programs,
    i.e. sequences of primitive instructions.

    * The /primitive instructions/ are given by the type constructor @instr :: * -> *@.

    * @a@ is the return type of a program.

    @'Program' instr@ is always a monad and
    automatically obeys the monad laws.
-}
type Program instr = ProgramT instr Identity

-- | View type for inspecting the first instruction.
--   It has two constructors 'Return' and @:>>=@.
--   (For technical reasons, they are documented at 'ProgramViewT'.)
type ProgramView instr  = ProgramViewT instr Identity

-- | View function for inspecting the first instruction.
view :: Program instr a -> ProgramView instr a
view :: Program instr a -> ProgramView instr a
view = Identity (ProgramView instr a) -> ProgramView instr a
forall a. Identity a -> a
runIdentity (Identity (ProgramView instr a) -> ProgramView instr a)
-> (Program instr a -> Identity (ProgramView instr a))
-> Program instr a
-> ProgramView instr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program instr a -> Identity (ProgramView instr a)
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
ProgramT instr m a -> m (ProgramViewT instr m a)
viewT


-- | Utility function that extends
-- a given interpretation of instructions as monadic actions
-- to an interpration of 'Program's as monadic actions.
--
-- This function can be useful if you are mainly interested in
-- mapping a 'Program' to different standard monads, like the state monad.
-- For implementing a truly custom monad,
-- you should write your interpreter directly with 'view' instead.
interpretWithMonad :: forall instr m b.
    Monad m => (forall a. instr a -> m a) -> (Program instr b -> m b)
interpretWithMonad :: (forall a. instr a -> m a) -> Program instr b -> m b
interpretWithMonad forall a. instr a -> m a
f = ProgramView instr b -> m b
forall a. ProgramView instr a -> m a
eval (ProgramView instr b -> m b)
-> (Program instr b -> ProgramView instr b)
-> Program instr b
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program instr b -> ProgramView instr b
forall (instr :: * -> *) a. Program instr a -> ProgramView instr a
view
    where
    eval :: forall a. ProgramView instr a -> m a
    eval :: ProgramView instr a -> m a
eval (Return a
a) = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    eval (instr b
m :>>= b -> ProgramT instr Identity a
k) = instr b -> m b
forall a. instr a -> m a
f instr b
m m b -> (b -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. instr a -> m a) -> ProgramT instr Identity a -> m a
forall (instr :: * -> *) (m :: * -> *) b.
Monad m =>
(forall a. instr a -> m a) -> Program instr b -> m b
interpretWithMonad forall a. instr a -> m a
f (ProgramT instr Identity a -> m a)
-> (b -> ProgramT instr Identity a) -> b -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT instr Identity a
k

{- $example

/Example usage/

Stack machine from \"The Operational Monad Tutorial\".

>    data StackInstruction a where
>        Push :: Int -> StackInstruction ()
>        Pop  :: StackInstruction Int
>
>    type StackProgram a = Program StackInstruction a
>    type Stack b        = [b]
>
>    interpret :: StackProgram a -> (Stack Int -> a)
>    interpret = eval . view
>        where
>        eval :: ProgramView StackInstruction a -> (Stack Int -> a)
>        eval (Push a :>>= is) stack     = interpret (is ()) (a:stack)
>        eval (Pop    :>>= is) (a:stack) = interpret (is a ) stack
>        eval (Return a)       stack     = a

In this example, the type signature for the `eval` helper function is optional.

-}

{------------------------------------------------------------------------------
    ProgramT - monad transformer
------------------------------------------------------------------------------}
{-| The abstract data type @'ProgramT' instr m a@ represents programs
    over a base monad @m@,
    i.e. sequences of primitive instructions and actions from the base monad.

    * The /primitive instructions/ are given by the type constructor @instr :: * -> *@.

    * @m@ is the base monad, embedded with 'lift'.

    * @a@ is the return type of a program.

    @'ProgramT' instr m@ is a monad transformer and
    automatically obeys both the monad and the lifting laws.
-}
data ProgramT instr m a where
    Lift   :: m a -> ProgramT instr m a
    Bind   :: ProgramT instr m b -> (b -> ProgramT instr m a)
           -> ProgramT instr m a
    Instr  :: instr a -> ProgramT instr m a

    -- basic instances
instance Monad m => Monad (ProgramT instr m) where
    return :: a -> ProgramT instr m a
return = m a -> ProgramT instr m a
forall (m :: * -> *) a (instr :: * -> *). m a -> ProgramT instr m a
Lift (m a -> ProgramT instr m a)
-> (a -> m a) -> a -> ProgramT instr m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    >>= :: ProgramT instr m a
-> (a -> ProgramT instr m b) -> ProgramT instr m b
(>>=)  = ProgramT instr m a
-> (a -> ProgramT instr m b) -> ProgramT instr m b
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
Bind

instance MonadTrans (ProgramT instr) where
    lift :: m a -> ProgramT instr m a
lift   = m a -> ProgramT instr m a
forall (m :: * -> *) a (instr :: * -> *). m a -> ProgramT instr m a
Lift

instance Monad m => Functor (ProgramT instr m) where
    fmap :: (a -> b) -> ProgramT instr m a -> ProgramT instr m b
fmap   = (a -> b) -> ProgramT instr m a -> ProgramT instr m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Monad m => Applicative (ProgramT instr m) where
    pure :: a -> ProgramT instr m a
pure   = a -> ProgramT instr m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: ProgramT instr m (a -> b)
-> ProgramT instr m a -> ProgramT instr m b
(<*>)  = ProgramT instr m (a -> b)
-> ProgramT instr m a -> ProgramT instr m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

-- | Program made from a single primitive instruction.
singleton :: instr a -> ProgramT instr m a
singleton :: instr a -> ProgramT instr m a
singleton = instr a -> ProgramT instr m a
forall (instr :: * -> *) a (m :: * -> *).
instr a -> ProgramT instr m a
Instr

-- | View type for inspecting the first instruction.
-- This is very similar to pattern matching on lists.
--
-- * The case @(Return a)@ means that the program contains no instructions
-- and just returns the result @a@.
--
-- *The case @(someInstruction :>>= k)@ means that the first instruction
-- is @someInstruction@ and the remaining program is given by the function @k@.
data ProgramViewT instr m a where
    Return :: a -> ProgramViewT instr m a
    (:>>=) :: instr b
           -> (b -> ProgramT instr m a)
           -> ProgramViewT instr m a

instance Monad m => Functor (ProgramViewT instr m) where
    fmap :: (a -> b) -> ProgramViewT instr m a -> ProgramViewT instr m b
fmap a -> b
f (Return a
a) = b -> ProgramViewT instr m b
forall a (instr :: * -> *) (m :: * -> *).
a -> ProgramViewT instr m a
Return (b -> ProgramViewT instr m b) -> b -> ProgramViewT instr m b
forall a b. (a -> b) -> a -> b
$ a -> b
f a
a
    fmap a -> b
f (instr b
instr :>>= b -> ProgramT instr m a
cont) = instr b
instr instr b -> (b -> ProgramT instr m b) -> ProgramViewT instr m b
forall (instr :: * -> *) b (m :: * -> *) a.
instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a
:>>= ((a -> b) -> ProgramT instr m a -> ProgramT instr m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ProgramT instr m a -> ProgramT instr m b)
-> (b -> ProgramT instr m a) -> b -> ProgramT instr m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT instr m a
cont)

instance Monad m => Applicative (ProgramViewT instr m) where
    pure :: a -> ProgramViewT instr m a
pure = a -> ProgramViewT instr m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: ProgramViewT instr m (a -> b)
-> ProgramViewT instr m a -> ProgramViewT instr m b
(<*>) = ProgramViewT instr m (a -> b)
-> ProgramViewT instr m a -> ProgramViewT instr m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (ProgramViewT instr m) where
    return :: a -> ProgramViewT instr m a
return = a -> ProgramViewT instr m a
forall a (instr :: * -> *) (m :: * -> *).
a -> ProgramViewT instr m a
Return
    Return a
a >>= :: ProgramViewT instr m a
-> (a -> ProgramViewT instr m b) -> ProgramViewT instr m b
>>= a -> ProgramViewT instr m b
cont = a -> ProgramViewT instr m b
cont a
a
    (instr b
instr :>>= b -> ProgramT instr m a
cont1) >>= a -> ProgramViewT instr m b
cont2 = instr b
instr instr b -> (b -> ProgramT instr m b) -> ProgramViewT instr m b
forall (instr :: * -> *) b (m :: * -> *) a.
instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a
:>>= (b -> ProgramT instr m a
cont1 (b -> ProgramT instr m a)
-> (a -> ProgramT instr m b) -> b -> ProgramT instr m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ProgramViewT instr m b -> ProgramT instr m b
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
ProgramViewT instr m a -> ProgramT instr m a
unviewT (ProgramViewT instr m b -> ProgramT instr m b)
-> (a -> ProgramViewT instr m b) -> a -> ProgramT instr m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ProgramViewT instr m b
cont2)

-- | View function for inspecting the first instruction.
viewT :: Monad m => ProgramT instr m a -> m (ProgramViewT instr m a)
viewT :: ProgramT instr m a -> m (ProgramViewT instr m a)
viewT (Lift m a
m)                = m a
m m a
-> (a -> m (ProgramViewT instr m a)) -> m (ProgramViewT instr m a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProgramViewT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ProgramViewT instr m a -> m (ProgramViewT instr m a))
-> (a -> ProgramViewT instr m a) -> a -> m (ProgramViewT instr m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ProgramViewT instr m a
forall a (instr :: * -> *) (m :: * -> *).
a -> ProgramViewT instr m a
Return
viewT ((Lift m b
m)     `Bind` b -> ProgramT instr m a
g) = m b
m m b
-> (b -> m (ProgramViewT instr m a)) -> m (ProgramViewT instr m a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProgramT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
ProgramT instr m a -> m (ProgramViewT instr m a)
viewT (ProgramT instr m a -> m (ProgramViewT instr m a))
-> (b -> ProgramT instr m a) -> b -> m (ProgramViewT instr m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT instr m a
g
viewT ((ProgramT instr m b
m `Bind` b -> ProgramT instr m b
g) `Bind` b -> ProgramT instr m a
h) = ProgramT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
ProgramT instr m a -> m (ProgramViewT instr m a)
viewT (ProgramT instr m b
m ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
`Bind` (\b
x -> b -> ProgramT instr m b
g b
x ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
`Bind` b -> ProgramT instr m a
h))
viewT ((Instr instr b
i)    `Bind` b -> ProgramT instr m a
g) = ProgramViewT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (instr b
i instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a
forall (instr :: * -> *) b (m :: * -> *) a.
instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a
:>>= b -> ProgramT instr m a
g)
viewT (Instr instr a
i)               = ProgramViewT instr m a -> m (ProgramViewT instr m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (instr a
i instr a -> (a -> ProgramT instr m a) -> ProgramViewT instr m a
forall (instr :: * -> *) b (m :: * -> *) a.
instr b -> (b -> ProgramT instr m a) -> ProgramViewT instr m a
:>>= a -> ProgramT instr m a
forall (m :: * -> *) a. Monad m => a -> m a
return)

{-| Lift a plain sequence of instructions to a sequence
    of instructions over a monad 'm'.
    This is the counterpart of the 'lift' function from 'MonadTrans'.

    It can be defined as follows:

@
    liftProgram = eval . view
        where
        eval :: ProgramView instr a -> ProgramT instr m a
        eval (Return a) = return a
        eval (i :>>= k) = singleton i >>= liftProgram . k
@

-}
liftProgram :: Monad m => Program instr a -> ProgramT instr m a
liftProgram :: Program instr a -> ProgramT instr m a
liftProgram (Lift Identity a
m)     = a -> ProgramT instr m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Identity a -> a
forall a. Identity a -> a
runIdentity Identity a
m)
liftProgram (ProgramT instr Identity b
m `Bind` b -> Program instr a
k) = ProgramT instr Identity b -> ProgramT instr m b
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
Program instr a -> ProgramT instr m a
liftProgram ProgramT instr Identity b
m ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
`Bind` (Program instr a -> ProgramT instr m a
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
Program instr a -> ProgramT instr m a
liftProgram (Program instr a -> ProgramT instr m a)
-> (b -> Program instr a) -> b -> ProgramT instr m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Program instr a
k)
liftProgram (Instr instr a
i)    = instr a -> ProgramT instr m a
forall (instr :: * -> *) a (m :: * -> *).
instr a -> ProgramT instr m a
Instr instr a
i


-- | Utility function that extends
-- a given interpretation of instructions as monadic actions
-- to an interpration of 'ProgramT's as monadic actions.
--
-- Ideally, you would not use another monad,
-- but write a custom interpreter directly with `viewT`.
-- See the remark at 'interpretWithMonad'.
interpretWithMonadT :: Monad m => (forall x . instr x -> m x) -> ProgramT instr m a -> m a
interpretWithMonadT :: (forall x. instr x -> m x) -> ProgramT instr m a -> m a
interpretWithMonadT forall x. instr x -> m x
interpreter = ProgramT instr m a -> m a
forall b. ProgramT instr m b -> m b
go
  where
    go :: ProgramT instr m b -> m b
go ProgramT instr m b
program = do
      ProgramViewT instr m b
firstInstruction <- ProgramT instr m b -> m (ProgramViewT instr m b)
forall (m :: * -> *) (instr :: * -> *) a.
Monad m =>
ProgramT instr m a -> m (ProgramViewT instr m a)
viewT ProgramT instr m b
program
      case ProgramViewT instr m b
firstInstruction of
        Return b
a -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
a
        instr b
instruction :>>= b -> ProgramT instr m b
continuation -> instr b -> m b
forall x. instr x -> m x
interpreter instr b
instruction m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ProgramT instr m b -> m b
go (ProgramT instr m b -> m b)
-> (b -> ProgramT instr m b) -> b -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT instr m b
continuation)

-- | Utilitiy function for mapping a 'ProgramViewT' back into a 'ProgramT'.
-- 
-- Semantically, the function 'unviewT' is an inverse of 'viewT',
-- e.g. we have
--
-- @
--   viewT (singleton i) >>= unviewT = return (singleton i)
-- @
unviewT :: Monad m => ProgramViewT instr m a -> ProgramT instr m a
unviewT :: ProgramViewT instr m a -> ProgramT instr m a
unviewT (Return a
a) = a -> ProgramT instr m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
unviewT (instr b
instruction :>>= b -> ProgramT instr m a
continuation) =
    (instr b -> ProgramT instr m b
forall (instr :: * -> *) a (m :: * -> *).
instr a -> ProgramT instr m a
Instr instr b
instruction) ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
`Bind` b -> ProgramT instr m a
continuation

-- | Extend a mapping of instructions to a mapping of 'ProgramT'.
mapInstr ::
    forall instr1 instr2 m a . Monad m
    => (forall x . instr1 x -> instr2 x)
    -> ProgramT instr1 m a -> ProgramT instr2 m a
mapInstr :: (forall x. instr1 x -> instr2 x)
-> ProgramT instr1 m a -> ProgramT instr2 m a
mapInstr forall x. instr1 x -> instr2 x
f = ProgramT instr1 m a -> ProgramT instr2 m a
forall x. ProgramT instr1 m x -> ProgramT instr2 m x
go
    where
        go :: forall x. ProgramT instr1 m x -> ProgramT instr2 m x
        go :: ProgramT instr1 m x -> ProgramT instr2 m x
go (Lift m x
action) = m x -> ProgramT instr2 m x
forall (m :: * -> *) a (instr :: * -> *). m a -> ProgramT instr m a
Lift m x
action
        go (Bind ProgramT instr1 m b
action b -> ProgramT instr1 m x
continuation) = ProgramT instr2 m b
-> (b -> ProgramT instr2 m x) -> ProgramT instr2 m x
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
Bind (ProgramT instr1 m b -> ProgramT instr2 m b
forall x. ProgramT instr1 m x -> ProgramT instr2 m x
go ProgramT instr1 m b
action) (ProgramT instr1 m x -> ProgramT instr2 m x
forall x. ProgramT instr1 m x -> ProgramT instr2 m x
go (ProgramT instr1 m x -> ProgramT instr2 m x)
-> (b -> ProgramT instr1 m x) -> b -> ProgramT instr2 m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT instr1 m x
continuation)
        go (Instr instr1 x
instruction) = instr2 x -> ProgramT instr2 m x
forall (instr :: * -> *) a (m :: * -> *).
instr a -> ProgramT instr m a
Instr (instr2 x -> ProgramT instr2 m x)
-> instr2 x -> ProgramT instr2 m x
forall a b. (a -> b) -> a -> b
$ instr1 x -> instr2 x
forall x. instr1 x -> instr2 x
f instr1 x
instruction

{- $exampleT

/Example usage/

List monad transformer.

>    data PlusI m a where
>        Zero :: PlusI m a
>        Plus :: ListT m a -> ListT m a -> PlusI m a
>
>    type ListT m a = ProgramT (PlusI m) m a
>
>    runList :: Monad m => ListT m a -> m [a]
>    runList = eval <=< viewT
>        where
>        eval :: Monad m => ProgramViewT (PlusI m) m a -> m [a]
>        eval (Return x)        = return [x]
>        eval (Zero     :>>= k) = return []
>        eval (Plus m n :>>= k) =
>            liftM2 (++) (runList (m >>= k)) (runList (n >>= k))

In this example, the type signature for the `eval` helper function is optional.

-}

{------------------------------------------------------------------------------
    mtl instances

  * All of these instances need UndecidableInstances,
    because they do not satisfy the coverage condition.
    Most of the instance in the  mtl  package itself have the same issue.

  * Lifting algebraic operations is easy,
    lifting control operations is more elaborate, but sometimes possible.
    See the design notes in  `doc/design.md`.
------------------------------------------------------------------------------}
instance (MonadState s m) => MonadState s (ProgramT instr m) where
    get :: ProgramT instr m s
get = m s -> ProgramT instr m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
    put :: s -> ProgramT instr m ()
put = m () -> ProgramT instr m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ProgramT instr m ())
-> (s -> m ()) -> s -> ProgramT instr m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance (MonadIO m) => MonadIO (ProgramT instr m) where
    liftIO :: IO a -> ProgramT instr m a
liftIO = m a -> ProgramT instr m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ProgramT instr m a)
-> (IO a -> m a) -> IO a -> ProgramT instr m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance (MonadReader r m) => MonadReader r (ProgramT instr m) where
    ask :: ProgramT instr m r
ask = m r -> ProgramT instr m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask

    local :: (r -> r) -> ProgramT instr m a -> ProgramT instr m a
local r -> r
r (Lift m a
m)     = m a -> ProgramT instr m a
forall (m :: * -> *) a (instr :: * -> *). m a -> ProgramT instr m a
Lift ((r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
r m a
m)
    local r -> r
r (ProgramT instr m b
m `Bind` b -> ProgramT instr m a
k) = (r -> r) -> ProgramT instr m b -> ProgramT instr m b
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
r ProgramT instr m b
m ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
forall (instr :: * -> *) (m :: * -> *) b a.
ProgramT instr m b
-> (b -> ProgramT instr m a) -> ProgramT instr m a
`Bind` ((r -> r) -> ProgramT instr m a -> ProgramT instr m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
r (ProgramT instr m a -> ProgramT instr m a)
-> (b -> ProgramT instr m a) -> b -> ProgramT instr m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> ProgramT instr m a
k)
    local r -> r
_ (Instr instr a
i)    = instr a -> ProgramT instr m a
forall (instr :: * -> *) a (m :: * -> *).
instr a -> ProgramT instr m a
Instr instr a
i