mirror of
https://github.com/haskell-effectful/effectful.git
synced 2024-11-27 01:45:16 +03:00
Rename Pure/MVar to Local/Shared
This commit is contained in:
Andrzej Rybczak
parent
48138ff547
commit
cee28d5c51
@ -12,9 +12,9 @@ import qualified Control.Effect as L
|
||||
-- effectful
|
||||
import qualified Effectful as E
|
||||
import qualified Effectful.Reader as E
|
||||
import qualified Effectful.State as E
|
||||
import qualified Effectful.State.Dynamic as DE
|
||||
import qualified Effectful.State.MVar as ME
|
||||
import qualified Effectful.State.Dynamic as ED
|
||||
import qualified Effectful.State.Local as EL
|
||||
import qualified Effectful.State.Shared as ES
|
||||
|
||||
-- freer-simple
|
||||
#ifdef VERSION_freer_simple
|
||||
@ -103,85 +103,87 @@ countdownMtlDeep n = runIdentity
|
||||
----------------------------------------
|
||||
-- effectful (pure)
|
||||
|
||||
programEffectfulStatic :: E.State Integer E.:> es => E.Eff es Integer
|
||||
programEffectfulStatic = do
|
||||
n <- E.get @Integer
|
||||
programEffectfulLocal :: EL.State Integer E.:> es => E.Eff es Integer
|
||||
programEffectfulLocal = do
|
||||
n <- EL.get @Integer
|
||||
if n <= 0
|
||||
then pure n
|
||||
else do
|
||||
E.put (n - 1)
|
||||
programEffectfulStatic
|
||||
{-# NOINLINE programEffectfulStatic #-}
|
||||
EL.put (n - 1)
|
||||
programEffectfulLocal
|
||||
{-# NOINLINE programEffectfulLocal #-}
|
||||
|
||||
countdownEffectfulStatic :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulStatic n = E.runPureEff . E.runState n $ programEffectfulStatic
|
||||
countdownEffectfulLocal :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulLocal n = E.runPureEff . EL.runState n $ programEffectfulLocal
|
||||
|
||||
countdownEffectfulStaticDeep :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulStaticDeep n = E.runPureEff
|
||||
countdownEffectfulLocalDeep :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulLocalDeep n = E.runPureEff
|
||||
. runR . runR . runR . runR . runR
|
||||
. E.runState n
|
||||
. EL.runState n
|
||||
. runR . runR . runR . runR . runR
|
||||
$ programEffectfulStatic
|
||||
$ programEffectfulLocal
|
||||
where
|
||||
runR = E.runReader ()
|
||||
|
||||
----------------------------------------
|
||||
-- effectful (mvar)
|
||||
|
||||
programEffectfulMVar :: ME.State Integer E.:> es => E.Eff es Integer
|
||||
programEffectfulMVar = do
|
||||
n <- ME.get @Integer
|
||||
programEffectfulShared :: ES.State Integer E.:> es => E.Eff es Integer
|
||||
programEffectfulShared = do
|
||||
n <- ES.get @Integer
|
||||
if n <= 0
|
||||
then pure n
|
||||
else do
|
||||
ME.put (n - 1)
|
||||
programEffectfulMVar
|
||||
{-# NOINLINE programEffectfulMVar #-}
|
||||
ES.put (n - 1)
|
||||
programEffectfulShared
|
||||
{-# NOINLINE programEffectfulShared #-}
|
||||
|
||||
countdownEffectfulMVar :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulMVar n = E.runPureEff . ME.runState n $ programEffectfulMVar
|
||||
countdownEffectfulShared :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulShared n = E.runPureEff . ES.runState n $ programEffectfulShared
|
||||
|
||||
countdownEffectfulMVarDeep :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulMVarDeep n = E.runPureEff
|
||||
countdownEffectfulSharedDeep :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulSharedDeep n = E.runPureEff
|
||||
. runR . runR . runR . runR . runR
|
||||
. ME.runState n
|
||||
. ES.runState n
|
||||
. runR . runR . runR . runR . runR
|
||||
$ programEffectfulMVar
|
||||
$ programEffectfulShared
|
||||
where
|
||||
runR = E.runReader ()
|
||||
|
||||
----------------------------------------
|
||||
-- effectful (dynamic)
|
||||
|
||||
programEffectfulDynamic :: DE.State Integer E.:> es => E.Eff es Integer
|
||||
programEffectfulDynamic :: ED.State Integer E.:> es => E.Eff es Integer
|
||||
programEffectfulDynamic = do
|
||||
n <- DE.get @Integer
|
||||
n <- ED.get @Integer
|
||||
if n <= 0
|
||||
then pure n
|
||||
else do
|
||||
DE.put (n - 1)
|
||||
ED.put (n - 1)
|
||||
programEffectfulDynamic
|
||||
{-# NOINLINE programEffectfulDynamic #-}
|
||||
|
||||
countdownEffectfulDynPure :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulDynPure n = E.runPureEff . DE.runState n $ programEffectfulDynamic
|
||||
countdownEffectfulDynLocal :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulDynLocal n =
|
||||
E.runPureEff . ED.runLocalState n $ programEffectfulDynamic
|
||||
|
||||
countdownEffectfulDynMVar :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulDynMVar n = E.runPureEff . DE.runStateMVar n $ programEffectfulDynamic
|
||||
countdownEffectfulDynShared :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulDynShared n =
|
||||
E.runPureEff . ED.runSharedState n $ programEffectfulDynamic
|
||||
|
||||
countdownEffectfulDynPureDeep :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulDynPureDeep n = E.runPureEff
|
||||
countdownEffectfulDynLocalDeep :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulDynLocalDeep n = E.runPureEff
|
||||
. runR . runR . runR . runR . runR
|
||||
. DE.runState n
|
||||
. ED.runLocalState n
|
||||
. runR . runR . runR . runR . runR
|
||||
$ programEffectfulDynamic
|
||||
where
|
||||
runR = E.runReader ()
|
||||
|
||||
countdownEffectfulDynMVarDeep :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulDynMVarDeep n = E.runPureEff
|
||||
countdownEffectfulDynSharedDeep :: Integer -> (Integer, Integer)
|
||||
countdownEffectfulDynSharedDeep n = E.runPureEff
|
||||
. runR . runR . runR . runR . runR
|
||||
. DE.runStateMVar n
|
||||
. ED.runSharedState n
|
||||
. runR . runR . runR . runR . runR
|
||||
$ programEffectfulDynamic
|
||||
where
|
||||
|
||||
@ -11,7 +11,7 @@ import System.Posix
|
||||
-- effectful
|
||||
import qualified Effectful as E
|
||||
import qualified Effectful.Reader as E
|
||||
import qualified Effectful.State as E
|
||||
import qualified Effectful.State.Local as E
|
||||
|
||||
-- eff
|
||||
#ifdef VERSION_eff
|
||||
|
||||
@ -26,47 +26,47 @@ main = defaultMain
|
||||
countdown :: Integer -> Benchmark
|
||||
countdown n = bgroup (show n)
|
||||
[ bgroup "shallow"
|
||||
[ bench "reference (pure)" $ nf countdownRef n
|
||||
, bench "reference (ST)" $ nf countdownST n
|
||||
, bench "effectful (pure-static)" $ nf countdownEffectfulStatic n
|
||||
, bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPure n
|
||||
, bench "effectful (MVar-static)" $ nf countdownEffectfulMVar n
|
||||
, bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVar n
|
||||
[ bench "reference (pure)" $ nf countdownRef n
|
||||
, bench "reference (ST)" $ nf countdownST n
|
||||
, bench "effectful (local/static)" $ nf countdownEffectfulLocal n
|
||||
, bench "effectful (local/dynamic)" $ nf countdownEffectfulDynLocal n
|
||||
, bench "effectful (shared/static)" $ nf countdownEffectfulShared n
|
||||
, bench "effectful (shared/dynamic)" $ nf countdownEffectfulDynShared n
|
||||
#ifdef VERSION_freer_simple
|
||||
, bench "freer-simple" $ nf countdownFreerSimple n
|
||||
, bench "freer-simple" $ nf countdownFreerSimple n
|
||||
#endif
|
||||
#ifdef VERSION_eff
|
||||
, bench "eff" $ nf countdownEff n
|
||||
, bench "eff" $ nf countdownEff n
|
||||
#endif
|
||||
#ifdef VERSION_mtl
|
||||
, bench "mtl" $ nf countdownMtl n
|
||||
, bench "mtl" $ nf countdownMtl n
|
||||
#endif
|
||||
#ifdef VERSION_fused_effects
|
||||
, bench "fused-effects" $ nf countdownFusedEffects n
|
||||
, bench "fused-effects" $ nf countdownFusedEffects n
|
||||
#endif
|
||||
#ifdef VERSION_polysemy
|
||||
, bench "polysemy" $ nf countdownPolysemy n
|
||||
, bench "polysemy" $ nf countdownPolysemy n
|
||||
#endif
|
||||
]
|
||||
, bgroup "deep"
|
||||
[ bench "effectful (pure-static)" $ nf countdownEffectfulStaticDeep n
|
||||
, bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPureDeep n
|
||||
, bench "effectful (MVar-static)" $ nf countdownEffectfulMVarDeep n
|
||||
, bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVarDeep n
|
||||
[ bench "effectful (local/static)" $ nf countdownEffectfulLocalDeep n
|
||||
, bench "effectful (local/dynamic)" $ nf countdownEffectfulDynLocalDeep n
|
||||
, bench "effectful (shared/static)" $ nf countdownEffectfulSharedDeep n
|
||||
, bench "effectful (shared/dynamic)" $ nf countdownEffectfulDynSharedDeep n
|
||||
#ifdef VERSION_freer_simple
|
||||
, bench "freer-simple" $ nf countdownFreerSimpleDeep n
|
||||
, bench "freer-simple" $ nf countdownFreerSimpleDeep n
|
||||
#endif
|
||||
#ifdef VERSION_eff
|
||||
, bench "eff" $ nf countdownEffDeep n
|
||||
, bench "eff" $ nf countdownEffDeep n
|
||||
#endif
|
||||
#ifdef VERSION_polysemy
|
||||
, bench "polysemy" $ nf countdownPolysemyDeep n
|
||||
, bench "polysemy" $ nf countdownPolysemyDeep n
|
||||
#endif
|
||||
#ifdef VERSION_mtl
|
||||
, bench "mtl" $ nf countdownMtlDeep n
|
||||
, bench "mtl" $ nf countdownMtlDeep n
|
||||
#endif
|
||||
#ifdef VERSION_fused_effects
|
||||
, bench "fused-effects" $ nf countdownFusedEffectsDeep n
|
||||
, bench "fused-effects" $ nf countdownFusedEffectsDeep n
|
||||
#endif
|
||||
]
|
||||
]
|
||||
|
||||
@ -16,5 +16,6 @@ runDeep
|
||||
] a
|
||||
-> IO a
|
||||
runDeep = runEff
|
||||
. evalState () . evalState () . evalState () . evalState () . evalState ()
|
||||
. evalState () . evalState () . evalState () . evalState () . evalState ()
|
||||
. evalLocalState () . evalLocalState () . evalLocalState () . evalLocalState ()
|
||||
. evalLocalState () . evalLocalState () . evalLocalState () . evalLocalState ()
|
||||
. evalLocalState () . evalLocalState ()
|
||||
|
||||
@ -95,12 +95,12 @@ library
|
||||
Effectful.Monad
|
||||
Effectful.Reader
|
||||
Effectful.Resource
|
||||
Effectful.State
|
||||
Effectful.State.Dynamic
|
||||
Effectful.State.MVar
|
||||
Effectful.Writer
|
||||
Effectful.State.Local
|
||||
Effectful.State.Shared
|
||||
Effectful.Writer.Dynamic
|
||||
Effectful.Writer.MVar
|
||||
Effectful.Writer.Local
|
||||
Effectful.Writer.Shared
|
||||
|
||||
reexported-modules: Effectful.Internal.Utils
|
||||
|
||||
|
||||
@ -1,27 +1,25 @@
|
||||
-- | The 'State' effect with dynamic dispatch.
|
||||
--
|
||||
-- It's not clear in which situation it's beneficial to use this instead of
|
||||
-- "Effectful.State" or "Effectful.State.MVar" as you either:
|
||||
-- "Effectful.State.Local" or "Effectful.State.Shared" as you either:
|
||||
--
|
||||
-- - Share state between threads and need the synchonized version.
|
||||
-- - Share state between threads and need the shared version.
|
||||
--
|
||||
-- - Don't share state between threads (or want it to be thread local) and are
|
||||
-- free to use the faster, pure version.
|
||||
--
|
||||
-- However, let's include this for now.
|
||||
-- free to use the faster, local version.
|
||||
--
|
||||
module Effectful.State.Dynamic
|
||||
( State(..)
|
||||
|
||||
-- * Pure
|
||||
, runState
|
||||
, evalState
|
||||
, execState
|
||||
-- * Local
|
||||
, runLocalState
|
||||
, evalLocalState
|
||||
, execLocalState
|
||||
|
||||
-- * MVar
|
||||
, runStateMVar
|
||||
, evalStateMVar
|
||||
, execStateMVar
|
||||
-- * Shared
|
||||
, runSharedState
|
||||
, evalSharedState
|
||||
, execSharedState
|
||||
|
||||
-- * Operations
|
||||
, get
|
||||
@ -35,13 +33,12 @@ module Effectful.State.Dynamic
|
||||
|
||||
import Effectful.Handler
|
||||
import Effectful.Monad
|
||||
import qualified Effectful.State as SP
|
||||
import qualified Effectful.State.MVar as SM
|
||||
import qualified Effectful.State.Local as L
|
||||
import qualified Effectful.State.Shared as S
|
||||
|
||||
-- | Provide access to a mutable state of type @s@.
|
||||
--
|
||||
-- Whether the state is represented as a pure value or an 'MVar' underneath
|
||||
-- depends on the interpretation.
|
||||
-- Whether the state is local and shareable depends on the interpretation.
|
||||
data State s :: Effect where
|
||||
Get :: State s m s
|
||||
Put :: ~s -> State s m ()
|
||||
@ -49,50 +46,50 @@ data State s :: Effect where
|
||||
StateM :: (s -> m (a, s)) -> State s m a
|
||||
|
||||
----------------------------------------
|
||||
-- Pure
|
||||
-- Local
|
||||
|
||||
runState :: s -> Eff (State s : es) a -> Eff es (a, s)
|
||||
runState s0 = reinterpretM (SP.runState s0) statePure
|
||||
runLocalState :: s -> Eff (State s : es) a -> Eff es (a, s)
|
||||
runLocalState s0 = reinterpretM (L.runState s0) localState
|
||||
|
||||
evalState :: s -> Eff (State s : es) a -> Eff es a
|
||||
evalState s0 = reinterpretM (SP.evalState s0) statePure
|
||||
evalLocalState :: s -> Eff (State s : es) a -> Eff es a
|
||||
evalLocalState s0 = reinterpretM (L.evalState s0) localState
|
||||
|
||||
execState :: s -> Eff (State s : es) a -> Eff es s
|
||||
execState s0 = reinterpretM (SP.execState s0) statePure
|
||||
execLocalState :: s -> Eff (State s : es) a -> Eff es s
|
||||
execLocalState s0 = reinterpretM (L.execState s0) localState
|
||||
|
||||
statePure
|
||||
:: SP.State s :> es
|
||||
localState
|
||||
:: L.State s :> es
|
||||
=> LocalEnv localEs
|
||||
-> State s (Eff localEs) a
|
||||
-> Eff es a
|
||||
statePure env = \case
|
||||
Get -> SP.get
|
||||
Put s -> SP.put s
|
||||
State f -> SP.state f
|
||||
StateM f -> localSeqUnlift env $ \run -> SP.stateM (run . f)
|
||||
localState env = \case
|
||||
Get -> L.get
|
||||
Put s -> L.put s
|
||||
State f -> L.state f
|
||||
StateM f -> localSeqUnlift env $ \run -> L.stateM (run . f)
|
||||
|
||||
----------------------------------------
|
||||
-- MVar
|
||||
-- Shared
|
||||
|
||||
runStateMVar :: s -> Eff (State s : es) a -> Eff es (a, s)
|
||||
runStateMVar s0 = reinterpretM (SM.runState s0) stateMVar
|
||||
runSharedState :: s -> Eff (State s : es) a -> Eff es (a, s)
|
||||
runSharedState s0 = reinterpretM (S.runState s0) sharedState
|
||||
|
||||
evalStateMVar :: s -> Eff (State s : es) a -> Eff es a
|
||||
evalStateMVar s0 = reinterpretM (SM.evalState s0) stateMVar
|
||||
evalSharedState :: s -> Eff (State s : es) a -> Eff es a
|
||||
evalSharedState s0 = reinterpretM (S.evalState s0) sharedState
|
||||
|
||||
execStateMVar :: s -> Eff (State s : es) a -> Eff es s
|
||||
execStateMVar s0 = reinterpretM (SM.execState s0) stateMVar
|
||||
execSharedState :: s -> Eff (State s : es) a -> Eff es s
|
||||
execSharedState s0 = reinterpretM (S.execState s0) sharedState
|
||||
|
||||
stateMVar
|
||||
:: SM.State s :> es
|
||||
sharedState
|
||||
:: S.State s :> es
|
||||
=> LocalEnv localEs
|
||||
-> State s (Eff localEs) a
|
||||
-> Eff es a
|
||||
stateMVar env = \case
|
||||
Get -> SM.get
|
||||
Put s -> SM.put s
|
||||
State f -> SM.state f
|
||||
StateM f -> localSeqUnlift env $ \run -> SM.stateM (run . f)
|
||||
sharedState env = \case
|
||||
Get -> S.get
|
||||
Put s -> S.put s
|
||||
State f -> S.state f
|
||||
StateM f -> localSeqUnlift env $ \run -> S.stateM (run . f)
|
||||
|
||||
----------------------------------------
|
||||
-- Operations
|
||||
|
||||
@ -2,11 +2,12 @@
|
||||
--
|
||||
-- Represented as a pure value underneath, therefore:
|
||||
--
|
||||
-- - thread local (if you need sharing, have a look at "Effectful.State.MVar"),
|
||||
-- - thread local (if you need the state to be shareble, have a look at
|
||||
-- "Effectful.State.Shared"),
|
||||
--
|
||||
-- - very fast.
|
||||
--
|
||||
module Effectful.State
|
||||
module Effectful.State.Local
|
||||
( State
|
||||
, runState
|
||||
, evalState
|
||||
@ -4,9 +4,9 @@
|
||||
--
|
||||
-- - shareable between multiple threads,
|
||||
--
|
||||
-- - slower than "Effectful.State".
|
||||
-- - slower than "Effectful.State.Local".
|
||||
--
|
||||
module Effectful.State.MVar
|
||||
module Effectful.State.Shared
|
||||
( State
|
||||
, runState
|
||||
, evalState
|
||||
@ -23,6 +23,7 @@ module Effectful.State.MVar
|
||||
import Control.Concurrent.MVar
|
||||
|
||||
import Effectful.Internal.Effect
|
||||
import Effectful.Internal.Env
|
||||
import Effectful.Internal.Monad
|
||||
|
||||
-- | Provide access to a strict (WHNF), shareable, mutable state of type @s@.
|
||||
@ -47,30 +48,30 @@ execState s m = do
|
||||
unsafeEff_ $ readMVar v
|
||||
|
||||
get :: State s :> es => Eff es s
|
||||
get = do
|
||||
IdE (State v) <- getEffect
|
||||
unsafeEff_ $ readMVar v
|
||||
get = unsafeEff $ \es -> do
|
||||
IdE (State v) <- getEnv es
|
||||
readMVar v
|
||||
|
||||
gets :: State s :> es => (s -> a) -> Eff es a
|
||||
gets f = f <$> get
|
||||
|
||||
put :: State s :> es => s -> Eff es ()
|
||||
put s = do
|
||||
IdE (State v) <- getEffect
|
||||
unsafeEff_ . modifyMVar_ v $ \_ -> s `seq` pure s
|
||||
put s = unsafeEff $ \es -> do
|
||||
IdE (State v) <- getEnv es
|
||||
modifyMVar_ v $ \_ -> s `seq` pure s
|
||||
|
||||
state :: State s :> es => (s -> (a, s)) -> Eff es a
|
||||
state f = do
|
||||
IdE (State v) <- getEffect
|
||||
unsafeEff_ . modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)
|
||||
state f = unsafeEff $ \es -> do
|
||||
IdE (State v) <- getEnv es
|
||||
modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)
|
||||
|
||||
modify :: State s :> es => (s -> s) -> Eff es ()
|
||||
modify f = state (\s -> ((), f s))
|
||||
|
||||
stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
|
||||
stateM f = do
|
||||
IdE (State v) <- getEffect
|
||||
unsafeEff $ \es -> modifyMVar v $ \s0 -> do
|
||||
stateM f = unsafeEff $ \es -> do
|
||||
IdE (State v) <- getEnv es
|
||||
modifyMVar v $ \s0 -> do
|
||||
(a, s) <- unEff (f s0) es
|
||||
s `seq` pure (s, a)
|
||||
|
||||
@ -1,13 +1,13 @@
|
||||
module Effectful.Writer.Dynamic
|
||||
( Writer(..)
|
||||
|
||||
-- * Pure
|
||||
, runWriter
|
||||
, execWriter
|
||||
-- * Local
|
||||
, runLocalWriter
|
||||
, execLocalWriter
|
||||
|
||||
-- * MVar
|
||||
, runWriterMVar
|
||||
, execWriterMVar
|
||||
-- * Shared
|
||||
, runSharedWriter
|
||||
, execSharedWriter
|
||||
|
||||
-- * Operations
|
||||
, tell
|
||||
@ -17,48 +17,48 @@ module Effectful.Writer.Dynamic
|
||||
|
||||
import Effectful.Handler
|
||||
import Effectful.Monad
|
||||
import qualified Effectful.Writer as WP
|
||||
import qualified Effectful.Writer.MVar as WM
|
||||
import qualified Effectful.Writer.Local as L
|
||||
import qualified Effectful.Writer.Shared as S
|
||||
|
||||
data Writer w :: Effect where
|
||||
Tell :: ~w -> Writer w m ()
|
||||
Listen :: m a -> Writer w m (a, w)
|
||||
|
||||
----------------------------------------
|
||||
-- Pure
|
||||
-- Local
|
||||
|
||||
runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
|
||||
runWriter = reinterpretM WP.runWriter writerPure
|
||||
runLocalWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
|
||||
runLocalWriter = reinterpretM L.runWriter localWriter
|
||||
|
||||
execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
|
||||
execWriter = reinterpretM WP.execWriter writerPure
|
||||
execLocalWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
|
||||
execLocalWriter = reinterpretM L.execWriter localWriter
|
||||
|
||||
writerPure
|
||||
:: (WP.Writer w :> es, Monoid w)
|
||||
localWriter
|
||||
:: (L.Writer w :> es, Monoid w)
|
||||
=> LocalEnv localEs
|
||||
-> Writer w (Eff localEs) a
|
||||
-> Eff es a
|
||||
writerPure env = \case
|
||||
Tell w -> WP.tell w
|
||||
Listen m -> localSeqUnlift env $ \run -> WP.listen (run m)
|
||||
localWriter env = \case
|
||||
Tell w -> L.tell w
|
||||
Listen m -> localSeqUnlift env $ \run -> L.listen (run m)
|
||||
|
||||
----------------------------------------
|
||||
-- MVar
|
||||
-- Shared
|
||||
|
||||
runWriterMVar :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
|
||||
runWriterMVar = reinterpretM WM.runWriter writerMVar
|
||||
runSharedWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
|
||||
runSharedWriter = reinterpretM S.runWriter sharedWriter
|
||||
|
||||
execWriterMVar :: Monoid w => Eff (Writer w : es) a -> Eff es w
|
||||
execWriterMVar = reinterpretM WM.execWriter writerMVar
|
||||
execSharedWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
|
||||
execSharedWriter = reinterpretM S.execWriter sharedWriter
|
||||
|
||||
writerMVar
|
||||
:: (WM.Writer w :> es, Monoid w)
|
||||
sharedWriter
|
||||
:: (S.Writer w :> es, Monoid w)
|
||||
=> LocalEnv localEs
|
||||
-> Writer w (Eff localEs) a
|
||||
-> Eff es a
|
||||
writerMVar env = \case
|
||||
Tell w -> WM.tell w
|
||||
Listen m -> localSeqUnlift env $ \run -> WM.listen (run m)
|
||||
sharedWriter env = \case
|
||||
Tell w -> S.tell w
|
||||
Listen m -> localSeqUnlift env $ \run -> S.listen (run m)
|
||||
|
||||
----------------------------------------
|
||||
-- Operations
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
-- | The 'Writer' effect.
|
||||
module Effectful.Writer
|
||||
module Effectful.Writer.Local
|
||||
( Writer
|
||||
, runWriter
|
||||
, execWriter
|
||||
@ -1,4 +1,4 @@
|
||||
module Effectful.Writer.MVar
|
||||
module Effectful.Writer.Shared
|
||||
( Writer
|
||||
, runWriter
|
||||
, execWriter
|
||||
@ -31,25 +31,27 @@ execWriter m = do
|
||||
unsafeEff_ $ readMVar v
|
||||
|
||||
tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
|
||||
tell w1 = do
|
||||
IdE (Writer v) <- getEffect
|
||||
unsafeEff_ . modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w
|
||||
tell w1 = unsafeEff $ \es -> do
|
||||
IdE (Writer v) <- getEnv es
|
||||
modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w
|
||||
|
||||
listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
|
||||
listen m = unsafeEff $ \es -> uninterruptibleMask $ \restore -> do
|
||||
v1 <- newMVar mempty
|
||||
-- Replace thread local MVar with a fresh one for isolated listening.
|
||||
v0 <- unsafeStateEnv (\(IdE (Writer v)) -> (v, IdE (Writer v1))) es
|
||||
a <- restore (unEff m es) `onException` merge es v0 v1
|
||||
(a, ) <$> merge es v0 v1
|
||||
listen m = unsafeEff $ \es -> do
|
||||
-- The mask is uninterruptible because modifyMVar_ v0 in the merge function
|
||||
-- might block and if an async exception is received while waiting, w1 will be
|
||||
-- lost.
|
||||
uninterruptibleMask $ \restore -> do
|
||||
v1 <- newMVar mempty
|
||||
-- Replace thread local MVar with a fresh one for isolated listening.
|
||||
v0 <- unsafeStateEnv (\(IdE (Writer v)) -> (v, IdE (Writer v1))) es
|
||||
a <- restore (unEff m es) `onException` merge es v0 v1
|
||||
(a, ) <$> merge es v0 v1
|
||||
where
|
||||
-- Merge results accumulated in the local MVar with the mainline. If an
|
||||
-- exception was received while listening, merge results recorded so far.
|
||||
merge es v0 v1 = do
|
||||
unsafePutEnv (IdE (Writer v0)) es
|
||||
w1 <- readMVar v1
|
||||
-- The mask is uninterruptible because modifyMVar_ v0 might block and if
|
||||
-- we get an async exception while waiting, w1 will be lost.
|
||||
modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
|
||||
pure w1
|
||||
|
||||
@ -24,7 +24,7 @@ asyncTests = testGroup "Async"
|
||||
]
|
||||
|
||||
test_localState :: Assertion
|
||||
test_localState = runEff . runAsyncE . evalState x $ do
|
||||
test_localState = runEff . runAsyncE . evalLocalState x $ do
|
||||
replicateConcurrently_ 2 $ do
|
||||
r <- goDownward 0
|
||||
U.assertEqual "expected result" x r
|
||||
@ -42,7 +42,7 @@ test_localState = runEff . runAsyncE . evalState x $ do
|
||||
else goDownward $ acc + 1
|
||||
|
||||
test_sharedState :: Assertion
|
||||
test_sharedState = runEff . runAsyncE . evalStateMVar (S.empty @Int) $ do
|
||||
test_sharedState = runEff . runAsyncE . evalSharedState (S.empty @Int) $ do
|
||||
concurrently_ (addWhen even x) (addWhen odd x)
|
||||
U.assertEqual "expected result" (S.fromList [1..x]) =<< get
|
||||
where
|
||||
@ -58,7 +58,7 @@ test_sharedState = runEff . runAsyncE . evalStateMVar (S.empty @Int) $ do
|
||||
addWhen f $ n - 1
|
||||
|
||||
test_errorHandling :: Assertion
|
||||
test_errorHandling = runEff . runAsyncE . evalStateMVar (0::Int) $ do
|
||||
test_errorHandling = runEff . runAsyncE . evalSharedState (0::Int) $ do
|
||||
r <- runError $ concurrently_
|
||||
(liftIO (threadDelay 10000) >> throwError err)
|
||||
(modify (+x))
|
||||
@ -74,7 +74,7 @@ test_errorHandling = runEff . runAsyncE . evalStateMVar (0::Int) $ do
|
||||
err = "thrown from async"
|
||||
|
||||
test_asyncWithUnmask :: Assertion
|
||||
test_asyncWithUnmask = runEff . runAsyncE . evalState "initial" $ do
|
||||
test_asyncWithUnmask = runEff . runAsyncE . evalLocalState "initial" $ do
|
||||
x <- asyncWithUnmask $ \unmask -> do
|
||||
liftIO $ threadDelay 10000
|
||||
r1 <- get @String -- 2
|
||||
@ -89,7 +89,7 @@ test_asyncWithUnmask = runEff . runAsyncE . evalState "initial" $ do
|
||||
(inner1, inner2, outer)
|
||||
|
||||
test_pooledWorkers :: Assertion
|
||||
test_pooledWorkers = runEff . runAsyncE . evalState (0::Int) $ do
|
||||
test_pooledWorkers = runEff . runAsyncE . evalLocalState (0::Int) $ do
|
||||
x <- pooledForConcurrentlyN threads [1..n] $ \k -> do
|
||||
r <- get @Int
|
||||
modify @Int (+1)
|
||||
|
||||
@ -24,7 +24,7 @@ concurrencyTests = testGroup "Concurrency"
|
||||
]
|
||||
|
||||
test_localState :: Assertion
|
||||
test_localState = runEff . evalState x $ do
|
||||
test_localState = runEff . evalLocalState x $ do
|
||||
withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do
|
||||
replicateConcurrently_ 2 $ do
|
||||
r <- goDownward 0
|
||||
@ -43,7 +43,7 @@ test_localState = runEff . evalState x $ do
|
||||
else goDownward $ acc + 1
|
||||
|
||||
test_sharedState :: Assertion
|
||||
test_sharedState = runEff . evalStateMVar (S.empty @Int) $ do
|
||||
test_sharedState = runEff . evalSharedState (S.empty @Int) $ do
|
||||
withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do
|
||||
concurrently_ (addWhen even x) (addWhen odd x)
|
||||
U.assertEqual "expected result" (S.fromList [1..x]) =<< get
|
||||
@ -60,7 +60,7 @@ test_sharedState = runEff . evalStateMVar (S.empty @Int) $ do
|
||||
addWhen f $ n - 1
|
||||
|
||||
test_errorHandling :: Assertion
|
||||
test_errorHandling = runEff . evalStateMVar (0::Int) $ do
|
||||
test_errorHandling = runEff . evalSharedState (0::Int) $ do
|
||||
withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do
|
||||
r <- runError $ concurrently_
|
||||
(liftIO (threadDelay 10000) >> throwError err)
|
||||
@ -77,7 +77,7 @@ test_errorHandling = runEff . evalStateMVar (0::Int) $ do
|
||||
err = "thrown from async"
|
||||
|
||||
test_unliftMany :: Assertion
|
||||
test_unliftMany = runEff . evalState "initial value" $ do
|
||||
test_unliftMany = runEff . evalLocalState "initial value" $ do
|
||||
withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
|
||||
x <- withRunInIO $ \runInIO -> async $ do
|
||||
v1 <- runInIO $ get @String -- 1
|
||||
@ -95,7 +95,7 @@ test_unliftMany = runEff . evalState "initial value" $ do
|
||||
(v1, v2, v3, v4)
|
||||
|
||||
test_asyncWithUnmask :: Assertion
|
||||
test_asyncWithUnmask = runEff . evalState "initial" $ do
|
||||
test_asyncWithUnmask = runEff . evalLocalState "initial" $ do
|
||||
withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
|
||||
x <- asyncWithUnmask $ \unmask -> do
|
||||
liftIO $ threadDelay 10000
|
||||
@ -111,7 +111,7 @@ test_asyncWithUnmask = runEff . evalState "initial" $ do
|
||||
(inner1, inner2, outer)
|
||||
|
||||
test_pooledWorkers :: Assertion
|
||||
test_pooledWorkers = runEff . evalState (0::Int) $ do
|
||||
test_pooledWorkers = runEff . evalLocalState (0::Int) $ do
|
||||
withUnliftStrategy (ConcUnlift Ephemeral $ Limited n) $ do
|
||||
x <- pooledForConcurrentlyN threads [1..n] $ \k -> do
|
||||
r <- get @Int
|
||||
|
||||
@ -7,7 +7,7 @@ import qualified Control.Exception.Lifted as LE
|
||||
import qualified UnliftIO.Exception as UE
|
||||
|
||||
import Effectful
|
||||
import Effectful.State.Dynamic
|
||||
import Effectful.State.Local
|
||||
import qualified Utils as U
|
||||
|
||||
stateTests :: TestTree
|
||||
|
||||
Loading…
Reference in New Issue
Block a user