a2681eb...master · effectful

.github/workflows/haskell-ci.yml−5

since splitsnapshots

unifiedsplit

@@ -37,11 +37,6 @@ jobs:

37 compilerVersion: 9.2.1

38 setup-method: ghcup

39 allow-failure: false

40− - compiler: ghc-9.0.1

41− compilerKind: ghc

42− compilerVersion: 9.0.1

43− setup-method: hvr-ppa

44− allow-failure: false

45 - compiler: ghc-8.10.7

40 - compiler: ghc-8.10.7

46 compilerKind: ghc

41 compilerKind: ghc

47 compilerVersion: 8.10.7

42 compilerVersion: 8.10.7

README.md+2−2

@@ -20,8 +20,8 @@ Main features:

20

212. Easy to use API (no boilerplate code and dealing with arcane types).

22

23−3. Correct semantics in presence of runtime exceptions (no more lost or

23+3. Correct semantics in presence of runtime exceptions (no more lost state

24− discarded state).

24+ modifications).

25

264. Seamless integration with the existing ecosystem (`exceptions`,

27 `monad-control`, `unliftio-core`, `resourcet` etc.).

effectful-core/effectful-core.cabal+1−1

@@ -18,7 +18,7 @@ description: An easy to use, performant extensible effects library with seamless

18

19extra-source-files: CHANGELOG.md

20

21−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1

21+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1

22

23bug-reports: https://github.com/arybczak/effectful/issues

24source-repository head

effectful-core/src/Effectful/Dispatch/Dynamic.hs+15−3

@@ -32,7 +32,8 @@ module Effectful.Dispatch.Dynamic

32 ) where

33

34import Control.Monad.IO.Unlift

35−import GHC.Stack

35+import Data.Kind

36+import GHC.Stack (HasCallStack)

36

37

37import Effectful.Internal.Effect

38import Effectful.Internal.Effect

38import Effectful.Internal.Env

39import Effectful.Internal.Env

@@ -49,7 +50,7 @@ interpret

49 -> Eff es a

50 -> Eff es a

50interpret handler m = unsafeEff $ \es -> do

51interpret handler m = unsafeEff $ \es -> do

51 les <- forkEnv es

52 les <- forkEnv es

52− (`unEff` es) $ runHandlerA (HandlerA les handler) m

53+ (`unEff` es) $ runHandler (HandlerA les handler) m

53

54

54-- | Interpret an effect using other effects.

55-- | Interpret an effect using other effects.

55reinterpret

56reinterpret

@@ -62,7 +63,7 @@ reinterpret

62reinterpret runHandlerEs handler m = unsafeEff $ \es -> do

63reinterpret runHandlerEs handler m = unsafeEff $ \es -> do

63 les0 <- forkEnv es

64 les0 <- forkEnv es

64 (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do

65 (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do

65− (`unEff` es) $ runHandlerA (HandlerA les handler) m

66+ (`unEff` es) $ runHandler (HandlerA les handler) m

66

67

67----------------------------------------

68----------------------------------------

68-- Unlifts

69-- Unlifts

@@ -230,5 +231,16 @@ localLiftUnliftIO (LocalEnv les) strategy k = case strategy of

230 SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_

231 SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_

231 ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_

232 ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_

232

233

234+----------------------------------------

235+-- Utils

236+

237+-- | Require that the second list of effects is a suffix of the first one.

238+--

239+-- In other words, 'SuffixOf' @es@ @baseEs@ means "a suffix of @es@ is

240+-- @baseEs@".

241+type family SuffixOf (es :: [Effect]) (baseEs :: [Effect]) :: Constraint where

242+ SuffixOf baseEs baseEs = ()

243+ SuffixOf (e : es) baseEs = SuffixOf es baseEs

244+

233-- $setup

245-- $setup

234-- >>> import Control.Concurrent

246-- >>> import Control.Concurrent

effectful-core/src/Effectful/Dispatch/Static.hs+18−21

@@ -1,23 +1,30 @@

1module Effectful.Dispatch.Static

2 ( -- * Low level API

3− IdA(..)

3+ DataA(..)

4

5− -- ** Running

5+ -- ** Extending the environment

6− , runEffect

6+ , runData

7− , evalEffect

7+ , evalData

8− , execEffect

8+ , execData

9

10− -- ** Modification

10+ -- ** Data retrieval and update

11− , getEffect

11+ , getData

12− , putEffect

12+ , putData

13− , stateEffect

13+ , stateData

14− , stateEffectM

14+ , stateDataM

15− , localEffect

15+ , localData

16

17 -- ** Unlifts

18 , seqUnliftIO

19 , concUnliftIO

20

21+ -- ** Utils

22+ , unEff

23+ , unsafeEff

24+ , unsafeEff_

25+ , unsafeLiftMapIO

26+ , unsafeUnliftIO

27+

21 -- * Primitive API

28 -- * Primitive API

22 , Env

29 , Env

23 , Relinker(..)

30 , Relinker(..)

@@ -39,18 +46,8 @@ module Effectful.Dispatch.Static

39 , putEnv

46 , putEnv

40 , stateEnv

47 , stateEnv

41 , modifyEnv

48 , modifyEnv

42−

43− -- * Unsafe 'Eff' operations

44− , unsafeEff

45− , unsafeEff_

46− , unsafeLiftMapIO

47− , unsafeUnliftIO

48−

49− -- * Utils

50− , unEff

51 ) where

49 ) where

52

50

53−import Effectful.Internal.Effect

54import Effectful.Internal.Env

51import Effectful.Internal.Env

55import Effectful.Internal.Monad

52import Effectful.Internal.Monad

56

53

effectful-core/src/Effectful/Error.hs+36−6

@@ -1,8 +1,6 @@

1-- | Support for handling errors of a particular type, i.e. checked exceptions.

2--

3−-- /Note:/ the 'Error' effect is a suitable replacement for the

4−-- 'Control.Monad.Trans.Except.ExceptT' monad transformer from the

5−-- @transformers@ library. It is __not__ a general mechanism for handling

3+-- The 'Error' effect is __not__ a general mechanism for handling regular

6-- exceptions, that's what functions from the @exceptions@ library are for (see

4-- exceptions, that's what functions from the @exceptions@ library are for (see

7-- "Control.Monad.Catch" for more information).

5-- "Control.Monad.Catch" for more information).

8--

6--

@@ -37,6 +35,38 @@

37-- Cleaning up.

35-- Cleaning up.

38-- Left "oops"

36-- Left "oops"

39--

37--

38+-- /Note:/ unlike the 'Control.Monad.Trans.Except.ExceptT' monad transformer

39+-- from the @transformers@ library, the order in which you handle the 'Error'

40+-- effect with regard to other stateful effects does not matter. Consider the

41+-- following:

42+--

43+-- >>> import qualified Control.Monad.State.Strict as T

44+-- >>> import qualified Control.Monad.Except as T

45+--

46+-- >>> let m1 = (T.modify (++ " there!") >> T.throwError "oops") `T.catchError` \_ -> pure ()

47+--

48+-- >>> (`T.runStateT` "Hi") . T.runExceptT $ m1

49+-- (Right (),"Hi there!")

50+--

51+-- >>> T.runExceptT . (`T.runStateT` "Hi") $ m1

