{- |
Module      : Control.Monad.Script
Description : An unrolled stack of Reader, Writer, Error, State, and Prompt transformers.
Copyright   : 2018, Automattic, Inc.
License     : BSD3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX

`ScriptT` is an unrolled stack of reader, writer, state, error, and prompt monad transformers, meant as a basis for building more specific DSLs. Also comes in "monad transformer transformer" flavor with `ScriptTT`.

The addition of prompt to the monad team makes it straightforward to build effectful computations which defer the actual effects (and effect types) to an evaluator function that is both precisely controlled and easily extended. This allows us to build testable and composable API layers.

The name "script" is meant to evoke the script of a play. In the theater sense a script is not a list of /instructions/ so much as a list of /suggestions/, and every cast gives a unique interpretation. Similarly a 'ScriptT eff a' is a pure value that gets an effectful interpretation in monad `eff` from a user-supplied evaluator.
-}

{-#
  LANGUAGE
    CPP,
    GADTs,
    Rank2Types,
    TupleSections, 
    KindSignatures,
    ScopedTypeVariables,
    QuantifiedConstraints
#-}

module Control.Monad.Script (
  -- * ScriptT
    ScriptT

  -- * ScriptTT
  , ScriptTT()
  , execScriptTT
  , liftScriptTT

  -- * Error
  , except
  , triage
  , throw
  , catch

  -- * Reader
  , ask
  , local
  , transport
  , reader

  -- * Writer
  , tell
  , draft
  , listen
  , pass
  , censor

  -- * State
  , get
  , put
  , modify
  , modify'
  , gets

  -- * Prompt
  , prompt

  -- * Testing
  , checkScriptTT
) where



#if MIN_VERSION_base(4,9,0)
import Prelude hiding (fail)
#endif

import Control.Monad
  ( ap, join )
import Control.Monad.Trans.Class
  ( MonadTrans(..) )
import Control.Monad.Trans.Identity
  ( IdentityT(..) )
import Data.Functor.Classes
  ()
import Data.Functor.Identity
  ( Identity(..) )
import Data.Monoid
  ()
import Data.Typeable
  ( Typeable )
import Test.QuickCheck
  ( Property, Gen, Arbitrary(..), CoArbitrary(..), Testable )
import Test.QuickCheck.Monadic
  ( PropertyM, monadicIO, run, stop, assert )

-- Transitional MonadFail implementation
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail
#endif





-- | Opaque stack of error (@e@), reader (@r@), writer (@w@), state (@s@), and prompt (@p@) monad transformers, accepting a monad transformer parameter (@t@). Behaves something like a monad transformer transformer.
data
  ScriptTT
    (e :: *)
    (r :: *)
    (w :: *)
    (s :: *)
    (p :: * -> *)
    (t :: (* -> *) -> * -> *)
    (eff :: * -> *)
    (a :: *)
  where
  ScriptTT
    :: (Monad eff, Monad (t eff), MonadTrans t)
    => ((s,r)
         -> forall v.
             ((Either e a, s, w) -> t eff v)
             -> (forall u. p u -> (u -> t eff v) -> t eff v)
             -> t eff v)
    -> ScriptTT e r w s p t eff a
  deriving Typeable

-- Only needed to make type inference work correctly.
runScriptTT
  :: ScriptTT e r w s p t eff a
  -> (s,r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v)
       -> t eff v
runScriptTT :: ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT (ScriptTT (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
x) = (s, r)
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
(s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
x

instance
  (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
    => Monad (ScriptTT e r w s p t eff) where
  return :: a -> ScriptTT e r w s p t eff a
return a
x = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ ->
    (Either e a, s, w) -> t eff v
end (a -> Either e a
forall a b. b -> Either a b
Right a
x, s
s, w
forall a. Monoid a => a
mempty)

  ScriptTT e r w s p t eff a
x >>= :: ScriptTT e r w s p t eff a
-> (a -> ScriptTT e r w s p t eff b) -> ScriptTT e r w s p t eff b
>>= a -> ScriptTT e r w s p t eff b
f = ((s, r)
 -> forall v.
    ((Either e b, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff b
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e b, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff b)
-> ((s, r)
    -> forall v.
       ((Either e b, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff b
forall a b. (a -> b) -> a -> b
$ \(s
s0,r
r) -> \(Either e b, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont -> do
    let
      g :: (Either e a, s, w) -> t eff v
g (Either e a
z1,s
s1,w
w1) = case Either e a
z1 of
        Right a
y -> do
          let h :: (Either e b, s, w) -> t eff v
h (Either e b
z2,s
s2,w
w2) = (Either e b, s, w) -> t eff v
end (Either e b
z2, s
s2, w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
w1 w
w2)
          ScriptTT e r w s p t eff b
-> (s, r)
-> ((Either e b, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT (a -> ScriptTT e r w s p t eff b
f a
y) (s
s1,r
r) (Either e b, s, w) -> t eff v
h forall u. p u -> (u -> t eff v) -> t eff v
cont
        Left e
e -> do
          let h :: (Either Any (), s, w) -> t eff v
h (Either Any ()
_,s
s2,w
w2) = (Either e b, s, w) -> t eff v
end (e -> Either e b
forall a b. a -> Either a b
Left e
e, s
s2, w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
w1 w
w2)
          ScriptTT Any r w s p t eff ()
-> (s, r)
-> ((Either Any (), s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT (() -> ScriptTT Any r w s p t eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (s
s1,r
r) (Either Any (), s, w) -> t eff v
h forall u. p u -> (u -> t eff v) -> t eff v
cont
          
    ScriptTT e r w s p t eff a
-> (s, r)
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT ScriptTT e r w s p t eff a
x (s
s0,r
r) (Either e a, s, w) -> t eff v
g forall u. p u -> (u -> t eff v) -> t eff v
cont

instance
  (Monoid w, Monad eff, Monad (t eff), MonadTrans t, MonadFail (t eff))
    => MonadFail (ScriptTT e r w s p t eff) where
  fail :: String -> ScriptTT e r w s p t eff a
fail String
msg = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s, r)
_ -> \(Either e a, s, w) -> t eff v
_ forall u. p u -> (u -> t eff v) -> t eff v
_ -> String -> t eff v
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg

instance
  (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
    => Applicative (ScriptTT e r w s p t eff) where
  pure :: a -> ScriptTT e r w s p t eff a
pure = a -> ScriptTT e r w s p t eff a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: ScriptTT e r w s p t eff (a -> b)
-> ScriptTT e r w s p t eff a -> ScriptTT e r w s p t eff b
(<*>) = ScriptTT e r w s p t eff (a -> b)
-> ScriptTT e r w s p t eff a -> ScriptTT e r w s p t eff b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance
  (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
    => Functor (ScriptTT e r w s p t eff) where
  fmap :: (a -> b)
-> ScriptTT e r w s p t eff a -> ScriptTT e r w s p t eff b
fmap a -> b
f ScriptTT e r w s p t eff a
x = ScriptTT e r w s p t eff a
x ScriptTT e r w s p t eff a
-> (a -> ScriptTT e r w s p t eff b) -> ScriptTT e r w s p t eff b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> ScriptTT e r w s p t eff b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ScriptTT e r w s p t eff b)
-> (a -> b) -> a -> ScriptTT e r w s p t eff b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance
  (Monoid w, forall m. (Monad m) => Monad (t m), MonadTrans t)
    => MonadTrans (ScriptTT e r w s p t) where
  lift :: m a -> ScriptTT e r w s p t m a
lift m a
x = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t m v)
    -> (forall u. p u -> (u -> t m v) -> t m v) -> t m v)
-> ScriptTT e r w s p t m a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t m v)
     -> (forall u. p u -> (u -> t m v) -> t m v) -> t m v)
 -> ScriptTT e r w s p t m a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t m v)
       -> (forall u. p u -> (u -> t m v) -> t m v) -> t m v)
-> ScriptTT e r w s p t m a
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e a, s, w) -> t m v
end forall u. p u -> (u -> t m v) -> t m v
_ ->
    m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
x t m a -> (a -> t m v) -> t m v
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> (Either e a, s, w) -> t m v
end (a -> Either e a
forall a b. b -> Either a b
Right a
a, s
s, w
forall a. Monoid a => a
mempty)

-- | Lift a value from the inner transformer.
liftScriptTT
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => t eff a -> ScriptTT e r w s p t eff a
liftScriptTT :: t eff a -> ScriptTT e r w s p t eff a
liftScriptTT t eff a
x = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ -> do
  a
a <- t eff a
x
  (Either e a, s, w) -> t eff v
end (a -> Either e a
forall a b. b -> Either a b
Right a
a, s
s, w
forall a. Monoid a => a
mempty)




-- | Opaque stack of error (@e@), reader (@r@), writer (@w@), state (@s@), and prompt (@p@) monad transformers.
type ScriptT e r w s p = ScriptTT e r w s p IdentityT





-- Execute a `ScriptTT` with a specified initial state, environment, and continuation.
execScriptTC
  :: s -- ^ Initial state
  -> r -- ^ Environment
  -> ((Either e a, s, w) -> t eff v)
  -> (forall u. p u -> (u -> t eff v) -> t eff v)
  -> ScriptTT e r w s p t eff a
  -> t eff v
execScriptTC :: s
-> r
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
-> t eff v
execScriptTC s
s r
r (Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont (ScriptTT (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
run) =
  (s, r)
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
(s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
run (s
s,r
r) (Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont

-- | Execute a `ScriptTT` with a specified inital state and environment and with a specified prompt evaluator into the effect monad @eff@.
execScriptTT
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => s -- ^ Initial state
  -> r -- ^ Environment
  -> (forall u. p u -> eff u) -- ^ Monadic effect evaluator
  -> ScriptTT e r w s p t eff a
  -> t eff (Either e a, s, w)
execScriptTT :: s
-> r
-> (forall u. p u -> eff u)
-> ScriptTT e r w s p t eff a
-> t eff (Either e a, s, w)
execScriptTT s
s r
r forall u. p u -> eff u
eval =
  s
-> r
-> ((Either e a, s, w) -> t eff (Either e a, s, w))
-> (forall u.
    p u -> (u -> t eff (Either e a, s, w)) -> t eff (Either e a, s, w))
-> ScriptTT e r w s p t eff a
-> t eff (Either e a, s, w)
forall s r e a w (t :: (* -> *) -> * -> *) (eff :: * -> *) v
       (p :: * -> *).
s
-> r
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
-> t eff v
execScriptTC s
s r
r (Either e a, s, w) -> t eff (Either e a, s, w)
forall (m :: * -> *) a. Monad m => a -> m a
return
    (\p u
p u -> t eff (Either e a, s, w)
c -> (eff u -> t eff u
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (eff u -> t eff u) -> eff u -> t eff u
forall a b. (a -> b) -> a -> b
$ p u -> eff u
forall u. p u -> eff u
eval p u
p) t eff u
-> (u -> t eff (Either e a, s, w)) -> t eff (Either e a, s, w)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= u -> t eff (Either e a, s, w)
c)

-- | Turn a `ScriptTT` with a monadic evaluator into a `Property`; for testing with QuickCheck. Wraps `execScriptTT`.
checkScriptTT
  :: forall eff t q prop e r w s p a
   . (Monad eff, Monad (t eff), MonadTrans t, Show q, Testable prop)
  => s -- ^ Initial state
  -> r -- ^ Environment
  -> (forall u. p u -> eff u) -- ^ Moandic effect evaluator
  -> (t eff (Either e a, s, w) -> IO q) -- ^ Condense to `IO`
  -> (q -> prop) -- ^ Result check
  -> ScriptTT e r w s p t eff a
  -> Property
checkScriptTT :: s
-> r
-> (forall u. p u -> eff u)
-> (t eff (Either e a, s, w) -> IO q)
-> (q -> prop)
-> ScriptTT e r w s p t eff a
-> Property
checkScriptTT s
s r
r forall u. p u -> eff u
eval t eff (Either e a, s, w) -> IO q
cond q -> prop
check ScriptTT e r w s p t eff a
script =
  let
    action :: PropertyM IO prop
    action :: PropertyM IO prop
action = do
      let result :: t eff (Either e a, s, w)
result = s
-> r
-> (forall u. p u -> eff u)
-> ScriptTT e r w s p t eff a
-> t eff (Either e a, s, w)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r (p :: * -> *)
       e w a.
(Monad eff, Monad (t eff), MonadTrans t) =>
s
-> r
-> (forall u. p u -> eff u)
-> ScriptTT e r w s p t eff a
-> t eff (Either e a, s, w)
execScriptTT s
s r
r forall u. p u -> eff u
eval ScriptTT e r w s p t eff a
script
      q
q <- IO q -> PropertyM IO q
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
run (IO q -> PropertyM IO q) -> IO q -> PropertyM IO q
forall a b. (a -> b) -> a -> b
$ t eff (Either e a, s, w) -> IO q
cond t eff (Either e a, s, w)
result
      prop -> PropertyM IO prop
forall prop (m :: * -> *) a.
(Testable prop, Monad m) =>
prop -> PropertyM m a
stop (prop -> PropertyM IO prop) -> prop -> PropertyM IO prop
forall a b. (a -> b) -> a -> b
$ q -> prop
check q
q
  in PropertyM IO prop -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO PropertyM IO prop
action



-- | Retrieve the environment.
ask
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => ScriptTT e r w s p t eff r
ask :: ScriptTT e r w s p t eff r
ask = ((s, r)
 -> forall v.
    ((Either e r, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff r
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e r, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff r)
-> ((s, r)
    -> forall v.
       ((Either e r, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff r
forall a b. (a -> b) -> a -> b
$ \(s
s,r
r) -> \(Either e r, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ ->
  (Either e r, s, w) -> t eff v
end (r -> Either e r
forall a b. b -> Either a b
Right r
r, s
s, w
forall a. Monoid a => a
mempty)



-- | Run an action with a locally adjusted environment of the same type.
local
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => (r -> r)
  -> ScriptTT e r w s p t eff a
  -> ScriptTT e r w s p t eff a
local :: (r -> r)
-> ScriptTT e r w s p t eff a -> ScriptTT e r w s p t eff a
local = (r -> r)
-> ScriptTT e r w s p t eff a -> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) r2 r1 e w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(r2 -> r1)
-> ScriptTT e r1 w s p t eff a -> ScriptTT e r2 w s p t eff a
transport



-- | Run an action with a locally adjusted environment of a possibly different type.
transport
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => (r2 -> r1)
  -> ScriptTT e r1 w s p t eff a
  -> ScriptTT e r2 w s p t eff a
transport :: (r2 -> r1)
-> ScriptTT e r1 w s p t eff a -> ScriptTT e r2 w s p t eff a
transport r2 -> r1
f ScriptTT e r1 w s p t eff a
x = ((s, r2)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r2 w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r2)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r2 w s p t eff a)
-> ((s, r2)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r2 w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
s,r2
r) -> \(Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont ->
  ScriptTT e r1 w s p t eff a
-> (s, r1)
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT ScriptTT e r1 w s p t eff a
x (s
s, r2 -> r1
f r2
r) (Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont



-- | Retrieve the image of the environment under a given function.
reader
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t, Monad (t eff))
  => (r -> a)
  -> ScriptTT e r w s p t eff a
reader :: (r -> a) -> ScriptTT e r w s p t eff a
reader r -> a
f = (r -> a)
-> ScriptTT e r w s p t eff r -> ScriptTT e r w s p t eff a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap r -> a
f ScriptTT e r w s p t eff r
forall w (eff :: * -> *) (t :: (* -> *) -> * -> *) e r s
       (p :: * -> *).
(Monoid w, Monad eff, Monad (t eff), MonadTrans t) =>
ScriptTT e r w s p t eff r
ask



-- | Retrieve the current state.
get
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => ScriptTT e r w s p t eff s
get :: ScriptTT e r w s p t eff s
get = ((s, r)
 -> forall v.
    ((Either e s, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff s
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e s, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff s)
-> ((s, r)
    -> forall v.
       ((Either e s, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff s
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e s, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ ->
  (Either e s, s, w) -> t eff v
end (s -> Either e s
forall a b. b -> Either a b
Right s
s, s
s, w
forall a. Monoid a => a
mempty)



-- | Replace the state.
put
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => s
  -> ScriptTT e r w s p t eff ()
put :: s -> ScriptTT e r w s p t eff ()
put s
s = ((s, r)
 -> forall v.
    ((Either e (), s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e (), s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff ())
-> ((s, r)
    -> forall v.
       ((Either e (), s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff ()
forall a b. (a -> b) -> a -> b
$ \(s
_,r
_) -> \(Either e (), s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ ->
  (Either e (), s, w) -> t eff v
end (() -> Either e ()
forall a b. b -> Either a b
Right (), s
s, w
forall a. Monoid a => a
mempty)



-- | Modify the current state lazily.
modify
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => (s -> s)
  -> ScriptTT e r w s p t eff ()
modify :: (s -> s) -> ScriptTT e r w s p t eff ()
modify s -> s
f = ((s, r)
 -> forall v.
    ((Either e (), s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e (), s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff ())
-> ((s, r)
    -> forall v.
       ((Either e (), s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff ()
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e (), s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ ->
  (Either e (), s, w) -> t eff v
end (() -> Either e ()
forall a b. b -> Either a b
Right (), s -> s
f s
s, w
forall a. Monoid a => a
mempty)



-- | Modify the current state strictly.
modify'
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => (s -> s)
  -> ScriptTT e r w s p t eff ()
modify' :: (s -> s) -> ScriptTT e r w s p t eff ()
modify' s -> s
f = ((s, r)
 -> forall v.
    ((Either e (), s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e (), s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff ())
-> ((s, r)
    -> forall v.
       ((Either e (), s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff ()
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e (), s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ ->
  (Either e (), s, w) -> t eff v
end (() -> Either e ()
forall a b. b -> Either a b
Right (), s -> s
f (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$! s
s, w
forall a. Monoid a => a
mempty)



-- | Retrieve the image of the current state under a given function.
gets
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => (s -> a)
  -> ScriptTT e r w s p t eff a
gets :: (s -> a) -> ScriptTT e r w s p t eff a
gets s -> a
f = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ ->
  (Either e a, s, w) -> t eff v
end (a -> Either e a
forall a b. b -> Either a b
Right (s -> a
f s
s), s
s, w
forall a. Monoid a => a
mempty)



-- | Write to the log.
tell
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => w
  -> ScriptTT e r w s p t eff ()
tell :: w -> ScriptTT e r w s p t eff ()
tell w
w = ((s, r)
 -> forall v.
    ((Either e (), s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e (), s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff ())
-> ((s, r)
    -> forall v.
       ((Either e (), s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff ()
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e (), s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ ->
  (Either e (), s, w) -> t eff v
end (() -> Either e ()
forall a b. b -> Either a b
Right (), s
s, w
w)



-- | Run an action and attach the log to the result, setting the log to `mempty`.
draft
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => ScriptTT e r w s p t eff a
  -> ScriptTT e r w s p t eff (a,w)
draft :: ScriptTT e r w s p t eff a -> ScriptTT e r w s p t eff (a, w)
draft ScriptTT e r w s p t eff a
x = ((s, r)
 -> forall v.
    ((Either e (a, w), s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff (a, w)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e (a, w), s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff (a, w))
-> ((s, r)
    -> forall v.
       ((Either e (a, w), s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff (a, w)
forall a b. (a -> b) -> a -> b
$ \(s
r,r
s) -> \(Either e (a, w), s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont ->
  ScriptTT e r w s p t eff a
-> (s, r)
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT ScriptTT e r w s p t eff a
x (s
r,r
s)
    (\(Either e a
y,s
s,w
w) -> (Either e (a, w), s, w) -> t eff v
end ((a -> (a, w)) -> Either e a -> Either e (a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,w
w) Either e a
y, s
s, w
forall a. Monoid a => a
mempty)) forall u. p u -> (u -> t eff v) -> t eff v
cont



-- | Run an action and attach the log to the result.
listen
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => ScriptTT e r w s p t eff a
  -> ScriptTT e r w s p t eff (a,w)
listen :: ScriptTT e r w s p t eff a -> ScriptTT e r w s p t eff (a, w)
listen ScriptTT e r w s p t eff a
x = ((s, r)
 -> forall v.
    ((Either e (a, w), s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff (a, w)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e (a, w), s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff (a, w))
-> ((s, r)
    -> forall v.
       ((Either e (a, w), s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff (a, w)
forall a b. (a -> b) -> a -> b
$ \(s
r,r
s) -> \(Either e (a, w), s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont ->
  ScriptTT e r w s p t eff a
-> (s, r)
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT ScriptTT e r w s p t eff a
x (s
r,r
s)
    (\(Either e a
y,s
s,w
w) -> (Either e (a, w), s, w) -> t eff v
end ((a -> (a, w)) -> Either e a -> Either e (a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,w
w) Either e a
y, s
s, w
w)) forall u. p u -> (u -> t eff v) -> t eff v
cont



-- | Run an action that returns a value and a log-adjusting function, and apply the function to the local log.
pass
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => ScriptTT e r w s p t eff (a, w -> w)
  -> ScriptTT e r w s p t eff a
pass :: ScriptTT e r w s p t eff (a, w -> w) -> ScriptTT e r w s p t eff a
pass ScriptTT e r w s p t eff (a, w -> w)
x = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
r,r
s) -> \(Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont ->
  let
    end' :: (Either e (a, w -> w), s, w) -> t eff v
end' (Either e (a, w -> w)
z,s
s1,w
w) = case Either e (a, w -> w)
z of
      Right (a
y,w -> w
f) -> (Either e a, s, w) -> t eff v
end (a -> Either e a
forall a b. b -> Either a b
Right a
y, s
s1, w -> w
f w
w)
      Left e
e -> (Either e a, s, w) -> t eff v
end (e -> Either e a
forall a b. a -> Either a b
Left e
e, s
s1, w
w)
  in
    ScriptTT e r w s p t eff (a, w -> w)
-> (s, r)
-> ((Either e (a, w -> w), s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT ScriptTT e r w s p t eff (a, w -> w)
x (s
r,r
s) (Either e (a, w -> w), s, w) -> t eff v
end' forall u. p u -> (u -> t eff v) -> t eff v
cont



-- | Run an action, applying a function to the local log.
censor
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => (w -> w)
  -> ScriptTT e r w s p t eff a
  -> ScriptTT e r w s p t eff a
censor :: (w -> w)
-> ScriptTT e r w s p t eff a -> ScriptTT e r w s p t eff a
censor w -> w
f ScriptTT e r w s p t eff a
x = ScriptTT e r w s p t eff (a, w -> w) -> ScriptTT e r w s p t eff a
forall w (eff :: * -> *) (t :: (* -> *) -> * -> *) e r s
       (p :: * -> *) a.
(Monoid w, Monad eff, Monad (t eff), MonadTrans t) =>
ScriptTT e r w s p t eff (a, w -> w) -> ScriptTT e r w s p t eff a
pass (ScriptTT e r w s p t eff (a, w -> w)
 -> ScriptTT e r w s p t eff a)
-> ScriptTT e r w s p t eff (a, w -> w)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ ((s, r)
 -> forall v.
    ((Either e (a, w -> w), s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff (a, w -> w)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e (a, w -> w), s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff (a, w -> w))
-> ((s, r)
    -> forall v.
       ((Either e (a, w -> w), s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff (a, w -> w)
forall a b. (a -> b) -> a -> b
$ \(s
s,r
r) -> \(Either e (a, w -> w), s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont ->
  let
    end' :: (Either e a, s, w) -> t eff v
end' (Either e a
z,s
s1,w
w) = case Either e a
z of
      Right a
y -> (Either e (a, w -> w), s, w) -> t eff v
end ((a, w -> w) -> Either e (a, w -> w)
forall a b. b -> Either a b
Right (a
y,w -> w
f), s
s1, w
w)
      Left e
e -> (Either e (a, w -> w), s, w) -> t eff v
end (e -> Either e (a, w -> w)
forall a b. a -> Either a b
Left e
e, s
s1, w
w)
  in
    ScriptTT e r w s p t eff a
-> (s, r)
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT ScriptTT e r w s p t eff a
x (s
s,r
r) (Either e a, s, w) -> t eff v
end' forall u. p u -> (u -> t eff v) -> t eff v
cont



-- | Inject an 'Either' into a 'Script'.
except
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => Either e a
  -> ScriptTT e r w s p t eff a
except :: Either e a -> ScriptTT e r w s p t eff a
except Either e a
z = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
_ ->
  (Either e a, s, w) -> t eff v
end (Either e a
z, s
s, w
forall a. Monoid a => a
mempty)



-- | Run an action, applying a function to any error.
triage
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => (e1 -> e2)
  -> ScriptTT e1 r w s p t eff a
  -> ScriptTT e2 r w s p t eff a
triage :: (e1 -> e2)
-> ScriptTT e1 r w s p t eff a -> ScriptTT e2 r w s p t eff a
triage e1 -> e2
f ScriptTT e1 r w s p t eff a
x = ((s, r)
 -> forall v.
    ((Either e2 a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e2 r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e2 a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e2 r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e2 a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e2 r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
s,r
r) -> \(Either e2 a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont ->
  let
    end' :: (Either e1 a, s, w) -> t eff v
end' (Either e1 a
z,s
s1,w
w) = case Either e1 a
z of
      Right a
y -> (Either e2 a, s, w) -> t eff v
end (a -> Either e2 a
forall a b. b -> Either a b
Right a
y, s
s1, w
w)
      Left e1
e -> (Either e2 a, s, w) -> t eff v
end (e2 -> Either e2 a
forall a b. a -> Either a b
Left (e1 -> e2
f e1
e), s
s1, w
w)
  in
    ScriptTT e1 r w s p t eff a
-> (s, r)
-> ((Either e1 a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT ScriptTT e1 r w s p t eff a
x (s
s,r
r) (Either e1 a, s, w) -> t eff v
end' forall u. p u -> (u -> t eff v) -> t eff v
cont



-- | Raise an error.
throw
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => e
  -> ScriptTT e r w s p t eff a
throw :: e -> ScriptTT e r w s p t eff a
throw e
e = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
s,r
r) -> \(Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont ->
  let end' :: (Either Any (), s, w) -> t eff v
end' (Either Any ()
_,s
s1,w
w1) = (Either e a, s, w) -> t eff v
end (e -> Either e a
forall a b. a -> Either a b
Left e
e, s
s1, w
w1)
  in ScriptTT Any r w s p t eff ()
-> (s, r)
-> ((Either Any (), s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT (() -> ScriptTT Any r w s p t eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (s
s,r
r) (Either Any (), s, w) -> t eff v
end' forall u. p u -> (u -> t eff v) -> t eff v
cont



-- | Run an action, applying a handler in case of an error result.
catch
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => ScriptTT e r w s p t eff a
  -> (e -> ScriptTT e r w s p t eff a)
  -> ScriptTT e r w s p t eff a
catch :: ScriptTT e r w s p t eff a
-> (e -> ScriptTT e r w s p t eff a) -> ScriptTT e r w s p t eff a
catch (ScriptTT (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
x) e -> ScriptTT e r w s p t eff a
h = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
s,r
r) -> \(Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont ->
  let
    end' :: (Either e a, s, w) -> t eff v
end' (Either e a
z,s
s1,w
w) = case Either e a
z of
      Right a
y -> (Either e a, s, w) -> t eff v
end (a -> Either e a
forall a b. b -> Either a b
Right a
y, s
s1, w
w)
      Left e
e -> do
        let end'' :: (Either e a, s, w) -> t eff v
end'' (Either e a
z2,s
s2,w
w2) = (Either e a, s, w) -> t eff v
end (Either e a
z2, s
s2, w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
w w
w2)
        ScriptTT e r w s p t eff a
-> (s, r)
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
forall e r w s (p :: * -> *) (t :: (* -> *) -> * -> *)
       (eff :: * -> *) a.
ScriptTT e r w s p t eff a
-> (s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
runScriptTT (e -> ScriptTT e r w s p t eff a
h e
e) (s
s1,r
r) (Either e a, s, w) -> t eff v
end'' forall u. p u -> (u -> t eff v) -> t eff v
cont
  in
    (s, r)
-> ((Either e a, s, w) -> t eff v)
-> (forall u. p u -> (u -> t eff v) -> t eff v)
-> t eff v
(s, r)
-> forall v.
   ((Either e a, s, w) -> t eff v)
   -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v
x (s
s,r
r) (Either e a, s, w) -> t eff v
end' forall u. p u -> (u -> t eff v) -> t eff v
cont



-- | Inject an atomic effect.
prompt
  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)
  => p a
  -> ScriptTT e r w s p t eff a
prompt :: p a -> ScriptTT e r w s p t eff a
prompt p a
p = ((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s r e a w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
((s, r)
 -> forall v.
    ((Either e a, s, w) -> t eff v)
    -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
ScriptTT (((s, r)
  -> forall v.
     ((Either e a, s, w) -> t eff v)
     -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
 -> ScriptTT e r w s p t eff a)
-> ((s, r)
    -> forall v.
       ((Either e a, s, w) -> t eff v)
       -> (forall u. p u -> (u -> t eff v) -> t eff v) -> t eff v)
-> ScriptTT e r w s p t eff a
forall a b. (a -> b) -> a -> b
$ \(s
s,r
_) -> \(Either e a, s, w) -> t eff v
end forall u. p u -> (u -> t eff v) -> t eff v
cont ->
  p a -> (a -> t eff v) -> t eff v
forall u. p u -> (u -> t eff v) -> t eff v
cont p a
p (\a
a -> (Either e a, s, w) -> t eff v
end (a -> Either e a
forall a b. b -> Either a b
Right a
a, s
s, w
forall a. Monoid a => a
mempty))





instance
  ( Monoid w, Monad eff, forall m. Monad m => Monad (t m), MonadTrans t
  , Arbitrary a, CoArbitrary a
  ) => Arbitrary (ScriptTT e r w s p t eff a) where
  arbitrary :: Gen (ScriptTT e r w s p t eff a)
arbitrary = do
    (a
a,a
b) <- Gen (a, a)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (a,a)
    Int
k <- Gen Int
forall a. Arbitrary a => Gen a
arbitrary :: Gen Int
    if Int
kInt -> Int -> Int
forall a. Integral a => a -> a -> a
`rem`Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      then ScriptTT e r w s p t eff a -> Gen (ScriptTT e r w s p t eff a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptTT e r w s p t eff a -> Gen (ScriptTT e r w s p t eff a))
-> ScriptTT e r w s p t eff a -> Gen (ScriptTT e r w s p t eff a)
forall a b. (a -> b) -> a -> b
$ a -> ScriptTT e r w s p t eff a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
      else do
        a -> ScriptTT e r w s p t eff a
f <- Gen (a -> ScriptTT e r w s p t eff a)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (a -> ScriptTT e r w s p t eff a)
        ScriptTT e r w s p t eff a -> Gen (ScriptTT e r w s p t eff a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptTT e r w s p t eff a -> Gen (ScriptTT e r w s p t eff a))
-> ScriptTT e r w s p t eff a -> Gen (ScriptTT e r w s p t eff a)
forall a b. (a -> b) -> a -> b
$ a -> ScriptTT e r w s p t eff a
f a
a ScriptTT e r w s p t eff a
-> ScriptTT e r w s p t eff a -> ScriptTT e r w s p t eff a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> eff a -> ScriptTT e r w s p t eff a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> eff a
forall (m :: * -> *) a. Monad m => a -> m a
return a
b)

instance Show (ScriptTT e r w s p t eff a) where
  show :: ScriptTT e r w s p t eff a -> String
show ScriptTT e r w s p t eff a
_ = String
"<Script>"