release(0.1.1): fix all warnings; separate examples

examples/src/Common.hs

@@ -0,0 +1,6 @@
+module Common where
+
+import Control.Applicative
+
+add :: Applicative f => f Int -> f Int -> f Int
+add = liftA2 (+)

examples/src/Exception.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+module Exception where
+
+import Control.Monad.Freer
+import Control.Monad.Freer.Exception
+import Control.Monad.Freer.Reader
+import Control.Monad.Freer.State
+
+import Common
+
+--------------------------------------------------------------------------------
+                       -- Tests and Examples --
+--------------------------------------------------------------------------------
+et1 :: Eff r Int
+et1 = return 1 `add` return 2
+
+et1r :: Bool
+et1r = 3 == run et1
+
+et2 :: Member (Exc Int) r => Eff r Int
+et2 = return 1 `add` throwError (2::Int)
+
+-- The following won't type: unhandled exception!
+-- ex2rw = run et2
+{-
+    No instance for (Member (Exc Int) Void)
+      arising from a use of `et2'
+-}
+
+et21 :: Eff r (Either Int Int)
+et21 = runError et2
+
+et21r :: Bool
+et21r = Left 2 == run et21
+
+
+-- The example from the paper
+newtype TooBig = TooBig Int deriving (Eq, Show)
+-- The type is inferred
+ex2 :: Member (Exc TooBig) r => Eff r Int -> Eff r Int
+ex2 m = do
+  v <- m
+  if v > 5 then throwError (TooBig v)
+     else return v
+
+-- specialization to tell the type of the exception
+runErrBig :: Eff (Exc TooBig ': r) a -> Eff r (Either TooBig a)
+runErrBig = runError
+
+
+-- exceptions and state
+incr :: Member (State Int) r => Eff r ()
+incr = get >>= put . (+ (1::Int))
+
+tes1 :: (Member (State Int) r, Member (Exc String) r) => Eff r b
+tes1 = do
+ incr
+ throwError "exc"
+
+ter1 :: Bool
+ter1 = ((Left "exc" :: Either String Int,2) ==) $
+       run $ runState (runError tes1) (1::Int)
+
+
+ter2 :: Bool
+ter2 = ((Left "exc" :: Either String (Int,Int)) ==) $
+       run $ runError (runState tes1 (1::Int))
+
+
+teCatch :: Member (Exc String) r => Eff r a -> Eff r String
+teCatch m = catchError (m >> return "done") (\e -> return (e::String))
+
+ter3 :: Bool
+ter3 = ((Right "exc" :: Either String String,2) ==) $
+       run $ runState (runError (teCatch tes1)) (1::Int)
+
+ter4 :: Bool
+ter4 = ((Right ("exc",2) :: Either String (String,Int)) ==) $
+       run $ runError (runState (teCatch tes1) (1::Int))
+
+ex2r :: Eff r (Either TooBig Int)
+ex2r = runReader (runErrBig (ex2 ask)) (5::Int)
+
+ex2rr :: Bool
+ex2rr = Right 5 == run ex2r
+
+ex2rr1 :: Bool
+ex2rr1 = (Left (TooBig 7) ==) $
+         run $ runReader (runErrBig (ex2 ask)) (7::Int)
+
+-- Different order of handlers (layers)
+ex2rr2 :: Bool
+ex2rr2 = (Left (TooBig 7) ==) $
+         run $ runErrBig (runReader (ex2 ask) (7::Int))

examples/src/Fresh.hs

@@ -0,0 +1,18 @@
+module Fresh where
+
+import Control.Monad.Freer.Fresh
+import Control.Monad.Freer.Trace
+
+--------------------------------------------------------------------------------
+                             -- Tests --
+--------------------------------------------------------------------------------
+tfresh' :: IO ()
+tfresh' = runTrace $ flip runFresh' 0 $ do
+  n <- fresh
+  trace $ "Fresh " ++ show n
+  n' <- fresh
+  trace $ "Fresh " ++ show n'
+{-
+Fresh 0
+Fresh 1
+-}

examples/src/Main.hs

@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = print "placeholder"

examples/src/Reader.hs

@@ -0,0 +1,97 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+module Reader where
+
+import Control.Applicative
+import Control.Monad.Freer
+import Control.Monad.Freer.Reader
+
+import Common
+
+--------------------------------------------------------------------------------
+                            -- Examples --
+--------------------------------------------------------------------------------
+t1 :: Member (Reader Int) r => Eff r Int
+t1 = ask `add` return (1 :: Int)
+
+t1' :: Member (Reader Int) r => Eff r Int
+t1' = do v <- ask; return (v + 1 :: Int)
+
+t1r :: Eff r Int
+t1r = runReader t1 (10::Int)
+
+t1rr :: Bool
+t1rr = 11 == run t1r
+
+{-
+t1rr' = run t1
+    No instance for (Member (Reader Int) Void)
+      arising from a use of `t1'
+-}
+
+t2 :: (Member (Reader Int) r, Member (Reader Float) r) => Eff r Float
+t2 = do
+  v1 <- ask
+  v2 <- ask
+  return $ fromIntegral (v1 + (1::Int)) + (v2 + (2::Float))
+
+t2r :: Member (Reader Float) r => Eff r Float
+t2r = runReader t2 (10::Int)
+
+t2rr :: Eff r Float
+t2rr = flip runReader (20::Float) . flip runReader (10::Int) $ t2
+
+t2rrr :: Bool
+t2rrr = 33.0 == run t2rr
+
+-- The opposite order of layers
+{- If we mess up, we get an error
+t2rrr1' = run $ runReader (runReader t2 (20::Float)) (10::Float)
+    No instance for (Member (Reader Int) [])
+      arising from a use of `t2'
+-}
+t2rrr' :: Bool
+t2rrr' = (33.0 ==) $
+         run $ runReader (runReader t2 (20 :: Float)) (10 :: Int)
+
+t3 :: Member (Reader Int) r => Eff r Int
+t3 = t1 `add` local (+ (10::Int)) t1
+
+t3r :: Bool
+t3r = (212 ==) $ run $ runReader t3 (100::Int)
+
+
+-- The following example demonstrates true interleaving of Reader Int
+-- and Reader Float layers
+t4 :: (Member (Reader Int) r, Member (Reader Float) r) =>
+      Eff r Float
+t4 = liftA2 (+) (local (+ (10::Int)) t2)
+                (local (+ (30::Float)) t2)
+
+t4rr :: Bool
+t4rr = (106.0 ==) $ run $ runReader (runReader t4 (10::Int)) (20::Float)
+
+-- The opposite order of layers gives the same result
+t4rr' :: Bool
+t4rr' = (106.0 ==) $ run $ runReader (runReader t4 (20 :: Float)) (10 :: Int)
+
+addGet :: Member (Reader Int) r => Int -> Eff r Int
+addGet x = ask >>= \i -> return (i+x)
+
+addN :: Member (Reader Int) r => Int -> Eff r Int
+addN n = foldl (>>>) return (replicate n addGet) 0
+ where f >>> g = (>>= g) . f
+
+-- Map an effectful function
+tmap :: Member (Reader Int) r => Eff r [Int]
+tmap = mapM f [1..5]
+ where f x = ask `add` return x
+
+tmapr :: Bool
+tmapr = ([11,12,13,14,15] ==) $
+        run $ runReader tmap (10::Int)

examples/src/State.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE FlexibleContexts #-}
+module State where
+
+import Control.Monad.Freer
+import Control.Monad.Freer.State
+
+--------------------------------------------------------------------------------
+                       -- Tests and Examples --
+--------------------------------------------------------------------------------
+ts1 :: Member (State Int) r => Eff r Int
+ts1 = do
+  put (10 ::Int)
+  x <- get
+  return (x::Int)
+
+ts1r :: Bool
+ts1r = ((10,10) ==) $ run (runState ts1 (0::Int))
+
+ts2 :: Member (State Int) r => Eff r Int
+ts2 = do
+  put (10::Int)
+  x <- get
+  put (20::Int)
+  y <- get
+  return (x+y)
+
+ts2r :: Bool
+ts2r = ((30,20) ==) $ run (runState ts2 (0::Int))

examples/src/StateRW.hs

@@ -0,0 +1,35 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+module StateRW where
+
+import Control.Monad.Freer
+import Control.Monad.Freer.StateRW
+
+--------------------------------------------------------------------------------
+                       -- Tests and Examples --
+--------------------------------------------------------------------------------
+-- If we had a Writer, we could have decomposed State into Writer and Reader
+-- requests.
+
+ts11 :: (Member (Reader Int) r, Member (Writer Int) r) => Eff r Int
+ts11 = do
+  tell (10 ::Int)
+  x <- ask
+  return (x::Int)
+
+ts11r :: Bool
+ts11r = ((10,10) ==) $ run (runStateR ts11 (0::Int))
+
+
+ts21 :: (Member (Reader Int) r, Member (Writer Int) r) => Eff r Int
+ts21 = do
+  tell (10::Int)
+  x <- ask
+  tell (20::Int)
+  y <- ask
+  return (x+y)
+
+ts21r :: Bool
+ts21r = ((30,20) ==) $ run (runStateR ts21 (0::Int))

examples/src/Trace.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+module Trace where
+
+import Control.Monad.Freer
+import Control.Monad.Freer.Reader
+import Control.Monad.Freer.Trace
+
+import Common
+
+--------------------------------------------------------------------------------
+                       -- Tests and Examples --
+--------------------------------------------------------------------------------
+-- Higher-order effectful function
+-- The inferred type shows that the Trace affect is added to the effects
+-- of r
+mapMdebug:: (Show a, Member Trace r) =>
+     (a -> Eff r b) -> [a] -> Eff r [b]
+mapMdebug _ [] = return []
+mapMdebug f (h:t) = do
+ trace $ "mapMdebug: " ++ show h
+ h' <- f h
+ t' <- mapMdebug f t
+ return (h':t')
+
+tMd :: IO [Int]
+tMd = runTrace $ runReader (mapMdebug f [1..5]) (10::Int)
+ where f x = ask `add` return x
+{-
+mapMdebug: 1
+mapMdebug: 2
+mapMdebug: 3
+mapMdebug: 4
+mapMdebug: 5
+[11,12,13,14,15]
+-}
+
+-- duplicate layers
+tdup :: IO ()
+tdup = runTrace $ runReader m (10::Int)
+ where
+ m = do
+     runReader tr (20::Int)
+     tr
+ tr = do
+      v <- ask
+      trace $ "Asked: " ++ show (v::Int)
+{-
+Asked: 20
+Asked: 10
+-}

freer.cabal

@@ -1,15 +1,12 @@
--- Initial freer.cabal generated by cabal init.  For further documentation,
---  see http://haskell.org/cabal/users-guide/
-
 name:                freer
-version:             0.1.0.0
+version:             0.1.1.0
 synopsis:            Implementation of the Freer Monad
 -- description:
 license:             BSD3
 license-file:        LICENSE
 author:              Alej Cabrera
 maintainer:          cpp.cabrera@gmail.com
--- copyright:
+copyright:           Alej Cabrera 2015
 category:            Control
 build-type:          Simple
 -- extra-source-files:
@@ -19,6 +16,7 @@ library
   exposed-modules:     Control.Monad.Freer.Internal
                      , Data.FTCQueue
                      , Data.Open.Union
+                     , Control.Monad.Freer
                      , Control.Monad.Freer.Reader
                      , Control.Monad.Freer.Writer
                      , Control.Monad.Freer.State
@@ -26,9 +24,23 @@ library
                      , Control.Monad.Freer.Exception
                      , Control.Monad.Freer.Trace
                      , Control.Monad.Freer.Fresh
-  -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4.8 && <4.9
+  build-depends:       base >=4.7 && <4.9
   hs-source-dirs:      src
-  -- ghc-options:         -Wall
+  ghc-options:         -Wall
+  default-language:    Haskell2010
+
+executable examples
+  main-is:             Main.hs
+  other-modules:       Reader
+                     , Exception
+                     , Common
+                     , State
+                     , StateRW
+                     , Trace
+                     , Fresh
+  build-depends:       base >=4.7 && <4.9
+                     , freer
+  hs-source-dirs:      examples/src
+  ghc-options:         -Wall
   default-language:    Haskell2010

src/Control/Monad/Freer.hs

@@ -0,0 +1,7 @@
+module Control.Monad.Freer (
+  Member,
+  Eff,
+  run
+) where
+
+import Control.Monad.Freer.Internal

src/Control/Monad/Freer/Exception.hs

@@ -10,9 +10,6 @@ module Control.Monad.Freer.Exception (
   catchError
 ) where
 
-import Control.Monad
-import Control.Monad.Freer.Reader -- for examples
-import Control.Monad.Freer.State  -- for examples
 import Control.Monad.Freer.Internal
 
 --------------------------------------------------------------------------------
@@ -33,89 +30,3 @@ runError =
 catchError :: Member (Exc e) r =>
         Eff r a -> (e -> Eff r a) -> Eff r a
 catchError m handle = interpose return (\(Exc e) _k -> handle e) m
-
-
---------------------------------------------------------------------------------
-                       -- Tests and Examples --
---------------------------------------------------------------------------------
-add = liftM2 (+)
-
--- The type is inferred
-et1 :: Eff r Int
-et1 = return 1 `add` return 2
-
-et1r :: Bool
-et1r = 3 == run et1
-
--- The type is inferred
--- et2 :: Member (Exc Int) r => Eff r Int
-et2 = return 1 `add` throwError (2::Int)
-
--- The following won't type: unhandled exception!
--- ex2rw = run et2
-{-
-    No instance for (Member (Exc Int) Void)
-      arising from a use of `et2'
--}
-
--- The inferred type shows that ex21 is now pure
-et21 :: Eff r (Either Int Int)
-et21 = runError et2
-
-et21r = Left 2 == run et21
-
-
--- The example from the paper
-newtype TooBig = TooBig Int deriving (Eq, Show)
--- The type is inferred
-ex2 :: Member (Exc TooBig) r => Eff r Int -> Eff r Int
-ex2 m = do
-  v <- m
-  if v > 5 then throwError (TooBig v)
-     else return v
-
--- specialization to tell the type of the exception
-runErrBig :: Eff (Exc TooBig ': r) a -> Eff r (Either TooBig a)
-runErrBig = runError
-
-
--- exceptions and state
-incr :: Member (State Int) r => Eff r ()
-incr = get >>= put . (+ (1::Int))
-
-tes1 :: (Member (State Int) r, Member (Exc String) r) => Eff r b
-tes1 = do
- incr
- throwError "exc"
-
-ter1 :: Bool
-ter1 = ((Left "exc" :: Either String Int,2) ==) $
-       run $ runState (runError tes1) (1::Int)
-
-
-ter2 :: Bool
-ter2 = ((Left "exc" :: Either String (Int,Int)) ==) $
-       run $ runError (runState tes1 (1::Int))
-
-
-teCatch :: Member (Exc String) r => Eff r a -> Eff r String
-teCatch m = catchError (m >> return "done") (\e -> return (e::String))
-
-ter3 :: Bool
-ter3 = ((Right "exc" :: Either String String,2) ==) $
-       run $ runState (runError (teCatch tes1)) (1::Int)
-
-ter4 :: Bool
-ter4 = ((Right ("exc",2) :: Either String (String,Int)) ==) $
-       run $ runError (runState (teCatch tes1) (1::Int))
-
-ex2r = runReader (runErrBig (ex2 ask)) (5::Int)
-
-ex2rr = Right 5 == run ex2r
-
-ex2rr1 = (Left (TooBig 7) ==) $
-         run $ runReader (runErrBig (ex2 ask)) (7::Int)
-
--- Different order of handlers (layers)
-ex2rr2 = (Left (TooBig 7) ==) $
-         run $ runErrBig (runReader (ex2 ask) (7::Int))

src/Control/Monad/Freer/Fresh.hs

@@ -9,7 +9,6 @@ module Control.Monad.Freer.Fresh (
 ) where
 
 import Control.Monad.Freer.Internal
-import Control.Monad.Freer.Trace  -- for example
 
 --------------------------------------------------------------------------------
                              -- Fresh --
@@ -24,19 +23,5 @@ fresh = send Fresh
 runFresh' :: Eff (Fresh ': r) w -> Int -> Eff r w
 runFresh' m s =
   handleRelayS s (\_s x -> return x)
