2015-09-13 08:00:16 +03:00
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
module Tests.State (
|
|
|
|
testPutGet,
|
|
|
|
testPutGetPutGetPlus,
|
2017-01-21 19:36:50 +03:00
|
|
|
testGetStart,
|
|
|
|
testEvalState,
|
|
|
|
testExecState
|
2015-09-13 08:00:16 +03:00
|
|
|
) where
|
|
|
|
|
|
|
|
import Control.Monad.Freer
|
|
|
|
import Control.Monad.Freer.State
|
|
|
|
|
|
|
|
testPutGet :: Int -> Int -> (Int,Int)
|
|
|
|
testPutGet n start = run (runState go start)
|
2015-09-13 08:17:28 +03:00
|
|
|
where go = put n >> get
|
2015-09-13 08:00:16 +03:00
|
|
|
|
|
|
|
testPutGetPutGetPlus :: Int -> Int -> Int -> (Int,Int)
|
|
|
|
testPutGetPutGetPlus p1 p2 start = run (runState go start)
|
|
|
|
where go = do
|
|
|
|
put p1
|
|
|
|
x <- get
|
|
|
|
put p2
|
|
|
|
y <- get
|
|
|
|
return (x+y)
|
|
|
|
|
|
|
|
testGetStart :: Int -> (Int,Int)
|
2015-09-13 08:17:28 +03:00
|
|
|
testGetStart = run . runState get
|
2017-01-21 19:36:50 +03:00
|
|
|
|
|
|
|
testEvalState :: Int -> Int
|
|
|
|
testEvalState = run . evalState go
|
|
|
|
where
|
|
|
|
go = do
|
|
|
|
x <- get
|
|
|
|
-- destroy the previous state
|
|
|
|
put (0 :: Int)
|
|
|
|
return x
|
|
|
|
|
|
|
|
testExecState :: Int -> Int
|
|
|
|
testExecState n = run $ execState (put n) 0
|