cee28d5 · effectful · git.iko.soy

git.iko.soy/effectful

Rename Pure/MVar to Local/Shared

commitcee28d5c510b65c226c198994a3514a2abba288b authorAndrzej Rybczak <andrzej@rybczak.net> dateMon 12 Jul 2021, 20:10 (5 years ago) parent48138ff

14 files changed+185−181

compare with master

unifiedsplit

bench/Countdown.hs+42−40 bench/FileSizes.hs+1−1 bench/Main.hs+20−20 bench/Utils.hs+3−2 effectful.cabal+4−4 src/Effectful/State/Dynamic.hs+42−45 src/Effectful/State.hs → src/Effectful/State/Local.hs+3−2 src/Effectful/State/MVar.hs → src/Effectful/State/Shared.hs+15−14 src/Effectful/Writer/Dynamic.hs+28−28 src/Effectful/Writer.hs → src/Effectful/Writer/Local.hs+1−1 src/Effectful/Writer/MVar.hs → src/Effectful/Writer/Shared.hs+14−12 tests/AsyncTests.hs+5−5 tests/ConcurrencyTests.hs+6−6 tests/StateTests.hs+1−1

bench/Countdown.hs+42−40

@@ -12,9 +12,9 @@ import qualified Control.Effect as L

1212-- effectful

1313import qualified Effectful as E

1414import qualified Effectful.Reader as E

15−import qualified Effectful.State as E

16−import qualified Effectful.State.Dynamic as DE

17−import qualified Effectful.State.MVar as ME

15+import qualified Effectful.State.Dynamic as ED

16+import qualified Effectful.State.Local as EL

17+import qualified Effectful.State.Shared as ES

1818

1919-- freer-simple

2020#ifdef VERSION_freer_simple

@@ -103,85 +103,87 @@ countdownMtlDeep n = runIdentity

103103----------------------------------------

104104-- effectful (pure)

105105

106−programEffectfulStatic :: E.State Integer E.:> es => E.Eff es Integer

107−programEffectfulStatic = do

108− n <- E.get @Integer

106+programEffectfulLocal :: EL.State Integer E.:> es => E.Eff es Integer

107+programEffectfulLocal = do

108+ n <- EL.get @Integer

109109 if n <= 0

110110 then pure n

111111 else do

112− E.put (n - 1)

113− programEffectfulStatic