52+-- Right ((),"Hi")

53+--

54+-- Here, whether state modifications within the @catchError@ block are lost or

55+-- not depends on the shape of the monad transformer stack, which is surprising

56+-- and can be a source of subtle bugs. On the other hand:

57+--

58+-- >>> import Effectful.State.Local

59+--

60+-- >>> let m2 = (modify (++ " there!") >> throwError "oops") `catchError` \_ (_::String) -> pure ()

61+--

62+-- >>> runEff . runState "Hi" . runError @String $ m2

63+-- (Right (),"Hi there!")

64+--

65+-- >>> runEff . runError @String . runState "Hi" $ m2

66+-- Right ((),"Hi there!")

67+--

68+-- Here, no matter the order of effects, state modifications within the

69+-- @catchError@ block always persist, giving predictable behavior.

40module Effectful.Error

70module Effectful.Error

41 ( Error

71 ( Error

42 , runError

72 , runError

@@ -72,7 +102,7 @@ runError

72runError m = unsafeEff $ \es0 -> mask $ \release -> do

102runError m = unsafeEff $ \es0 -> mask $ \release -> do

73 eid <- newErrorId

103 eid <- newErrorId

74 size0 <- sizeEnv es0

104 size0 <- sizeEnv es0

75− es <- unsafeConsEnv (IdA (Error @e eid)) noRelinker es0

105+ es <- unsafeConsEnv (DataA (Error @e eid)) noRelinker es0

76 r <- tryErrorIO release eid es `onException` unsafeTailEnv size0 es

106 r <- tryErrorIO release eid es `onException` unsafeTailEnv size0 es

77 unsafeTailEnv size0 es

107 unsafeTailEnv size0 es

78 pure r

108 pure r

@@ -89,7 +119,7 @@ throwError

89 -- ^ The error.

119 -- ^ The error.

90 -> Eff es a

120 -> Eff es a

91throwError e = unsafeEff $ \es -> do

121throwError e = unsafeEff $ \es -> do

92− IdA (Error eid) <- getEnv @(Error e) es

122+ DataA (Error eid) <- getEnv @(Error e) es

93 throwIO $ ErrorEx eid callStack e

123 throwIO $ ErrorEx eid callStack e

94

124

95-- | Handle an error of type @e@.

125-- | Handle an error of type @e@.

@@ -101,7 +131,7 @@ catchError

101 -- ^ A handler for errors in the inner computation.

131 -- ^ A handler for errors in the inner computation.

102 -> Eff es a

132 -> Eff es a

103catchError m handler = unsafeEff $ \es -> do

133catchError m handler = unsafeEff $ \es -> do

104− IdA (Error eid) <- getEnv @(Error e) es

134+ DataA (Error eid) <- getEnv @(Error e) es

105 size <- sizeEnv es

135 size <- sizeEnv es

106 catchErrorIO eid (unEff m es) $ \cs e -> do

136 catchErrorIO eid (unEff m es) $ \cs e -> do

107 checkSizeEnv size es

137 checkSizeEnv size es

effectful-core/src/Effectful/Internal/Effect.hs+1−17

@@ -8,10 +8,6 @@

8module Effectful.Internal.Effect

9 ( Effect

10 , (:>)(..)

11− , IdA(..)

12−

13− -- * Utils

14− , SuffixOf

15

11

16 -- * Re-exports

12 -- * Re-exports

17 , Type

13 , Type

@@ -23,10 +19,6 @@ import GHC.TypeLits

23-- | The kind of effects.

19-- | The kind of effects.

24type Effect = (Type -> Type) -> Type -> Type

20type Effect = (Type -> Type) -> Type -> Type

25

21

26−-- | An adapter for statically dispatched effects.

27−newtype IdA :: Effect -> Type where

28− IdA :: (forall m r. e m r) -> IdA e

29−

30-- | A constraint that requires that a particular effect @e@ is a member of the

22-- | A constraint that requires that a particular effect @e@ is a member of the

31-- type-level list @es@. This is used to parameterize an 'Effectful.Monad.Eff'

23-- type-level list @es@. This is used to parameterize an 'Effectful.Monad.Eff'

32-- computation over an arbitrary list of effects, so long as @e@ is /somewhere/

24-- computation over an arbitrary list of effects, so long as @e@ is /somewhere/

@@ -36,7 +28,7 @@ newtype IdA :: Effect -> Type where

36-- 'Integer' would likely use the following type:

28-- 'Integer' would likely use the following type:

37--

29--

38-- @

30-- @

39−-- 'Effectful.State.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()

31+-- 'Effectful.State.Local.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()

40-- @

32-- @

41class (e :: Effect) :> (es :: [Effect]) where

33class (e :: Effect) :> (es :: [Effect]) where

42 -- | Get the position of @e@ in @es@.

34 -- | Get the position of @e@ in @es@.

@@ -59,11 +51,3 @@ instance {-# OVERLAPPING #-} e :> (e : es) where

59

51

60instance e :> es => e :> (x : es) where

52instance e :> es => e :> (x : es) where

61 reifyIndex = 1 + reifyIndex @e @es

53 reifyIndex = 1 + reifyIndex @e @es

62−

63−-- | Require that the second list of effects is a suffix of the first one.

64−--

65−-- In other words, 'SuffixOf' @es@ @baseEs@ means "a suffix of @es@ is

66−-- @baseEs@".

67−type family SuffixOf (es :: [Effect]) (baseEs :: [Effect]) :: Constraint where

68− SuffixOf baseEs baseEs = ()

69− SuffixOf (e : es) baseEs = SuffixOf es baseEs

effectful-core/src/Effectful/Internal/Env.hs+25−20

@@ -1,3 +1,4 @@

1+{-# LANGUAGE MagicHash #-}

1{-# OPTIONS_HADDOCK not-home #-}

2{-# OPTIONS_HADDOCK not-home #-}

2-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.

3-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.

3--

4--

@@ -42,7 +43,7 @@ import Control.Monad

42import Control.Monad.Primitive

43import Control.Monad.Primitive

43import Data.IORef

44import Data.IORef

44import Data.Primitive.SmallArray

45import Data.Primitive.SmallArray

45−import GHC.Exts (Any)

46+import GHC.Exts (Any, SmallMutableArray#)

46import GHC.Stack (HasCallStack)

47import GHC.Stack (HasCallStack)

47import Unsafe.Coerce

48import Unsafe.Coerce

48import qualified Data.IntMap.Strict as IM

49import qualified Data.IntMap.Strict as IM

@@ -417,43 +418,43 @@ unsafeTailEnv len (Env fork gref _) = case fork of

417

418

418-- | Extract a specific data type from the environment.

419-- | Extract a specific data type from the environment.

419getEnv

420getEnv

420− :: forall e es adapter. e :> es

421+ :: forall e adapter es. e :> es

421 => Env es

422 => Env es

422 -> IO (adapter e)

423 -> IO (adapter e)

423getEnv env = do

424getEnv env = do

424− (i, es) <- getLocation (reifyIndex @e @es) env

425+ Location i es <- getLocation (reifyIndex @e @es) env

425 fromAny <$> readSmallArray es i

426 fromAny <$> readSmallArray es i

426

427

427-- | Replace the data type in the environment with a new value (in place).

428-- | Replace the data type in the environment with a new value (in place).

428putEnv

429putEnv

429− :: forall e es adapter. e :> es

430+ :: forall e adapter es. e :> es

430 => Env es

431 => Env es

431 -> adapter e

432 -> adapter e

432 -> IO ()

433 -> IO ()

433putEnv env e = do

434putEnv env e = do

434− (i, es) <- getLocation (reifyIndex @e @es) env

435+ Location i es <- getLocation (reifyIndex @e @es) env

435 e `seq` writeSmallArray es i (toAny e)

436 e `seq` writeSmallArray es i (toAny e)

436

437

437-- | Modify the data type in the environment (in place) and return a value.

438-- | Modify the data type in the environment (in place) and return a value.

438stateEnv

439stateEnv

439− :: forall e es adapter a. e :> es

440+ :: forall e adapter es a. e :> es

440 => Env es

441 => Env es

441 -> (adapter e -> (a, adapter e))

442 -> (adapter e -> (a, adapter e))

442 -> IO a

443 -> IO a

443stateEnv env f = do

444stateEnv env f = do

444− (i, es) <- getLocation (reifyIndex @e @es) env

445+ Location i es <- getLocation (reifyIndex @e @es) env

445 (a, e) <- f . fromAny <$> readSmallArray es i

446 (a, e) <- f . fromAny <$> readSmallArray es i

446 e `seq` writeSmallArray es i (toAny e)

447 e `seq` writeSmallArray es i (toAny e)

447 pure a

448 pure a

448

449

449-- | Modify the data type in the environment (in place).

450-- | Modify the data type in the environment (in place).

450modifyEnv

451modifyEnv

451− :: forall e es adapter. e :> es

452+ :: forall e adapter es. e :> es

452 => Env es

453 => Env es

453 -> (adapter e -> adapter e)

454 -> (adapter e -> adapter e)

454 -> IO ()

455 -> IO ()

455modifyEnv env f = do

456modifyEnv env f = do

456− (i, es) <- getLocation (reifyIndex @e @es) env

457+ Location i es <- getLocation (reifyIndex @e @es) env

457 e <- f . fromAny <$> readSmallArray es i

458 e <- f . fromAny <$> readSmallArray es i

458 e `seq` writeSmallArray es i (toAny e)

459 e `seq` writeSmallArray es i (toAny e)

459

460

@@ -469,13 +470,17 @@ emptyEnvRef = do

469 fs <- newSmallArray 0 undefinedData

470 fs <- newSmallArray 0 undefinedData

470 newIORef $ EnvRef 0 es fs

471 newIORef $ EnvRef 0 es fs

471

472

473+-- | Location with unboxed fields to make GHC generate Core without unnecessary

474+-- reboxing around the local 'go' function from 'getLocation'.

475+data Location = Location !Int !(SmallMutableArray RealWorld Any)

476+

472-- | Determine location of the data type in the environment.

477-- | Determine location of the data type in the environment.

473getLocation

478getLocation

474 :: Int

479 :: Int

475 -> Env es

480 -> Env es

476− -> IO (Int, SmallMutableArray RealWorld Any)

481+ -> IO Location

477getLocation ixE (Env fork ref _) = do

482getLocation ixE (Env fork ref _) = do

478− EnvRef n es _ <- readIORef ref

483+ EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref

479 -- Optimized for the common access pattern:

484 -- Optimized for the common access pattern:

480 --

485 --

481 -- - Most application code has no access to forks, in which case we look at

486 -- - Most application code has no access to forks, in which case we look at

@@ -484,25 +489,25 @@ getLocation ixE (Env fork ref _) = do

484 -- - Effect handlers will most likely access the newest fork with handler

489 -- - Effect handlers will most likely access the newest fork with handler

485 -- specific effects for reinterpretation.

490 -- specific effects for reinterpretation.

486 case fork of

491 case fork of

487− NoFork -> pure (ix n, es)

492+ NoFork -> pure $ Location (ix n) es

488 Forks _ baseIx lref forks -> do

493 Forks _ baseIx lref forks -> do

489 EnvRef ln les _ <- readIORef lref

494 EnvRef ln les _ <- readIORef lref

490 let i = ix (baseIx + ln)

495 let i = ix (baseIx + ln)

491 if i >= baseIx

496 if i >= baseIx

492− then pure (i - baseIx, les)

497+ then pure $ Location (i - baseIx) les

493− else go es i forks

498+ else go es# i forks

494 where

499 where

495− go :: SmallMutableArray RealWorld Any

500+ go :: SmallMutableArray# RealWorld Any

496 -> Int

501 -> Int

497 -> Forks

502 -> Forks

498− -> IO (Int, SmallMutableArray RealWorld Any)

503+ -> IO Location

499− go es i = \case

504+ go es# i = \case

500− NoFork -> pure (i, es)

505+ NoFork -> pure $ Location i (SmallMutableArray es#)

501 Forks _ baseIx lref forks -> do

506 Forks _ baseIx lref forks -> do

502 EnvRef _ les _ <- readIORef lref

507 EnvRef _ les _ <- readIORef lref

503 if i >= baseIx

508 if i >= baseIx

504− then pure (i - baseIx, les)

509+ then pure $ Location (i - baseIx) les

505− else go es i forks

510+ else go es# i forks

506

511

507 ix :: Int -> Int

512 ix :: Int -> Int

508 ix n = n - ixE - 1

513 ix n = n - ixE - 1

effectful-core/src/Effectful/Internal/Monad.hs+69−56

@@ -6,7 +6,7 @@

6-- This module is intended for internal use only, and may change without warning

7-- in subsequent releases.

8module Effectful.Internal.Monad

9− ( -- * Monad

9+ ( -- * The 'Eff' monad

10 Eff

11 , runPureEff

12

@@ -22,11 +22,11 @@ module Effectful.Internal.Monad

22 , IOE

23 , runEff

24

25− -- * Primitive

25+ -- * Prim

26 , Prim

27 , runPrim

28

29− -- ** Unlift strategies

29+ -- * Unlift strategies

30 , UnliftStrategy(..)

31 , Persistence(..)

32 , Limit(..)

@@ -34,34 +34,29 @@ module Effectful.Internal.Monad

34 , withUnliftStrategy

35 , withEffToIO

36

37− --- *** Low-level helpers

37+ -- ** Low-level unlifts

38 , seqUnliftIO

39 , concUnliftIO

40

41 -- * Effects

42

43− -- ** Handler

43+ -- ** Dynamic dispatch

44 , EffectHandler

45 , LocalEnv(..)

46 , HandlerA(..)

47− , runHandlerA

47+ , runHandler

48−

49− -- *** Sending operations

50 , send

48 , send

51

49

52− -- ** Primitive

50+ -- ** Static dispatch

53−

51+ , DataA(..)

54− -- *** Running

52+ , runData

55− , runEffect

53+ , evalData

56− , evalEffect

54+ , execData

57− , execEffect

55+ , getData

58−

56+ , putData

59− -- *** Modification

57+ , stateData

60− , getEffect

58+ , stateDataM

61− , putEffect

59+ , localData

62− , stateEffect

63− , stateEffectM

64− , localEffect

65 ) where

60 ) where

66

61

67import Control.Applicative (liftA2)

62import Control.Applicative (liftA2)

@@ -92,17 +87,16 @@ type role Eff nominal representational

92-- would have the following type:

87-- would have the following type:

93--

88--

94-- @

89-- @

95−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'

90+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'

96-- @

91-- @

97--

92--

98-- Normally, a concrete list of effects is not used to parameterize 'Eff'.

93-- Normally, a concrete list of effects is not used to parameterize 'Eff'.

99-- Instead, the '(:>)' type class is used to express constraints on the list of

94-- Instead, the '(:>)' type class is used to express constraints on the list of

100-- effects without coupling a computation to a concrete list of effects. For

95-- effects without coupling a computation to a concrete list of effects. For

101−-- example, the above example would more commonly be expressed with the

96+-- example, the above example would be expressed with the following type:

102−-- following type:

103--

97--

104-- @

98-- @

105−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'

99+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'

106-- @

100-- @

107--

101--

108-- This abstraction allows the computation to be used in functions that may

102-- This abstraction allows the computation to be used in functions that may

@@ -116,12 +110,12 @@ newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)

116-- For running computations with side effects see 'runEff'.

110-- For running computations with side effects see 'runEff'.

117runPureEff :: Eff '[] a -> a

111runPureEff :: Eff '[] a -> a

118runPureEff (Eff m) =

112runPureEff (Eff m) =

119− -- unsafePerformIO is safe here since IOE was not on the stack, so no IO with

113+ -- unsafeDupablePerformIO is safe here since IOE was not on the stack, so no

120− -- side effects was performed (unless someone sneakily introduced side effects

114+ -- IO with side effects was performed (unless someone sneakily introduced side

121− -- with unsafeEff, but then all bets are off).

115+ -- effects with unsafeEff, but then all bets are off).

122 --

116 --

123 -- Moreover, internals don't allocate any resources that require explicit

117 -- Moreover, internals don't allocate any resources that require explicit

124− -- cleanup actions to run, so the "Dupable" part should also be just fine.

118+ -- cleanup actions to run.

125 unsafeDupablePerformIO $ m =<< emptyEnv

119 unsafeDupablePerformIO $ m =<< emptyEnv

126

120

127----------------------------------------

121----------------------------------------

@@ -151,12 +145,12 @@ unsafeEff_ m = unsafeEff $ \_ -> m

151-- | Get the current 'UnliftStrategy'.

145-- | Get the current 'UnliftStrategy'.

152unliftStrategy :: IOE :> es => Eff es UnliftStrategy

146unliftStrategy :: IOE :> es => Eff es UnliftStrategy

153unliftStrategy = do

147unliftStrategy = do

154− IdA (IOE unlift) <- getEffect

148+ DataA (IOE unlift) <- getData

155 pure unlift

149 pure unlift

156

150

157-- | Locally override the 'UnliftStrategy' with the given value.

151-- | Locally override the 'UnliftStrategy' with the given value.

158withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a

152withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a

159−withUnliftStrategy unlift = localEffect $ \_ -> IdA (IOE unlift)

153+withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)

160

154

161-- | Create an unlifting function with the current 'UnliftStrategy'.

155-- | Create an unlifting function with the current 'UnliftStrategy'.

162--

156--

@@ -164,7 +158,7 @@ withUnliftStrategy unlift = localEffect $ \_ -> IdA (IOE unlift)

164-- constraint for accurate stack traces in case an insufficiently powerful

158-- constraint for accurate stack traces in case an insufficiently powerful

165-- 'UnliftStrategy' is used and the unlifting function fails.

159-- 'UnliftStrategy' is used and the unlifting function fails.

166--

160--

167−-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.

161+-- /Note:/ the strategy is reset to 'SeqUnlift' inside the continuation.

168withEffToIO

162withEffToIO

169 :: (HasCallStack, IOE :> es)

163 :: (HasCallStack, IOE :> es)

170 => ((forall r. Eff es r -> IO r) -> IO a)

164 => ((forall r. Eff es r -> IO r) -> IO a)

@@ -272,7 +266,7 @@ newtype IOE :: Effect where

272--

266--

273-- For running pure computations see 'runPureEff'.

267-- For running pure computations see 'runPureEff'.

274runEff :: Eff '[IOE] a -> IO a

268runEff :: Eff '[IOE] a -> IO a

275−runEff m = unEff (evalEffect (IdA (IOE SeqUnlift)) m) =<< emptyEnv

269+runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv

276

270

277instance IOE :> es => MonadIO (Eff es) where

271instance IOE :> es => MonadIO (Eff es) where

278 liftIO = unsafeEff_

272 liftIO = unsafeEff_

@@ -302,14 +296,14 @@ data Prim :: Effect where

302

296

303-- | Run an 'Eff' computation with primitive state-transformer actions.

297-- | Run an 'Eff' computation with primitive state-transformer actions.

304runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a

298runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a

305−runPrim = evalEffect (IdA Prim)

299+runPrim = evalData (DataA Prim)

306

300

307instance Prim :> es => PrimMonad (Eff es) where

301instance Prim :> es => PrimMonad (Eff es) where

308 type PrimState (Eff es) = RealWorld

302 type PrimState (Eff es) = RealWorld

309 primitive = unsafeEff_ . IO

303 primitive = unsafeEff_ . IO

310

304

311----------------------------------------

305----------------------------------------

312−-- Handler

306+-- Dynamic dispatch

313

307

314type role LocalEnv nominal nominal

308type role LocalEnv nominal nominal

315

309

@@ -333,13 +327,13 @@ type EffectHandler e es

333

327

334-- | An adapter for dynamically dispatched effects.

328-- | An adapter for dynamically dispatched effects.

335--

329--

336−-- Represents the effect handler bundled along with its environment.

330+-- Represents the effect handler bundled with its environment.

337data HandlerA :: Effect -> Type where

331data HandlerA :: Effect -> Type where

338 HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e

332 HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e

339

333

340−-- | Run the effect with the given handler.

334+-- | Run a dynamically dispatched effect with the given handler.

341−runHandlerA :: HandlerA e -> Eff (e : es) a -> Eff es a

335+runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a

342−runHandlerA e m = unsafeEff $ \es0 -> do

336+runHandler e m = unsafeEff $ \es0 -> do

343 size0 <- sizeEnv es0

337 size0 <- sizeEnv es0

344 E.bracket (unsafeConsEnv e relinker es0)

338 E.bracket (unsafeConsEnv e relinker es0)

345 (unsafeTailEnv size0)

339 (unsafeTailEnv size0)

@@ -357,46 +351,65 @@ send op = unsafeEff $ \es -> do

357 unEff (handle (LocalEnv es) op) handlerEs

351 unEff (handle (LocalEnv es) op) handlerEs

358

352

359----------------------------------------

353----------------------------------------

360−-- Helpers

354+-- Static dispatch

361

355

356+-- | An adapter for statically dispatched effects.

357+--

358+-- Represents an arbitrary data type with the appropriate number of phantom type

359+-- parameters.

360+newtype DataA :: Effect -> Type where

361+ DataA :: (forall m r. e m r) -> DataA e

362+

363+-- | Run a statically dispatched effect with the given initial state and return

364+-- the final value along with the final state.

362−runEffect :: adapter e -> Eff (e : es) a -> Eff es (a, adapter e)

365+runData :: DataA e -> Eff (e : es) a -> Eff es (a, DataA e)

363−runEffect e0 m = unsafeEff $ \es0 -> do

366+runData e0 m = unsafeEff $ \es0 -> do

364 size0 <- sizeEnv es0

367 size0 <- sizeEnv es0

365 E.bracket (unsafeConsEnv e0 noRelinker es0)

368 E.bracket (unsafeConsEnv e0 noRelinker es0)

366 (unsafeTailEnv size0)

369 (unsafeTailEnv size0)

367 (\es -> (,) <$> unEff m es <*> getEnv es)

370 (\es -> (,) <$> unEff m es <*> getEnv es)

368

371

372+-- | Run a statically dispatched effect with the given initial state and return

373+-- the final value, discarding the final state.

369−evalEffect :: adapter e -> Eff (e : es) a -> Eff es a

374+evalData :: DataA e -> Eff (e : es) a -> Eff es a

370−evalEffect e m = unsafeEff $ \es0 -> do

375+evalData e m = unsafeEff $ \es0 -> do

371 size0 <- sizeEnv es0

376 size0 <- sizeEnv es0

372 E.bracket (unsafeConsEnv e noRelinker es0)

377 E.bracket (unsafeConsEnv e noRelinker es0)

373 (unsafeTailEnv size0)

378 (unsafeTailEnv size0)

374 (\es -> unEff m es)

379 (\es -> unEff m es)

375

380

381+-- | Run a statically dispatched effect with the given initial state and return

382+-- the final state, discarding the final value.

376−execEffect :: adapter e -> Eff (e : es) a -> Eff es (adapter e)

383+execData :: DataA e -> Eff (e : es) a -> Eff es (DataA e)

377−execEffect e0 m = unsafeEff $ \es0 -> do

384+execData e0 m = unsafeEff $ \es0 -> do

378 size0 <- sizeEnv es0

385 size0 <- sizeEnv es0

379 E.bracket (unsafeConsEnv e0 noRelinker es0)

386 E.bracket (unsafeConsEnv e0 noRelinker es0)

380 (unsafeTailEnv size0)

387 (unsafeTailEnv size0)

381 (\es -> unEff m es *> getEnv es)

388 (\es -> unEff m es *> getEnv es)

382

389

383−getEffect :: e :> es => Eff es (adapter e)

390+-- | Fetch the current state of the effect.

391+getData :: e :> es => Eff es (DataA e)

384−getEffect = unsafeEff $ \es -> getEnv es

392+getData = unsafeEff $ \es -> getEnv es

385

393

386−putEffect :: e :> es => adapter e -> Eff es ()

394+-- | Set the current state of the effect to the given value.

395+putData :: e :> es => DataA e -> Eff es ()

387−putEffect e = unsafeEff $ \es -> putEnv es e

396+putData e = unsafeEff $ \es -> putEnv es e

388

397

389−stateEffect :: e :> es => (adapter e -> (a, adapter e)) -> Eff es a

398+-- | Apply the function to the current state of the effect and return a value.

399+stateData :: e :> es => (DataA e -> (a, DataA e)) -> Eff es a

390−stateEffect f = unsafeEff $ \es -> stateEnv es f

400+stateData f = unsafeEff $ \es -> stateEnv es f

391

401

402+-- | Apply the monadic function to the current state of the effect and return a

403+-- value.

392−stateEffectM :: e :> es => (adapter e -> Eff es (a, adapter e)) -> Eff es a

404+stateDataM :: e :> es => (DataA e -> Eff es (a, DataA e)) -> Eff es a

393−stateEffectM f = unsafeEff $ \es -> E.mask $ \release -> do

405+stateDataM f = unsafeEff $ \es -> E.mask $ \release -> do

394 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es

406 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es

395 putEnv es e

407 putEnv es e

396 pure a

408 pure a

397

409

410+-- | Execute a computation with a temporarily modified state of the effect.

398−localEffect :: e :> es => (adapter e -> adapter e) -> Eff es a -> Eff es a

411+localData :: e :> es => (DataA e -> DataA e) -> Eff es a -> Eff es a

399−localEffect f m = unsafeEff $ \es -> do

412+localData f m = unsafeEff $ \es -> do

400 E.bracket (stateEnv es $ \e -> (e, f e))

413 E.bracket (stateEnv es $ \e -> (e, f e))

401 (\e -> putEnv es e)

414 (\e -> putEnv es e)

402 (\_ -> unEff m es)

415 (\_ -> unEff m es)

effectful-core/src/Effectful/Reader.hs+3−3

@@ -20,12 +20,12 @@ runReader

20 :: r -- ^ An initial environment.

21 -> Eff (Reader r : es) a

22 -> Eff es a

23−runReader r = evalEffect (IdA (Reader r))

23+runReader r = evalData (DataA (Reader r))

24

25-- | Fetch the value of the environment.

26ask :: Reader r :> es => Eff es r

27ask = do

28− IdA (Reader r) <- getEffect

28+ DataA (Reader r) <- getData

29 pure r

30

31-- | Retrieve a function of the current environment.

@@ -46,4 +46,4 @@ local

46 => (r -> r) -- ^ The function to modify the environment.

47 -> Eff es a

48 -> Eff es a

49−local f = localEffect $ \(IdA (Reader r)) -> IdA (Reader (f r))

49+local f = localData $ \(DataA (Reader r)) -> DataA (Reader (f r))

effectful-core/src/Effectful/State/Local.hs+16−13

@@ -5,13 +5,12 @@

5--

6-- - very fast.

7--

8−-- /Note:/ unlike 'Control.Monad.Trans.State.StateT', the 'State' effect doesn't

8+-- /Note:/ unlike the 'Control.Monad.Trans.State.StateT' monad transformer from

9−-- lose state modifications in presence of runtime exceptions:

9+-- the @transformers@ library, the 'State' effect doesn't lose state

10−--

10+-- modifications when an exception is received:

11−-- >>> import Control.Exception (ErrorCall)

12−-- >>> import Control.Monad.Catch

13--

11--

14-- >>> import qualified Control.Monad.Trans.State.Strict as S

12-- >>> import qualified Control.Monad.Trans.State.Strict as S

13+--

15-- >>> :{

14-- >>> :{

16-- (`S.execStateT` "Hi") . handle (\(_::ErrorCall) -> pure ()) $ do

15-- (`S.execStateT` "Hi") . handle (\(_::ErrorCall) -> pure ()) $ do

17-- S.modify (++ " there!")

16-- S.modify (++ " there!")

@@ -53,7 +52,7 @@ runState

53 -> Eff (State s : es) a

52 -> Eff (State s : es) a

54 -> Eff es (a, s)

53 -> Eff es (a, s)

55runState s0 m = do

54runState s0 m = do

56− (a, IdA (State s)) <- runEffect (IdA (State s0)) m

55+ (a, DataA (State s)) <- runData (DataA (State s0)) m

57 pure (a, s)

56 pure (a, s)

58

57

59-- | Run a 'State' effect with the given initial state and return the final

58-- | Run a 'State' effect with the given initial state and return the final

@@ -62,7 +61,7 @@ evalState

62 :: s -- ^ An initial state.

61 :: s -- ^ An initial state.

63 -> Eff (State s : es) a

62 -> Eff (State s : es) a

64 -> Eff es a -- ^ A return value.

63 -> Eff es a -- ^ A return value.

65−evalState s = evalEffect (IdA (State s))

64+evalState s = evalData (DataA (State s))

66

65

67-- | Run a 'State' effect with the given initial state and return the final

66-- | Run a 'State' effect with the given initial state and return the final

68-- state, discarding the final value.

67-- state, discarding the final value.

@@ -71,13 +70,13 @@ execState

71 -> Eff (State s : es) a

70 -> Eff (State s : es) a

72 -> Eff es s

71 -> Eff es s

73execState s0 m = do

72execState s0 m = do

74− IdA (State s) <- execEffect (IdA (State s0)) m

73+ DataA (State s) <- execData (DataA (State s0)) m

75 pure s

74 pure s

76

75

77-- | Fetch the current value of the state.

76-- | Fetch the current value of the state.

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

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

79get = do

78get = do

80− IdA (State s) <- getEffect

79+ DataA (State s) <- getData

81 pure s

80 pure s

82

81

83-- | Get a function of the current state.

82-- | Get a function of the current state.

@@ -91,14 +90,14 @@ gets f = f <$> get

91

90

92-- | Set the current state to the given value.

91-- | Set the current state to the given value.

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

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

94−put s = putEffect (IdA (State s))

93+put s = putData (DataA (State s))

95

94

96-- | Apply the function to the current state and return a value.

95-- | Apply the function to the current state and return a value.

97state

96state

98 :: State s :> es

97 :: State s :> es

99 => (s -> (a, s)) -- ^ The function to modify the state.

98 => (s -> (a, s)) -- ^ The function to modify the state.

100 -> Eff es a

99 -> Eff es a

101−state f = stateEffect $ \(IdA (State s0)) -> let (a, s) = f s0 in (a, IdA (State s))

100+state f = stateData $ \(DataA (State s0)) -> let (a, s) = f s0 in (a, DataA (State s))

102

101

103-- | Apply the function to the current state.

102-- | Apply the function to the current state.

104--

103--

@@ -114,9 +113,9 @@ stateM

114 :: State s :> es

113 :: State s :> es

115 => (s -> Eff es (a, s)) -- ^ The function to modify the state.

114 => (s -> Eff es (a, s)) -- ^ The function to modify the state.

116 -> Eff es a

115 -> Eff es a

117−stateM f = stateEffectM $ \(IdA (State s0)) -> do

116+stateM f = stateDataM $ \(DataA (State s0)) -> do

118 (a, s) <- f s0

117 (a, s) <- f s0

119− pure (a, IdA (State s))

118+ pure (a, DataA (State s))

120

119

121-- | Apply the monadic function to the current state.

120-- | Apply the monadic function to the current state.

122--

121--

@@ -126,3 +125,7 @@ modifyM

126 => (s -> Eff es s) -- ^ The monadic function to modify the state.

125 => (s -> Eff es s) -- ^ The monadic function to modify the state.

127 -> Eff es ()

126 -> Eff es ()

128modifyM f = stateM (\s -> ((), ) <$> f s)

127modifyM f = stateM (\s -> ((), ) <$> f s)

128+

129+-- $setup

130+-- >>> import Control.Exception (ErrorCall)

131+-- >>> import Control.Monad.Catch

effectful-core/src/Effectful/State/Shared.hs+31−8

@@ -3,8 +3,27 @@

3-- - shared between multiple threads (if you want each thead to manage its own

4-- version of the value, see "Effectful.State.Local").

5--

6−-- - slower than "Effectful.State.Local".

6+-- - slightly slower than "Effectful.State.Local".

7--

8+-- /Note:/ unlike the 'Control.Monad.Trans.State.StateT' monad transformer from

9+-- the @transformers@ library, the 'State' effect doesn't lose state

10+-- modifications when an exception is received:

11+--

12+-- >>> import qualified Control.Monad.Trans.State.Strict as S

13+--

14+-- >>> :{

15+-- (`S.execStateT` "Hi") . handle (\(_::ErrorCall) -> pure ()) $ do

16+-- S.modify (++ " there!")

17+-- error "oops"

18+-- :}

19+-- "Hi"

20+--

21+-- >>> :{

22+-- runEff . execState "Hi" . handle (\(_::ErrorCall) -> pure ()) $ do

23+-- modify (++ " there!")

24+-- error "oops"

25+-- :}

26+-- "Hi there!"

8module Effectful.State.Shared

27module Effectful.State.Shared

9 ( State

28 ( State

10 , runState

29 , runState

@@ -33,7 +52,7 @@ newtype State s :: Effect where

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

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

34runState s m = do

53runState s m = do

35 v <- unsafeEff_ $ newMVar s

54 v <- unsafeEff_ $ newMVar s

36− a <- evalEffect (IdA (State v)) m

55+ a <- evalData (DataA (State v)) m

37 (a, ) <$> unsafeEff_ (readMVar v)

56 (a, ) <$> unsafeEff_ (readMVar v)

38

57

39-- | Run a 'State' effect with the given initial state and return the final

58-- | Run a 'State' effect with the given initial state and return the final

@@ -41,20 +60,20 @@ runState s m = do

41evalState :: s -> Eff (State s : es) a -> Eff es a

60evalState :: s -> Eff (State s : es) a -> Eff es a

42evalState s m = do

61evalState s m = do

43 v <- unsafeEff_ $ newMVar s

62 v <- unsafeEff_ $ newMVar s

44− evalEffect (IdA (State v)) m

63+ evalData (DataA (State v)) m

45

64

46-- | Run a 'State' effect with the given initial state and return the final

65-- | Run a 'State' effect with the given initial state and return the final

47-- state, discarding the final value.

66-- state, discarding the final value.

48execState :: s -> Eff (State s : es) a -> Eff es s

67execState :: s -> Eff (State s : es) a -> Eff es s

49execState s m = do

68execState s m = do

50 v <- unsafeEff_ $ newMVar s

69 v <- unsafeEff_ $ newMVar s

51− _ <- evalEffect (IdA (State v)) m

70+ _ <- evalData (DataA (State v)) m

52 unsafeEff_ $ readMVar v

71 unsafeEff_ $ readMVar v

53

72

54-- | Fetch the current value of the state.

73-- | Fetch the current value of the state.

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

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

56get = unsafeEff $ \es -> do

75get = unsafeEff $ \es -> do

57− IdA (State v) <- getEnv es

76+ DataA (State v) <- getEnv es

58 readMVar v

77 readMVar v

59

78

60-- | Get a function of the current state.

79-- | Get a function of the current state.

@@ -66,7 +85,7 @@ gets f = f <$> get

66-- | Set the current state to the given value.

85-- | Set the current state to the given value.

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

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

68put s = unsafeEff $ \es -> do

87put s = unsafeEff $ \es -> do

69− IdA (State v) <- getEnv es

88+ DataA (State v) <- getEnv es

70 modifyMVar_ v $ \_ -> s `seq` pure s

89 modifyMVar_ v $ \_ -> s `seq` pure s

71

90

72-- | Apply the function to the current state and return a value.

91-- | Apply the function to the current state and return a value.

@@ -74,7 +93,7 @@ put s = unsafeEff $ \es -> do

74-- /Note:/ this function gets an exclusive access to the state for its duration.

93-- /Note:/ this function gets an exclusive access to the state for its duration.

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

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

76state f = unsafeEff $ \es -> do

95state f = unsafeEff $ \es -> do

77− IdA (State v) <- getEnv es

96+ DataA (State v) <- getEnv es

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

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

79

98

80-- | Apply the function to the current state.

99-- | Apply the function to the current state.

@@ -90,7 +109,7 @@ modify f = state (\s -> ((), f s))

90-- /Note:/ this function gets an exclusive access to the state for its duration.

109-- /Note:/ this function gets an exclusive access to the state for its duration.

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

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

92stateM f = unsafeEff $ \es -> do

111stateM f = unsafeEff $ \es -> do

93− IdA (State v) <- getEnv es

112+ DataA (State v) <- getEnv es

94 modifyMVar v $ \s0 -> do

113 modifyMVar v $ \s0 -> do

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

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

96 s `seq` pure (s, a)

115 s `seq` pure (s, a)

@@ -102,3 +121,7 @@ stateM f = unsafeEff $ \es -> do

102-- /Note:/ this function gets an exclusive access to the state for its duration.

121-- /Note:/ this function gets an exclusive access to the state for its duration.

103modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()

122modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()

104modifyM f = stateM (\s -> ((), ) <$> f s)

123modifyM f = stateM (\s -> ((), ) <$> f s)

124+

125+-- $setup

126+-- >>> import Control.Exception (ErrorCall)

127+-- >>> import Control.Monad.Catch

effectful-core/src/Effectful/Writer/Local.hs+24−9

@@ -24,7 +24,7 @@ module Effectful.Writer.Local

24 , listens

25 ) where

26

27−import Control.Exception

27+import Control.Exception (onException, mask)

28

29import Effectful.Dispatch.Static

30import Effectful.Monad

@@ -38,35 +38,46 @@ newtype Writer w :: Effect where

38-- output.

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

40runWriter m = do

41− (a, IdA (Writer w)) <- runEffect (IdA (Writer mempty)) m

41+ (a, DataA (Writer w)) <- runData (DataA (Writer mempty)) m

42 pure (a, w)

43

44-- | Run a 'Writer' effect and return the final output, discarding the final

45-- value.

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

47execWriter m = do

48− IdA (Writer w) <- execEffect (IdA (Writer mempty)) m

48+ DataA (Writer w) <- execData (DataA (Writer mempty)) m

49 pure w

50

51-- | Append the given output to the overall output of the 'Writer'.

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

53−tell w = stateEffect $ \(IdA (Writer w0)) -> ((), IdA (Writer (w0 <> w)))

53+tell w = stateData $ \(DataA (Writer w0)) -> ((), DataA (Writer (w0 <> w)))

54

55-- | Execute an action and append its output to the overall output of the

56-- 'Writer'.

57--

58−-- /Note:/ if a runtime exception is received while the action is executed, the

58+-- /Note:/ if an exception is received while the action is executed, the partial

59−-- partial output of the action will still be appended to the overall output of

59+-- output of the action will still be appended to the overall output of the

60−-- the 'Writer'.

60+-- 'Writer':

61+--

62+-- >>> :{

63+-- runEff . execWriter @String $ do

64+-- tell "Hi"

65+-- handle (\(_::ErrorCall) -> pure ((), "")) $ do

66+-- tell " there"

67+-- listen $ do

68+-- tell "!"

69+-- error "oops"

70+-- :}

71+-- "Hi there!"

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

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

62listen m = unsafeEff $ \es -> mask $ \restore -> do

73listen m = unsafeEff $ \es -> mask $ \restore -> do

63− w0 <- stateEnv es $ \(IdA (Writer w)) -> (w, IdA (Writer mempty))

74+ w0 <- stateEnv es $ \(DataA (Writer w)) -> (w, DataA (Writer mempty))

64 a <- restore (unEff m es) `onException` merge es w0

75 a <- restore (unEff m es) `onException` merge es w0

65 (a, ) <$> merge es w0

76 (a, ) <$> merge es w0

66 where

77 where

67 merge es w0 =

78 merge es w0 =

68 -- If an exception is thrown, restore w0 and keep parts of w1.

79 -- If an exception is thrown, restore w0 and keep parts of w1.

69− stateEnv es $ \(IdA (Writer w1)) -> (w1, IdA (Writer (w0 <> w1)))

80+ stateEnv es $ \(DataA (Writer w1)) -> (w1, DataA (Writer (w0 <> w1)))

70

81

71-- | Execute an action and append its output to the overall output of the

82-- | Execute an action and append its output to the overall output of the

72-- 'Writer', then return the final value along with a function of the recorded

83-- 'Writer', then return the final value along with a function of the recorded

@@ -77,3 +88,7 @@ listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)

77listens f m = do

88listens f m = do

78 (a, w) <- listen m

89 (a, w) <- listen m

79 pure (a, f w)

90 pure (a, f w)

91+

92+-- $setup

93+-- >>> import Control.Exception (ErrorCall)

94+-- >>> import Control.Monad.Catch

effectful-core/src/Effectful/Writer/Shared.hs+25−10

@@ -3,7 +3,7 @@

3-- - shared between multiple threads (if you want each thead to manage its own

4-- version of the value, see "Effectful.Writer.Local").

5--

6−-- - slower than "Effectful.Writer.Local".

6+-- - slightly slower than "Effectful.Writer.Local".

7--

8-- /Warning:/ 'Writer'\'s state will be accumulated via __left-associated__ uses

9-- of '<>', which makes it unsuitable for use with types for which such pattern

@@ -25,7 +25,7 @@ module Effectful.Writer.Shared

25 ) where

26

27import Control.Concurrent.MVar

28−import Control.Exception

28+import Control.Exception (onException, uninterruptibleMask)

29

30import Effectful.Dispatch.Static

31import Effectful.Monad

@@ -39,7 +39,7 @@ newtype Writer w :: Effect where

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

40runWriter m = do

41 v <- unsafeEff_ $ newMVar mempty

42− a <- evalEffect (IdA (Writer v)) m

42+ a <- evalData (DataA (Writer v)) m

43 (a, ) <$> unsafeEff_ (readMVar v)

44

45-- | Run a 'Writer' effect and return the final output, discarding the final

@@ -47,21 +47,32 @@ runWriter m = do

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

48execWriter m = do

49 v <- unsafeEff_ $ newMVar mempty

50− _ <- evalEffect (IdA (Writer v)) m

50+ _ <- evalData (DataA (Writer v)) m

51 unsafeEff_ $ readMVar v

52

53-- | Append the given output to the overall output of the 'Writer'.

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

55tell w1 = unsafeEff $ \es -> do

56− IdA (Writer v) <- getEnv es

56+ DataA (Writer v) <- getEnv es

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

58

59-- | Execute an action and append its output to the overall output of the

60-- 'Writer'.

61--

62−-- /Note:/ if a runtime exception is received while the action is executed, the

62+-- /Note:/ if an exception is received while the action is executed, the partial

63−-- partial output of the action will still be appended to the overall output of

63+-- output of the action will still be appended to the overall output of the

64−-- the 'Writer'.

64+-- 'Writer':

65+--

66+-- >>> :{

67+-- runEff . execWriter @String $ do

68+-- tell "Hi"

69+-- handle (\(_::ErrorCall) -> pure ((), "")) $ do

70+-- tell " there"

71+-- listen $ do

72+-- tell "!"

73+-- error "oops"

74+-- :}

75+-- "Hi there!"

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

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

66listen m = unsafeEff $ \es -> do

77listen m = unsafeEff $ \es -> do

67 -- The mask is uninterruptible because modifyMVar_ v0 in the merge function

78 -- The mask is uninterruptible because modifyMVar_ v0 in the merge function

@@ -70,14 +81,14 @@ listen m = unsafeEff $ \es -> do

70 uninterruptibleMask $ \restore -> do

81 uninterruptibleMask $ \restore -> do

71 v1 <- newMVar mempty

82 v1 <- newMVar mempty

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

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

73− v0 <- stateEnv es $ \(IdA (Writer v)) -> (v, IdA (Writer v1))

84+ v0 <- stateEnv es $ \(DataA (Writer v)) -> (v, DataA (Writer v1))

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

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

75 (a, ) <$> merge es v0 v1

86 (a, ) <$> merge es v0 v1

76 where

87 where

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

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

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

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

79 merge es v0 v1 = do

90 merge es v0 v1 = do

80− putEnv es $ IdA (Writer v0)

91+ putEnv es $ DataA (Writer v0)

81 w1 <- readMVar v1

92 w1 <- readMVar v1

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

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

83 pure w1

94 pure w1

@@ -91,3 +102,7 @@ listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)

91listens f m = do

102listens f m = do

92 (a, w) <- listen m

103 (a, w) <- listen m

93 pure (a, f w)

104 pure (a, f w)

105+

106+-- $setup

107+-- >>> import Control.Exception (ErrorCall)

108+-- >>> import Control.Monad.Catch

effectful/bench/Main.hs+3−3

@@ -97,11 +97,11 @@ filesize n = bgroup (show n)

97#ifdef VERSION_eff

98 , bench "eff" $ nfAppIO eff_calculateFileSizesDeep (take n files)

99#endif

100−#ifdef VERSION_polysemy

101− , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)

102−#endif

103#ifdef VERSION_mtl

100#ifdef VERSION_mtl

104 , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)

101 , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)

102+#endif

103+#ifdef VERSION_polysemy

104+ , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)

105#endif

106 ]

107 ]

effectful/effectful.cabal+1−1

@@ -20,7 +20,7 @@ description: An easy to use, performant extensible effects library with seamless

20

21extra-source-files: CHANGELOG.md

22

23−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1

23+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1

24

25bug-reports: https://github.com/arybczak/effectful/issues

26source-repository head

effectful/src/Effectful/Concurrent/Effect.hs+1−1

@@ -72,7 +72,7 @@ data Concurrent :: Effect where

72

73-- | Run the 'Concurrent' effect.

74runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a

75−runConcurrent = evalEffect (IdA Concurrent)

75+runConcurrent = evalData (DataA Concurrent)

76

77-- $setup

78-- >>> import Effectful.Concurrent

effectful/src/Effectful/Environment.hs+1−1

@@ -28,7 +28,7 @@ data Environment :: Effect where

28

29-- | Run the 'Environment' effect.

30runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a

31−runEnvironment = evalEffect (IdA Environment)

31+runEnvironment = evalData (DataA Environment)

32

33-- | Lifted 'E.getArgs'.

34getArgs :: Environment :> es => Eff es [String]

effectful/src/Effectful/FileSystem.hs+1−1

@@ -100,7 +100,7 @@ data FileSystem :: Effect where

100

101-- | Run the 'FileSystem' effect.

102runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a

103−runFileSystem = evalEffect (IdA FileSystem)

103+runFileSystem = evalData (DataA FileSystem)

104

105----------------------------------------

106-- Actions on directories

effectful/src/Effectful/FileSystem/Effect.hs+1−1

@@ -12,4 +12,4 @@ data FileSystem :: Effect where

12

13-- | Run the 'FileSystem' effect.

14runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a

15−runFileSystem = evalEffect (IdA FileSystem)

15+runFileSystem = evalData (DataA FileSystem)

effectful/src/Effectful/Process.hs+1−1

@@ -58,7 +58,7 @@ data Process :: Effect where

58 Process :: Process m r

59

60runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a

61−runProcess = evalEffect (IdA Process)

61+runProcess = evalData (DataA Process)

62

63----------------------------------------

64-- Running sub-processes

effectful/src/Effectful/Resource.hs+4−4

@@ -37,7 +37,7 @@ runResource m = unsafeEff $ \es0 -> do

37 size0 <- sizeEnv es0

38 istate <- R.createInternalState

39 mask $ \restore -> do

40− es <- unsafeConsEnv (IdA (Resource istate)) noRelinker es0

40+ es <- unsafeConsEnv (DataA (Resource istate)) noRelinker es0

41 a <- restore (unEff m es) `catch` \e -> do

42 unsafeTailEnv size0 es

43 RI.stateCleanupChecked (Just e) istate

@@ -52,18 +52,18 @@ runResource m = unsafeEff $ \es0 -> do

52-- | Get the 'R.InternalState' of the current 'Resource' effect.

53getInternalState :: Resource :> es => Eff es R.InternalState

54getInternalState = do

55− IdA (Resource istate) <- getEffect

55+ DataA (Resource istate) <- getData

56 pure istate

57

58-- | Run the 'Resource' effect with existing 'R.InternalState'.

59--

60-- /Note:/ the 'R.InternalState' will not be closed at the end.

61runInternalState :: R.InternalState -> Eff (Resource : es) a -> Eff es a

62−runInternalState istate = evalEffect $ IdA (Resource istate)

62+runInternalState istate = evalData (DataA (Resource istate))

63

64----------------------------------------

65-- Orphan instance

66

67instance (IOE :> es, Resource :> es) => R.MonadResource (Eff es) where

68 liftResourceT (RI.ResourceT m) = unsafeEff $ \es -> do

69− getEnv es >>= \(IdA (Resource istate)) -> m istate

69+ getEnv es >>= \(DataA (Resource istate)) -> m istate

effectful/src/Effectful/Temporary.hs+1−1

@@ -19,7 +19,7 @@ data Temporary :: Effect where

19

20-- | Run the 'Temporary' effect.

21runTemporary :: IOE :> es => Eff (Temporary : es) a -> Eff es a

22−runTemporary = evalEffect (IdA Temporary)

22+runTemporary = evalData (DataA Temporary)

23

24-- | Lifted 'T.withSystemTempFile'.

25withSystemTempFile

effectful/src/Effectful/Timeout.hs+1−1

@@ -15,7 +15,7 @@ data Timeout :: Effect where

15

16-- | Run the 'Timeout' effect.

17runTimeout :: IOE :> es => Eff (Timeout : es) a -> Eff es a

18−runTimeout = evalEffect (IdA Timeout)

18+runTimeout = evalData (DataA Timeout)

19

20-- | Lifted 'T.timeout'.

21timeout