git.iko.soy/effectful
on master help sign in
Rename Pure/MVar to Local/Shared
cee28d5Andrzej Rybczak
bench/Countdown.hs+42−40
compare with master
unifiedsplit
@@ -12,9 +12,9 @@ import qualified Control.Effect as L
12-- effectful
12-- effectful
13import qualified Effectful as E
13import qualified Effectful as E
14import qualified Effectful.Reader as E
14import qualified Effectful.Reader as E
15−import qualified Effectful.State as E
15+import qualified Effectful.State.Dynamic as ED
16−import qualified Effectful.State.Dynamic as DE
16+import qualified Effectful.State.Local as EL
17−import qualified Effectful.State.MVar as ME
17+import qualified Effectful.State.Shared as ES
18
18
19-- freer-simple
19-- freer-simple
20#ifdef VERSION_freer_simple
20#ifdef VERSION_freer_simple
@@ -103,85 +103,87 @@ countdownMtlDeep n = runIdentity
103----------------------------------------
103----------------------------------------
104-- effectful (pure)
104-- effectful (pure)
105
105
106−programEffectfulStatic :: E.State Integer E.:> es => E.Eff es Integer
106+programEffectfulLocal :: EL.State Integer E.:> es => E.Eff es Integer
107−programEffectfulStatic = do
107+programEffectfulLocal = do
108− n <- E.get @Integer
108+ n <- EL.get @Integer
109 if n <= 0
109 if n <= 0
110 then pure n
110 then pure n
111 else do
111 else do
112− E.put (n - 1)
112+ EL.put (n - 1)
113− programEffectfulStatic
113+ programEffectfulLocal
114−{-# NOINLINE programEffectfulStatic #-}
114+{-# NOINLINE programEffectfulLocal #-}
115
115
116−countdownEffectfulStatic :: Integer -> (Integer, Integer)
116+countdownEffectfulLocal :: Integer -> (Integer, Integer)
117−countdownEffectfulStatic n = E.runPureEff . E.runState n $ programEffectfulStatic
117+countdownEffectfulLocal n = E.runPureEff . EL.runState n $ programEffectfulLocal
118
118
119−countdownEffectfulStaticDeep :: Integer -> (Integer, Integer)
119+countdownEffectfulLocalDeep :: Integer -> (Integer, Integer)
120−countdownEffectfulStaticDeep n = E.runPureEff
120+countdownEffectfulLocalDeep n = E.runPureEff
121 . runR . runR . runR . runR . runR
121 . runR . runR . runR . runR . runR
122− . E.runState n
122+ . EL.runState n
123 . runR . runR . runR . runR . runR
123 . runR . runR . runR . runR . runR
124− $ programEffectfulStatic
124+ $ programEffectfulLocal
125 where
125 where
126 runR = E.runReader ()
126 runR = E.runReader ()
127
127
128----------------------------------------
128----------------------------------------
129-- effectful (mvar)
129-- effectful (mvar)
130
130
131−programEffectfulMVar :: ME.State Integer E.:> es => E.Eff es Integer
131+programEffectfulShared :: ES.State Integer E.:> es => E.Eff es Integer
132−programEffectfulMVar = do
132+programEffectfulShared = do
133− n <- ME.get @Integer
133+ n <- ES.get @Integer
134 if n <= 0
134 if n <= 0
135 then pure n
135 then pure n
136 else do
136 else do
137− ME.put (n - 1)
137+ ES.put (n - 1)
138− programEffectfulMVar
138+ programEffectfulShared
139−{-# NOINLINE programEffectfulMVar #-}
139+{-# NOINLINE programEffectfulShared #-}
140
140
141−countdownEffectfulMVar :: Integer -> (Integer, Integer)
141+countdownEffectfulShared :: Integer -> (Integer, Integer)
142−countdownEffectfulMVar n = E.runPureEff . ME.runState n $ programEffectfulMVar
142+countdownEffectfulShared n = E.runPureEff . ES.runState n $ programEffectfulShared
143
143
144−countdownEffectfulMVarDeep :: Integer -> (Integer, Integer)
144+countdownEffectfulSharedDeep :: Integer -> (Integer, Integer)
145−countdownEffectfulMVarDeep n = E.runPureEff
145+countdownEffectfulSharedDeep n = E.runPureEff
146 . runR . runR . runR . runR . runR
146 . runR . runR . runR . runR . runR
147− . ME.runState n
147+ . ES.runState n
148 . runR . runR . runR . runR . runR
148 . runR . runR . runR . runR . runR
149− $ programEffectfulMVar
149+ $ programEffectfulShared
150 where
150 where
151 runR = E.runReader ()
151 runR = E.runReader ()
152
152
153----------------------------------------
153----------------------------------------
154-- effectful (dynamic)
154-- effectful (dynamic)
155
155
156−programEffectfulDynamic :: DE.State Integer E.:> es => E.Eff es Integer
156+programEffectfulDynamic :: ED.State Integer E.:> es => E.Eff es Integer
157programEffectfulDynamic = do
157programEffectfulDynamic = do
158− n <- DE.get @Integer
158+ n <- ED.get @Integer
159 if n <= 0
159 if n <= 0
160 then pure n
160 then pure n
161 else do
161 else do
162− DE.put (n - 1)
162+ ED.put (n - 1)
163 programEffectfulDynamic
163 programEffectfulDynamic
164{-# NOINLINE programEffectfulDynamic #-}
164{-# NOINLINE programEffectfulDynamic #-}
165
165
166−countdownEffectfulDynPure :: Integer -> (Integer, Integer)
166+countdownEffectfulDynLocal :: Integer -> (Integer, Integer)
167+countdownEffectfulDynLocal n =
167−countdownEffectfulDynPure n = E.runPureEff . DE.runState n $ programEffectfulDynamic
168+ E.runPureEff . ED.runLocalState n $ programEffectfulDynamic
168
169
169−countdownEffectfulDynMVar :: Integer -> (Integer, Integer)
170+countdownEffectfulDynShared :: Integer -> (Integer, Integer)
171+countdownEffectfulDynShared n =
170−countdownEffectfulDynMVar n = E.runPureEff . DE.runStateMVar n $ programEffectfulDynamic
172+ E.runPureEff . ED.runSharedState n $ programEffectfulDynamic
171
173
172−countdownEffectfulDynPureDeep :: Integer -> (Integer, Integer)
174+countdownEffectfulDynLocalDeep :: Integer -> (Integer, Integer)
173−countdownEffectfulDynPureDeep n = E.runPureEff
175+countdownEffectfulDynLocalDeep n = E.runPureEff
174 . runR . runR . runR . runR . runR
176 . runR . runR . runR . runR . runR
175− . DE.runState n
177+ . ED.runLocalState n
176 . runR . runR . runR . runR . runR
178 . runR . runR . runR . runR . runR
177 $ programEffectfulDynamic
179 $ programEffectfulDynamic
178 where
180 where
179 runR = E.runReader ()
181 runR = E.runReader ()
180
182
181−countdownEffectfulDynMVarDeep :: Integer -> (Integer, Integer)
183+countdownEffectfulDynSharedDeep :: Integer -> (Integer, Integer)
182−countdownEffectfulDynMVarDeep n = E.runPureEff
184+countdownEffectfulDynSharedDeep n = E.runPureEff
183 . runR . runR . runR . runR . runR
185 . runR . runR . runR . runR . runR
184− . DE.runStateMVar n
186+ . ED.runSharedState n
185 . runR . runR . runR . runR . runR
187 . runR . runR . runR . runR . runR
186 $ programEffectfulDynamic
188 $ programEffectfulDynamic
187 where
189 where
bench/FileSizes.hs+1−1
@@ -11,7 +11,7 @@ import System.Posix
11-- effectful
11-- effectful
12import qualified Effectful as E
12import qualified Effectful as E
13import qualified Effectful.Reader as E
13import qualified Effectful.Reader as E
14−import qualified Effectful.State as E
14+import qualified Effectful.State.Local as E
15
15
16-- eff
16-- eff
17#ifdef VERSION_eff
17#ifdef VERSION_eff
bench/Main.hs+20−20
@@ -26,47 +26,47 @@ main = defaultMain
26countdown :: Integer -> Benchmark
26countdown :: Integer -> Benchmark
27countdown n = bgroup (show n)
27countdown n = bgroup (show n)
28 [ bgroup "shallow"
28 [ bgroup "shallow"
29− [ bench "reference (pure)" $ nf countdownRef n
29+ [ bench "reference (pure)" $ nf countdownRef n
30− , bench "reference (ST)" $ nf countdownST n
30+ , bench "reference (ST)" $ nf countdownST n
31− , bench "effectful (pure-static)" $ nf countdownEffectfulStatic n
31+ , bench "effectful (local/static)" $ nf countdownEffectfulLocal n
32− , bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPure n
32+ , bench "effectful (local/dynamic)" $ nf countdownEffectfulDynLocal n
33− , bench "effectful (MVar-static)" $ nf countdownEffectfulMVar n
33+ , bench "effectful (shared/static)" $ nf countdownEffectfulShared n
34− , bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVar n
34+ , bench "effectful (shared/dynamic)" $ nf countdownEffectfulDynShared n
35#ifdef VERSION_freer_simple
35#ifdef VERSION_freer_simple
36− , bench "freer-simple" $ nf countdownFreerSimple n
36+ , bench "freer-simple" $ nf countdownFreerSimple n
37#endif
37#endif
38#ifdef VERSION_eff
38#ifdef VERSION_eff
39− , bench "eff" $ nf countdownEff n
39+ , bench "eff" $ nf countdownEff n
40#endif
40#endif
41#ifdef VERSION_mtl
41#ifdef VERSION_mtl
42− , bench "mtl" $ nf countdownMtl n
42+ , bench "mtl" $ nf countdownMtl n
43#endif
43#endif
44#ifdef VERSION_fused_effects
44#ifdef VERSION_fused_effects
45− , bench "fused-effects" $ nf countdownFusedEffects n
45+ , bench "fused-effects" $ nf countdownFusedEffects n
46#endif
46#endif
47#ifdef VERSION_polysemy
47#ifdef VERSION_polysemy
48− , bench "polysemy" $ nf countdownPolysemy n
48+ , bench "polysemy" $ nf countdownPolysemy n
49#endif
49#endif
50 ]
50 ]
51 , bgroup "deep"
51 , bgroup "deep"
52− [ bench "effectful (pure-static)" $ nf countdownEffectfulStaticDeep n
52+ [ bench "effectful (local/static)" $ nf countdownEffectfulLocalDeep n
53− , bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPureDeep n
53+ , bench "effectful (local/dynamic)" $ nf countdownEffectfulDynLocalDeep n
54− , bench "effectful (MVar-static)" $ nf countdownEffectfulMVarDeep n
54+ , bench "effectful (shared/static)" $ nf countdownEffectfulSharedDeep n
55− , bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVarDeep n
55+ , bench "effectful (shared/dynamic)" $ nf countdownEffectfulDynSharedDeep n
56#ifdef VERSION_freer_simple
56#ifdef VERSION_freer_simple
57− , bench "freer-simple" $ nf countdownFreerSimpleDeep n
57+ , bench "freer-simple" $ nf countdownFreerSimpleDeep n
58#endif
58#endif
59#ifdef VERSION_eff
59#ifdef VERSION_eff
60− , bench "eff" $ nf countdownEffDeep n
60+ , bench "eff" $ nf countdownEffDeep n
61#endif
61#endif
62#ifdef VERSION_polysemy
62#ifdef VERSION_polysemy
63− , bench "polysemy" $ nf countdownPolysemyDeep n
63+ , bench "polysemy" $ nf countdownPolysemyDeep n
64#endif
64#endif
65#ifdef VERSION_mtl
65#ifdef VERSION_mtl
66− , bench "mtl" $ nf countdownMtlDeep n
66+ , bench "mtl" $ nf countdownMtlDeep n
67#endif
67#endif
68#ifdef VERSION_fused_effects
68#ifdef VERSION_fused_effects
69− , bench "fused-effects" $ nf countdownFusedEffectsDeep n
69+ , bench "fused-effects" $ nf countdownFusedEffectsDeep n
70#endif
70#endif
71 ]
71 ]
72 ]
72 ]
bench/Utils.hs+3−2
@@ -16,5 +16,6 @@ runDeep
16 ] a
16 ] a
17 -> IO a
17 -> IO a
18runDeep = runEff
18runDeep = runEff
19− . evalState () . evalState () . evalState () . evalState () . evalState ()
19+ . evalLocalState () . evalLocalState () . evalLocalState () . evalLocalState ()
20− . evalState () . evalState () . evalState () . evalState () . evalState ()
20+ . evalLocalState () . evalLocalState () . evalLocalState () . evalLocalState ()
21+ . evalLocalState () . evalLocalState ()
effectful.cabal+4−4
@@ -95,12 +95,12 @@ library
95 Effectful.Monad
95 Effectful.Monad
96 Effectful.Reader
96 Effectful.Reader
97 Effectful.Resource
97 Effectful.Resource
98− Effectful.State
99 Effectful.State.Dynamic
98 Effectful.State.Dynamic
100− Effectful.State.MVar
99+ Effectful.State.Local
101− Effectful.Writer
100+ Effectful.State.Shared
102 Effectful.Writer.Dynamic
101 Effectful.Writer.Dynamic
103− Effectful.Writer.MVar
102+ Effectful.Writer.Local
103+ Effectful.Writer.Shared
104
104
105 reexported-modules: Effectful.Internal.Utils
105 reexported-modules: Effectful.Internal.Utils
106
106
src/Effectful/State/Dynamic.hs+42−45
@@ -1,27 +1,25 @@
1-- | The 'State' effect with dynamic dispatch.
1-- | The 'State' effect with dynamic dispatch.
2--
2--
3-- It's not clear in which situation it's beneficial to use this instead of
3-- It's not clear in which situation it's beneficial to use this instead of
4−-- "Effectful.State" or "Effectful.State.MVar" as you either:
4+-- "Effectful.State.Local" or "Effectful.State.Shared" as you either:
5--
5--
6−-- - Share state between threads and need the synchonized version.
6+-- - Share state between threads and need the shared version.
7--
7--
8-- - Don't share state between threads (or want it to be thread local) and are
8-- - Don't share state between threads (or want it to be thread local) and are
9−-- free to use the faster, pure version.
9+-- free to use the faster, local version.
10−--
11−-- However, let's include this for now.
12--
10--
13module Effectful.State.Dynamic
11module Effectful.State.Dynamic
14 ( State(..)
12 ( State(..)
15
13
16− -- * Pure
14+ -- * Local
17− , runState
15+ , runLocalState
18− , evalState
16+ , evalLocalState
19− , execState
17+ , execLocalState
20
18
21− -- * MVar
19+ -- * Shared
22− , runStateMVar
20+ , runSharedState
23− , evalStateMVar
21+ , evalSharedState
24− , execStateMVar
22+ , execSharedState
25
23
26 -- * Operations
24 -- * Operations
27 , get
25 , get
@@ -35,13 +33,12 @@ module Effectful.State.Dynamic
35
33
36import Effectful.Handler
34import Effectful.Handler
37import Effectful.Monad
35import Effectful.Monad
38−import qualified Effectful.State as SP
36+import qualified Effectful.State.Local as L
39−import qualified Effectful.State.MVar as SM
37+import qualified Effectful.State.Shared as S
40
38
41-- | Provide access to a mutable state of type @s@.
39-- | Provide access to a mutable state of type @s@.
42--
40--
43−-- Whether the state is represented as a pure value or an 'MVar' underneath
44−-- depends on the interpretation.
41+-- Whether the state is local and shareable depends on the interpretation.
45data State s :: Effect where
42data State s :: Effect where
46 Get :: State s m s
43 Get :: State s m s
47 Put :: ~s -> State s m ()
44 Put :: ~s -> State s m ()
@@ -49,50 +46,50 @@ data State s :: Effect where
49 StateM :: (s -> m (a, s)) -> State s m a
46 StateM :: (s -> m (a, s)) -> State s m a
50
47
51----------------------------------------
48----------------------------------------
52−-- Pure
49+-- Local
53
50
54−runState :: s -> Eff (State s : es) a -> Eff es (a, s)
51+runLocalState :: s -> Eff (State s : es) a -> Eff es (a, s)
55−runState s0 = reinterpretM (SP.runState s0) statePure
52+runLocalState s0 = reinterpretM (L.runState s0) localState
56
53
57−evalState :: s -> Eff (State s : es) a -> Eff es a
54+evalLocalState :: s -> Eff (State s : es) a -> Eff es a
58−evalState s0 = reinterpretM (SP.evalState s0) statePure
55+evalLocalState s0 = reinterpretM (L.evalState s0) localState
59
56
60−execState :: s -> Eff (State s : es) a -> Eff es s
57+execLocalState :: s -> Eff (State s : es) a -> Eff es s
61−execState s0 = reinterpretM (SP.execState s0) statePure
58+execLocalState s0 = reinterpretM (L.execState s0) localState
62
59
63−statePure
60+localState
64− :: SP.State s :> es
61+ :: L.State s :> es
65 => LocalEnv localEs
62 => LocalEnv localEs
66 -> State s (Eff localEs) a
63 -> State s (Eff localEs) a
67 -> Eff es a
64 -> Eff es a
68−statePure env = \case
65+localState env = \case
69− Get -> SP.get
66+ Get -> L.get
70− Put s -> SP.put s
67+ Put s -> L.put s
71− State f -> SP.state f
68+ State f -> L.state f
72− StateM f -> localSeqUnlift env $ \run -> SP.stateM (run . f)
69+ StateM f -> localSeqUnlift env $ \run -> L.stateM (run . f)
73
70
74----------------------------------------
71----------------------------------------
75−-- MVar
72+-- Shared
76
73
77−runStateMVar :: s -> Eff (State s : es) a -> Eff es (a, s)
74+runSharedState :: s -> Eff (State s : es) a -> Eff es (a, s)
78−runStateMVar s0 = reinterpretM (SM.runState s0) stateMVar
75+runSharedState s0 = reinterpretM (S.runState s0) sharedState
79
76
80−evalStateMVar :: s -> Eff (State s : es) a -> Eff es a
77+evalSharedState :: s -> Eff (State s : es) a -> Eff es a
81−evalStateMVar s0 = reinterpretM (SM.evalState s0) stateMVar
78+evalSharedState s0 = reinterpretM (S.evalState s0) sharedState
82
79
83−execStateMVar :: s -> Eff (State s : es) a -> Eff es s
80+execSharedState :: s -> Eff (State s : es) a -> Eff es s
84−execStateMVar s0 = reinterpretM (SM.execState s0) stateMVar
81+execSharedState s0 = reinterpretM (S.execState s0) sharedState
85
82
86−stateMVar
83+sharedState
87− :: SM.State s :> es
84+ :: S.State s :> es
88 => LocalEnv localEs
85 => LocalEnv localEs
89 -> State s (Eff localEs) a
86 -> State s (Eff localEs) a
90 -> Eff es a
87 -> Eff es a
91−stateMVar env = \case
88+sharedState env = \case
92− Get -> SM.get
89+ Get -> S.get
93− Put s -> SM.put s
90+ Put s -> S.put s
94− State f -> SM.state f
91+ State f -> S.state f
95− StateM f -> localSeqUnlift env $ \run -> SM.stateM (run . f)
92+ StateM f -> localSeqUnlift env $ \run -> S.stateM (run . f)
96
93
97----------------------------------------
94----------------------------------------
98-- Operations
95-- Operations
src/Effectful/State.hs → src/Effectful/State/Local.hsrenamed+3−2
@@ -2,11 +2,12 @@
2--
2--
3-- Represented as a pure value underneath, therefore:
3-- Represented as a pure value underneath, therefore:
4--
4--
5−-- - thread local (if you need sharing, have a look at "Effectful.State.MVar"),
5+-- - thread local (if you need the state to be shareble, have a look at
6+-- "Effectful.State.Shared"),
6--
7--
7-- - very fast.
8-- - very fast.
8--
9--
9−module Effectful.State
10+module Effectful.State.Local
10 ( State
11 ( State
11 , runState
12 , runState
12 , evalState
13 , evalState
src/Effectful/State/MVar.hs → src/Effectful/State/Shared.hsrenamed+15−14
@@ -4,9 +4,9 @@
4--
4--
5-- - shareable between multiple threads,
5-- - shareable between multiple threads,
6--
6--
7−-- - slower than "Effectful.State".
7+-- - slower than "Effectful.State.Local".
8--
8--
9−module Effectful.State.MVar
9+module Effectful.State.Shared
10 ( State
10 ( State
11 , runState
11 , runState
12 , evalState
12 , evalState
@@ -23,6 +23,7 @@ module Effectful.State.MVar
23import Control.Concurrent.MVar
23import Control.Concurrent.MVar
24
24
25import Effectful.Internal.Effect
25import Effectful.Internal.Effect
26+import Effectful.Internal.Env
26import Effectful.Internal.Monad
27import Effectful.Internal.Monad
27
28
28-- | Provide access to a strict (WHNF), shareable, mutable state of type @s@.
29-- | Provide access to a strict (WHNF), shareable, mutable state of type @s@.
@@ -47,30 +48,30 @@ execState s m = do
47 unsafeEff_ $ readMVar v
48 unsafeEff_ $ readMVar v
48
49
49get :: State s :> es => Eff es s
50get :: State s :> es => Eff es s
50−get = do
51+get = unsafeEff $ \es -> do
51− IdE (State v) <- getEffect
52+ IdE (State v) <- getEnv es
52− unsafeEff_ $ readMVar v
53+ readMVar v
53
54
54gets :: State s :> es => (s -> a) -> Eff es a
55gets :: State s :> es => (s -> a) -> Eff es a
55gets f = f <$> get
56gets f = f <$> get
56
57
57put :: State s :> es => s -> Eff es ()
58put :: State s :> es => s -> Eff es ()
58−put s = do
59+put s = unsafeEff $ \es -> do
59− IdE (State v) <- getEffect
60+ IdE (State v) <- getEnv es
60− unsafeEff_ . modifyMVar_ v $ \_ -> s `seq` pure s
61+ modifyMVar_ v $ \_ -> s `seq` pure s
61
62
62state :: State s :> es => (s -> (a, s)) -> Eff es a
63state :: State s :> es => (s -> (a, s)) -> Eff es a
63−state f = do
64+state f = unsafeEff $ \es -> do
64− IdE (State v) <- getEffect
65+ IdE (State v) <- getEnv es
65− unsafeEff_ . modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)
66+ modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)
66
67
67modify :: State s :> es => (s -> s) -> Eff es ()
68modify :: State s :> es => (s -> s) -> Eff es ()
68modify f = state (\s -> ((), f s))
69modify f = state (\s -> ((), f s))
69
70
70stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
71stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
71−stateM f = do
72+stateM f = unsafeEff $ \es -> do
72− IdE (State v) <- getEffect
73+ IdE (State v) <- getEnv es
73− unsafeEff $ \es -> modifyMVar v $ \s0 -> do
74+ modifyMVar v $ \s0 -> do
74 (a, s) <- unEff (f s0) es
75 (a, s) <- unEff (f s0) es
75 s `seq` pure (s, a)
76 s `seq` pure (s, a)
76
77
src/Effectful/Writer/Dynamic.hs+28−28
@@ -1,13 +1,13 @@
1module Effectful.Writer.Dynamic
1module Effectful.Writer.Dynamic
2 ( Writer(..)
2 ( Writer(..)
3
3
4− -- * Pure
4+ -- * Local
5− , runWriter
5+ , runLocalWriter
6− , execWriter
6+ , execLocalWriter
7
7
8− -- * MVar
8+ -- * Shared
9− , runWriterMVar
9+ , runSharedWriter
10− , execWriterMVar
10+ , execSharedWriter
11
11
12 -- * Operations
12 -- * Operations
13 , tell
13 , tell
@@ -17,48 +17,48 @@ module Effectful.Writer.Dynamic
17
17
18import Effectful.Handler
18import Effectful.Handler
19import Effectful.Monad
19import Effectful.Monad
20−import qualified Effectful.Writer as WP
20+import qualified Effectful.Writer.Local as L
21−import qualified Effectful.Writer.MVar as WM
21+import qualified Effectful.Writer.Shared as S
22
22
23data Writer w :: Effect where
23data Writer w :: Effect where
24 Tell :: ~w -> Writer w m ()
24 Tell :: ~w -> Writer w m ()
25 Listen :: m a -> Writer w m (a, w)
25 Listen :: m a -> Writer w m (a, w)
26
26
27----------------------------------------
27----------------------------------------
28−-- Pure
28+-- Local
29
29
30−runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
30+runLocalWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
31−runWriter = reinterpretM WP.runWriter writerPure
31+runLocalWriter = reinterpretM L.runWriter localWriter
32
32
33−execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
33+execLocalWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
34−execWriter = reinterpretM WP.execWriter writerPure
34+execLocalWriter = reinterpretM L.execWriter localWriter
35
35
36−writerPure
36+localWriter
37− :: (WP.Writer w :> es, Monoid w)
37+ :: (L.Writer w :> es, Monoid w)
38 => LocalEnv localEs
38 => LocalEnv localEs
39 -> Writer w (Eff localEs) a
39 -> Writer w (Eff localEs) a
40 -> Eff es a
40 -> Eff es a
41−writerPure env = \case
41+localWriter env = \case
42− Tell w -> WP.tell w
42+ Tell w -> L.tell w
43− Listen m -> localSeqUnlift env $ \run -> WP.listen (run m)
43+ Listen m -> localSeqUnlift env $ \run -> L.listen (run m)
44
44
45----------------------------------------
45----------------------------------------
46−-- MVar
46+-- Shared
47
47
48−runWriterMVar :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
48+runSharedWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
49−runWriterMVar = reinterpretM WM.runWriter writerMVar
49+runSharedWriter = reinterpretM S.runWriter sharedWriter
50
50
51−execWriterMVar :: Monoid w => Eff (Writer w : es) a -> Eff es w
51+execSharedWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
52−execWriterMVar = reinterpretM WM.execWriter writerMVar
52+execSharedWriter = reinterpretM S.execWriter sharedWriter
53
53
54−writerMVar
54+sharedWriter
55− :: (WM.Writer w :> es, Monoid w)
55+ :: (S.Writer w :> es, Monoid w)
56 => LocalEnv localEs
56 => LocalEnv localEs
57 -> Writer w (Eff localEs) a
57 -> Writer w (Eff localEs) a
58 -> Eff es a
58 -> Eff es a
59−writerMVar env = \case
59+sharedWriter env = \case
60− Tell w -> WM.tell w
60+ Tell w -> S.tell w
61− Listen m -> localSeqUnlift env $ \run -> WM.listen (run m)
61+ Listen m -> localSeqUnlift env $ \run -> S.listen (run m)
62
62
63----------------------------------------
63----------------------------------------
64-- Operations
64-- Operations
src/Effectful/Writer.hs → src/Effectful/Writer/Local.hsrenamed+1−1
@@ -1,5 +1,5 @@
1-- | The 'Writer' effect.
1-- | The 'Writer' effect.
2−module Effectful.Writer
2+module Effectful.Writer.Local
3 ( Writer
3 ( Writer
4 , runWriter
4 , runWriter
5 , execWriter
5 , execWriter
src/Effectful/Writer/MVar.hs → src/Effectful/Writer/Shared.hsrenamed+14−12
@@ -1,4 +1,4 @@
1−module Effectful.Writer.MVar
1+module Effectful.Writer.Shared
2 ( Writer
2 ( Writer
3 , runWriter
3 , runWriter
4 , execWriter
4 , execWriter
@@ -31,25 +31,27 @@ execWriter m = do
31 unsafeEff_ $ readMVar v
31 unsafeEff_ $ readMVar v
32
32
33tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
33tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
34−tell w1 = do
34+tell w1 = unsafeEff $ \es -> do
35− IdE (Writer v) <- getEffect
35+ IdE (Writer v) <- getEnv es
36− unsafeEff_ . modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w
36+ modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w
37
37
38listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
38listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
39+listen m = unsafeEff $ \es -> do
40+ -- The mask is uninterruptible because modifyMVar_ v0 in the merge function
41+ -- might block and if an async exception is received while waiting, w1 will be
42+ -- lost.
39−listen m = unsafeEff $ \es -> uninterruptibleMask $ \restore -> do
43+ uninterruptibleMask $ \restore -> do
40− v1 <- newMVar mempty
44+ v1 <- newMVar mempty
41− -- Replace thread local MVar with a fresh one for isolated listening.
45+ -- Replace thread local MVar with a fresh one for isolated listening.
42− v0 <- unsafeStateEnv (\(IdE (Writer v)) -> (v, IdE (Writer v1))) es
46+ v0 <- unsafeStateEnv (\(IdE (Writer v)) -> (v, IdE (Writer v1))) es
43− a <- restore (unEff m es) `onException` merge es v0 v1
47+ a <- restore (unEff m es) `onException` merge es v0 v1
44− (a, ) <$> merge es v0 v1
48+ (a, ) <$> merge es v0 v1
45 where
49 where
46 -- Merge results accumulated in the local MVar with the mainline. If an
50 -- Merge results accumulated in the local MVar with the mainline. If an
47 -- exception was received while listening, merge results recorded so far.
51 -- exception was received while listening, merge results recorded so far.
48 merge es v0 v1 = do
52 merge es v0 v1 = do
49 unsafePutEnv (IdE (Writer v0)) es
53 unsafePutEnv (IdE (Writer v0)) es
50 w1 <- readMVar v1
54 w1 <- readMVar v1
51− -- The mask is uninterruptible because modifyMVar_ v0 might block and if
52− -- we get an async exception while waiting, w1 will be lost.
53 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
55 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
54 pure w1
56 pure w1
55
57
tests/AsyncTests.hs+5−5
@@ -24,7 +24,7 @@ asyncTests = testGroup "Async"
24 ]
24 ]
25
25
26test_localState :: Assertion
26test_localState :: Assertion
27−test_localState = runEff . runAsyncE . evalState x $ do
27+test_localState = runEff . runAsyncE . evalLocalState x $ do
28 replicateConcurrently_ 2 $ do
28 replicateConcurrently_ 2 $ do
29 r <- goDownward 0
29 r <- goDownward 0
30 U.assertEqual "expected result" x r
30 U.assertEqual "expected result" x r
@@ -42,7 +42,7 @@ test_localState = runEff . runAsyncE . evalState x $ do
42 else goDownward $ acc + 1
42 else goDownward $ acc + 1
43
43
44test_sharedState :: Assertion
44test_sharedState :: Assertion
45−test_sharedState = runEff . runAsyncE . evalStateMVar (S.empty @Int) $ do
45+test_sharedState = runEff . runAsyncE . evalSharedState (S.empty @Int) $ do
46 concurrently_ (addWhen even x) (addWhen odd x)
46 concurrently_ (addWhen even x) (addWhen odd x)
47 U.assertEqual "expected result" (S.fromList [1..x]) =<< get
47 U.assertEqual "expected result" (S.fromList [1..x]) =<< get
48 where
48 where
@@ -58,7 +58,7 @@ test_sharedState = runEff . runAsyncE . evalStateMVar (S.empty @Int) $ do
58 addWhen f $ n - 1
58 addWhen f $ n - 1
59
59
60test_errorHandling :: Assertion
60test_errorHandling :: Assertion
61−test_errorHandling = runEff . runAsyncE . evalStateMVar (0::Int) $ do
61+test_errorHandling = runEff . runAsyncE . evalSharedState (0::Int) $ do
62 r <- runError $ concurrently_
62 r <- runError $ concurrently_
63 (liftIO (threadDelay 10000) >> throwError err)
63 (liftIO (threadDelay 10000) >> throwError err)
64 (modify (+x))
64 (modify (+x))
@@ -74,7 +74,7 @@ test_errorHandling = runEff . runAsyncE . evalStateMVar (0::Int) $ do
74 err = "thrown from async"
74 err = "thrown from async"
75
75
76test_asyncWithUnmask :: Assertion
76test_asyncWithUnmask :: Assertion
77−test_asyncWithUnmask = runEff . runAsyncE . evalState "initial" $ do
77+test_asyncWithUnmask = runEff . runAsyncE . evalLocalState "initial" $ do
78 x <- asyncWithUnmask $ \unmask -> do
78 x <- asyncWithUnmask $ \unmask -> do
79 liftIO $ threadDelay 10000
79 liftIO $ threadDelay 10000
80 r1 <- get @String -- 2
80 r1 <- get @String -- 2
@@ -89,7 +89,7 @@ test_asyncWithUnmask = runEff . runAsyncE . evalState "initial" $ do
89 (inner1, inner2, outer)
89 (inner1, inner2, outer)
90
90
91test_pooledWorkers :: Assertion
91test_pooledWorkers :: Assertion
92−test_pooledWorkers = runEff . runAsyncE . evalState (0::Int) $ do
92+test_pooledWorkers = runEff . runAsyncE . evalLocalState (0::Int) $ do
93 x <- pooledForConcurrentlyN threads [1..n] $ \k -> do
93 x <- pooledForConcurrentlyN threads [1..n] $ \k -> do
94 r <- get @Int
94 r <- get @Int
95 modify @Int (+1)
95 modify @Int (+1)
tests/ConcurrencyTests.hs+6−6
@@ -24,7 +24,7 @@ concurrencyTests = testGroup "Concurrency"
24 ]
24 ]
25
25
26test_localState :: Assertion
26test_localState :: Assertion
27−test_localState = runEff . evalState x $ do
27+test_localState = runEff . evalLocalState x $ do
28 withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do
28 withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do
29 replicateConcurrently_ 2 $ do
29 replicateConcurrently_ 2 $ do
30 r <- goDownward 0
30 r <- goDownward 0
@@ -43,7 +43,7 @@ test_localState = runEff . evalState x $ do
43 else goDownward $ acc + 1
43 else goDownward $ acc + 1
44
44
45test_sharedState :: Assertion
45test_sharedState :: Assertion
46−test_sharedState = runEff . evalStateMVar (S.empty @Int) $ do
46+test_sharedState = runEff . evalSharedState (S.empty @Int) $ do
47 withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do
47 withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do
48 concurrently_ (addWhen even x) (addWhen odd x)
48 concurrently_ (addWhen even x) (addWhen odd x)
49 U.assertEqual "expected result" (S.fromList [1..x]) =<< get
49 U.assertEqual "expected result" (S.fromList [1..x]) =<< get
@@ -60,7 +60,7 @@ test_sharedState = runEff . evalStateMVar (S.empty @Int) $ do
60 addWhen f $ n - 1
60 addWhen f $ n - 1
61
61
62test_errorHandling :: Assertion
62test_errorHandling :: Assertion
63−test_errorHandling = runEff . evalStateMVar (0::Int) $ do
63+test_errorHandling = runEff . evalSharedState (0::Int) $ do
64 withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do
64 withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do
65 r <- runError $ concurrently_
65 r <- runError $ concurrently_
66 (liftIO (threadDelay 10000) >> throwError err)
66 (liftIO (threadDelay 10000) >> throwError err)
@@ -77,7 +77,7 @@ test_errorHandling = runEff . evalStateMVar (0::Int) $ do
77 err = "thrown from async"
77 err = "thrown from async"
78
78
79test_unliftMany :: Assertion
79test_unliftMany :: Assertion
80−test_unliftMany = runEff . evalState "initial value" $ do
80+test_unliftMany = runEff . evalLocalState "initial value" $ do
81 withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
81 withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
82 x <- withRunInIO $ \runInIO -> async $ do
82 x <- withRunInIO $ \runInIO -> async $ do
83 v1 <- runInIO $ get @String -- 1
83 v1 <- runInIO $ get @String -- 1
@@ -95,7 +95,7 @@ test_unliftMany = runEff . evalState "initial value" $ do
95 (v1, v2, v3, v4)
95 (v1, v2, v3, v4)
96
96
97test_asyncWithUnmask :: Assertion
97test_asyncWithUnmask :: Assertion
98−test_asyncWithUnmask = runEff . evalState "initial" $ do
98+test_asyncWithUnmask = runEff . evalLocalState "initial" $ do
99 withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
99 withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
100 x <- asyncWithUnmask $ \unmask -> do
100 x <- asyncWithUnmask $ \unmask -> do
101 liftIO $ threadDelay 10000
101 liftIO $ threadDelay 10000
@@ -111,7 +111,7 @@ test_asyncWithUnmask = runEff . evalState "initial" $ do
111 (inner1, inner2, outer)
111 (inner1, inner2, outer)
112
112
113test_pooledWorkers :: Assertion
113test_pooledWorkers :: Assertion
114−test_pooledWorkers = runEff . evalState (0::Int) $ do
114+test_pooledWorkers = runEff . evalLocalState (0::Int) $ do
115 withUnliftStrategy (ConcUnlift Ephemeral $ Limited n) $ do
115 withUnliftStrategy (ConcUnlift Ephemeral $ Limited n) $ do
116 x <- pooledForConcurrentlyN threads [1..n] $ \k -> do
116 x <- pooledForConcurrentlyN threads [1..n] $ \k -> do
117 r <- get @Int
117 r <- get @Int
tests/StateTests.hs+1−1
@@ -7,7 +7,7 @@ import qualified Control.Exception.Lifted as LE
7import qualified UnliftIO.Exception as UE
7import qualified UnliftIO.Exception as UE
8
8
9import Effectful
9import Effectful
10−import Effectful.State.Dynamic
10+import Effectful.State.Local
11import qualified Utils as U
11import qualified Utils as U
12
12
13stateTests :: TestTree
13stateTests :: TestTree