master..bf25f34 · effectful

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

since splitsnapshots

unifiedsplit

@@ -37,6 +37,11 @@ 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

40 - compiler: ghc-8.10.7

45 - compiler: ghc-8.10.7

41 compilerKind: ghc

46 compilerKind: ghc

42 compilerVersion: 8.10.7

47 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 state

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

24− modifications).

24+ discarded state).

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

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

22

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

24source-repository head

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

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

32 ) where

33

34import Control.Monad.IO.Unlift

35−import Data.Kind

35+import GHC.Stack

36−import GHC.Stack (HasCallStack)

37

36

38import Effectful.Internal.Effect

37import Effectful.Internal.Effect

39import Effectful.Internal.Env

38import Effectful.Internal.Env

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

50 -> Eff es a

49 -> Eff es a

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

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

52 les <- forkEnv es

51 les <- forkEnv es

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

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

54

53

55-- | Interpret an effect using other effects.

54-- | Interpret an effect using other effects.

56reinterpret

55reinterpret

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

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

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

64 les0 <- forkEnv es

63 les0 <- forkEnv es

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

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

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

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

67

66

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

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

69-- Unlifts

68-- Unlifts

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

231 SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_

230 SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_

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

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

233

232

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−

245-- $setup

233-- $setup

246-- >>> import Control.Concurrent

234-- >>> import Control.Concurrent

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

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

1module Effectful.Dispatch.Static

2 ( -- * Low level API

3− DataA(..)

3+ IdA(..)

4

5− -- ** Extending the environment

5+ -- ** Running

6− , runData

6+ , runEffect

7− , evalData

7+ , evalEffect

8− , execData

8+ , execEffect

9

10− -- ** Data retrieval and update

10+ -- ** Modification

11− , getData

11+ , getEffect

12− , putData

12+ , putEffect

13− , stateData

13+ , stateEffect

14− , stateDataM

14+ , stateEffectM

15− , localData

15+ , localEffect

16

17 -- ** Unlifts

18 , seqUnliftIO

19 , concUnliftIO

20

21− -- ** Utils

22− , unEff

23− , unsafeEff

24− , unsafeEff_

25− , unsafeLiftMapIO

26− , unsafeUnliftIO

27−

28 -- * Primitive API

21 -- * Primitive API

29 , Env

22 , Env

30 , Relinker(..)

23 , Relinker(..)

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

46 , putEnv

39 , putEnv

47 , stateEnv

40 , stateEnv

48 , modifyEnv

41 , modifyEnv

42+

43+ -- * Unsafe 'Eff' operations

44+ , unsafeEff

45+ , unsafeEff_

46+ , unsafeLiftMapIO

47+ , unsafeUnliftIO

48+

49+ -- * Utils

50+ , unEff

49 ) where

51 ) where

50

52

53+import Effectful.Internal.Effect

51import Effectful.Internal.Env

54import Effectful.Internal.Env

52import Effectful.Internal.Monad

55import Effectful.Internal.Monad

53

56

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

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

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

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

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

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

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

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

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

6--

8--

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

35-- Cleaning up.

37-- Cleaning up.

36-- Left "oops"

38-- Left "oops"

37--

39--

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.

70module Effectful.Error

40module Effectful.Error

