lexi-lambda/freer-simple
1
1
Fork 0
mirror of https://github.com/lexi-lambda/freer-simple.git synced 2024-12-24 14:43:57 +03:00
Code Issues Projects Releases Wiki Activity

better Fresh for use with Continuation

Browse Source
This commit is contained in:
Schell Scivally 2017-03-14 11:59:22 -07:00 committed by Peter Trško
parent e74c583c0c
commit a1e415b967
3 changed files with 19 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
examples/src/Fresh.hs
View File

@ -6,12 +6,12 @@ import Data.Monoid ((<>))
import System.IO (IO) import System.IO (IO)
import Text.Show (show) import Text.Show (show)
import Control.Monad.Freer.Fresh (fresh, runFresh') import Control.Monad.Freer.Fresh (evalFresh, fresh)
import Control.Monad.Freer.Trace (runTrace, trace) import Control.Monad.Freer.Trace (runTrace, trace)
traceFresh :: IO () traceFresh :: IO ()
traceFresh = runTrace $ flip runFresh' 0 $ do traceFresh = runTrace $ flip evalFresh 0 $ do
n <- fresh n <- fresh
trace $ "Fresh " <> show n trace $ "Fresh " <> show n
n' <- fresh n' <- fresh

21
src/Control/Monad/Freer/Fresh.hs
View File

@ -9,7 +9,7 @@
-- Copyright: (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o. -- Copyright: (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.
-- License: BSD3 -- License: BSD3
-- Maintainer: ixcom-core@ixperta.com -- Maintainer: ixcom-core@ixperta.com
-- Stability: broken -- Stability: experimental
-- Portability: GHC specific language extensions. -- Portability: GHC specific language extensions.
-- --
-- Composable handler for 'Fresh' effects. This is likely to be of use when -- Composable handler for 'Fresh' effects. This is likely to be of use when
@ -19,11 +19,12 @@
module Control.Monad.Freer.Fresh module Control.Monad.Freer.Fresh
( Fresh(..) ( Fresh(..)
, fresh , fresh
, runFresh' , runFresh
, evalFresh
) )
where where
import Prelude (($!), (+)) import Prelude (($!), (+), (<$>), (.), fst)
import Control.Applicative (pure) import Control.Applicative (pure)
import Data.Int (Int) import Data.Int (Int)
@ -43,7 +44,13 @@ data Fresh a where
fresh :: Member Fresh effs => Eff effs Int fresh :: Member Fresh effs => Eff effs Int
fresh = send Fresh fresh = send Fresh
-- | Handler for 'Fresh' effects, with an 'Int' for a starting value. -- | Handler for 'Fresh' effects, with an 'Int' for a starting value. The return
runFresh' :: Eff (Fresh ': effs) a -> Int -> Eff effs a -- value includes the next fresh value.
runFresh' m s = runFresh :: Eff (Fresh ': effs) a -> Int -> Eff effs (a, Int)
handleRelayS s (\_s a -> pure a) (\s' Fresh k -> (k $! s' + 1) s') m runFresh m s =
handleRelayS s (\_s a -> pure (a, _s)) (\s' Fresh k -> (k $! s' + 1) s') m
-- | Handler for 'Fresh' effects, with an 'Int' for a starting value. Discards
-- the next fresh value.
evalFresh :: Eff (Fresh ': effs) a -> Int -> Eff effs a
evalFresh = ((fst <$>) .) . runFresh

5
tests/Tests/Fresh.hs
View File

@ -11,13 +11,14 @@ import Data.Functor ((<$>))
import Data.Int (Int) import Data.Int (Int)
import Data.List (last) import Data.List (last)
import Data.Ord ((>)) import Data.Ord ((>))
import Data.Tuple (fst)
import Test.Tasty (TestTree, testGroup) import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit ((@?=), testCase) import Test.Tasty.HUnit ((@?=), testCase)
import Test.Tasty.QuickCheck ((==>), testProperty) import Test.Tasty.QuickCheck ((==>), testProperty)
import Control.Monad.Freer (Eff, run) import Control.Monad.Freer (Eff, run)
import Control.Monad.Freer.Fresh (fresh, runFresh') import Control.Monad.Freer.Fresh (fresh, runFresh)
tests :: TestTree tests :: TestTree
@ -29,7 +30,7 @@ tests = testGroup "Fresh tests"
] ]
makeFresh :: Int -> Eff r Int makeFresh :: Int -> Eff r Int
makeFresh n = runFresh' (last <$> replicateM n fresh) 0 makeFresh n = fst <$> runFresh (last <$> replicateM n fresh) 0
testFresh :: Int -> Int testFresh :: Int -> Int
testFresh = run . makeFresh testFresh = run . makeFresh