cleanup: examples, tests

examples/src/Exception.hs

@@ -1,96 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-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

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

examples/src/Reader.hs

@@ -1,104 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-module Reader where
-
-import Control.Applicative
-import Control.Monad.Freer
-import Control.Monad.Freer.Reader
-import Control.Monad.Freer.Writer
-
-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)
-
-rdwr :: (Member (Reader Int) r, Member (Writer String) r)
-     => Eff r Int
-rdwr = do
-  tell "begin"
-  r <- addN 10
-  tell "end"
-  return r
-
-rdwrr :: (Int,[String])
-rdwrr = run . (`runReader` (1::Int)) . runWriter $ rdwr
--- (10,["begin","end"])

examples/src/State.hs

@@ -1,28 +0,0 @@
-{-# 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

@@ -1,29 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-module StateRW where
-
-import Control.Monad.Freer
-import Control.Monad.Freer.StateRW
-
---------------------------------------------------------------------------------
-                       -- Tests and Examples --
---------------------------------------------------------------------------------
-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

@@ -8,9 +8,6 @@ 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
@@ -18,10 +15,10 @@ 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')
+  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)

freer.cabal

@@ -59,12 +59,8 @@ executable examples
   other-modules:       Common
                      , Coroutine
                      , Cut
-                     , Exception
                      , Fresh
                      , NonDetEff
-                     , Reader
-                     , State
-                     , StateRW
                      , Teletype
                      , Trace
   build-depends:       base >=4.7 && <4.9

tests/Tests/Exception.hs

@@ -23,9 +23,6 @@ import Control.Monad.Freer.State
 
 import Tests.Common
 
---------------------------------------------------------------------------------
-                       -- Tests and Examples --
---------------------------------------------------------------------------------
 testExceptionTakesPriority :: Int -> Int -> Either Int Int
 testExceptionTakesPriority x y = run $ runError (go x y)
   where go a b = return a `add` throwError b

tests/Tests/Fresh.hs

@@ -4,9 +4,6 @@ import Control.Monad
 import Control.Monad.Freer
 import Control.Monad.Freer.Fresh
 
---------------------------------------------------------------------------------
-                             -- Tests --
---------------------------------------------------------------------------------
 makeFresh :: Int -> Eff r Int
 makeFresh n = flip runFresh' 0 (replicateM n fresh >>= (return . last))
 

tests/Tests/State.hs

@@ -8,9 +8,6 @@ module Tests.State (
 import Control.Monad.Freer
 import Control.Monad.Freer.State
 
---------------------------------------------------------------------------------
-                       -- Tests and Examples --
---------------------------------------------------------------------------------
 testPutGet :: Int -> Int -> (Int,Int)
 testPutGet n start = run (runState go start)
   where go = put n >> get >>= return

tests/Tests/StateRW.hs

@@ -8,9 +8,6 @@ module Tests.StateRW (
 import Control.Monad.Freer
 import Control.Monad.Freer.StateRW
 
---------------------------------------------------------------------------------
-                       -- Tests and Examples --
---------------------------------------------------------------------------------
 testPutGetRW :: Int -> Int -> (Int,Int)
 testPutGetRW n start = run (runStateR go start)
   where go = tell n >> ask >>= return