dadd56f..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.hs+3−3

@@ -8,10 +8,10 @@ module Effectful

8

9 -- * Running the 'Eff' monad

10

11− -- ** Pure operations

11+ -- ** Pure computations

12 , runPureEff

13

14− -- ** Operations with side effects

14+ -- ** Computations with side effects

15 , IOE

16 , runEff

17

@@ -32,7 +32,7 @@ module Effectful

32 , interpret

33 , reinterpret

34

35− -- ** Handling local 'Eff' operations

35+ -- ** Handling local 'Eff' computations

36 , LocalEnv

37

38 -- *** Unlifts

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

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

7 , interpret

8 , reinterpret

9

10− -- ** Handling local 'Eff' operations

10+ -- ** Handling local 'Eff' computations

11 , LocalEnv

12

13 -- *** Unlifts

@@ -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) $ runHandler (Handler 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) $ runHandler (Handler les handler) m

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

66

67

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

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

68-- Unlifts

69-- Unlifts

@@ -121,7 +122,7 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of

121 SeqUnlift -> liftIO $ seqUnliftIO les k

122 SeqUnlift -> liftIO $ seqUnliftIO les k

122 ConcUnlift p l -> liftIO $ concUnliftIO les p l k

123 ConcUnlift p l -> liftIO $ concUnliftIO les p l k

123

124

124−-- | Utility for lifting 'Eff' operations of type

125+-- | Utility for lifting 'Eff' computations of type

125--

126--

126-- @'Eff' es a -> 'Eff' es b@

127-- @'Eff' es a -> 'Eff' es b@

127--

128--

@@ -129,7 +130,7 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of

129--

130--

130-- @'Eff' localEs a -> 'Eff' localEs b@

131-- @'Eff' localEs a -> 'Eff' localEs b@

131--

132--

132−-- /Note:/ the operation must not run its argument in a separate thread,

133+-- /Note:/ the computation must not run its argument in a separate thread,

133-- attempting to do so will result in a runtime error.

134-- attempting to do so will result in a runtime error.

134withLiftMap

135withLiftMap

135 :: (HasCallStack, SuffixOf es handlerEs)

136 :: (HasCallStack, SuffixOf es handlerEs)

@@ -145,7 +146,7 @@ withLiftMap !_ k = unsafeEff $ \es -> do

145 seqUnliftIO localEs $ \unlift -> do

146 seqUnliftIO localEs $ \unlift -> do

146 (`unEff` es) . mapEff . unsafeEff_ $ unlift m

147 (`unEff` es) . mapEff . unsafeEff_ $ unlift m

147

148

148−-- | Utility for lifting 'IO' operations of type

149+-- | Utility for lifting 'IO' computations of type

149--

150--

150-- @'IO' a -> 'IO' b@

151-- @'IO' a -> 'IO' b@

151--

152--

@@ -153,11 +154,11 @@ withLiftMap !_ k = unsafeEff $ \es -> do

153--

154--

154-- @'Eff' localEs a -> 'Eff' localEs b@

155-- @'Eff' localEs a -> 'Eff' localEs b@

155--

156--

156−-- /Note:/ the operation must not run its argument in a separate thread,

157+-- /Note:/ the computation must not run its argument in a separate thread,

157-- attempting to do so will result in a runtime error.

158-- attempting to do so will result in a runtime error.

158--

159--

159-- Useful e.g. for lifting the unmasking function in

160-- Useful e.g. for lifting the unmasking function in

160−-- 'Control.Exception.mask'-like operations:

161+-- 'Control.Exception.mask'-like computations:

161--

162--

