script-monad 0.0.2.1 → 0.0.3

raw patch · 6 files changed

+571/−530 lines, 6 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• ChangeLog.md +26/−0
• script-monad.cabal +4/−2
• src/Control/Monad/Script.hs +188/−230
• src/Control/Monad/Script/Http.hs +231/−178
• test/Control/Monad/Script/Http/Test.hs +110/−109
• test/Control/Monad/Script/Test.hs +12/−11

@@ -1,6 +1,32 @@ Changelog for script-monad ========================== +0.0.3+-----++This release has some significant changes to type names and signatures. The good news is that these changes make the code simpler and more modular. The bad news is that it now uses the `QuantifiedConstraints` extension, available only in GHC >=8.6.++* Added+    * `liftScriptTT` and `liftHttpTT`+* Changed+    * Most functions now have additional `Monad` and `MonadTrans` constraints.+    * `ScriptT` is now `ScriptTT` and takes the effect monad as an explicit type parameter. Now acts like a monad transformer transformer.+    * `Script` is now `ScriptT` and takes the effect monad as an explicit type parameter, reflecting its status as a monad transformer+    * `HttpT` is now `HttpTT` and takes the effect monad as an explicit type parameter. Now acts like a monad transformer transformer.+    * `Http` is now `HttpT` and takes the effect monad as an explicit type parameter, reflecting its status as a monad transformer+    * `execScriptTM` is now `execScriptTT` and does not take an explicit `lift` parameter, using the generic `MonadTrans` instance instead.+    * `checkScriptTM` is now `checkScriptTT` and does not take an explicit `lift` parameter, using the generic `MonadTrans` instance instead.+    * `execHttpTM` is now `execHttpTT` and does not take an explicit `lift` parameter, using the generic `MonadTrans` instance instead.+    * `checkHttpTM` is now `checkHttpTT` and does not take an explicit `lift` parameter, using the generic `MonadTrans` instance instead.+* Removed+    * `Script.lift`, in favor of a generic `MonadTrans` instance+    * `liftHttpT`, in favor of a generic `MonadTrans` instance+    * `execScriptT`, `execScript`, `checkScript`, and `checkScript`, which use a pure evaluator. These are subsumed by `ScriptTT` where the base monad is `Identity`.+    * `execScriptM` and `checkScriptM`, which are subsumed by `ScriptTT` with the `IdentityT` transformer.+    * `execHttpM` and `checkHttpM`, which are subsumed by `HttpTT` with the `IdentityT` transformer.+++ 0.0.2.1 ------- 

@@ -1,5 +1,5 @@ name:           script-monad-version:        0.0.2.1+version:        0.0.3 description:    Please see the README on GitHub at <https://github.com/nbloomf/script-monad#readme> homepage:       https://github.com/nbloomf/script-monad#readme bug-reports:    https://github.com/nbloomf/script-monad/issues@@ -11,7 +11,7 @@ build-type:     Simple cabal-version:  >= 1.10 category:       Control.Monad-synopsis:       Transformer stack of error, reader, writer, state, and prompt monads+synopsis:       Stack of error, reader, writer, state, and prompt monad transformers  extra-source-files:     ChangeLog.md@@ -38,6 +38,7 @@     , QuickCheck >=2.10.1     , text >=1.2.3.0     , time >=1.8.0.2+    , transformers >=0.5.2.0     , unordered-containers >=0.2.9.0     , vector >=0.12.0.1     , wreq >=0.5.2@@ -82,6 +83,7 @@     , tasty-hunit >=0.10.0.1     , tasty-quickcheck >=0.9.2     , tasty-quickcheck-laws >= 0.0.1+    , transformers >=0.5.2.0    other-modules:       Control.Monad.Script.Test