71 ( Error

41 ( Error

72 , runError

42 , runError

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

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

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

103 eid <- newErrorId

73 eid <- newErrorId

104 size0 <- sizeEnv es0

74 size0 <- sizeEnv es0

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

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

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

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

107 unsafeTailEnv size0 es

77 unsafeTailEnv size0 es

108 pure r

78 pure r

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

119 -- ^ The error.

89 -- ^ The error.

120 -> Eff es a

90 -> Eff es a

121throwError e = unsafeEff $ \es -> do

91throwError e = unsafeEff $ \es -> do

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

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

123 throwIO $ ErrorEx eid callStack e

93 throwIO $ ErrorEx eid callStack e

124

94

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

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

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

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

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

132 -> Eff es a

102 -> Eff es a

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

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

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

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

135 size <- sizeEnv es

105 size <- sizeEnv es

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

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

137 checkSizeEnv size es

107 checkSizeEnv size es

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

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

8module Effectful.Internal.Effect

9 ( Effect

10 , (:>)(..)

11+ , IdA(..)

12+

13+ -- * Utils

14+ , SuffixOf

11

15

12 -- * Re-exports

16 -- * Re-exports

13 , Type

17 , Type

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

19-- | The kind of effects.

23-- | The kind of effects.

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

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

21

25

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

27+newtype IdA :: Effect -> Type where

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

29+

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

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

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

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

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

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

@@ -28,7 +36,7 @@ type Effect = (Type -> Type) -> Type -> Type

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

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

29--

37--

30-- @

38-- @

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

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

32-- @

40-- @

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

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

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

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

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

51

59

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

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

53 reifyIndex = 1 + reifyIndex @e @es

61 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+20−25

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

1−{-# LANGUAGE MagicHash #-}

2{-# OPTIONS_HADDOCK not-home #-}

1{-# OPTIONS_HADDOCK not-home #-}

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

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

4--

3--

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

43import Control.Monad.Primitive

42import Control.Monad.Primitive

44import Data.IORef

43import Data.IORef

45import Data.Primitive.SmallArray

44import Data.Primitive.SmallArray

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

45+import GHC.Exts (Any)

47import GHC.Stack (HasCallStack)

46import GHC.Stack (HasCallStack)

48import Unsafe.Coerce

47import Unsafe.Coerce

49import qualified Data.IntMap.Strict as IM

48import qualified Data.IntMap.Strict as IM

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

418

417

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

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

420getEnv

419getEnv

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

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

422 => Env es

421 => Env es

423 -> IO (adapter e)

422 -> IO (adapter e)

424getEnv env = do

423getEnv env = do

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

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

426 fromAny <$> readSmallArray es i

425 fromAny <$> readSmallArray es i

427

426

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

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

429putEnv

428putEnv

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

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

431 => Env es

430 => Env es

432 -> adapter e

431 -> adapter e

433 -> IO ()

432 -> IO ()

434putEnv env e = do

433putEnv env e = do

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

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

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

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

437

436

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

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

439stateEnv

438stateEnv

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

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

441 => Env es

440 => Env es

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

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

443 -> IO a

442 -> IO a

444stateEnv env f = do

443stateEnv env f = do

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

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

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

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

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

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

448 pure a

447 pure a

449

448

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

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

451modifyEnv

450modifyEnv

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

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

453 => Env es

452 => Env es

454 -> (adapter e -> adapter e)

453 -> (adapter e -> adapter e)

455 -> IO ()

454 -> IO ()

456modifyEnv env f = do

455modifyEnv env f = do

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

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

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

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

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

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

460

459

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

470 fs <- newSmallArray 0 undefinedData

469 fs <- newSmallArray 0 undefinedData

471 newIORef $ EnvRef 0 es fs

470 newIORef $ EnvRef 0 es fs

472

471

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−

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

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

478getLocation

473getLocation

479 :: Int

474 :: Int

480 -> Env es

475 -> Env es

481− -> IO Location

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

482getLocation ixE (Env fork ref _) = do

477getLocation ixE (Env fork ref _) = do

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

478+ EnvRef n es _ <- readIORef ref

484 -- Optimized for the common access pattern:

479 -- Optimized for the common access pattern:

485 --

480 --

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

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

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

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

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

490 -- specific effects for reinterpretation.

485 -- specific effects for reinterpretation.

491 case fork of

486 case fork of

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

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

493 Forks _ baseIx lref forks -> do

488 Forks _ baseIx lref forks -> do

494 EnvRef ln les _ <- readIORef lref

489 EnvRef ln les _ <- readIORef lref

495 let i = ix (baseIx + ln)

490 let i = ix (baseIx + ln)

496 if i >= baseIx

491 if i >= baseIx

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

492+ then pure (i - baseIx, les)

498− else go es# i forks

493+ else go es i forks

499 where

494 where

500− go :: SmallMutableArray# RealWorld Any

495+ go :: SmallMutableArray RealWorld Any

501 -> Int

496 -> Int

502 -> Forks

497 -> Forks

503− -> IO Location

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

504− go es# i = \case

499+ go es i = \case

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

500+ NoFork -> pure (i, es)

506 Forks _ baseIx lref forks -> do

501 Forks _ baseIx lref forks -> do

507 EnvRef _ les _ <- readIORef lref

502 EnvRef _ les _ <- readIORef lref

508 if i >= baseIx

503 if i >= baseIx

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

504+ then pure (i - baseIx, les)

510− else go es# i forks

505+ else go es i forks

511

506

512 ix :: Int -> Int

507 ix :: Int -> Int

513 ix n = n - ixE - 1

508 ix n = n - ixE - 1

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

@@ -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− ( -- * The 'Eff' monad

9+ ( -- * Monad

10 Eff

11 , runPureEff

12

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

22 , IOE

23 , runEff

24

25− -- * Prim

25+ -- * Primitive

26 , Prim

27 , runPrim

28

29− -- * Unlift strategies

29+ -- ** Unlift strategies

30 , UnliftStrategy(..)

31 , Persistence(..)

32 , Limit(..)

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

34 , withUnliftStrategy

35 , withEffToIO

36

37− -- ** Low-level unlifts

37+ --- *** Low-level helpers

38 , seqUnliftIO

39 , concUnliftIO

40

41 -- * Effects

42

43− -- ** Dynamic dispatch

43+ -- ** Handler

44 , EffectHandler

45 , LocalEnv(..)

46 , HandlerA(..)

47− , runHandler

47+ , runHandlerA

48+

49+ -- *** Sending operations

48 , send

50 , send

49

51

50− -- ** Static dispatch

52+ -- ** Primitive

51− , DataA(..)

53+

52− , runData

54+ -- *** Running

53− , evalData

55+ , runEffect

54− , execData

56+ , evalEffect

55− , getData

57+ , execEffect

56− , putData

58+

57− , stateData

59+ -- *** Modification

58− , stateDataM

60+ , getEffect

59− , localData

61+ , putEffect

62+ , stateEffect

63+ , stateEffectM

64+ , localEffect

60 ) where

65 ) where

61

66

62import Control.Applicative (liftA2)

67import Control.Applicative (liftA2)

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

87-- would have the following type:

92-- would have the following type:

88--

93--

89-- @

94-- @

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

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

91-- @

96-- @

92--

97--

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

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

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

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

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

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

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

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

102+-- following type:

97--

103--

98-- @

104-- @

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

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

100-- @

106-- @

101--

107--

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

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

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

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

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

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

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

112runPureEff (Eff m) =

118runPureEff (Eff m) =

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

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

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

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

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

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

116 --

122 --

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

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

118− -- cleanup actions to run.

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

119 unsafeDupablePerformIO $ m =<< emptyEnv

125 unsafeDupablePerformIO $ m =<< emptyEnv

120

126

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

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

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

145-- | Get the current 'UnliftStrategy'.

151-- | Get the current 'UnliftStrategy'.

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

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

147unliftStrategy = do

153unliftStrategy = do

148− DataA (IOE unlift) <- getData

154+ IdA (IOE unlift) <- getEffect

149 pure unlift

155 pure unlift

150

156

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

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

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

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

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

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

154

160

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

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

156--

162--

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

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

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

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

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

160--

166--

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

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

162withEffToIO

168withEffToIO

163 :: (HasCallStack, IOE :> es)

169 :: (HasCallStack, IOE :> es)

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

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

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

266--

272--

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

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

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

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

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

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

270

276

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

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

272 liftIO = unsafeEff_

278 liftIO = unsafeEff_

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

296

302

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

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

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

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

299−runPrim = evalData (DataA Prim)

305+runPrim = evalEffect (IdA Prim)

300

306

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

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

302 type PrimState (Eff es) = RealWorld

308 type PrimState (Eff es) = RealWorld

303 primitive = unsafeEff_ . IO

309 primitive = unsafeEff_ . IO

304

310

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

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

306−-- Dynamic dispatch

312+-- Handler

307

313

308type role LocalEnv nominal nominal

314type role LocalEnv nominal nominal

309

315

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

327

333

328-- | An adapter for dynamically dispatched effects.

334-- | An adapter for dynamically dispatched effects.

329--

335--

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

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

331data HandlerA :: Effect -> Type where

337data HandlerA :: Effect -> Type where

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

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

333

339

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

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

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

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

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

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

337 size0 <- sizeEnv es0

343 size0 <- sizeEnv es0

338 E.bracket (unsafeConsEnv e relinker es0)

344 E.bracket (unsafeConsEnv e relinker es0)

339 (unsafeTailEnv size0)

345 (unsafeTailEnv size0)

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

351 unEff (handle (LocalEnv es) op) handlerEs

357 unEff (handle (LocalEnv es) op) handlerEs

352

358

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

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

354−-- Static dispatch

360+-- Helpers

355

361

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.

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

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

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

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

367 size0 <- sizeEnv es0

364 size0 <- sizeEnv es0

368 E.bracket (unsafeConsEnv e0 noRelinker es0)

365 E.bracket (unsafeConsEnv e0 noRelinker es0)

369 (unsafeTailEnv size0)

366 (unsafeTailEnv size0)

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

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

371

368

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

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

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

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

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

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

376 size0 <- sizeEnv es0

371 size0 <- sizeEnv es0

377 E.bracket (unsafeConsEnv e noRelinker es0)

372 E.bracket (unsafeConsEnv e noRelinker es0)

378 (unsafeTailEnv size0)

373 (unsafeTailEnv size0)

379 (\es -> unEff m es)

374 (\es -> unEff m es)

380

375

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

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

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

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

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

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

385 size0 <- sizeEnv es0

378 size0 <- sizeEnv es0

386 E.bracket (unsafeConsEnv e0 noRelinker es0)

379 E.bracket (unsafeConsEnv e0 noRelinker es0)

387 (unsafeTailEnv size0)

380 (unsafeTailEnv size0)

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

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

389

382

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

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

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

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

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

393

385

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

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

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

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

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

397

388

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

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

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

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

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

401

391

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

403−-- value.

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

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

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

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

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

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

407 putEnv es e

395 putEnv es e

408 pure a

396 pure a

409

397

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

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

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

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

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

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

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

414 (\e -> putEnv es e)

401 (\e -> putEnv es e)

415 (\_ -> unEff m es)

402 (\_ -> 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 = evalData (DataA (Reader r))

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

24

25-- | Fetch the value of the environment.

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

27ask = do

28− DataA (Reader r) <- getData

28+ IdA (Reader r) <- getEffect

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 = localData $ \(DataA (Reader r)) -> DataA (Reader (f r))

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

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

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

52 -> Eff (State s : es) a

53 -> Eff es (a, s)

54runState s0 m = do

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

55+ (a, IdA (State s)) <- runEffect (IdA (State s0)) m

56 pure (a, s)

57

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

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

61 :: s -- ^ An initial state.

62 -> Eff (State s : es) a

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

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

64+evalState s = evalEffect (IdA (State s))

65

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

67-- state, discarding the final value.

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

70 -> Eff (State s : es) a

71 -> Eff es s

72execState s0 m = do

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

73+ IdA (State s) <- execEffect (IdA (State s0)) m

74 pure s

75

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

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

78get = do

79− DataA (State s) <- getData

79+ IdA (State s) <- getEffect

80 pure s

81

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

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

90

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

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

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

93+put s = putEffect (IdA (State s))

94

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

96state

97 :: State s :> es

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

99 -> Eff es a

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

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

101

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

103--

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

113 :: State s :> es

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

115 -> Eff es a

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

116+stateM f = stateEffectM $ \(IdA (State s0)) -> do

117 (a, s) <- f s0

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

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

119

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

121--

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

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

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−-- - slightly slower than "Effectful.State.Local".

6+-- - 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!"

27module Effectful.State.Shared

8module Effectful.State.Shared

28 ( State

9 ( State

29 , runState

10 , runState

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

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

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

53runState s m = do

34runState s m = do

54 v <- unsafeEff_ $ newMVar s

35 v <- unsafeEff_ $ newMVar s

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

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

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

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

57

38

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

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

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

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

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

61evalState s m = do

42evalState s m = do

62 v <- unsafeEff_ $ newMVar s

43 v <- unsafeEff_ $ newMVar s

63− evalData (DataA (State v)) m

44+ evalEffect (IdA (State v)) m

64

45

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

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

66-- state, discarding the final value.

47-- state, discarding the final value.

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

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

68execState s m = do

49execState s m = do

69 v <- unsafeEff_ $ newMVar s

50 v <- unsafeEff_ $ newMVar s

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

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

71 unsafeEff_ $ readMVar v

52 unsafeEff_ $ readMVar v

72

53

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

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

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

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

75get = unsafeEff $ \es -> do

56get = unsafeEff $ \es -> do

76− DataA (State v) <- getEnv es

57+ IdA (State v) <- getEnv es

77 readMVar v

58 readMVar v

78

59

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

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

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

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

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

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

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

87put s = unsafeEff $ \es -> do

68put s = unsafeEff $ \es -> do

88− DataA (State v) <- getEnv es

69+ IdA (State v) <- getEnv es

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

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

90

71

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

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

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

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

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

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

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

95state f = unsafeEff $ \es -> do

76state f = unsafeEff $ \es -> do

96− DataA (State v) <- getEnv es

77+ IdA (State v) <- getEnv es

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

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

98

79

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

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

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

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

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

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

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

111stateM f = unsafeEff $ \es -> do

92stateM f = unsafeEff $ \es -> do

112− DataA (State v) <- getEnv es

93+ IdA (State v) <- getEnv es

113 modifyMVar v $ \s0 -> do

94 modifyMVar v $ \s0 -> do

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

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

115 s `seq` pure (s, a)

96 s `seq` pure (s, a)

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

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

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

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

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

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

104modifyM 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+9−9

@@ -38,26 +38,26 @@ newtype Writer w :: Effect where

38-- output.

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

40runWriter m = do

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

41+ (a, IdA (Writer w)) <- runEffect (IdA (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− DataA (Writer w) <- execData (DataA (Writer mempty)) m

48+ IdA (Writer w) <- execEffect (IdA (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 = stateData $ \(DataA (Writer w0)) -> ((), DataA (Writer (w0 <> w)))

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

54

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

56-- 'Writer'.

57--

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

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

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

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

60−-- 'Writer':

60+-- the 'Writer':

61--

62-- >>> :{

63-- runEff . execWriter @String $ do

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

71-- "Hi there!"

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

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

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

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

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

76 (a, ) <$> merge es w0

77 where

78 merge es w0 =

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

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

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

81

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

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

@@ -90,5 +90,5 @@ listens f m = do

90 pure (a, f w)

91

92-- $setup

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

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

93-- >>> import Control.Monad.Catch

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

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

@@ -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−-- - slightly slower than "Effectful.Writer.Local".

6+-- - 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 (onException, uninterruptibleMask)

28+import Control.Exception

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 <- evalData (DataA (Writer v)) m

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

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

44

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

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

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

48execWriter m = do

49 v <- unsafeEff_ $ newMVar mempty

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

50+ _ <- evalEffect (IdA (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− DataA (Writer v) <- getEnv es

56+ IdA (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 an exception is received while the action is executed, the partial

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

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

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

64−-- 'Writer':

64+-- the '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!"

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

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

77listen m = unsafeEff $ \es -> do

66listen m = unsafeEff $ \es -> do

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

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

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

81 uninterruptibleMask $ \restore -> do

70 uninterruptibleMask $ \restore -> do

82 v1 <- newMVar mempty

71 v1 <- newMVar mempty

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

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

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

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

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

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

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

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

87 where

76 where

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

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

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

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

90 merge es v0 v1 = do

79 merge es v0 v1 = do

91− putEnv es $ DataA (Writer v0)

80+ putEnv es $ IdA (Writer v0)

92 w1 <- readMVar v1

81 w1 <- readMVar v1

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

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

94 pure w1

83 pure w1

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

102listens f m = do

91listens f m = do

103 (a, w) <- listen m

92 (a, w) <- listen m

104 pure (a, f w)

93 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_mtl

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

102−#endif

103#ifdef VERSION_polysemy

100#ifdef VERSION_polysemy

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

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

102+#endif

103+#ifdef VERSION_mtl

104+ , bench "mtl" $ nfAppIO mtl_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.2.1

23+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==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 = evalData (DataA Concurrent)

75+runConcurrent = evalEffect (IdA 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 = evalData (DataA Environment)

31+runEnvironment = evalEffect (IdA 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 = evalData (DataA FileSystem)

103+runFileSystem = evalEffect (IdA 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 = evalData (DataA FileSystem)

15+runFileSystem = evalEffect (IdA 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 = evalData (DataA Process)

61+runProcess = evalEffect (IdA 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 (DataA (Resource istate)) noRelinker es0

40+ es <- unsafeConsEnv (IdA (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− DataA (Resource istate) <- getData

55+ IdA (Resource istate) <- getEffect

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 = evalData (DataA (Resource istate))

62+runInternalState istate = evalEffect $ IdA (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 >>= \(DataA (Resource istate)) -> m istate

69+ getEnv es >>= \(IdA (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 = evalData (DataA Temporary)

22+runTemporary = evalEffect (IdA 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 = evalData (DataA Timeout)

18+runTimeout = evalEffect (IdA Timeout)

19

20-- | Lifted 'T.timeout'.

21timeout