162-- >>> :{

163-- >>> :{

163-- data Fork :: Effect where

164-- data Fork :: Effect where

@@ -187,10 +188,10 @@ withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do

187

188

188-- | Create a local lifting and unlifting function with the given strategy.

189-- | Create a local lifting and unlifting function with the given strategy.

189--

190--

190−-- Useful for lifting complicated 'Eff' operations where the monadic action

191+-- Useful for lifting complicated 'Eff' computations where the monadic action

191-- shows in both positive (as a result) and negative (as an argument) position.

192-- shows in both positive (as a result) and negative (as an argument) position.

192--

193--

193−-- /Note:/ depending on the operation you're lifting 'localUnlift' along with

194+-- /Note:/ depending on the computation you're lifting 'localUnlift' along with

194-- 'withLiftMap' might be enough and is more efficient.

195-- 'withLiftMap' might be enough and is more efficient.

195localLiftUnlift

196localLiftUnlift

196 :: (HasCallStack, SuffixOf es handlerEs)

197 :: (HasCallStack, SuffixOf es handlerEs)

@@ -213,11 +214,11 @@ localLiftUnlift (LocalEnv les) strategy k = case strategy of

213-- | Create a local unlifting function with the given strategy along with an

214-- | Create a local unlifting function with the given strategy along with an

214-- unrestricted lifting function.

215-- unrestricted lifting function.

215--

216--

216−-- Useful for lifting complicated 'IO' operations where the monadic action shows

217+-- Useful for lifting complicated 'IO' computations where the monadic action

217−-- in both positive (as a result) and negative (as an argument) position.

218+-- shows in both positive (as a result) and negative (as an argument) position.

218--

219--

219−-- /Note:/ depending on the operation you're lifting 'localUnliftIO' along with

220+-- /Note:/ depending on the computation you're lifting 'localUnliftIO' along

220−-- 'withLiftMapIO' might be enough and is more efficient.

221+-- with 'withLiftMapIO' might be enough and is more efficient.

221localLiftUnliftIO

222localLiftUnliftIO

222 :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)

223 :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)

223 => LocalEnv localEs handlerEs

224 => LocalEnv localEs handlerEs

@@ -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+24−27

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

1module Effectful.Dispatch.Static

2 ( -- * Low level API

3− IdE(..)

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,22 +46,12 @@ 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

57−-- | Utility for lifting 'IO' operations of type

54+-- | Utility for lifting 'IO' computations of type

58--

55--

59-- @'IO' a -> 'IO' b@

56-- @'IO' a -> 'IO' b@

60--

57--

@@ -65,10 +62,10 @@ import Effectful.Internal.Monad

65-- This function is __unsafe__ because:

62-- This function is __unsafe__ because:

66--

63--

67-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'

64-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'

68−-- operations.

65+-- computations.

69--

66--

70−-- - The 'IO' operation must not run its argument in a separate thread, but it's

67+-- - The 'IO' computation must not run its argument in a separate thread, but

71−-- not checked anywhere.

68+-- it's not checked anywhere.

72unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b

69unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b

73unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)

70unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)

74

71

@@ -77,9 +74,9 @@ unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)

77-- This function is __unsafe__ because:

74-- This function is __unsafe__ because:

78--

75--

79-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'

76-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'

80−-- operations.

77+-- computations.

81--

78--

82−-- - Unlifted 'Eff' operations must not be run in a thread distinct from the

79+-- - Unlifted 'Eff' computations must not be run in a thread distinct from the

83-- caller of 'unsafeUnliftIO', but it's not checked anywhere.

80-- caller of 'unsafeUnliftIO', but it's not checked anywhere.

84unsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a

81unsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a

85unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)

82unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)

effectful-core/src/Effectful/Error.hs+40−10

@@ -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--

@@ -25,18 +23,50 @@

25-- resources such as 'Control.Monad.Catch.finally' and

23-- resources such as 'Control.Monad.Catch.finally' and

26-- 'Control.Monad.Catch.bracket' work as expected:

24-- 'Control.Monad.Catch.bracket' work as expected:

27--

25--

28−-- >>> let display = liftIO . putStrLn

26+-- >>> let msg = liftIO . putStrLn

29-- >>> :{

27-- >>> :{

30-- runEff . fmap (either (Left . snd) Right) . runError @String $ do

28-- runEff . fmap (either (Left . snd) Right) . runError @String $ do

31−-- E.bracket_ (display "Beginning.")

29+-- E.bracket_ (msg "Beginning.")

32−-- (display "Cleaning up.")

30+-- (msg "Cleaning up.")

33−-- (display "Computing." >> throwError "oops" >> display "More.")

31+-- (msg "Computing." >> throwError "oops" >> msg "More.")

34-- :}

32-- :}

35-- Beginning.

33-- Beginning.

36-- Computing.