-                 (\s Fresh k -> (k $! s+1) s)
+                 (\s' Fresh k -> (k $! s'+1) s')
                  m
-
---------------------------------------------------------------------------------
-                             -- Tests --
---------------------------------------------------------------------------------
-tfresh' :: IO ()
-tfresh' = runTrace $ flip runFresh' 0 $ do
-  n <- fresh
-  trace $ "Fresh " ++ show n
-  n <- fresh
-  trace $ "Fresh " ++ show n
-{-
-Fresh 0
-Fresh 1
--}

src/Control/Monad/Freer/Internal.hs

@@ -110,6 +110,7 @@ send t = E (inj t) (tsingleton Val)
 -- only pure computations may be run.
 run :: Eff '[] w -> w
 run (Val x) = x
+run _       = error "Internal:run - This (E) should never happen"
 -- the other case is unreachable since Union [] a cannot be
 -- constructed.
 -- Therefore, run is a total function if its argument terminates.

src/Control/Monad/Freer/Reader.hs

@@ -14,7 +14,6 @@ module Control.Monad.Freer.Reader (
   local
 ) where
 
-import Control.Applicative
 import Control.Monad.Freer.Internal
 
 -- ------------------------------------------------------------------------
@@ -65,86 +64,3 @@ local f m = do
   let h :: Reader e v -> Arr r v a -> Eff r a
       h Reader g = g e
   interpose return h m
