cleanup: examples, tests

This commit is contained in:
Alej Cabrera 2015-09-13 00:11:43 -05:00
parent 667aaef032
commit 85ceb6fbec
11 changed files with 6 additions and 285 deletions

View File

@ -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))

View File

@ -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

View File

@ -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"])

View File

@ -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))

View File

@ -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))

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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))

View File

@ -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

View File

@ -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