34-- Computing.

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 (IdE (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− IdE (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− IdE (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+4−20

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

8module Effectful.Internal.Effect

9 ( Effect

10 , (:>)(..)

11− , IdE(..)

12−

13− -- * Utils

14− , SuffixOf

15

11

16 -- * Re-exports

12 -- * Re-exports

17 , Type

13 , Type

@@ -23,20 +19,16 @@ 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 IdE :: Effect -> Type where

28− IdE :: (forall m r. e m r) -> IdE 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−-- operation over an arbitrary list of effects, so long as @e@ is /somewhere/ in

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

33−-- the list.

25+-- in the list.

34--

26--

35−-- For example, an operation that only needs access to a mutable value of type

27+-- For example, a computation that only needs access to a mutable value of type

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+91−78

@@ -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− , Handler(..)

46+ , HandlerA(..)

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)

@@ -84,44 +79,43 @@ import Effectful.Internal.Unlift

84

79

85type role Eff nominal representational

80type role Eff nominal representational

86

81

87−-- | The 'Eff' monad provides the implementation of an operation that performs

82+-- | The 'Eff' monad provides the implementation of a computation that performs

88-- an arbitrary set of effects. In @'Eff' es a@, @es@ is a type-level list that

83-- an arbitrary set of effects. In @'Eff' es a@, @es@ is a type-level list that

89−-- contains all the effects that the operation may perform. For example, an

84+-- contains all the effects that the computation may perform. For example, a

90−-- operation that produces an 'Integer' by consuming a 'String' from the global

85+-- computation that produces an 'Integer' by consuming a 'String' from the

91−-- environment and acting upon a single mutable value of type 'Bool' would have

86+-- global environment and acting upon a single mutable value of type 'Bool'

92−-- 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 an operation 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 operation to be used in functions that may

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

109-- perform other effects, and it also allows the effects to be handled in any

103-- perform other effects, and it also allows the effects to be handled in any

110-- order.

104-- order.

111newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)

105newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)

112 deriving (Monoid, Semigroup)

106 deriving (Monoid, Semigroup)

113

107

114−-- | Run a pure 'Eff' operation.

108+-- | Run a pure 'Eff' computation.

115--

109--

116−-- For running operations 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----------------------------------------

@@ -134,14 +128,14 @@ unEff (Eff m) = m

134-- | Access the underlying 'IO' monad along with the environment.

128-- | Access the underlying 'IO' monad along with the environment.

135--

129--

136-- This function is __unsafe__ because it can be used to introduce arbitrary

130-- This function is __unsafe__ because it can be used to introduce arbitrary

137−-- 'IO' actions into pure 'Eff' operations.

131+-- 'IO' actions into pure 'Eff' computations.

138unsafeEff :: (Env es -> IO a) -> Eff es a

132unsafeEff :: (Env es -> IO a) -> Eff es a

139unsafeEff m = Eff (oneShot m)

133unsafeEff m = Eff (oneShot m)

140

134

141-- | Access the underlying 'IO' monad.

135-- | Access the underlying 'IO' monad.

142--

136--

143-- This function is __unsafe__ because it can be used to introduce arbitrary

137-- This function is __unsafe__ because it can be used to introduce arbitrary

144−-- 'IO' actions into pure 'Eff' operations.

138+-- 'IO' actions into pure 'Eff' computations.

145unsafeEff_ :: IO a -> Eff es a

139unsafeEff_ :: IO a -> Eff es a

146unsafeEff_ m = unsafeEff $ \_ -> m

140unsafeEff_ m = unsafeEff $ \_ -> m

147

141

@@ -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− IdE (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 $ \_ -> IdE (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 $ \_ -> IdE (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)

@@ -264,15 +258,15 @@ instance Fail :> es => MonadFail (Eff es) where

264----------------------------------------

258----------------------------------------

265-- IO

259-- IO

266

260

267−-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.

261+-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.

268newtype IOE :: Effect where

262newtype IOE :: Effect where

269 IOE :: UnliftStrategy -> IOE m r

263 IOE :: UnliftStrategy -> IOE m r

270

264

271−-- | Run an 'Eff' operation with side effects.

265+-- | Run an 'Eff' computation with side effects.

272--

266--

273−-- For running pure operations 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 (IdE (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_

@@ -300,16 +294,16 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where

300data Prim :: Effect where

294data Prim :: Effect where

301 Prim :: Prim m r

295 Prim :: Prim m r

302

296

303−-- | Run an 'Eff' operation 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 (IdE 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

@@ -325,78 +319,97 @@ newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env l

325type EffectHandler e es

319type EffectHandler e es

326 = forall a localEs. HasCallStack

320 = forall a localEs. HasCallStack

327 => LocalEnv localEs es

321 => LocalEnv localEs es

328− -- ^ Capture of the local environment for handling local 'Eff' operations when

322+ -- ^ Capture of the local environment for handling local 'Eff' computations

329− -- @e@ is a higher order effect.

323+ -- when @e@ is a higher order effect.

330 -> e (Eff localEs) a

324 -> e (Eff localEs) a

331 -- ^ The effect performed in the local environment.

325 -- ^ The effect performed in the local environment.

332 -> Eff es a

326 -> Eff es a

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.

337−data Handler :: Effect -> Type where

331+data HandlerA :: Effect -> Type where

338− Handler :: !(Env es) -> !(EffectHandler e es) -> Handler 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−runHandler :: Handler e -> Eff (e : es) a -> Eff es a

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

342runHandler e m = unsafeEff $ \es0 -> do

336runHandler 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)

346 (\es -> unEff m es)

340 (\es -> unEff m es)

347 where

341 where

348− relinker :: Relinker Handler e

342+ relinker :: Relinker HandlerA e

349− relinker = Relinker $ \relink (Handler handlerEs handle) -> do

343+ relinker = Relinker $ \relink (HandlerA handlerEs handle) -> do

350 newHandlerEs <- relink handlerEs

344 newHandlerEs <- relink handlerEs

351− pure $ Handler newHandlerEs handle

345+ pure $ HandlerA newHandlerEs handle

352

346

353-- | Send an operation of the given effect to its handler for execution.

347-- | Send an operation of the given effect to its handler for execution.

354send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a

348send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a

355send op = unsafeEff $ \es -> do

349send op = unsafeEff $ \es -> do

356− Handler handlerEs handle <- getEnv es

350+ HandlerA handlerEs handle <- getEnv es

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/Internal/Unlift.hs+2−2

@@ -35,7 +35,7 @@ import Effectful.Internal.Utils

35----------------------------------------

36-- Unlift strategies

37

38−-- | The strategy to use when unlifting 'Eff' operations via 'withRunInIO',

38+-- | The strategy to use when unlifting 'Eff' computations via 'withRunInIO',

39-- 'Effectful.Monad.withEffToIO' or the 'Effectful.Dispatch.Dynamic.localUnlift'

40-- family.

41data UnliftStrategy

@@ -105,7 +105,7 @@ seqUnlift k es unEff = do

105 if tid `eqThreadId` tid0

106 then unEff m es

107 else error

108− $ "If you want to use the unlifting function to run Eff operations "

108+ $ "If you want to use the unlifting function to run Eff computations "

109 ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."

110

111-- | Concurrent unlift for various strategies and limits.

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 (IdE (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− IdE (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 $ \(IdE (Reader r)) -> IdE (Reader (f r))

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

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

@@ -5,6 +5,25 @@

5--

6-- - very fast.

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

27module Effectful.State.Local

9 ( State

28 ( State

10 , runState

29 , runState

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

33 -> Eff (State s : es) a

52 -> Eff (State s : es) a

34 -> Eff es (a, s)

53 -> Eff es (a, s)

35runState s0 m = do

54runState s0 m = do

36− (a, IdE (State s)) <- runEffect (IdE (State s0)) m

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

37 pure (a, s)

56 pure (a, s)

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

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

42 :: s -- ^ An initial state.

61 :: s -- ^ An initial state.

43 -> Eff (State s : es) a

62 -> Eff (State s : es) a

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

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

45−evalState s = evalEffect (IdE (State s))

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

46

65

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

48-- state, discarding the final value.

67-- state, discarding the final value.

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

51 -> Eff (State s : es) a

70 -> Eff (State s : es) a

52 -> Eff es s

71 -> Eff es s

53execState s0 m = do

72execState s0 m = do

54− IdE (State s) <- execEffect (IdE (State s0)) m

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

55 pure s

74 pure s

56

75

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

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

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

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

59get = do

78get = do

60− IdE (State s) <- getEffect

79+ DataA (State s) <- getData

61 pure s

80 pure s

62

81

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

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

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

71

90

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

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

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

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

74−put s = putEffect (IdE (State s))

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

75

94

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

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

77state

96state

78 :: State s :> es

97 :: State s :> es

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

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

80 -> Eff es a

99 -> Eff es a

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

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

82

101

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

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

84--

103--

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

94 :: State s :> es

113 :: State s :> es

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

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

96 -> Eff es a

115 -> Eff es a

97−stateM f = stateEffectM $ \(IdE (State s0)) -> do

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

98 (a, s) <- f s0

117 (a, s) <- f s0

99− pure (a, IdE (State s))

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

100

119

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

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

102--

121--

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

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

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

107 -> Eff es ()

126 -> Eff es ()

108modifyM 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+34−11

@@ -1,10 +1,29 @@

1-- | Support for access to a mutable value of a particular type, which is:

2--

3−-- - shareable between multiple threads (if you want each thead to manage their

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

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

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

@@ -24,7 +43,7 @@ import Control.Concurrent.MVar

24import Effectful.Dispatch.Static

43import Effectful.Dispatch.Static

25import Effectful.Monad

44import Effectful.Monad

26

45

27−-- | Provide access to a strict (WHNF), shareable, mutable value of type @s@.

46+-- | Provide access to a strict (WHNF), shared, mutable value of type @s@.

28newtype State s :: Effect where

47newtype State s :: Effect where

29 State :: MVar s -> State s m r

48 State :: MVar s -> State s m r

30

49

@@ -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 (IdE (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 (IdE (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 (IdE (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− IdE (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− IdE (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− IdE (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− IdE (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, IdE (Writer w)) <- runEffect (IdE (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− IdE (Writer w) <- execEffect (IdE (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 $ \(IdE (Writer w0)) -> ((), IdE (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 $ \(IdE (Writer w)) -> (w, IdE (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 $ \(IdE (Writer w1)) -> (w1, IdE (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+28−13

@@ -1,9 +1,9 @@

1-- | Support for access to a write only value of a particular type, which is:

2--

3−-- - shareable between multiple threads (if you want each thead to manage their

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

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

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,12 +25,12 @@ 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

32

33−-- | Provide access to a strict (WHNF), shareable, write only value of type @w@.

33+-- | Provide access to a strict (WHNF), shared, write only value of type @w@.

34newtype Writer w :: Effect where

35 Writer :: MVar w -> Writer w m r

36

@@ -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 (IdE (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 (IdE (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− IdE (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 $ \(IdE (Writer v)) -> (v, IdE (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 $ IdE (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.hs+15−2

@@ -1,6 +1,19 @@

1+-- | Lifted version of "Control.Concurrent".

2+--

3+-- For functions that spawn threads, the order of preference for their usage is

4+-- recommended as follows:

5+--

6+-- 1) High level functions from "Effectful.Concurrent.Async" such as

7+-- 'Effectful.Concurrent.Async.withAsync',

8+-- 'Effectful.Concurrent.Async.concurrently' or

9+-- 'Effectful.Concurrent.Async.mapConcurrently'.

10+--

11+-- 2) Low level functions from "Effectful.Concurrent.Async" such as

12+-- 'Effectful.Concurrent.Async.async'.

13+--

14+-- 3) Low level functions from "Effectful.Concurrent" such as 'forkIO'.

1module Effectful.Concurrent

15module Effectful.Concurrent

2− ( -- * The effect

3− Concurrent

16+ ( Concurrent

4 , runConcurrent

17 , runConcurrent

5

18

6 -- * Basic concurrency operations

19 -- * Basic concurrency operations

effectful/src/Effectful/Concurrent/Async.hs+2−2

@@ -1,7 +1,7 @@

1{-# LANGUAGE UndecidableInstances #-}

2+-- | Lifted version of "Control.Concurrent.Async".

2module Effectful.Concurrent.Async

3module Effectful.Concurrent.Async

3− ( -- * The effect

4− Concurrent

4+ ( Concurrent

5 , runConcurrent

6

7 -- * Asynchronous actions

effectful/src/Effectful/Concurrent/Chan.hs+1−2

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

1-- | Lifted version of "Control.Concurrent.Chan".

2module Effectful.Concurrent.Chan

3− ( -- * The effect

4− Concurrent

3+ ( Concurrent

5 , runConcurrent

4 , runConcurrent

6

5

7 -- * Chan

6 -- * Chan

effectful/src/Effectful/Concurrent/Effect.hs+64−5

@@ -6,15 +6,74 @@ module Effectful.Concurrent.Effect

6import Effectful.Dispatch.Static

7import Effectful.Monad

8

9−-- | Run 'Eff' operations asynchronously via the @async@ library.

9+-- | Provide the ability to run 'Eff' computations concurrently in multiple

10+-- threads and communicate between them.

10--

11--

11−-- /Note:/ thread local state changes in 'Eff' operations run asynchronously

12+-- /Warning:/ unless you stick to high level functions from the

12−-- will not affect the parent thread.

13+-- 'Effectful.Concurrent.Async.withAsync' family, the 'Concurrent' effect makes

14+-- it possible to escape the scope of any scoped effect operation. Consider the

15+-- following:

16+--

17+-- >>> import qualified Effectful.Reader as R

18+-- >>> let printAsk msg = liftIO . putStrLn . (msg ++) . (": " ++) =<< R.ask

19+-- >>> :{

20+-- runEff . R.runReader "GLOBAL" . runConcurrent $ do

21+-- a <- R.local (const "LOCAL") $ do

22+-- a <- async $ do

23+-- printAsk "child (first)"

24+-- threadDelay 20000

25+-- printAsk "child (second)"

26+-- threadDelay 10000

27+-- printAsk "parent (inside)"

28+-- pure a

29+-- printAsk "parent (outside)"

30+-- wait a

31+-- :}

32+-- child (first): LOCAL

33+-- parent (inside): LOCAL

34+-- parent (outside): GLOBAL

35+-- child (second): LOCAL

36+--

37+-- Note that the asynchronous computation doesn't respect the scope of

38+-- 'Effectful.Reader.local', i.e. the child thread still behaves like it's

39+-- inside the 'Effectful.Reader.local' block, even though the parent thread

40+-- already got out of it.

41+--

42+-- This is because the value provided by the 'Effectful.Reader.Reader' effect is

43+-- thread local, i.e. each thread manages its own version of it. For the

44+-- 'Effectful.Reader.Reader' it is the only reasonable behavior, it wouldn't be

45+-- very useful if its "read only" value was affected by calls to

46+-- 'Effectful.Reader.local' from its parent or child threads.

47+--

48+-- However, the cut isn't so clear if it comes to effects that provide access to

49+-- a mutable state. That's why primitive @State@ and @Writer@ effects come in

50+-- two flavors, local and shared:

51+--

52+-- >>> import qualified Effectful.State.Local as SL

53+-- >>> :{

54+-- runEff . SL.execState "Hi" . runConcurrent $ do

55+-- replicateConcurrently_ 3 $ SL.modify (++ "!")

56+-- :}

57+-- "Hi"

58+--

59+-- >>> import qualified Effectful.State.Shared as SS

60+-- >>> :{

61+-- runEff . SS.execState "Hi" . runConcurrent $ do

62+-- replicateConcurrently_ 3 $ SS.modify (++ "!")

63+-- :}

64+-- "Hi!!!"

65+--

66+-- In the first example state modification made concurrently are not reflected

67+-- in the parent thread because the value is thread local, but in the second

68+-- example they are, because the value is shared.

13--

69--

14−-- /TODO:/ write about 'Concurrent' not respecting scoped operations.

15data Concurrent :: Effect where

70data Concurrent :: Effect where

16 Concurrent :: Concurrent m r

71 Concurrent :: Concurrent m r

17

72

18-- | Run the 'Concurrent' effect.

73-- | Run the 'Concurrent' effect.

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

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

20−runConcurrent = evalEffect (IdE Concurrent)

75+runConcurrent = evalData (DataA Concurrent)

76+

77+-- $setup

78+-- >>> import Effectful.Concurrent

79+-- >>> import Effectful.Concurrent.Async

effectful/src/Effectful/Concurrent/MVar.hs+1−2

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

1-- | Lifted version of "Control.Concurrent.MVar".

2module Effectful.Concurrent.MVar

3− ( -- * The effect

4− Concurrent

3+ ( Concurrent

5 , runConcurrent

4 , runConcurrent

6

5

7 -- * MVar

6 -- * MVar

effectful/src/Effectful/Concurrent/QSem.hs+2−3

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

1−-- | Lifted "Control.Concurrent.QSem".

1+-- | Lifted version of "Control.Concurrent.QSem".

2module Effectful.Concurrent.QSem

3− ( -- * The effect

4− Concurrent

3+ ( Concurrent

5 , runConcurrent

4 , runConcurrent

6

5

7 -- * QSem

6 -- * QSem

effectful/src/Effectful/Concurrent/QSemN.hs+2−3

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

1−-- | Lifted "Control.Concurrent.QSemN".

1+-- | Lifted version of "Control.Concurrent.QSemN".

2module Effectful.Concurrent.QSemN

3− ( -- * The effect

4− Concurrent

3+ ( Concurrent

5 , runConcurrent

4 , runConcurrent

6

5

7 -- * QSemN

6 -- * QSemN

effectful/src/Effectful/Concurrent/STM.hs+1−2

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

1-- | Lifted version of "Control.Concurrent.STM".

2module Effectful.Concurrent.STM

3− ( -- * The effect

4− Concurrent

3+ ( Concurrent

5 , runConcurrent

4 , runConcurrent

6

5

7 -- * Core

6 -- * Core

effectful/src/Effectful/Environment.hs+2−3

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

1module Effectful.Environment

2− ( -- * The effect

3− Environment

2+ ( Environment

4 , runEnvironment

3 , runEnvironment

5

4

6 -- * Querying the environment

5 -- * Querying the environment

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

29

28

30-- | Run the 'Environment' effect.

29-- | Run the 'Environment' effect.

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

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

32−runEnvironment = evalEffect (IdE Environment)

31+runEnvironment = evalData (DataA Environment)

33

32

34-- | Lifted 'E.getArgs'.

33-- | Lifted 'E.getArgs'.

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

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

effectful/src/Effectful/FileSystem.hs+89−90

@@ -1,93 +1,92 @@

1module Effectful.FileSystem

2− ( -- * The effect

3− FileSystem

2+ ( FileSystem

4− , runFileSystem

3+ , runFileSystem

5−

4+

6− -- * Actions on directories

5+ -- * Actions on directories

7− , createDirectory

6+ , createDirectory

8− , createDirectoryIfMissing

7+ , createDirectoryIfMissing

9− , removeDirectory

8+ , removeDirectory

10− , removeDirectoryRecursive

9+ , removeDirectoryRecursive

11− , removePathForcibly

10+ , removePathForcibly

12− , renameDirectory

11+ , renameDirectory

13− , listDirectory

12+ , listDirectory

14− , getDirectoryContents

13+ , getDirectoryContents

15−

14+

16− -- ** Current working directory

15+ -- ** Current working directory

17− , getCurrentDirectory

16+ , getCurrentDirectory

18− , setCurrentDirectory

17+ , setCurrentDirectory

19− , withCurrentDirectory

18+ , withCurrentDirectory

20−

19+

21− -- * Pre-defined directories

20+ -- * Pre-defined directories

22− , getHomeDirectory

21+ , getHomeDirectory

23− , getXdgDirectory

22+ , getXdgDirectory

24− , getXdgDirectoryList

23+ , getXdgDirectoryList

25− , getAppUserDataDirectory

24+ , getAppUserDataDirectory

26− , getUserDocumentsDirectory

25+ , getUserDocumentsDirectory

27− , getTemporaryDirectory

26+ , getTemporaryDirectory

28−

27+

29− -- * Actions on files

28+ -- * Actions on files

30− , removeFile

29+ , removeFile

31− , renameFile

30+ , renameFile

32− , renamePath

31+ , renamePath

33− , copyFile

32+ , copyFile

34− , copyFileWithMetadata

33+ , copyFileWithMetadata

35− , getFileSize

34+ , getFileSize

36− , canonicalizePath

35+ , canonicalizePath

37− , makeAbsolute

36+ , makeAbsolute

38− , makeRelativeToCurrentDirectory

37+ , makeRelativeToCurrentDirectory

39−

38+

40− -- * Existence tests

39+ -- * Existence tests

41− , doesPathExist

40+ , doesPathExist

42− , doesFileExist

41+ , doesFileExist

43− , doesDirectoryExist

42+ , doesDirectoryExist

44− , findExecutable

43+ , findExecutable

45− , findExecutables

44+ , findExecutables

46− , findExecutablesInDirectories

45+ , findExecutablesInDirectories

47− , findFile

46+ , findFile

48− , findFiles

47+ , findFiles

49− , findFileWith

48+ , findFileWith

50− , findFilesWith

49+ , findFilesWith

51−

50+

52− -- * Symbolic links

51+ -- * Symbolic links

53− , createFileLink

52+ , createFileLink

54− , createDirectoryLink

53+ , createDirectoryLink

55− , removeDirectoryLink

54+ , removeDirectoryLink

56− , pathIsSymbolicLink

55+ , pathIsSymbolicLink

57− , getSymbolicLinkTarget

56+ , getSymbolicLinkTarget

58−

57+

59− -- * Permissions

58+ -- * Permissions

60− , getPermissions

59+ , getPermissions

61− , setPermissions

60+ , setPermissions

62− , copyPermissions

61+ , copyPermissions

63−

62+

64− -- * Timestamps

63+ -- * Timestamps

65− , getAccessTime

64+ , getAccessTime

66− , getModificationTime

65+ , getModificationTime

67− , setAccessTime

66+ , setAccessTime

68− , setModificationTime

67+ , setModificationTime

69−

68+

70− -- * Re-exports

69+ -- * Re-exports

71−

70+

72− -- ** Pre-defined directories

71+ -- ** Pre-defined directories

73− , D.XdgDirectory(..)

72+ , D.XdgDirectory(..)

74− , D.XdgDirectoryList(..)

73+ , D.XdgDirectoryList(..)

75−

74+

76− -- ** Existence tests

75+ -- ** Existence tests

77− , D.exeExtension

76+ , D.exeExtension

78−

77+

79− -- ** Permissions

78+ -- ** Permissions

80− , D.Permissions

79+ , D.Permissions

81− , D.emptyPermissions

80+ , D.emptyPermissions

82− , D.readable

81+ , D.readable

83− , D.writable

82+ , D.writable

84− , D.executable

83+ , D.executable

85− , D.searchable

84+ , D.searchable

86− , D.setOwnerReadable

85+ , D.setOwnerReadable

87− , D.setOwnerWritable

86+ , D.setOwnerWritable

88− , D.setOwnerExecutable

87+ , D.setOwnerExecutable

89− , D.setOwnerSearchable

88+ , D.setOwnerSearchable

90− ) where

89+ ) where

91

90

92import Data.Time (UTCTime)

91import Data.Time (UTCTime)

93import qualified System.Directory as D

92import qualified System.Directory as D

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

101

100

102-- | Run the 'FileSystem' effect.

101-- | Run the 'FileSystem' effect.

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

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

104−runFileSystem = evalEffect (IdE FileSystem)

103+runFileSystem = evalData (DataA FileSystem)

105

104

106----------------------------------------

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

107-- Actions on directories

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 (IdE FileSystem)

15+runFileSystem = evalData (DataA FileSystem)

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

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

1-- | Lifted version of "System.IO".

2module Effectful.FileSystem.IO

3− ( -- * The effect

4− FileSystem

3+ ( FileSystem

5 , runFileSystem

4 , runFileSystem

6

5

7 -- * IO

6 -- * IO

effectful/src/Effectful/Process.hs+2−3

@@ -1,8 +1,7 @@

1{-# LANGUAGE CPP #-}

2-- | Lifted version of "System.Process".

3module Effectful.Process

4− ( -- * The effect

5− Process

4+ ( Process

6 , runProcess

5 , runProcess

7

6

8 -- * Running sub-processes

7 -- * Running sub-processes

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

59 Process :: Process m r

58 Process :: Process m r

60

59

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

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

62−runProcess = evalEffect (IdE Process)

61+runProcess = evalData (DataA Process)

63

62

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

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

65-- Running sub-processes

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 (IdE (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− IdE (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 $ IdE (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 >>= \(IdE (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 (IdE 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 (IdE Timeout)

18+runTimeout = evalData (DataA Timeout)

19

20-- | Lifted 'T.timeout'.

21timeout