-
-
--- Examples
-add :: Applicative f => f Int -> f Int -> f Int
-add = liftA2 (+)
-
-
--- The type is inferred
-t1 :: Member (Reader Int) r => Eff r Int
-t1 = ask `add` return (1 :: Int)
-
-t1' :: Member (Reader Int) r => Eff r Int
-t1' = do v <- ask; return (v + 1 :: Int)
-
--- t1r :: Eff r Int
-t1r = runReader t1 (10::Int)
-
-t1rr = 11 == run t1r
-
-{-
-t1rr' = run t1
-    No instance for (Member (Reader Int) Void)
-      arising from a use of `t1'
--}
-
--- Inferred type
--- t2 :: (Member (Reader Int) r, Member (Reader Float) r) => Eff r Float
-t2 = do
-  v1 <- ask
-  v2 <- ask
-  return $ fromIntegral (v1 + (1::Int)) + (v2 + (2::Float))
-
--- t2r :: Member (Reader Float) r => Eff r Float
-t2r = runReader t2 (10::Int)
--- t2rr :: Eff r Float
-t2rr = flip runReader (20::Float) . flip runReader (10::Int) $ t2
-
-t2rrr = 33.0 == run t2rr
-
--- The opposite order of layers
-{- If we mess up, we get an error
-t2rrr1' = run $ runReader (runReader t2 (20::Float)) (10::Float)
-    No instance for (Member (Reader Int) [])
-      arising from a use of `t2'
--}
-t2rrr' = (33.0 ==) $
-         run $ runReader (runReader t2 (20 :: Float)) (10 :: Int)
-
--- The type is inferred
-t3 :: Member (Reader Int) r => Eff r Int
-t3 = t1 `add` local (+ (10::Int)) t1
-t3r = (212 ==) $ run $ runReader t3 (100::Int)
-
-
--- The following example demonstrates true interleaving of Reader Int
--- and Reader Float layers
-{-
-t4
-  :: (Member (Reader Int) r, Member (Reader Float) r) =>
-     () -> Eff r Float
--}
-t4 = liftA2 (+) (local (+ (10::Int)) t2)
-                (local (+ (30::Float)) t2)
-
-t4rr = (106.0 ==) $ run $ runReader (runReader t4 (10::Int)) (20::Float)
-
--- The opposite order of layers gives the same result
-t4rr' = (106.0 ==) $ run $ runReader (runReader t4 (20 :: Float)) (10 :: Int)
-
-addGet :: Member (Reader Int) r => Int -> Eff r Int
-addGet x = ask >>= \i -> return (i+x)
-
-addN n = foldl (>>>) return (replicate n addGet) 0
- where f >>> g = (>>= g) . f
-
--- Map an effectful function
--- The type is inferred
-tmap :: Member (Reader Int) r => Eff r [Int]
-tmap = mapM f [1..5]
- where f x = ask `add` return x
-
-tmapr = ([11,12,13,14,15] ==) $
-        run $ runReader tmap (10::Int)