@@ -1,32 +1,38 @@ {- | Module      : Control.Monad.Script-Description : An unrolled stack of Reader, Writer, Error, State, and Prompt.+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 -`Script` is an unrolled stack of reader, writer, state, error, and prompt monads, meant as a basis for building more specific DSLs. Also comes in monad transformer flavor with `ScriptT`.+`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 'Script' is a pure value that gets an effectful interpretation from a user-supplied evaluator.+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 Rank2Types, TupleSections, ScopedTypeVariables #-}-module Control.Monad.Script (-  -- * Script-    Script-  , execScript-  , execScriptM+{-#+  LANGUAGE+    GADTs,+    Rank2Types,+    TupleSections, +    KindSignatures,+    ScopedTypeVariables,+    QuantifiedConstraints+#-} +module Control.Monad.Script (   -- * ScriptT-  , ScriptT()-  , execScriptT-  , execScriptTM-  , lift+    ScriptT +  -- * ScriptTT+  , ScriptTT()+  , execScriptTT+  , liftScriptTT+   -- * Error   , except   , triage@@ -57,16 +63,17 @@   , prompt    -- * Testing-  , checkScript-  , checkScriptM-  , checkScriptT-  , checkScriptTM+  , checkScriptTT ) where    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@@ -84,175 +91,126 @@   --- | Opaque transformer stack of error (@e@), reader (@r@), writer (@w@), state (@s@), and prompt (@p@) monads.-newtype ScriptT e r w s p m a = ScriptT-  { runScriptT-      :: (s,r)-      -> forall v.-           ((Either e a, s, w) -> m v)-        -> (forall u. p u -> (u -> m v) -> m v)-        -> m v-  } deriving Typeable+-- | 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 -instance (Monoid w) => Monad (ScriptT e r w s p m) where-  return x = ScriptT $ \(s,_) -> \end _ -> end (Right x, s, mempty)+-- 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 x) = x -  x >>= f = ScriptT $ \(s0,r) -> \end cont -> do+instance+  (Monoid w, Monad eff, Monad (t eff), MonadTrans t)+    => Monad (ScriptTT e r w s p t eff) where+  return x = ScriptTT $ \(s,_) -> \end _ ->+    end (Right x, s, mempty)++  x >>= f = ScriptTT $ \(s0,r) -> \end cont -> do     let       g (z1,s1,w1) = case z1 of         Right y -> do           let h (z2,s2,w2) = end (z2, s2, mappend w1 w2)-          runScriptT (f y) (s1,r) h cont+          runScriptTT (f y) (s1,r) h cont         Left e -> do           let h (_,s2,w2) = end (Left e, s2, mappend w1 w2)-          runScriptT (return ()) (s1,r) h cont+          runScriptTT (return ()) (s1,r) h cont           -    runScriptT x (s0,r) g cont+    runScriptTT x (s0,r) g cont -instance (Monoid w) => Applicative (ScriptT e r w s p m) where+instance+  (Monoid w, Monad eff, Monad (t eff), MonadTrans t)+    => Applicative (ScriptTT e r w s p t eff) where   pure = return   (<*>) = ap -instance (Monoid w) => Functor (ScriptT e r w s p m) where+instance+  (Monoid w, Monad eff, Monad (t eff), MonadTrans t)+    => Functor (ScriptTT e r w s p t eff) where   fmap f x = x >>= (return . f) +instance+  (Monoid w, forall m. (Monad m) => Monad (t m), MonadTrans t)+    => MonadTrans (ScriptTT e r w s p t) where+  lift x = ScriptTT $ \(s,_) -> \end _ ->+    lift x >>= \a -> end (Right a, s, 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 x = ScriptTT $ \(s,_) -> \end _ -> do+  a <- x+  end (Right a, s, mempty)   --- | Opaque stack of error (@e@), reader (@r@), writer (@w@), state (@s@), and prompt (@p@) monads.-type Script e r w s p = ScriptT e r w s p Identity +-- | 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 'ScriptT' with a specified initial state, environment, and continuation.++-- Execute a `ScriptTT` with a specified initial state, environment, and continuation. execScriptTC   :: s -- ^ Initial state   -> r -- ^ Environment-  -> ((Either e a, s, w) -> m v)-  -> (forall u. p u -> (u -> m v) -> m v)-  -> ScriptT e r w s p m a-  -> m v-execScriptTC s r end cont x =-  runScriptT x (s,r) end cont---- | Execute a 'ScriptT' with a specified initial state and environment, and with a pure evaluator.-execScriptT-  :: (Monad m)-  => s -- ^ Initial state-  -> r -- ^ Environment-  -> (forall u. p u -> u) -- ^ Pure effect evaluator-  -> ScriptT e r w s p m t-  -> m (Either e t, s, w)-execScriptT s r eval =-  execScriptTC s r return (\p c -> c $ eval p)---- | Turn a `ScriptT` with a pure evaluator into a `Property`; for testing with QuickCheck. Wraps `execScriptT`.-checkScriptT-  :: (Monad m)-  => s -- ^ Initial state-  -> r -- ^ Environment-  -> (forall u. p u -> u) -- ^ Pure effect evaluator-  -> (m (Either e t, s, w) -> IO q) -- ^ Condense to `IO`-  -> (q -> Bool) -- ^ Result check-  -> ScriptT e r w s p m t-  -> Property-checkScriptT s r eval cond check script = monadicIO $ do-  let result = execScriptT s r eval script-  q <- run $ cond result-  assert $ check q+  -> ((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 end cont (ScriptTT run) =+  run (s,r) end cont --- | Execute a 'ScriptT' with a specified inital state and environment, and with a monadic evaluator. In this case the inner monad @m@ will typically be a monad transformer over the effect monad @n@.-execScriptTM-  :: (Monad (m eff), Monad eff)+-- | 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-  -> (forall u. eff u -> m eff u) -- ^ Lift effects to the inner monad-  -> ScriptT e r w s p (m eff) t-  -> m eff (Either e t, s, w)-execScriptTM s r eval lift =+  -> ScriptTT e r w s p t eff a+  -> t eff (Either e a, s, w)+execScriptTT s r eval =   execScriptTC s r return     (\p c -> (lift $ eval p) >>= c) --- | Turn a `ScriptT` with a monadic evaluator into a `Property`; for testing with QuickCheck. Wraps `execScriptTM`.-checkScriptTM-  :: (Monad (m eff), Monad eff)-  => s -- ^ Initial state-  -> r -- ^ Environment-  -> (forall u. p u -> eff u) -- ^ Moandic effect evaluator-  -> (forall u. eff u -> m eff u) -- ^ Lift effects to the inner monad-  -> (m eff (Either e t, s, w) -> IO q) -- ^ Condense to `IO`-  -> (q -> Bool) -- ^ Result check-  -> ScriptT e r w s p (m eff) t-  -> Property-checkScriptTM s r eval lift cond check script = monadicIO $ do-  let result = execScriptTM s r eval lift script-  q <- run $ cond result-  assert $ check q------ | Execute a 'Script' with a specified initial state, environment, and continuation.-execScriptC-  :: s -- ^ Initial state-  -> r -- ^ Environment-  -> ((Either e a, s, w) -> v)-  -> (forall u. p u -> (u -> v) -> v)-  -> Script e r w s p a-  -> v-execScriptC s r end cont x =-  let cont' p c = Identity $ cont p (runIdentity . c) in-  runIdentity $ runScriptT x (s,r) (Identity . end) cont'---- | Execute a 'Script' with a specified initial state and environment, and with a pure evaluator.-execScript-  :: s -- ^ Initial state-  -> r -- ^ Environment-  -> (forall u. p u -> u) -- ^ Pure evaluator-  -> Script e r w s p t-  -> (Either e t, s, w)-execScript s r eval =-  execScriptC s r id (\p c -> c $ eval p)---- | Turn a `Script` with a pure evaluator into a `Bool`; for testing with QuickCheck. Wraps `execScript`.-checkScript-  :: s -- ^ Initial state-  -> r -- ^ Environment-  -> (forall u. p u -> u) -- ^ Pure evaluator-  -> ((Either e t, s, w) -> q) -- ^ Condense-  -> (q -> Bool) -- ^ Result check-  -> Script e r w s p t-  -> Bool-checkScript s r eval cond check script =-  check $ cond $ execScript s r eval script---- | Execute a 'Script' with a specified inital state and environment, and with a monadic evaluator.-execScriptM-  :: (Monad eff)-  => s -- ^ Initial state-  -> r -- ^ Environment-  -> (forall u. p u -> eff u) -- ^ Monadic evaluator-  -> Script e r w s p t-  -> eff (Either e t, s, w)-execScriptM s r eval =-  execScriptC s r return-    (\p c -> (eval p) >>= c)---- | Turn a `Script` with a monadic evaluator into a `Property`; for testing with QuickCheck. Wraps `execScriptM`.-checkScriptM-  :: (Monad eff)+-- | Turn a `ScriptTT` with a monadic evaluator into a `Property`; for testing with QuickCheck. Wraps `execScriptTT`.+checkScriptTT+  :: (Monad eff, Monad (t eff), MonadTrans t, Show q)   => s -- ^ Initial state   -> r -- ^ Environment   -> (forall u. p u -> eff u) -- ^ Moandic effect evaluator-  -> (eff (Either e t, s, w) -> IO q) -- ^ Condense to `IO`+  -> (t eff (Either e a, s, w) -> IO q) -- ^ Condense to `IO`   -> (q -> Bool) -- ^ Result check-  -> Script e r w s p t+  -> ScriptTT e r w s p t eff a   -> Property-checkScriptM s r eval cond check script = monadicIO $ do-  let result = execScriptM s r eval script+checkScriptTT s r eval cond check script = monadicIO $ do+  let result = execScriptTT s r eval script   q <- run $ cond result   assert $ check q @@ -260,234 +218,234 @@  -- | Retrieve the environment. ask-  :: (Monoid w)-  => ScriptT e r w s p m r-ask = ScriptT $ \(s,r) -> \end _ ->+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)+  => ScriptTT e r w s p t eff r+ask = ScriptTT $ \(s,r) -> \end _ ->   end (Right r, s, mempty)    -- | Run an action with a locally adjusted environment of the same type. local-  :: (r -> r)-  -> ScriptT e r w s p m a-  -> ScriptT e r w s p m a+  :: (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 = transport    -- | Run an action with a locally adjusted environment of a possibly different type. transport-  :: (r2 -> r1)-  -> ScriptT e r1 w s p m a-  -> ScriptT e r2 w s p m a-transport f x = ScriptT $ \(s,r) -> \end cont ->-  runScriptT x (s, f r) end cont+  :: (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 f x = ScriptTT $ \(s,r) -> \end cont ->+  runScriptTT x (s, f r) end cont    -- | Retrieve the image of the environment under a given function. reader-  :: (Monoid w)+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t, Monad (t eff))   => (r -> a)-  -> ScriptT e r w s p m a+  -> ScriptTT e r w s p t eff a reader f = fmap f ask    -- | Retrieve the current state. get-  :: (Monoid w)-  => ScriptT e r w s p m s-get = ScriptT $ \(s,_) -> \end _ ->+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)+  => ScriptTT e r w s p t eff s+get = ScriptTT $ \(s,_) -> \end _ ->   end (Right s, s, mempty)    -- | Replace the state. put-  :: (Monoid w)+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)   => s-  -> ScriptT e r w s p m ()-put s = ScriptT $ \(_,_) -> \end _ ->+  -> ScriptTT e r w s p t eff ()+put s = ScriptTT $ \(_,_) -> \end _ ->   end (Right (), s, mempty)    -- | Modify the current state lazily. modify-  :: (Monoid w)+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)   => (s -> s)-  -> ScriptT e r w s p m ()-modify f = ScriptT $ \(s,_) -> \end _ ->+  -> ScriptTT e r w s p t eff ()+modify f = ScriptTT $ \(s,_) -> \end _ ->   end (Right (), f s, mempty)    -- | Modify the current state strictly. modify'-  :: (Monoid w)+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)   => (s -> s)-  -> ScriptT e r w s p m ()-modify' f = ScriptT $ \(s,_) -> \end _ ->+  -> ScriptTT e r w s p t eff ()+modify' f = ScriptTT $ \(s,_) -> \end _ ->   end (Right (), f $! s, mempty)    -- | Retrieve the image of the current state under a given function. gets-  :: (Monoid w)+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)   => (s -> a)-  -> ScriptT e r w s p m a-gets f = ScriptT $ \(s,_) -> \end _ ->+  -> ScriptTT e r w s p t eff a+gets f = ScriptTT $ \(s,_) -> \end _ ->   end (Right (f s), s, mempty)    -- | Write to the log. tell-  :: w-  -> ScriptT e r w s p m ()-tell w = ScriptT $ \(s,_) -> \end _ ->+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)+  => w+  -> ScriptTT e r w s p t eff ()+tell w = ScriptTT $ \(s,_) -> \end _ ->   end (Right (), s, w)    -- | Run an action and attach the log to the result, setting the log to `mempty`. draft-  :: (Monoid w)-  => ScriptT e r w s p m a-  -> ScriptT e r w s p m (a,w)-draft x = ScriptT $ \(r,s) -> \end cont ->-  runScriptT x (r,s)+  :: (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 x = ScriptTT $ \(r,s) -> \end cont ->+  runScriptTT x (r,s)     (\(y,s,w) -> end (fmap (,w) y, s, mempty)) cont    -- | Run an action and attach the log to the result. listen-  :: ScriptT e r w s p m a-  -> ScriptT e r w s p m (a,w)-listen x = ScriptT $ \(r,s) -> \end cont ->-  runScriptT x (r,s)+  :: (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 x = ScriptTT $ \(r,s) -> \end cont ->+  runScriptTT x (r,s)     (\(y,s,w) -> end (fmap (,w) y, s, w)) cont    -- | Run an action that returns a value and a log-adjusting function, and apply the function to the local log. pass-  :: ScriptT e r w s p m (a, w -> w)-  -> ScriptT e r w s p m a-pass x = ScriptT $ \(r,s) -> \end cont ->+  :: (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 x = ScriptTT $ \(r,s) -> \end cont ->   let     end' (z,s1,w) = case z of       Right (y,f) -> end (Right y, s1, f w)       Left e -> end (Left e, s1, w)   in-    runScriptT x (r,s) end' cont+    runScriptTT x (r,s) end' cont    -- | Run an action, applying a function to the local log. censor-  :: (w -> w)-  -> ScriptT e r w s p m a-  -> ScriptT e r w s p m a-censor f x = pass $ ScriptT $ \(s,r) -> \end cont ->+  :: (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 f x = pass $ ScriptTT $ \(s,r) -> \end cont ->   let     end' (z,s1,w) = case z of       Right y -> end (Right (y,f), s1, w)       Left e -> end (Left e, s1, w)   in-    runScriptT x (s,r) end' cont+    runScriptTT x (s,r) end' cont    -- | Inject an 'Either' into a 'Script'. except-  :: (Monoid w)+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)   => Either e a-  -> ScriptT e r w s p m a-except z = ScriptT $ \(s,_) -> \end _ ->+  -> ScriptTT e r w s p t eff a+except z = ScriptTT $ \(s,_) -> \end _ ->   end (z, s, mempty)    -- | Run an action, applying a function to any error. triage-  :: (Monoid w)+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)   => (e1 -> e2)-  -> ScriptT e1 r w s p m a-  -> ScriptT e2 r w s p m a-triage f x = ScriptT $ \(s,r) -> \end cont ->+  -> ScriptTT e1 r w s p t eff a+  -> ScriptTT e2 r w s p t eff a+triage f x = ScriptTT $ \(s,r) -> \end cont ->   let     end' (z,s1,w) = case z of       Right y -> end (Right y, s1, w)       Left e -> end (Left (f e), s1, w)   in-    runScriptT x (s,r) end' cont+    runScriptTT x (s,r) end' cont    -- | Raise an error. throw-  :: (Monoid w)+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)   => e-  -> ScriptT e r w s p m a-throw e = ScriptT $ \(s,r) -> \end cont ->+  -> ScriptTT e r w s p t eff a+throw e = ScriptTT $ \(s,r) -> \end cont ->   let end' (_,s1,w1) = end (Left e, s1, w1)-  in runScriptT (return ()) (s,r) end' cont+  in runScriptTT (return ()) (s,r) end' cont    -- | Run an action, applying a handler in case of an error result. catch-  :: (Monoid w)-  => ScriptT e r w s p m a-  -> (e -> ScriptT e r w s p m a)-  -> ScriptT e r w s p m a-catch x h = ScriptT $ \(s,r) -> \end cont ->+  :: (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 x) h = ScriptTT $ \(s,r) -> \end cont ->   let     end' (z,s1,w) = case z of       Right y -> end (Right y, s1, w)       Left e -> do         let end'' (z2,s2,w2) = end (z2, s2, mappend w w2)-        runScriptT (h e) (s1,r) end'' cont+        runScriptTT (h e) (s1,r) end'' cont   in-    runScriptT x (s,r) end' cont+    x (s,r) end' cont    -- | Inject an atomic effect. prompt-  :: (Monoid w)+  :: (Monoid w, Monad eff, Monad (t eff), MonadTrans t)   => p a-  -> ScriptT e r w s p m a-prompt p = ScriptT $ \(s,_) -> \end cont ->+  -> ScriptTT e r w s p t eff a+prompt p = ScriptTT $ \(s,_) -> \end cont ->   cont p (\a -> end (Right a, s, mempty))   --- | Lift a computation in the base monad.-lift-  :: (Monoid w, Monad m)-  => m a-  -> ScriptT e r w s p m a-lift x = ScriptT $ \(s,_) -> \end _ ->-  x >>= \a -> end (Right a, s, mempty)  --instance (Monad m, Monoid w, Arbitrary a, CoArbitrary a)-  => Arbitrary (ScriptT e r w s p m a) where+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 = do     (a,b) <- arbitrary :: Gen (a,a)     k <- arbitrary :: Gen Int     if k`rem`2 == 0       then return $ return a       else do-        f <- arbitrary :: Gen (a -> ScriptT e r w s p m a)+        f <- arbitrary :: Gen (a -> ScriptTT e r w s p t eff a)         return $ f a >> lift (return b) -instance Show (ScriptT e r w s p m a) where+instance Show (ScriptTT e r w s p t eff a) where   show _ = "<Script>"

@@ -7,19 +7,25 @@ Stability   : experimental Portability : POSIX -A basic type and monad for describing HTTP interactions.+A basic type and monad transformer transformer for describing HTTP interactions. -} -{-# LANGUAGE GADTs, Rank2Types, RecordWildCards #-}+{-#+  LANGUAGE+    GADTs,+    Rank2Types,+    RecordWildCards,+    QuantifiedConstraints+#-}+ module Control.Monad.Script.Http (-  -- * Http-    Http()-  , execHttpM+  -- * HttpT+    HttpT()    -- * HttpT-  , HttpT()-  , execHttpTM-  , liftHttpT+  , HttpTT()+  , execHttpTT+  , liftHttpTT    -- * Error   , throwError@@ -100,8 +106,7 @@   , HttpResponse(..)    -- * Testing-  , checkHttpM-  , checkHttpTM+  , checkHttpTT ) where  import Prelude hiding (lookup)@@ -116,6 +121,10 @@   ( IOException, Exception, try ) import Control.Monad   ( Functor(..), Monad(..), ap )+import Control.Monad.Trans.Class+  ( MonadTrans(..) )+import Control.Monad.Trans.Identity+  ( IdentityT(..) ) import Control.Lens   ( preview, (^.) ) import Data.Aeson@@ -177,175 +186,177 @@   --- | An HTTP session returning an @a@, writing to a log of type @W e w@, reading from an environment of type @R e w r@, with state of type @S s@, throwing errors of type @E e@, performing effectful computations described by @P p a@, and with inner monad @m@.-newtype HttpT e r w s p m a = HttpT-  { httpT :: S.ScriptT (E e) (R e w r) (W e w) (S s) (P p) m a+-- | An HTTP session returning an @a@, writing to a log of type @W e w@, reading from an environment of type @R e w r@, with state of type @S s@, throwing errors of type @E e@, performing effectful computations described by @P p a@, and with inner monad @t eff@.+newtype HttpTT e r w s p t eff a = HttpTT+  { httpTT :: S.ScriptTT (E e) (R e w r) (W e w) (S s) (P p) t eff a   } deriving Typeable --- | An HTTP session returning an @a@, writing to a log of type @W e w@, reading from an environment of type @R e w r@, with state of type @S s@, throwing errors of type @E e@, performing effectful computations described by @P p a@. `HttpT` over `Identity`.-type Http e r w s p a = HttpT e r w s p Identity a+-- | An HTTP session returning an @a@, writing to a log of type @W e w@, reading from an environment of type @R e w r@, with state of type @S s@, throwing errors of type @E e@, performing effectful computations described by @P p a@, with inner monad @eff@. `HttpTT` over `IdentityT`.+type HttpT e r w s p = HttpTT e r w s p IdentityT -instance Functor (HttpT e r w s p m) where-  fmap f = HttpT . fmap f . httpT+instance+  (Monad eff, Monad (t eff), MonadTrans t)+    => Functor (HttpTT e r w s p t eff) where+  fmap f = HttpTT . fmap f . httpTT -instance Applicative (HttpT e r w s p m) where+instance+  (Monad eff, Monad (t eff), MonadTrans t)+    => Applicative (HttpTT e r w s p t eff) where   pure = return   (<*>) = ap -instance Monad (HttpT e r w s p m) where-  return = HttpT . return-  (HttpT x) >>= f = HttpT (x >>= (httpT . f))+instance+  (Monad eff, Monad (t eff), MonadTrans t)+    => Monad (HttpTT e r w s p t eff) where+  return = HttpTT . return+  (HttpTT x) >>= f = HttpTT (x >>= (httpTT . f)) +instance+  (MonadTrans t, forall m. (Monad m) => Monad (t m))+    => MonadTrans (HttpTT e r w s p t) where+  lift = HttpTT . lift +-- | Lift a value from the inner transformer.+liftHttpTT+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => t eff a -> HttpTT e r w s p t eff a+liftHttpTT = HttpTT . S.liftScriptTT --- | Execute an `HttpT` session.-execHttpTM-  :: (Monad (m eff), Monad eff)-  => S s -- ^ Initial state-  -> R e w r -- ^ Environment-  -> (forall u. P p u -> eff u) -- ^ Effect evaluator-  -> (forall u. eff u -> m eff u) -- ^ Lift effects to the inner monad-  -> HttpT e r w s p (m eff) t-  -> m eff (Either (E e) t, S s, W e w)-execHttpTM s r p lift = S.execScriptTM s r p lift . httpT --- | Turn an `HttpT` into a property; for testing with QuickCheck.-checkHttpTM-  :: (Monad (m eff), Monad eff)-  => S s -- ^ Initial state-  -> R e w r -- ^ Environment-  -> (forall u. P p u -> eff u) -- ^ Effect evaluator-  -> (forall u. eff u -> m eff u) -- ^ Lift effects to the inner monad-  -> (m eff (Either (E e) t, S s, W e w) -> IO q) -- ^ Condense to `IO`-  -> (q -> Bool) -- ^ Result check-  -> HttpT e r w s p (m eff) t-  -> Property-checkHttpTM s r eval lift cond check =-  S.checkScriptTM s r eval lift cond check . httpT --- | Execute an `Http` session.-execHttpM-  :: (Monad eff)+++-- | Execute an `HttpTT` session.+execHttpTT+  :: (Monad eff, Monad (t eff), MonadTrans t)   => S s -- ^ Initial state   -> R e w r -- ^ Environment   -> (forall u. P p u -> eff u) -- ^ Effect evaluator-  -> Http e r w s p t-  -> eff (Either (E e) t, S s, W e w)-execHttpM s r eval = S.execScriptM s r eval . httpT+  -> HttpTT e r w s p t eff a+  -> t eff (Either (E e) a, S s, W e w)+execHttpTT s r p = S.execScriptTT s r p . httpTT --- | Turn an `Http` into a `Property`; for testing with QuickCheck.-checkHttpM-  :: (Monad eff)+-- | Turn an `HttpTT` into a property; for testing with QuickCheck.+checkHttpTT+  :: (Monad eff, Monad (t eff), MonadTrans t, Show q)   => S s -- ^ Initial state   -> R e w r -- ^ Environment   -> (forall u. P p u -> eff u) -- ^ Effect evaluator-  -> (eff (Either (E e) t, S s, W e w) -> IO q) -- ^ Condense to `IO`+  -> (t eff (Either (E e) a, S s, W e w) -> IO q) -- ^ Condense to `IO`   -> (q -> Bool) -- ^ Result check-  -> Http e r w s p t+  -> HttpTT e r w s p t eff a   -> Property-checkHttpM s r eval cond check =-  S.checkScriptM s r eval cond check . httpT+checkHttpTT s r eval cond check =+  S.checkScriptTT s r eval cond check . httpTT    -- | Retrieve the environment. ask-  :: HttpT e r w s p m (R e w r)-ask = HttpT S.ask+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpTT e r w s p t eff (R e w r)+ask = HttpTT S.ask  -- | Run an action with a locally adjusted environment of the same type. local-  :: (R e w r -> R e w r)-  -> HttpT e r w s p m a-  -> HttpT e r w s p m a-local f = HttpT . S.local f . httpT+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => (R e w r -> R e w r)+  -> HttpTT e r w s p t eff a+  -> HttpTT e r w s p t eff a+local f = HttpTT . S.local f . httpTT  -- | Run an action with a locally adjusted environment of a possibly different type. transport-  :: (R e w r2 -> R e w r1)-  -> HttpT e r1 w s p m a-  -> HttpT e r2 w s p m a-transport f = HttpT . S.transport f . httpT+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => (R e w r2 -> R e w r1)+  -> HttpTT e r1 w s p t eff a+  -> HttpTT e r2 w s p t eff a+transport f = HttpTT . S.transport f . httpTT  -- | Retrieve the image of the environment under a given function. reader-  :: (R e w r -> a)-  -> HttpT e r w s p m a-reader f = HttpT (S.reader f)+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => (R e w r -> a)+  -> HttpTT e r w s p t eff a+reader f = HttpTT (S.reader f)  -- | Retrieve the current state. get-  :: HttpT e r w s p m (S s)-get = HttpT S.get+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpTT e r w s p t eff (S s)+get = HttpTT S.get  -- | Replace the state. put-  :: S s-  -> HttpT e r w s p m ()-put s = HttpT (S.put s)+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => S s+  -> HttpTT e r w s p t eff ()+put s = HttpTT (S.put s)  -- | Modify the current state strictly. modify-  :: (S s -> S s)-  -> HttpT e r w s p m ()-modify f = HttpT (S.modify' f)+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => (S s -> S s)+  -> HttpTT e r w s p t eff ()+modify f = HttpTT (S.modify' f)  -- | Retrieve the image of the current state under a given function. gets-  :: (S s -> a)-  -> HttpT e r w s p m a-gets f = HttpT (S.gets f)+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => (S s -> a)+  -> HttpTT e r w s p t eff a+gets f = HttpTT (S.gets f)  -- | Do not export; we want to only allow writes to the log via functions that call @logNow@. tell-  :: W e w-  -> HttpT e r w s p m ()-tell w = HttpT (S.tell w)+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => W e w+  -> HttpTT e r w s p t eff ()+tell w = HttpTT (S.tell w)  -- | Run an action that returns a value and a log-adjusting function, and apply the function to the local log. pass-  :: HttpT e r w s p m (a, W e w -> W e w)-  -> HttpT e r w s p m a-pass = HttpT . S.pass . httpT+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpTT e r w s p t eff (a, W e w -> W e w)+  -> HttpTT e r w s p t eff a+pass = HttpTT . S.pass . httpTT  -- | Run an action, applying a function to the local log. censor-  :: (W e w -> W e w)-  -> HttpT e r w s p m a-  -> HttpT e r w s p m a-censor f = HttpT . S.censor f . httpT+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => (W e w -> W e w)+  -> HttpTT e r w s p t eff a+  -> HttpTT e r w s p t eff a+censor f = HttpTT . S.censor f . httpTT  -- | Inject an 'Either' into a 'Script'. except-  :: Either (E e) a-  -> HttpT e r w s p m a-except e = HttpT (S.except e)+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Either (E e) a+  -> HttpTT e r w s p t eff a+except e = HttpTT (S.except e)  -- | Raise an error throw-  :: E e-  -> HttpT e r w s p m a-throw e = HttpT (S.throw e)+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => E e+  -> HttpTT e r w s p t eff a+throw e = HttpTT (S.throw e)  -- | Run an action, applying a handler in case of an error result. catch-  :: HttpT e r w s p m a -- ^ Computation that may raise an error-  -> (E e -> HttpT e r w s p m a) -- ^ Handler-  -> HttpT e r w s p m a-catch x f = HttpT (S.catch (httpT x) (httpT . f))+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpTT e r w s p t eff a -- ^ Computation that may raise an error+  -> (E e -> HttpTT e r w s p t eff a) -- ^ Handler+  -> HttpTT e r w s p t eff a+catch x f = HttpTT (S.catch (httpTT x) (httpTT . f))  -- | Inject an atomic effect. prompt-  :: P p a-  -> HttpT e r w s p m a-prompt p = HttpT (S.prompt p)---- | Lift a value from the inner monad-liftHttpT-  :: (Monad m)-  => m a-  -> HttpT e r w s p m a-liftHttpT = HttpT . S.lift+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => P p a+  -> HttpTT e r w s p t eff a+prompt p = HttpTT (S.prompt p)   @@ -355,6 +366,7 @@   | E_IO IOException   | E_Json JsonError   | E e -- ^ Client-supplied error type.+  deriving Show  -- | Pretty printer for errors printError :: (e -> String) -> E e -> String@@ -366,17 +378,19 @@  -- | Also logs the exception. throwHttpException-  :: HttpException-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpException+  -> HttpTT e r w s p t eff a throwHttpException e = do   logNow LogError $ errorMessage $ E_Http e   throw $ E_Http e  -- | Re-throws other error types. catchHttpException-  :: HttpT e r w s p m a-  -> (HttpException -> HttpT e r w s p m a) -- ^ Handler-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpTT e r w s p t eff a+  -> (HttpException -> HttpTT e r w s p t eff a) -- ^ Handler+  -> HttpTT e r w s p t eff a catchHttpException x handler = catch x $ \err ->   case err of     E_Http e -> handler e@@ -384,17 +398,19 @@  -- | Also logs the exception. throwIOException-  :: IOException-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => IOException+  -> HttpTT e r w s p t eff a throwIOException e = do   logNow LogError $ errorMessage $ E_IO e   throw $ E_IO e  -- | Re-throws other error types. catchIOException-  :: HttpT e r w s p m a-  -> (IOException -> HttpT e r w s p m a) -- ^ Handler-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpTT e r w s p t eff a+  -> (IOException -> HttpTT e r w s p t eff a) -- ^ Handler+  -> HttpTT e r w s p t eff a catchIOException x handler = catch x $ \err ->   case err of     E_IO e -> handler e@@ -402,17 +418,19 @@  -- | Also logs the exception. throwJsonError-  :: JsonError-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => JsonError+  -> HttpTT e r w s p t eff a throwJsonError e = do   logNow LogError $ errorMessage $ E_Json e   throw $ E_Json e  -- | Re-throws other error types. catchJsonError-  :: HttpT e r w s p m a-  -> (JsonError -> HttpT e r w s p m a) -- ^ Handler-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpTT e r w s p t eff a+  -> (JsonError -> HttpTT e r w s p t eff a) -- ^ Handler+  -> HttpTT e r w s p t eff a catchJsonError x handler = catch x $ \err ->   case err of     E_Json e -> handler e@@ -420,17 +438,19 @@  -- | Also logs the exception. throwError-  :: e-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => e+  -> HttpTT e r w s p t eff a throwError e = do   logNow LogError $ errorMessage $ E e   throw $ E e  -- | Re-throws other error types. catchError-  :: HttpT e r w s p m a-  -> (e -> HttpT e r w s p m a) -- ^ Handler-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpTT e r w s p t eff a+  -> (e -> HttpTT e r w s p t eff a) -- ^ Handler+  -> HttpTT e r w s p t eff a catchError x handler = catch x $ \err ->   case err of     E e -> handler e@@ -438,12 +458,13 @@  -- | Handle any thrown error. To handle only errors of a specific type, see @catchError@, @catchJsonError@, @catchIOException@, or @catchHttpException@. catchAnyError-  :: HttpT e r w s p m a-  -> (e -> HttpT e r w s p m a)-  -> (HttpException -> HttpT e r w s p m a)-  -> (IOException -> HttpT e r w s p m a)-  -> (JsonError -> HttpT e r w s p m a)-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => HttpTT e r w s p t eff a+  -> (e -> HttpTT e r w s p t eff a)+  -> (HttpException -> HttpTT e r w s p t eff a)+  -> (IOException -> HttpTT e r w s p t eff a)+  -> (JsonError -> HttpTT e r w s p t eff a)+  -> HttpTT e r w s p t eff a catchAnyError x hE hHttp hIO hJson =   catch x $ \err -> case err of     E e -> hE e@@ -759,7 +780,7 @@   { _httpOptions :: Wreq.Options   , _httpSession :: Maybe S.Session   , _userState :: s-  }+  } deriving Show  -- | State constructor basicState :: s -> S s@@ -879,9 +900,10 @@  -- | All log statements should go through @logNow@. logNow-  :: LogSeverity+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => LogSeverity   -> Log e w-  -> HttpT e r w s p m ()+  -> HttpTT e r w s p t eff () logNow severity msg = do   time <- prompt GetSystemTime   printer <- reader _logEntryPrinter@@ -895,59 +917,80 @@  -- | Write a comment to the log comment-  :: String-  -> HttpT e r w s p m ()+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => String+  -> HttpTT e r w s p t eff () comment msg = logNow LogInfo $ L_Comment msg  -- | Pause the thread wait-  :: Int -- ^ milliseconds-  -> HttpT e r w s p m ()+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Int -- ^ milliseconds+  -> HttpTT e r w s p t eff () wait k = do   logNow LogInfo $ L_Pause k   prompt $ ThreadDelay k  -- | Write an entry to the log-logEntry :: LogSeverity -> w -> HttpT e r w s p m ()+logEntry+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => LogSeverity -> w -> HttpTT e r w s p t eff () logEntry severity = logNow severity . L_Log  -- | For debug level messages-logDebug :: w -> HttpT e r w s p m ()+logDebug+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => w -> HttpTT e r w s p t eff () logDebug = logEntry LogDebug  -- | For informational messages-logInfo :: w -> HttpT e r w s p m ()+logInfo+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => w -> HttpTT e r w s p t eff () logInfo = logEntry LogInfo  -- | For normal but significant conditions-logNotice :: w -> HttpT e r w s p m ()+logNotice+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => w -> HttpTT e r w s p t eff () logNotice = logEntry LogNotice  -- | For warning conditions-logWarning :: w -> HttpT e r w s p m ()+logWarning+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => w -> HttpTT e r w s p t eff () logWarning = logEntry LogWarning  -- | For error conditions-logError :: w -> HttpT e r w s p m ()+logError+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => w -> HttpTT e r w s p t eff () logError = logEntry LogError  -- | For critical conditions-logCritical :: w -> HttpT e r w s p m ()+logCritical+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => w -> HttpTT e r w s p t eff () logCritical = logEntry LogCritical  -- | Action must be taken immediately-logAlert :: w -> HttpT e r w s p m ()+logAlert+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => w -> HttpTT e r w s p t eff () logAlert = logEntry LogAlert  -- | System is unusable-logEmergency :: w -> HttpT e r w s p m ()+logEmergency+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => w -> HttpTT e r w s p t eff () logEmergency = logEntry LogEmergency  -- | Set the severity level of all log actions in a session. setLogSeverity-  :: LogSeverity-  -> HttpT e r w s p m a-  -> HttpT e r w s p m a+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => LogSeverity+  -> HttpTT e r w s p t eff a+  -> HttpTT e r w s p t eff a setLogSeverity severity = censor (W . map f . unW)   where     f :: LogEntry e w -> LogEntry e w@@ -957,9 +1000,10 @@  -- | Write a line to a handle hPutStrLn-  :: Handle+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Handle   -> String-  -> HttpT e r w s p m ()+  -> HttpTT e r w s p t eff () hPutStrLn h str = do   result <- prompt $ HPutStrLn h str   case result of@@ -968,10 +1012,11 @@  -- | Write a line to a handle, using the given `MVar` as a lock hPutStrLnBlocking-  :: MVar ()+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => MVar ()   -> Handle   -> String-  -> HttpT e r w s p m ()+  -> HttpTT e r w s p t eff () hPutStrLnBlocking lock h str = do   result <- prompt $ HPutStrLnBlocking lock h str   case result of@@ -982,8 +1027,9 @@  -- | Run a @GET@ request httpGet-  :: Url-  -> HttpT e r w s p m HttpResponse+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Url+  -> HttpTT e r w s p t eff HttpResponse httpGet url = do   R{..} <- ask   S{..} <- get@@ -999,8 +1045,9 @@  -- | Run a @GET@ request, but do not write the request or response to the logs. httpSilentGet-  :: Url-  -> HttpT e r w s p m HttpResponse+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Url+  -> HttpTT e r w s p t eff HttpResponse httpSilentGet url = do   R{..} <- ask   S{..} <- get@@ -1016,9 +1063,10 @@  -- | Run a @POST@ request httpPost-  :: Url+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Url   -> ByteString -- ^ Payload-  -> HttpT e r w s p m HttpResponse+  -> HttpTT e r w s p t eff HttpResponse httpPost url payload = do   R{..} <- ask   S{..} <- get@@ -1034,9 +1082,10 @@  -- | Run a @POST@ request, but do not write the request or response to the logs. httpSilentPost-  :: Url+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Url   -> ByteString -- ^ Payload-  -> HttpT e r w s p m HttpResponse+  -> HttpTT e r w s p t eff HttpResponse httpSilentPost url payload = do   R{..} <- ask   S{..} <- get@@ -1052,8 +1101,9 @@  -- | Run a @DELETE@ request httpDelete-  :: Url-  -> HttpT e r w s p m HttpResponse+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Url+  -> HttpTT e r w s p t eff HttpResponse httpDelete url = do   R{..} <- ask   S{..} <- get@@ -1069,8 +1119,9 @@  -- | Run a @DELETE@ request, but do not write the request or response to the logs. httpSilentDelete-  :: Url-  -> HttpT e r w s p m HttpResponse+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Url+  -> HttpTT e r w s p t eff HttpResponse httpSilentDelete url = do   R{..} <- ask   S{..} <- get@@ -1088,17 +1139,19 @@  -- | Parse a `ByteString` to a JSON `Value`. parseJson-  :: ByteString-  -> HttpT e r w s p m Value+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => ByteString+  -> HttpTT e r w s p t eff Value parseJson bytes = case preview _Value bytes of   Just value -> return value   Nothing -> throwJsonError $ JsonParseError bytes  -- | Object member lookup. lookupKeyJson-  :: Text -- ^ Key name+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Text -- ^ Key name   -> Value -- ^ JSON object-  -> HttpT e r w s p m Value+  -> HttpTT e r w s p t eff Value lookupKeyJson key v = case v of   Object obj -> case lookup key obj of     Nothing -> throwJsonError $ JsonKeyDoesNotExist key (Object obj)@@ -1107,9 +1160,9 @@  -- | Decode a `A.Value` to some other type. constructFromJson-  :: (FromJSON a)+  :: (Monad eff, Monad (t eff), MonadTrans t, FromJSON a)   => Value-  -> HttpT e r w s p m a+  -> HttpTT e r w s p t eff a constructFromJson value = case fromJSON value of   Success x -> return x   Error msg -> throwJsonError $ JsonConstructError msg

@@ -4,6 +4,7 @@ ) where  import Control.Concurrent.MVar+import Control.Monad.Trans.Identity import System.IO import Data.Functor.Identity   ( Identity(..) )@@ -104,31 +105,31 @@   in     testGroup label       [ testProperty "comment: return ()" $-        prop_comment_value pe pr pw ps (evalIO evalId) id undefined+        prop_comment_value pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "comment: state unchanged" $-        prop_comment_state pe pr pw ps (evalIO evalId) id undefined+        prop_comment_state pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "wait: return ()" $-        prop_wait_value pe pr pw ps (evalIO evalId) id undefined+        prop_wait_value pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "wait: state unchanged" $-        prop_wait_state pe pr pw ps (evalIO evalId) id undefined+        prop_wait_state pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "httpGet: return" $-        prop_httpGet pe pr pw ps (evalIO evalId) id undefined+        prop_httpGet pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "httpSilentGet: return" $-        prop_httpSilentGet pe pr pw ps (evalIO evalId) id undefined+        prop_httpSilentGet pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "httpPost: return ()" $-        prop_httpPost pe pr pw ps (evalIO evalId) id undefined+        prop_httpPost pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "httpSilentPost: return ()" $-        prop_httpSilentPost pe pr pw ps (evalIO evalId) id undefined+        prop_httpSilentPost pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "throwError: is caught" $-        prop_throwError pe pr pw ps (evalIO evalId) id undefined+        prop_throwError pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "throwJsonError: is caught" $-        prop_throwJsonError pe pr pw ps (evalIO evalId) id undefined+        prop_throwJsonError pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "parseJson: valid" $-        prop_parseJson pe pr pw ps (evalIO evalId) id undefined+        prop_parseJson pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "lookupKeyJson: valid" $-        prop_lookupKeyJson pe pr pw ps (evalIO evalId) id undefined+        prop_lookupKeyJson pe pr pw ps (evalIO evalId) runIdentityT undefined       , testProperty "logEntries: value" $-        prop_logEntries_log pe pr pw ps (evalIO evalId) id undefined+        prop_logEntries_log pe pr pw ps (evalIO evalId) runIdentityT undefined       ]  @@ -138,13 +139,13 @@ pI :: Proxy Int pI = Proxy -toIO :: MockWorld s -> MockIO s a -> IO a-toIO u (MockIO x) = do+toIO :: MockWorld s -> IdentityT (MockIO s) a -> IO a+toIO u (IdentityT (MockIO x)) = do   let (a,_) = x u   return a -toIOs :: MockWorld s -> MockIO s a -> IO (a, MockWorld s)-toIOs u (MockIO x) = do+toIOs :: MockWorld s -> IdentityT (MockIO s) a -> IO (a, MockWorld s)+toIOs u (IdentityT (MockIO x)) = do   return $ x u  as :: a -> a -> a@@ -177,55 +178,55 @@   }  prop_comment_value-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> String -> Property prop_comment_value _ _ _ _ eval cond x s r msg =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== ())) $     as x $ do       comment msg  prop_comment_state-  :: (Monad eff, Eq s)+  :: (Monad eff, Eq s, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> String -> Property prop_comment_state _ _ _ _ eval cond x s r msg =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasState (== s)) $     as x $ do       comment msg  prop_comment_write-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> String -> Property prop_comment_write _ _ _ _ eval cond x s r str =   let msg = filter (/= '\n') str in-  checkHttpM (basicState s) (noisyEnv r) eval cond+  checkHttpTT (basicState s) (noisyEnv r) eval cond     (hasWorld $ outputContains msg) $     as x $ do       comment msg  prop_comment_silent-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> String -> Property prop_comment_silent _ _ _ _ eval cond x s r str =   let msg = filter (/= '\n') str in-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasWorld outputIsEmpty) $     as x $ do       comment msg@@ -251,80 +252,80 @@   _files world == emptyFileSystem  prop_wait_value-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> Int -> Property prop_wait_value _ _ _ _ eval cond x s r k =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== ())) $     as x $ do       wait k  prop_wait_state-  :: (Monad eff, Eq s)+  :: (Monad eff, Eq s, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> Int -> Property prop_wait_state _ _ _ _ eval cond x s r k =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasState (== s)) $     as x $ do       wait k  prop_wait_write-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> Int -> Property prop_wait_write _ _ _ _ eval cond x s r k =-  checkHttpM (basicState s) (noisyEnv r) eval cond+  checkHttpTT (basicState s) (noisyEnv r) eval cond     (hasWorld $ outputContains $ "Wait for " ++ show k ++ "μs") $     as x $ do       wait k  prop_wait_silent-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> Int -> Property prop_wait_silent _ _ _ _ eval cond x s r k =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasWorld outputIsEmpty) $     as x $ do       wait k  prop_httpGet-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> Property prop_httpGet _ _ _ _ eval cond x s r =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== ())) $     as x $ do       httpGet "http://example.com"       return ()  prop_httpGet_json-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> Property prop_httpGet_json _ _ _ _ eval cond x s r =-  checkHttpM (basicState s) (jsonEnv r) eval cond+  checkHttpTT (basicState s) (jsonEnv r) eval cond     (hasWorld $ outputContains "True") $     as x $ do       val1 <- httpGet "http://example.com/json"@@ -335,126 +336,126 @@       return ()  prop_httpGet_write-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> Property prop_httpGet_write _ _ _ _ eval cond x s r =-  checkHttpM (basicState s) (noisyEnv r) eval cond+  checkHttpTT (basicState s) (noisyEnv r) eval cond     (hasWorld $ outputContains "GET http://example.com") $     as x $ do       httpGet "http://example.com"       return ()  prop_httpGet_silent-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> Property prop_httpGet_silent _ _ _ _ eval cond x s r =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasWorld outputIsEmpty) $     as x $ do       httpGet "http://example.com"       return ()  prop_httpSilentGet-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> Property prop_httpSilentGet _ _ _ _ eval cond x s r =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== ())) $     as x $ do       httpSilentGet "http://example.com"       return ()  prop_httpSilentGet_write-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> Property prop_httpSilentGet_write _ _ _ _ eval cond x s r =-  checkHttpM (basicState s) (noisyEnv r) eval cond+  checkHttpTT (basicState s) (noisyEnv r) eval cond     (hasWorld $ not . outputContains "http://example.com") $     as x $ do       httpSilentGet "http://example.com"       return ()  prop_httpPost-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> String -> Property prop_httpPost _ _ _ _ eval cond x s r payload =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== ())) $     as x $ do       httpPost "http://example.com" (fromString payload)       return ()  prop_httpSilentPost-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> String -> Property prop_httpSilentPost _ _ _ _ eval cond x s r payload =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== ())) $     as x $ do       httpSilentPost "http://example.com" (fromString payload)       return ()  prop_throwError-  :: (Monad eff, Eq e)+  :: (Monad eff, Eq e, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p Int+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff Int   -> s -> r -> Int -> e -> Property prop_throwError _ _ _ _ eval cond x s r k err =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== k)) $     as x $ do       catchError (throwError err)         (\e -> if e == err then return k else return (k+1))  prop_logDebug_write-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> w -> Property prop_logDebug_write _ _ _ _ eval cond x s r w =-  checkHttpM (basicState s) (noisyEnv r) eval cond+  checkHttpTT (basicState s) (noisyEnv r) eval cond     (hasWorld $ outputContains "LOG") $     as x $ do       logDebug w       return ()  prop_logEntries_log-  :: (Monad eff, Eq w)+  :: (Monad eff, Eq w, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> w -> w -> w -> Property prop_logEntries_log _ _ _ _ eval cond x s r w1 w2 w3 =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasLog $ \w -> [w1,w2,w3] == logEntries w) $     as x $ do       logDebug w1@@ -464,56 +465,56 @@       return ()  prop_throwError_write-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s, Show u)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO ((Either (E e) t, S s, W e w), MockWorld u))+  -> HttpT e r w s p eff ()   -> s -> r -> e -> Property prop_throwError_write _ _ _ _ eval cond x s r e =-  checkHttpM (basicState s) (noisyEnv r) eval cond+  checkHttpTT (basicState s) (noisyEnv r) eval cond     (hasWorld $ outputContains "ERROR") $     as x $ do       throwError e       return ()  prop_throwJsonError-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p Int+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff Int   -> s -> r -> Int -> JsonError -> Property prop_throwJsonError _ _ _ _ eval cond x s r k err =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== k)) $     as x $ do       catchJsonError (throwJsonError err)         (\e -> if e == err then return k else return (k+1))  prop_parseJson-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p ()+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff ()   -> s -> r -> Int -> Property prop_parseJson _ _ _ _ eval cond x s r k =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== ())) $     as x $ do       parseJson $ fromString $ "{ \"key\":" ++ show k ++ " }"       return ()  prop_lookupKeyJson-  :: (Monad eff)+  :: (Monad eff, Show e, Show w, Show s)   => Proxy e -> Proxy r -> Proxy w -> Proxy s   -> (forall u. P p u -> eff u)-  -> (forall e s w t. eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))-  -> Http e r w s p Int+  -> (forall e s w t. IdentityT eff (Either (E e) t, S s, W e w) -> IO (Either (E e) t, S s, W e w))+  -> HttpT e r w s p eff Int   -> s -> r -> Int -> Property prop_lookupKeyJson _ _ _ _ eval cond x s r k =-  checkHttpM (basicState s) (testEnv r) eval cond+  checkHttpTT (basicState s) (testEnv r) eval cond     (hasValue (== k)) $     as x $ do       obj <- parseJson $ fromString $ "{ \"key\":" ++ show k ++ " }"

@@ -3,6 +3,7 @@   tests ) where +import Control.Monad.Trans.Identity import Data.Proxy import Data.Functor.Classes import Data.Functor.Identity@@ -112,25 +113,25 @@   --- | `ScriptT` values are pure, so we can test them for equality.+-- | `ScriptTT` values are pure, so we can test them for equality. scriptEq-  :: (Monad m, Eq a, Eq e, Eq s, Eq w, Eq1 m)-  => (forall u. p u -> u)+  :: (Monad eff, Eq a, Eq e, Eq s, Eq w, Eq1 eff)+  => (forall u. p u -> eff u)   -> (s, r)-  -> ScriptT e r w s p m a-  -> ScriptT e r w s p m a+  -> ScriptTT e r w s p IdentityT eff a+  -> ScriptTT e r w s p IdentityT eff a   -> Bool scriptEq eval (s,r) sc1 sc2 =   liftEq (==)-    (execScriptT s r eval sc1)-    (execScriptT s r eval sc2)+    (execScriptTT s r eval sc1)+    (execScriptTT s r eval sc2)    data Q a = Q a -evalQ :: Q a -> a-evalQ (Q a) = a+evalQ :: (Monad eff) => Q a -> eff a+evalQ (Q a) = return a  pQ = Proxy :: Proxy Q @@ -145,8 +146,8 @@ pEi = Proxy :: Proxy (Either Int)  pSc-  :: Proxy e -> Proxy r -> Proxy w -> Proxy s -> Proxy p -> Proxy m-  -> Proxy (ScriptT e r w s p m)+  :: Proxy e -> Proxy r -> Proxy w -> Proxy s -> Proxy p -> Proxy eff+  -> Proxy (ScriptTT e r w s p IdentityT eff) pSc _ _ _ _ _ _ = Proxy  pSt