diff --git a/examples/src/Fresh.hs b/examples/src/Fresh.hs index f097839..a41e49b 100644 --- a/examples/src/Fresh.hs +++ b/examples/src/Fresh.hs @@ -6,12 +6,12 @@ import Data.Monoid ((<>)) import System.IO (IO) 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) traceFresh :: IO () -traceFresh = runTrace $ flip runFresh' 0 $ do +traceFresh = runTrace $ flip evalFresh 0 $ do n <- fresh trace $ "Fresh " <> show n n' <- fresh diff --git a/src/Control/Monad/Freer/Fresh.hs b/src/Control/Monad/Freer/Fresh.hs index c818b41..22bf973 100644 --- a/src/Control/Monad/Freer/Fresh.hs +++ b/src/Control/Monad/Freer/Fresh.hs @@ -9,7 +9,7 @@ -- Copyright: (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o. -- License: BSD3 -- Maintainer: ixcom-core@ixperta.com --- Stability: broken +-- Stability: experimental -- Portability: GHC specific language extensions. -- -- Composable handler for 'Fresh' effects. This is likely to be of use when @@ -19,11 +19,12 @@ module Control.Monad.Freer.Fresh ( Fresh(..) , fresh - , runFresh' + , runFresh + , evalFresh ) where -import Prelude (($!), (+)) +import Prelude (($!), (+), (<$>), (.), fst) import Control.Applicative (pure) import Data.Int (Int) @@ -43,7 +44,13 @@ data Fresh a where fresh :: Member Fresh effs => Eff effs Int fresh = send Fresh --- | Handler for 'Fresh' effects, with an 'Int' for a starting value. -runFresh' :: Eff (Fresh ': effs) a -> Int -> Eff effs a -runFresh' m s = - handleRelayS s (\_s a -> pure a) (\s' Fresh k -> (k $! s' + 1) s') m +-- | Handler for 'Fresh' effects, with an 'Int' for a starting value. The return +-- value includes the next fresh value. +runFresh :: Eff (Fresh ': effs) a -> Int -> Eff effs (a, Int) +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 diff --git a/tests/Tests/Fresh.hs b/tests/Tests/Fresh.hs index 7124437..08ff099 100644 --- a/tests/Tests/Fresh.hs +++ b/tests/Tests/Fresh.hs @@ -11,13 +11,14 @@ import Data.Functor ((<$>)) import Data.Int (Int) import Data.List (last) import Data.Ord ((>)) +import Data.Tuple (fst) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit ((@?=), testCase) import Test.Tasty.QuickCheck ((==>), testProperty) import Control.Monad.Freer (Eff, run) -import Control.Monad.Freer.Fresh (fresh, runFresh') +import Control.Monad.Freer.Fresh (fresh, runFresh) tests :: TestTree @@ -29,7 +30,7 @@ tests = testGroup "Fresh tests" ] 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 = run . makeFresh