src/Control/Monad/Freer/State.hs

@@ -10,6 +10,8 @@ module Control.Monad.Freer.State (
   put,
   runState',
   runState,
+
+  ProxyState(..),
   transactionState
 ) where
 
@@ -44,20 +46,20 @@ put :: Member (State s) r => s -> Eff r ()
 put s = send (Put s)
 
 runState' :: Eff (State s ': r) w -> s -> Eff r (w,s)
-runState' m s =
-  handleRelayS s (\s x -> return (x,s))
-                 (\s sreq k -> case sreq of
-                     Get    -> k s s
-                     Put s' -> k s' ())
-                 m
+runState' m s' =
+  handleRelayS s' (\s x -> return (x,s))
+                  (\s sreq k -> case sreq of
+                      Get    -> k s s
+                      Put s'' -> k s'' ())
+                  m
 
 -- Since State is so frequently used, we optimize it a bit
 runState :: Eff (State s ': r) w -> s -> Eff r (w,s)
 runState (Val x) s = return (x,s)
 runState (E u q) s = case decomp u of
-  Right Get     -> runState (qApp q s) s
-  Right (Put s) -> runState (qApp q ()) s
-  Left  u -> E u (tsingleton (\x -> runState (qApp q x) s))
+  Right Get      -> runState (qApp q s) s
+  Right (Put s') -> runState (qApp q ()) s'
+  Left  u'       -> E u' (tsingleton (\x -> runState (qApp q x) s))
 
 
 -- An encapsulated State handler, for transactional semantics
@@ -74,24 +76,3 @@ transactionState _ m = do s <- get; loop s m
      Just Get      -> loop s (qApp q s)
      Just (Put s') -> loop s'(qApp q ())
      _      -> E u (tsingleton k) where k = qComp q (loop s)
-
---------------------------------------------------------------------------------
-                       -- Tests and Examples --
---------------------------------------------------------------------------------
-ts1 :: Member (State Int) r => Eff r Int
-ts1 = do
-  put (10 ::Int)
-  x <- get
-  return (x::Int)
-
-ts1r = ((10,10) ==) $ run (runState ts1 (0::Int))
-
-ts2 :: Member (State Int) r => Eff r Int
-ts2 = do
-  put (10::Int)
-  x <- get
-  put (20::Int)
-  y <- get
-  return (x+y)
-
-ts2r = ((30,20) ==) $ run (runState ts2 (0::Int))

src/Control/Monad/Freer/StateRW.hs

@@ -3,7 +3,11 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 module Control.Monad.Freer.StateRW (
-  runStateR
+  runStateR,
+  Reader,
+  Writer,
+  tell,
+  ask
 ) where
 
 import Control.Monad.Freer.Reader
@@ -22,37 +26,10 @@ runStateR :: Eff (Writer s ': Reader s ': r) w -> s -> Eff r (w,s)
 runStateR m s = loop s m
  where
    loop :: s -> Eff (Writer s ': Reader s ': r) w -> Eff r (w,s)
-   loop s (Val x) = return (x,s)
-   loop s (E u q) = case decomp u of
+   loop s' (Val x) = return (x,s')
+   loop s' (E u q) = case decomp u of
      Right (Writer o) -> k o ()
-     Left  u  -> case decomp u of
-       Right Reader -> k s s
-       Left u -> E u (tsingleton (k s))
-    where k s = qComp q (loop s)
-
---------------------------------------------------------------------------------
-                       -- Tests and Examples --
---------------------------------------------------------------------------------
--- If we had a Writer, we could have decomposed State into Writer and Reader
--- requests.
-
-ts11 :: (Member (Reader Int) r, Member (Writer Int) r) => Eff r Int
-ts11 = do
-  tell (10 ::Int)
-  x <- ask
-  return (x::Int)
-
-ts11r :: Bool
-ts11r = ((10,10) ==) $ run (runStateR ts11 (0::Int))
-
-
-ts21 :: (Member (Reader Int) r, Member (Writer Int) r) => Eff r Int
-ts21 = do
-  tell (10::Int)
-  x <- ask
-  tell (20::Int)
-  y <- ask
-  return (x+y)
-
-ts21r :: Bool
-ts21r = ((30,20) ==) $ run (runStateR ts21 (0::Int))
+     Left  u'  -> case decomp u' of
+       Right Reader -> k s' s'
+       Left u'' -> E u'' (tsingleton (k s'))
+    where k s'' = qComp q (loop s'')

src/Control/Monad/Freer/Trace.hs

@@ -9,9 +9,7 @@ module Control.Monad.Freer.Trace (
   runTrace
 ) where
 
-import Control.Monad
 import Control.Monad.Freer.Internal
-import Control.Monad.Freer.Reader -- for examples
 
 --------------------------------------------------------------------------------
                     -- Tracing (debug printing) --
@@ -28,48 +26,4 @@ runTrace :: Eff '[Trace] w -> IO w
 runTrace (Val x) = return x
 runTrace (E u q) = case decomp u of
      Right (Trace s) -> putStrLn s >> runTrace (qApp q ())
-     -- Nothing more can occur
-
---------------------------------------------------------------------------------
-                       -- Tests and Examples --
---------------------------------------------------------------------------------
--- Higher-order effectful function
--- The inferred type shows that the Trace affect is added to the effects
--- of r
-mapMdebug:: (Show a, Member Trace r) =>
-     (a -> Eff r b) -> [a] -> Eff r [b]
-mapMdebug f [] = return []
-mapMdebug f (h:t) = do
- trace $ "mapMdebug: " ++ show h
- h' <- f h
- t' <- mapMdebug f t
- return (h':t')
-
-add = liftM2 (+)
-
-tMd :: IO [Int]
-tMd = runTrace $ runReader (mapMdebug f [1..5]) (10::Int)
- where f x = ask `add` return x
-{-
-mapMdebug: 1
-mapMdebug: 2
-mapMdebug: 3
-mapMdebug: 4
-mapMdebug: 5
-[11,12,13,14,15]
--}
-
--- duplicate layers
-tdup :: IO ()
-tdup = runTrace $ runReader m (10::Int)
- where
- m = do
-     runReader tr (20::Int)
-     tr
- tr = do
-      v <- ask
-      trace $ "Asked: " ++ show (v::Int)
-{-
-Asked: 20
-Asked: 10
--}
+     Left _          -> error "runTrace:Left - This should never happen"