114−{-# NOINLINE programEffectfulStatic #-}

112+ EL.put (n - 1)

113+ programEffectfulLocal

114+{-# NOINLINE programEffectfulLocal #-}

115115

116−countdownEffectfulStatic :: Integer -> (Integer, Integer)

117−countdownEffectfulStatic n = E.runPureEff . E.runState n $ programEffectfulStatic

116+countdownEffectfulLocal :: Integer -> (Integer, Integer)

117+countdownEffectfulLocal n = E.runPureEff . EL.runState n $ programEffectfulLocal

118118

119−countdownEffectfulStaticDeep :: Integer -> (Integer, Integer)

120−countdownEffectfulStaticDeep n = E.runPureEff

119+countdownEffectfulLocalDeep :: Integer -> (Integer, Integer)

120+countdownEffectfulLocalDeep n = E.runPureEff

121121 . runR . runR . runR . runR . runR

122− . E.runState n

122+ . EL.runState n

123123 . runR . runR . runR . runR . runR

124− $ programEffectfulStatic

124+ $ programEffectfulLocal

125125 where

126126 runR = E.runReader ()

127127

128128----------------------------------------

129129-- effectful (mvar)

130130

131−programEffectfulMVar :: ME.State Integer E.:> es => E.Eff es Integer

132−programEffectfulMVar = do

133− n <- ME.get @Integer

131+programEffectfulShared :: ES.State Integer E.:> es => E.Eff es Integer

132+programEffectfulShared = do

133+ n <- ES.get @Integer

134134 if n <= 0

135135 then pure n

136136 else do

137− ME.put (n - 1)

138− programEffectfulMVar

139−{-# NOINLINE programEffectfulMVar #-}

137+ ES.put (n - 1)

138+ programEffectfulShared

139+{-# NOINLINE programEffectfulShared #-}

140140

141−countdownEffectfulMVar :: Integer -> (Integer, Integer)

142−countdownEffectfulMVar n = E.runPureEff . ME.runState n $ programEffectfulMVar

141+countdownEffectfulShared :: Integer -> (Integer, Integer)

142+countdownEffectfulShared n = E.runPureEff . ES.runState n $ programEffectfulShared

143143

144−countdownEffectfulMVarDeep :: Integer -> (Integer, Integer)

145−countdownEffectfulMVarDeep n = E.runPureEff

144+countdownEffectfulSharedDeep :: Integer -> (Integer, Integer)

145+countdownEffectfulSharedDeep n = E.runPureEff

146146 . runR . runR . runR . runR . runR

147− . ME.runState n

147+ . ES.runState n

148148 . runR . runR . runR . runR . runR

149− $ programEffectfulMVar

149+ $ programEffectfulShared

150150 where

151151 runR = E.runReader ()

152152

153153----------------------------------------

154154-- effectful (dynamic)

155155

156−programEffectfulDynamic :: DE.State Integer E.:> es => E.Eff es Integer

156+programEffectfulDynamic :: ED.State Integer E.:> es => E.Eff es Integer

157157programEffectfulDynamic = do

158− n <- DE.get @Integer

158+ n <- ED.get @Integer

159159 if n <= 0

160160 then pure n

161161 else do

162− DE.put (n - 1)

162+ ED.put (n - 1)

163163 programEffectfulDynamic

164164{-# NOINLINE programEffectfulDynamic #-}

165165

166−countdownEffectfulDynPure :: Integer -> (Integer, Integer)

167−countdownEffectfulDynPure n = E.runPureEff . DE.runState n $ programEffectfulDynamic

166+countdownEffectfulDynLocal :: Integer -> (Integer, Integer)

167+countdownEffectfulDynLocal n =

168+ E.runPureEff . ED.runLocalState n $ programEffectfulDynamic

168169

169−countdownEffectfulDynMVar :: Integer -> (Integer, Integer)

170−countdownEffectfulDynMVar n = E.runPureEff . DE.runStateMVar n $ programEffectfulDynamic

170+countdownEffectfulDynShared :: Integer -> (Integer, Integer)

171+countdownEffectfulDynShared n =

172+ E.runPureEff . ED.runSharedState n $ programEffectfulDynamic

171173

172−countdownEffectfulDynPureDeep :: Integer -> (Integer, Integer)

173−countdownEffectfulDynPureDeep n = E.runPureEff

174+countdownEffectfulDynLocalDeep :: Integer -> (Integer, Integer)

175+countdownEffectfulDynLocalDeep n = E.runPureEff

174176 . runR . runR . runR . runR . runR

175− . DE.runState n

177+ . ED.runLocalState n

176178 . runR . runR . runR . runR . runR

177179 $ programEffectfulDynamic

178180 where

179181 runR = E.runReader ()

180182

181−countdownEffectfulDynMVarDeep :: Integer -> (Integer, Integer)

182−countdownEffectfulDynMVarDeep n = E.runPureEff

183+countdownEffectfulDynSharedDeep :: Integer -> (Integer, Integer)

184+countdownEffectfulDynSharedDeep n = E.runPureEff

183185 . runR . runR . runR . runR . runR

184− . DE.runStateMVar n

186+ . ED.runSharedState n

185187 . runR . runR . runR . runR . runR

186188 $ programEffectfulDynamic

187189 where

bench/FileSizes.hs+1−1

@@ -11,7 +11,7 @@ import System.Posix

1111-- effectful

1212import qualified Effectful as E

1313import qualified Effectful.Reader as E

14−import qualified Effectful.State as E

14+import qualified Effectful.State.Local as E

1515

1616-- eff

1717#ifdef VERSION_eff

bench/Main.hs+20−20

@@ -26,47 +26,47 @@ main = defaultMain

2626countdown :: Integer -> Benchmark

2727countdown n = bgroup (show n)

2828 [ bgroup "shallow"

29− [ bench "reference (pure)" $ nf countdownRef n

30− , bench "reference (ST)" $ nf countdownST n

31− , bench "effectful (pure-static)" $ nf countdownEffectfulStatic n

32− , bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPure n

33− , bench "effectful (MVar-static)" $ nf countdownEffectfulMVar n

34− , bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVar n

29+ [ bench "reference (pure)" $ nf countdownRef n

30+ , bench "reference (ST)" $ nf countdownST n

31+ , bench "effectful (local/static)" $ nf countdownEffectfulLocal n

32+ , bench "effectful (local/dynamic)" $ nf countdownEffectfulDynLocal n

33+ , bench "effectful (shared/static)" $ nf countdownEffectfulShared n

34+ , bench "effectful (shared/dynamic)" $ nf countdownEffectfulDynShared n

3535#ifdef VERSION_freer_simple

36− , bench "freer-simple" $ nf countdownFreerSimple n

36+ , bench "freer-simple" $ nf countdownFreerSimple n

3737#endif

3838#ifdef VERSION_eff

39− , bench "eff" $ nf countdownEff n

39+ , bench "eff" $ nf countdownEff n

4040#endif

4141#ifdef VERSION_mtl

42− , bench "mtl" $ nf countdownMtl n

42+ , bench "mtl" $ nf countdownMtl n

4343#endif

4444#ifdef VERSION_fused_effects

45− , bench "fused-effects" $ nf countdownFusedEffects n

45+ , bench "fused-effects" $ nf countdownFusedEffects n

4646#endif

4747#ifdef VERSION_polysemy

48− , bench "polysemy" $ nf countdownPolysemy n

48+ , bench "polysemy" $ nf countdownPolysemy n

4949#endif

5050 ]

5151 , bgroup "deep"

52− [ bench "effectful (pure-static)" $ nf countdownEffectfulStaticDeep n

53− , bench "effectful (pure-dynamic)" $ nf countdownEffectfulDynPureDeep n

54− , bench "effectful (MVar-static)" $ nf countdownEffectfulMVarDeep n

55− , bench "effectful (MVar-dynamic)" $ nf countdownEffectfulDynMVarDeep n

52+ [ bench "effectful (local/static)" $ nf countdownEffectfulLocalDeep n

53+ , bench "effectful (local/dynamic)" $ nf countdownEffectfulDynLocalDeep n

54+ , bench "effectful (shared/static)" $ nf countdownEffectfulSharedDeep n

55+ , bench "effectful (shared/dynamic)" $ nf countdownEffectfulDynSharedDeep n

5656#ifdef VERSION_freer_simple

57− , bench "freer-simple" $ nf countdownFreerSimpleDeep n

57+ , bench "freer-simple" $ nf countdownFreerSimpleDeep n

5858#endif

5959#ifdef VERSION_eff

60− , bench "eff" $ nf countdownEffDeep n

60+ , bench "eff" $ nf countdownEffDeep n

6161#endif

6262#ifdef VERSION_polysemy

63− , bench "polysemy" $ nf countdownPolysemyDeep n

63+ , bench "polysemy" $ nf countdownPolysemyDeep n

6464#endif

6565#ifdef VERSION_mtl

66− , bench "mtl" $ nf countdownMtlDeep n

66+ , bench "mtl" $ nf countdownMtlDeep n

6767#endif

6868#ifdef VERSION_fused_effects

69− , bench "fused-effects" $ nf countdownFusedEffectsDeep n

69+ , bench "fused-effects" $ nf countdownFusedEffectsDeep n

7070#endif

7171 ]

7272 ]

bench/Utils.hs+3−2

@@ -16,5 +16,6 @@ runDeep

1616 ] a

1717 -> IO a

1818runDeep = runEff

19− . evalState () . evalState () . evalState () . evalState () . evalState ()

20− . evalState () . evalState () . evalState () . evalState () . evalState ()

19+ . evalLocalState () . evalLocalState () . evalLocalState () . evalLocalState ()

20+ . evalLocalState () . evalLocalState () . evalLocalState () . evalLocalState ()

21+ . evalLocalState () . evalLocalState ()

effectful.cabal+4−4

@@ -95,12 +95,12 @@ library

9595 Effectful.Monad

9696 Effectful.Reader

9797 Effectful.Resource

98− Effectful.State

9998 Effectful.State.Dynamic

100− Effectful.State.MVar

101− Effectful.Writer

99+ Effectful.State.Local

100+ Effectful.State.Shared

102101 Effectful.Writer.Dynamic

103− Effectful.Writer.MVar

102+ Effectful.Writer.Local

103+ Effectful.Writer.Shared

104104

105105 reexported-modules: Effectful.Internal.Utils

106106

src/Effectful/State/Dynamic.hs+42−45

@@ -1,27 +1,25 @@

11-- | The 'State' effect with dynamic dispatch.

22--

33-- 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:

55--

6−-- - Share state between threads and need the synchonized version.

6+-- - Share state between threads and need the shared version.

77--

88-- - Don't share state between threads (or want it to be thread local) and are

9−-- free to use the faster, pure version.

10−--

11−-- However, let's include this for now.

9+-- free to use the faster, local version.

1210--

1311module Effectful.State.Dynamic

1412 ( State(..)

1513

16− -- * Pure

17− , runState

18− , evalState

19− , execState

14+ -- * Local

15+ , runLocalState

16+ , evalLocalState

17+ , execLocalState

2018

21− -- * MVar

22− , runStateMVar

23− , evalStateMVar

24− , execStateMVar

19+ -- * Shared

20+ , runSharedState

21+ , evalSharedState

22+ , execSharedState

2523

2624 -- * Operations

2725 , get

@@ -35,13 +33,12 @@ module Effectful.State.Dynamic

3533

3634import Effectful.Handler

3735import Effectful.Monad

38−import qualified Effectful.State as SP

39−import qualified Effectful.State.MVar as SM

36+import qualified Effectful.State.Local as L

37+import qualified Effectful.State.Shared as S

4038

4139-- | Provide access to a mutable state of type @s@.

4240--

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.

4542data State s :: Effect where

4643 Get :: State s m s

4744 Put :: ~s -> State s m ()

@@ -49,50 +46,50 @@ data State s :: Effect where

4946 StateM :: (s -> m (a, s)) -> State s m a

5047

5148----------------------------------------

52−-- Pure

49+-- Local

5350

54−runState :: s -> Eff (State s : es) a -> Eff es (a, s)

55−runState s0 = reinterpretM (SP.runState s0) statePure

51+runLocalState :: s -> Eff (State s : es) a -> Eff es (a, s)

52+runLocalState s0 = reinterpretM (L.runState s0) localState

5653

57−evalState :: s -> Eff (State s : es) a -> Eff es a

58−evalState s0 = reinterpretM (SP.evalState s0) statePure

54+evalLocalState :: s -> Eff (State s : es) a -> Eff es a

55+evalLocalState s0 = reinterpretM (L.evalState s0) localState

5956

60−execState :: s -> Eff (State s : es) a -> Eff es s

61−execState s0 = reinterpretM (SP.execState s0) statePure

57+execLocalState :: s -> Eff (State s : es) a -> Eff es s

58+execLocalState s0 = reinterpretM (L.execState s0) localState

6259

63−statePure

64− :: SP.State s :> es

60+localState

61+ :: L.State s :> es

6562 => LocalEnv localEs

6663 -> State s (Eff localEs) a

6764 -> Eff es a

68−statePure env = \case

69− Get -> SP.get

70− Put s -> SP.put s

71− State f -> SP.state f

72− StateM f -> localSeqUnlift env $ \run -> SP.stateM (run . f)

65+localState env = \case

66+ Get -> L.get

67+ Put s -> L.put s

68+ State f -> L.state f

69+ StateM f -> localSeqUnlift env $ \run -> L.stateM (run . f)

7370

7471----------------------------------------

75−-- MVar

72+-- Shared

7673

77−runStateMVar :: s -> Eff (State s : es) a -> Eff es (a, s)

78−runStateMVar s0 = reinterpretM (SM.runState s0) stateMVar

74+runSharedState :: s -> Eff (State s : es) a -> Eff es (a, s)

75+runSharedState s0 = reinterpretM (S.runState s0) sharedState

7976

80−evalStateMVar :: s -> Eff (State s : es) a -> Eff es a

81−evalStateMVar s0 = reinterpretM (SM.evalState s0) stateMVar

77+evalSharedState :: s -> Eff (State s : es) a -> Eff es a

78+evalSharedState s0 = reinterpretM (S.evalState s0) sharedState

8279

83−execStateMVar :: s -> Eff (State s : es) a -> Eff es s

84−execStateMVar s0 = reinterpretM (SM.execState s0) stateMVar

80+execSharedState :: s -> Eff (State s : es) a -> Eff es s

81+execSharedState s0 = reinterpretM (S.execState s0) sharedState

8582

86−stateMVar

87− :: SM.State s :> es

83+sharedState

84+ :: S.State s :> es

8885 => LocalEnv localEs

8986 -> State s (Eff localEs) a

9087 -> Eff es a

91−stateMVar env = \case

92− Get -> SM.get

93− Put s -> SM.put s

94− State f -> SM.state f

95− StateM f -> localSeqUnlift env $ \run -> SM.stateM (run . f)

88+sharedState env = \case

89+ Get -> S.get

90+ Put s -> S.put s

91+ State f -> S.state f

92+ StateM f -> localSeqUnlift env $ \run -> S.stateM (run . f)

9693

9794----------------------------------------

9895-- Operations

src/Effectful/State.hs → src/Effectful/State/Local.hsrenamed+3−2

@@ -2,11 +2,12 @@

22--

33-- Represented as a pure value underneath, therefore:

44--

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"),

67--

78-- - very fast.

89--

9−module Effectful.State

10+module Effectful.State.Local

1011 ( State

1112 , runState

1213 , evalState

src/Effectful/State/MVar.hs → src/Effectful/State/Shared.hsrenamed+15−14

@@ -4,9 +4,9 @@

44--

55-- - shareable between multiple threads,

66--

7−-- - slower than "Effectful.State".

7+-- - slower than "Effectful.State.Local".

88--

9−module Effectful.State.MVar

9+module Effectful.State.Shared

1010 ( State

1111 , runState

1212 , evalState

@@ -23,6 +23,7 @@ module Effectful.State.MVar

2323import Control.Concurrent.MVar

2424

2525import Effectful.Internal.Effect

26+import Effectful.Internal.Env

2627import Effectful.Internal.Monad

2728

2829-- | Provide access to a strict (WHNF), shareable, mutable state of type @s@.

@@ -47,30 +48,30 @@ execState s m = do

4748 unsafeEff_ $ readMVar v

4849

4950get :: State s :> es => Eff es s

50−get = do

51− IdE (State v) <- getEffect

52− unsafeEff_ $ readMVar v

51+get = unsafeEff $ \es -> do

52+ IdE (State v) <- getEnv es

53+ readMVar v

5354

5455gets :: State s :> es => (s -> a) -> Eff es a

5556gets f = f <$> get

5657

5758put :: State s :> es => s -> Eff es ()

58−put s = do

59− IdE (State v) <- getEffect

60− unsafeEff_ . modifyMVar_ v $ \_ -> s `seq` pure s

59+put s = unsafeEff $ \es -> do

60+ IdE (State v) <- getEnv es

61+ modifyMVar_ v $ \_ -> s `seq` pure s

6162

6263state :: State s :> es => (s -> (a, s)) -> Eff es a

63−state f = do

64− IdE (State v) <- getEffect

65− unsafeEff_ . modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)

64+state f = unsafeEff $ \es -> do

65+ IdE (State v) <- getEnv es

66+ modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)

6667

6768modify :: State s :> es => (s -> s) -> Eff es ()

6869modify f = state (\s -> ((), f s))

6970

7071stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a

71−stateM f = do

72− IdE (State v) <- getEffect

73− unsafeEff $ \es -> modifyMVar v $ \s0 -> do

72+stateM f = unsafeEff $ \es -> do

73+ IdE (State v) <- getEnv es

74+ modifyMVar v $ \s0 -> do

7475 (a, s) <- unEff (f s0) es

7576 s `seq` pure (s, a)

7677

src/Effectful/Writer/Dynamic.hs+28−28

@@ -1,13 +1,13 @@

11module Effectful.Writer.Dynamic

22 ( Writer(..)

4− -- * Pure

5− , runWriter

6− , execWriter

4+ -- * Local

5+ , runLocalWriter

6+ , execLocalWriter

8− -- * MVar

9− , runWriterMVar

10− , execWriterMVar

8+ -- * Shared

9+ , runSharedWriter

10+ , execSharedWriter

1111

1212 -- * Operations

1313 , tell

@@ -17,48 +17,48 @@ module Effectful.Writer.Dynamic

1717

1818import Effectful.Handler

1919import Effectful.Monad

20−import qualified Effectful.Writer as WP

21−import qualified Effectful.Writer.MVar as WM

20+import qualified Effectful.Writer.Local as L

21+import qualified Effectful.Writer.Shared as S

2222

2323data Writer w :: Effect where

2424 Tell :: ~w -> Writer w m ()

2525 Listen :: m a -> Writer w m (a, w)

2626

2727----------------------------------------

28−-- Pure

28+-- Local

2929

30−runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)

31−runWriter = reinterpretM WP.runWriter writerPure

30+runLocalWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)

31+runLocalWriter = reinterpretM L.runWriter localWriter

3232

33−execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w

34−execWriter = reinterpretM WP.execWriter writerPure

33+execLocalWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w

34+execLocalWriter = reinterpretM L.execWriter localWriter

3535

36−writerPure

37− :: (WP.Writer w :> es, Monoid w)

36+localWriter

37+ :: (L.Writer w :> es, Monoid w)

3838 => LocalEnv localEs

3939 -> Writer w (Eff localEs) a

4040 -> Eff es a

41−writerPure env = \case

42− Tell w -> WP.tell w

43− Listen m -> localSeqUnlift env $ \run -> WP.listen (run m)

41+localWriter env = \case

42+ Tell w -> L.tell w

43+ Listen m -> localSeqUnlift env $ \run -> L.listen (run m)

4444

4545----------------------------------------

46−-- MVar

46+-- Shared

4747

48−runWriterMVar :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)

49−runWriterMVar = reinterpretM WM.runWriter writerMVar

48+runSharedWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)

49+runSharedWriter = reinterpretM S.runWriter sharedWriter

5050

51−execWriterMVar :: Monoid w => Eff (Writer w : es) a -> Eff es w

52−execWriterMVar = reinterpretM WM.execWriter writerMVar

51+execSharedWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w

52+execSharedWriter = reinterpretM S.execWriter sharedWriter

5353

54−writerMVar

55− :: (WM.Writer w :> es, Monoid w)

54+sharedWriter

55+ :: (S.Writer w :> es, Monoid w)

5656 => LocalEnv localEs

5757 -> Writer w (Eff localEs) a

5858 -> Eff es a

59−writerMVar env = \case

60− Tell w -> WM.tell w

61− Listen m -> localSeqUnlift env $ \run -> WM.listen (run m)

59+sharedWriter env = \case

60+ Tell w -> S.tell w

61+ Listen m -> localSeqUnlift env $ \run -> S.listen (run m)

6262

6363----------------------------------------

6464-- Operations

src/Effectful/Writer.hs → src/Effectful/Writer/Local.hsrenamed+1−1

@@ -1,5 +1,5 @@

11-- | The 'Writer' effect.

2−module Effectful.Writer

2+module Effectful.Writer.Local

33 ( Writer

44 , runWriter

55 , 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

22 ( Writer

33 , runWriter

44 , execWriter

@@ -31,25 +31,27 @@ execWriter m = do

3131 unsafeEff_ $ readMVar v

3232

3333tell :: (Writer w :> es, Monoid w) => w -> Eff es ()

34−tell w1 = do

35− IdE (Writer v) <- getEffect

36− unsafeEff_ . modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w

34+tell w1 = unsafeEff $ \es -> do

35+ IdE (Writer v) <- getEnv es

36+ modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w

3737

3838listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)

39−listen m = unsafeEff $ \es -> uninterruptibleMask $ \restore -> do

40− v1 <- newMVar mempty

41− -- Replace thread local MVar with a fresh one for isolated listening.

42− v0 <- unsafeStateEnv (\(IdE (Writer v)) -> (v, IdE (Writer v1))) es

43− a <- restore (unEff m es) `onException` merge es v0 v1

44− (a, ) <$> merge es v0 v1

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.

43+ uninterruptibleMask $ \restore -> do

44+ v1 <- newMVar mempty

45+ -- Replace thread local MVar with a fresh one for isolated listening.

46+ v0 <- unsafeStateEnv (\(IdE (Writer v)) -> (v, IdE (Writer v1))) es

47+ a <- restore (unEff m es) `onException` merge es v0 v1

48+ (a, ) <$> merge es v0 v1

4549 where

4650 -- Merge results accumulated in the local MVar with the mainline. If an

4751 -- exception was received while listening, merge results recorded so far.

4852 merge es v0 v1 = do

4953 unsafePutEnv (IdE (Writer v0)) es

5054 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.

5355 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w

5456 pure w1

5557

tests/AsyncTests.hs+5−5

@@ -24,7 +24,7 @@ asyncTests = testGroup "Async"

2424 ]

2525

2626test_localState :: Assertion

27−test_localState = runEff . runAsyncE . evalState x $ do

27+test_localState = runEff . runAsyncE . evalLocalState x $ do

2828 replicateConcurrently_ 2 $ do

2929 r <- goDownward 0

3030 U.assertEqual "expected result" x r

@@ -42,7 +42,7 @@ test_localState = runEff . runAsyncE . evalState x $ do

4242 else goDownward $ acc + 1

4343

4444test_sharedState :: Assertion

45−test_sharedState = runEff . runAsyncE . evalStateMVar (S.empty @Int) $ do

45+test_sharedState = runEff . runAsyncE . evalSharedState (S.empty @Int) $ do

4646 concurrently_ (addWhen even x) (addWhen odd x)

4747 U.assertEqual "expected result" (S.fromList [1..x]) =<< get

4848 where

@@ -58,7 +58,7 @@ test_sharedState = runEff . runAsyncE . evalStateMVar (S.empty @Int) $ do

5858 addWhen f $ n - 1

5959

6060test_errorHandling :: Assertion

61−test_errorHandling = runEff . runAsyncE . evalStateMVar (0::Int) $ do

61+test_errorHandling = runEff . runAsyncE . evalSharedState (0::Int) $ do

6262 r <- runError $ concurrently_

6363 (liftIO (threadDelay 10000) >> throwError err)

6464 (modify (+x))

@@ -74,7 +74,7 @@ test_errorHandling = runEff . runAsyncE . evalStateMVar (0::Int) $ do

7474 err = "thrown from async"

7575

7676test_asyncWithUnmask :: Assertion

77−test_asyncWithUnmask = runEff . runAsyncE . evalState "initial" $ do

77+test_asyncWithUnmask = runEff . runAsyncE . evalLocalState "initial" $ do

7878 x <- asyncWithUnmask $ \unmask -> do

7979 liftIO $ threadDelay 10000

8080 r1 <- get @String -- 2

@@ -89,7 +89,7 @@ test_asyncWithUnmask = runEff . runAsyncE . evalState "initial" $ do

8989 (inner1, inner2, outer)

9090

9191test_pooledWorkers :: Assertion

92−test_pooledWorkers = runEff . runAsyncE . evalState (0::Int) $ do

92+test_pooledWorkers = runEff . runAsyncE . evalLocalState (0::Int) $ do

9393 x <- pooledForConcurrentlyN threads [1..n] $ \k -> do

9494 r <- get @Int

9595 modify @Int (+1)

tests/ConcurrencyTests.hs+6−6

@@ -24,7 +24,7 @@ concurrencyTests = testGroup "Concurrency"

2424 ]

2525

2626test_localState :: Assertion

27−test_localState = runEff . evalState x $ do

27+test_localState = runEff . evalLocalState x $ do

2828 withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do

2929 replicateConcurrently_ 2 $ do

3030 r <- goDownward 0

@@ -43,7 +43,7 @@ test_localState = runEff . evalState x $ do

4343 else goDownward $ acc + 1

4444

4545test_sharedState :: Assertion

46−test_sharedState = runEff . evalStateMVar (S.empty @Int) $ do

46+test_sharedState = runEff . evalSharedState (S.empty @Int) $ do

4747 withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do

4848 concurrently_ (addWhen even x) (addWhen odd x)

4949 U.assertEqual "expected result" (S.fromList [1..x]) =<< get

@@ -60,7 +60,7 @@ test_sharedState = runEff . evalStateMVar (S.empty @Int) $ do

6060 addWhen f $ n - 1

6161

6262test_errorHandling :: Assertion

63−test_errorHandling = runEff . evalStateMVar (0::Int) $ do

63+test_errorHandling = runEff . evalSharedState (0::Int) $ do

6464 withUnliftStrategy (ConcUnlift Ephemeral $ Limited 2) $ do

6565 r <- runError $ concurrently_

6666 (liftIO (threadDelay 10000) >> throwError err)

@@ -77,7 +77,7 @@ test_errorHandling = runEff . evalStateMVar (0::Int) $ do

7777 err = "thrown from async"

7878

7979test_unliftMany :: Assertion

80−test_unliftMany = runEff . evalState "initial value" $ do

80+test_unliftMany = runEff . evalLocalState "initial value" $ do

8181 withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do

8282 x <- withRunInIO $ \runInIO -> async $ do

8383 v1 <- runInIO $ get @String -- 1

@@ -95,7 +95,7 @@ test_unliftMany = runEff . evalState "initial value" $ do

9595 (v1, v2, v3, v4)

9696

9797test_asyncWithUnmask :: Assertion

98−test_asyncWithUnmask = runEff . evalState "initial" $ do

98+test_asyncWithUnmask = runEff . evalLocalState "initial" $ do

9999 withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do

100100 x <- asyncWithUnmask $ \unmask -> do

101101 liftIO $ threadDelay 10000

@@ -111,7 +111,7 @@ test_asyncWithUnmask = runEff . evalState "initial" $ do

111111 (inner1, inner2, outer)

112112

113113test_pooledWorkers :: Assertion

114−test_pooledWorkers = runEff . evalState (0::Int) $ do

114+test_pooledWorkers = runEff . evalLocalState (0::Int) $ do

115115 withUnliftStrategy (ConcUnlift Ephemeral $ Limited n) $ do

116116 x <- pooledForConcurrentlyN threads [1..n] $ \k -> do

117117 r <- get @Int

tests/StateTests.hs+1−1

@@ -7,7 +7,7 @@ import qualified Control.Exception.Lifted as LE

77import qualified UnliftIO.Exception as UE

99import Effectful

10−import Effectful.State.Dynamic

10+import Effectful.State.Local

1111import qualified Utils as U

1212

1313stateTests :: TestTree