master..c85a3bb · effectful

.github/workflows/haskell-ci.yml+18−19

since splitsnapshots

unifiedsplit

@@ -8,9 +8,9 @@

8#

9# For more information, see https://github.com/haskell-CI/haskell-ci

10#

11−# version: 0.13.20211116

11+# version: 0.13.20211030

12#

13−# REGENDATA ("0.13.20211116",["github","--config=cabal.haskell-ci","cabal.project"])

13+# REGENDATA ("0.13.20211030",["github","--config=cabal.haskell-ci","cabal.project"])

14#

15name: Haskell-CI

16on:

@@ -24,8 +24,6 @@ jobs:

24 linux:

25 name: Haskell-CI - Linux - ${{ matrix.compiler }}

26 runs-on: ubuntu-18.04

27− timeout-minutes:

28− 60

29 container:

27 container:

30 image: buildpack-deps:bionic

28 image: buildpack-deps:bionic

31 continue-on-error: ${{ matrix.allow-failure }}

29 continue-on-error: ${{ matrix.allow-failure }}

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

37 compilerVersion: 9.2.1

35 compilerVersion: 9.2.1

38 setup-method: ghcup

36 setup-method: ghcup

39 allow-failure: false

37 allow-failure: false

38+ - compiler: ghc-9.0.1

39+ compilerKind: ghc

40+ compilerVersion: 9.0.1

41+ setup-method: hvr-ppa

42+ allow-failure: false

40 - compiler: ghc-8.10.7

43 - compiler: ghc-8.10.7

41 compilerKind: ghc

44 compilerKind: ghc

42 compilerVersion: 8.10.7

45 compilerVersion: 8.10.7

@@ -126,10 +129,6 @@ jobs:

126 repository hackage.haskell.org

129 repository hackage.haskell.org

127 url: http://hackage.haskell.org/

130 url: http://hackage.haskell.org/

128 EOF

131 EOF

129− cat >> $CABAL_CONFIG <<EOF

130− program-default-options

131− ghc-options: $GHCJOBS +RTS -M3G -RTS

132− EOF

133 cat $CABAL_CONFIG

132 cat $CABAL_CONFIG

134 - name: versions

133 - name: versions

135 run: |

134 run: |

@@ -142,7 +141,7 @@ jobs:

142 - name: cache (tools)

141 - name: cache (tools)

143 uses: actions/cache@v2

142 uses: actions/cache@v2

144 with:

143 with:

145− key: ${{ runner.os }}-${{ matrix.compiler }}-tools-16fe7d6d

144+ key: ${{ runner.os }}-${{ matrix.compiler }}-tools-b692a344

146 path: ~/.haskell-ci-tools

145 path: ~/.haskell-ci-tools

147 - name: install cabal-plan

146 - name: install cabal-plan

148 run: |

147 run: |

@@ -155,8 +154,8 @@ jobs:

155 cabal-plan --version

154 cabal-plan --version

156 - name: install doctest

155 - name: install doctest

157 run: |

156 run: |

158− $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.20'

157+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.18' ; fi

159− doctest --version

158+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then doctest --version ; fi

160 - name: checkout

159 - name: checkout

161 uses: actions/checkout@v2

160 uses: actions/checkout@v2

162 with:

161 with:

@@ -164,8 +163,8 @@ jobs:

164 - name: initial cabal.project for sdist

163 - name: initial cabal.project for sdist

165 run: |

164 run: |

166 touch cabal.project

165 touch cabal.project

167− echo "packages: $GITHUB_WORKSPACE/source/effectful" >> cabal.project

166+ echo "packages: $GITHUB_WORKSPACE/source/./effectful" >> cabal.project

168− echo "packages: $GITHUB_WORKSPACE/source/effectful-core" >> cabal.project

167+ echo "packages: $GITHUB_WORKSPACE/source/./effectful-core" >> cabal.project

169 cat cabal.project

168 cat cabal.project

170 - name: sdist

169 - name: sdist

171 run: |

170 run: |

@@ -222,12 +221,12 @@ jobs:

222 $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct

221 $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct

223 - name: doctest

222 - name: doctest

224 run: |

223 run: |

225− cd ${PKGDIR_effectful} || false

224+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cd ${PKGDIR_effectful} || false ; fi

226− doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src

225+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi

227− cd ${PKGDIR_effectful_core} || false

226+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cd ${PKGDIR_effectful_core} || false ; fi

228− doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src

227+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi

229− cd ${PKGDIR_effectful_core} || false

228+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cd ${PKGDIR_effectful_core} || false ; fi

230− doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators utils

229+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators utils ; fi

231 - name: cabal check

230 - name: cabal check

232 run: |

231 run: |

233 cd ${PKGDIR_effectful} || false

232 cd ${PKGDIR_effectful} || false

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

cabal.haskell-ci+3−1

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

1branches: master

2

3−doctest: <9.3

3+doctest: <9.2

4tests: True

5benchmarks: True

6

7+ghcup-jobs: ==8.10.7 || >=9.2

8+

7raw-project

9raw-project

8 package effectful

10 package effectful

9 flags: +benchmark-foreign-libraries

11 flags: +benchmark-foreign-libraries

doctest.sh+1−2

@@ -17,7 +17,6 @@ run_doctest() {

17 -XConstraintKinds \

18 -XDataKinds \

19 -XDeriveFunctor \

20− -XDeriveGeneric \

21 -XFlexibleContexts \

20 -XFlexibleContexts \

22 -XFlexibleInstances \

21 -XFlexibleInstances \

23 -XGADTs \

22 -XGADTs \

@@ -37,5 +36,5 @@ run_doctest() {

37 popd

36 popd

38}

37}

39

38

40−run_doctest effectful-core src

41run_doctest effectful src

39run_doctest effectful src

40+run_doctest effectful-core src

effectful-core/effectful-core.cabal+11−15

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

@@ -34,7 +34,6 @@ common language

34 ConstraintKinds

35 DataKinds

36 DeriveFunctor

37− DeriveGeneric

38 FlexibleContexts

37 FlexibleContexts

39 FlexibleInstances

38 FlexibleInstances

40 GADTs

39 GADTs

@@ -67,24 +66,21 @@ library

67

66

68 ghc-options: -O2

67 ghc-options: -O2

69

68

70− build-depends: effectful-internal-utils

69+ build-depends: base >= 4.13 && <5

71−

72− build-depends: base >= 4.13 && < 5

73− , containers >= 0.6

70+ , containers

71+ , effectful-internal-utils

74− , exceptions >= 0.10.4

72+ , exceptions

75− , monad-control >= 1.0.3

73+ , monad-control

76− , primitive >= 0.7.3.0

74+ , primitive

77− , transformers-base >= 0.4.6

75+ , transformers-base

78− , unliftio-core >= 0.2.0.1

76+ , unliftio-core

79

77

80 hs-source-dirs: src

78 hs-source-dirs: src

81

79

82− exposed-modules: Effectful

80+ exposed-modules: Effectful.Error

83− Effectful.Dispatch.Dynamic

84− Effectful.Dispatch.Static

85− Effectful.Error

86 Effectful.Error.Dynamic

81 Effectful.Error.Dynamic

87 Effectful.Fail

82 Effectful.Fail

83+ Effectful.Handler

88 Effectful.Internal.Effect

84 Effectful.Internal.Effect

89 Effectful.Internal.Env

85 Effectful.Internal.Env

90 Effectful.Internal.Monad

86 Effectful.Internal.Monad

effectful-core/src/Effectful/Dispatch/Static.hsdeleted−82

@@ -1,82 +0,0 @@

1−module Effectful.Dispatch.Static

2− ( -- * Low level API

3− DataA(..)

4−

5− -- ** Extending the environment

6− , runData

7− , evalData

8− , execData

9−

10− -- ** Data retrieval and update

11− , getData

12− , putData

13− , stateData

14− , stateDataM

15− , localData

16−

17− -- ** Unlifts

18− , seqUnliftIO

19− , concUnliftIO

20−

21− -- ** Utils

22− , unEff

23− , unsafeEff

24− , unsafeEff_

25− , unsafeLiftMapIO

26− , unsafeUnliftIO

27−

28− -- * Primitive API

29− , Env

30− , Relinker(..)

31− , noRelinker

32−

33− -- ** Operations

34− , emptyEnv

35− , cloneEnv

36− , forkEnv

37− , sizeEnv

38− , checkSizeEnv

39−

40− -- ** Extending and shrinking

41− , unsafeConsEnv

42− , unsafeTailEnv

43−

44− -- ** Data retrieval and update

45− , getEnv

46− , putEnv

47− , stateEnv

48− , modifyEnv

49− ) where

50−

51−import Effectful.Internal.Env

52−import Effectful.Internal.Monad

53−

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

55−--

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

57−--

58−-- to

59−--

60−-- @'Eff' es a -> 'Eff' es b@

61−--

62−-- This function is __unsafe__ because:

63−--

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

65−-- computations.

66−--

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

68−-- it's not checked anywhere.

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

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

71−

72−-- | Utility for running 'Eff' computations locally in the 'IO' monad.

73−--

74−-- This function is __unsafe__ because:

75−--

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

77−-- computations.

78−--

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

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

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

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

effectful-core/src/Effectful/Error.hs+26−96

@@ -1,78 +1,28 @@

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

1+{- | Support for checked exceptions.

2−--

2+

3+The 'Error' effect provided by this module is a suitable replacement for the

4+'Control.Monad.Except.ExceptT' monad transformer found in the @mtl@ library. It

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

5+is __not__ intended to be a general mechanism for catching errors, that's what

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

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

6+functions from the "Control.Monad.Catch" module are for.

6−--

7+

7−-- In particular, regular exceptions of type @e@ are distinct from errors of

8+For example, if you want to catch an unchecked exception like

8−-- type @e@ and will __not__ be caught by functions from this module:

9−--

10−-- >>> import qualified Control.Monad.Catch as E

11−-- >>> let boom = error "BOOM!"

12−-- >>> runEff . runError @ErrorCall $ boom `catchError` \_ (_::ErrorCall) -> pure "caught"

13−-- *** Exception: BOOM!

14−-- ...

15−--

16−-- If you want to catch regular exceptions, you should use

17−-- 'Control.Monad.Catch.catch' (or a similar function):

9+'Control.Exception.ErrorCall' you could use 'Control.Monad.Catch.catch':

18−--

10+

19−-- >>> runEff $ boom `E.catch` \(_::ErrorCall) -> pure "caught"

20−-- "caught"

21−--

22−-- On the other hand, functions for safe finalization and management of

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

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

11+>>> import qualified Control.Monad.Catch as E

25−--

12+>>> :{

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

13+ let boom :: Eff es String

27−-- >>> :{

14+ boom = error "BOOM!"

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

15+ in

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

16+ runEff $ boom `E.catch` \(e :: ErrorCall) -> pure "caught some error"

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

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

32−-- :}

17+:}

33−-- Beginning.

18+"caught some error"

34−-- Computing.

19+

35−-- Cleaning up.

20+-}

36−-- Left "oops"

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.

70module Effectful.Error

21module Effectful.Error

71 ( Error

22 ( Error

72 , runError

23 , runError

73 , throwError

24 , throwError

74 , catchError

25 , catchError

75− , handleError

76 , tryError

26 , tryError

77

27

78 -- * Re-exports

28 -- * Re-exports

@@ -87,14 +37,13 @@ import Data.Typeable

87import Data.Unique

37import Data.Unique

88import GHC.Stack

38import GHC.Stack

89

39

90−import Effectful.Dispatch.Static

40+import Effectful.Internal.Effect

41+import Effectful.Internal.Env

91−import Effectful.Monad

42+import Effectful.Internal.Monad

92

43

93−-- | Provide the ability to handle errors of type @e@.

94newtype Error e :: Effect where

44newtype Error e :: Effect where

95 Error :: ErrorId -> Error e m r

45 Error :: ErrorId -> Error e m r

96

46

97−-- | Handle errors of type @e@.

98runError

47runError

99 :: forall e es a. Typeable e

48 :: forall e es a. Typeable e

100 => Eff (Error e : es) a

49 => Eff (Error e : es) a

@@ -102,7 +51,7 @@ runError

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

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

103 eid <- newErrorId

52 eid <- newErrorId

104 size0 <- sizeEnv es0

53 size0 <- sizeEnv es0

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

54+ es <- unsafeConsEnv (IdE (Error @e eid)) noRelinker es0

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

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

107 unsafeTailEnv size0 es

56 unsafeTailEnv size0 es

108 pure r

57 pure r

@@ -112,48 +61,29 @@ runError m = unsafeEff $ \es0 -> mask $ \release -> do

112 Left ex -> tryHandler ex eid (\cs e -> Left (cs, e))

61 Left ex -> tryHandler ex eid (\cs e -> Left (cs, e))

113 $ throwIO ex

62 $ throwIO ex

114

63

115−-- | Throw an error of type @e@.

116throwError

64throwError

117 :: forall e es a. (HasCallStack, Typeable e, Error e :> es)

65 :: forall e es a. (HasCallStack, Typeable e, Error e :> es)

118 => e

66 => e

119− -- ^ The error.

120 -> Eff es a

67 -> Eff es a

121throwError e = unsafeEff $ \es -> do

68throwError e = unsafeEff $ \es -> do

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

69+ IdE (Error eid) <- getEnv @(Error e) es

123 throwIO $ ErrorEx eid callStack e

70 throwIO $ ErrorEx eid callStack e

124

71

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

126catchError

72catchError

127 :: forall e es a. (Typeable e, Error e :> es)

73 :: forall e es a. (Typeable e, Error e :> es)

128 => Eff es a

74 => Eff es a

129− -- ^ The inner computation.

130 -> (CallStack -> e -> Eff es a)

75 -> (CallStack -> e -> Eff es a)

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

132 -> Eff es a

76 -> Eff es a

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

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

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

78+ IdE (Error eid) <- getEnv @(Error e) es

135 size <- sizeEnv es

79 size <- sizeEnv es

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

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

137 checkSizeEnv size es

81 checkSizeEnv size es

138 unEff (handler cs e) es

82 unEff (handler cs e) es

139

83

140−-- | The same as @'flip' 'catchError'@, which is useful in situations where the

141−-- code for the handler is shorter.

142−handleError

143− :: forall e es a. (Typeable e, Error e :> es)

144− => (CallStack -> e -> Eff es a)

145− -- ^ A handler for errors in the inner computation.

146− -> Eff es a

147− -- ^ The inner computation.

148− -> Eff es a

149−handleError = flip catchError

150−

151−-- | Similar to 'catchError', but returns an 'Either' result which is a 'Right'

152−-- if no error was thrown and a 'Left' otherwise.

153tryError

84tryError

154 :: forall e es a. (Typeable e, Error e :> es)

85 :: forall e es a. (Typeable e, Error e :> es)

155 => Eff es a

86 => Eff es a

156− -- ^ The inner computation.

157 -> Eff es (Either (CallStack, e) a)

87 -> Eff es (Either (CallStack, e) a)

158tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)

88tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)

159

89

effectful-core/src/Effectful/Error/Dynamic.hs+1−1

@@ -8,7 +8,7 @@ module Effectful.Error.Dynamic

8

9import Data.Typeable

10

11−import Effectful.Dispatch.Dynamic

11+import Effectful.Handler

12import Effectful.Monad

13import qualified Effectful.Error as E

14

effectful-core/src/Effectful/Fail.hs+1−2

@@ -1,11 +1,10 @@

1−-- | Provider of the 'MonadFail' instance for 'Eff'.

2module Effectful.Fail

1module Effectful.Fail

3 ( Fail(..)

2 ( Fail(..)

4 , runFail

3 , runFail

5 ) where

4 ) where

6

5

7−import Effectful.Dispatch.Dynamic

8import Effectful.Error

6import Effectful.Error

7+import Effectful.Handler

9import Effectful.Internal.Monad

8import Effectful.Internal.Monad

10

9

11-- | Run the 'Fail' effect via 'Error'.

10-- | Run the 'Fail' effect via 'Error'.

effectful-core/src/Effectful/Dispatch/Dynamic.hs → effectful-core/src/Effectful/Handler.hsrenamed+30−42

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

1−module Effectful.Dispatch.Dynamic

1+module Effectful.Handler

2 ( -- * Sending operations to the handler

3 send

4

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

7 , interpret

8 , reinterpret

9

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

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

11 , LocalEnv

12

13 -- *** Unlifts

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

67

66

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

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

69-- Unlifts

68-- Unlifts

@@ -78,7 +77,7 @@ localSeqUnlift

78 -- ^ Continuation with the unlifting function in scope.

77 -- ^ Continuation with the unlifting function in scope.

79 -> Eff es a

78 -> Eff es a

80localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do

79localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do

81− seqUnliftIO les $ \unlift -> do

80+ seqUnliftEff les $ \unlift -> do

82 (`unEff` es) $ k $ unsafeEff_ . unlift

81 (`unEff` es) $ k $ unsafeEff_ . unlift

83

82

84-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the

83-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the

@@ -90,7 +89,7 @@ localSeqUnliftIO

90 -> ((forall r. Eff localEs r -> IO r) -> IO a)

89 -> ((forall r. Eff localEs r -> IO r) -> IO a)

91 -- ^ Continuation with the unlifting function in scope.

90 -- ^ Continuation with the unlifting function in scope.

92 -> Eff es a

91 -> Eff es a

93−localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftIO les k

92+localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftEff les k

94

93

95-- | Create a local unlifting function with the given strategy.

94-- | Create a local unlifting function with the given strategy.

96localUnlift

95localUnlift

@@ -103,10 +102,10 @@ localUnlift

103 -> Eff es a

102 -> Eff es a

104localUnlift (LocalEnv les) strategy k = case strategy of

103localUnlift (LocalEnv les) strategy k = case strategy of

105 SeqUnlift -> unsafeEff $ \es -> do

104 SeqUnlift -> unsafeEff $ \es -> do

106− seqUnliftIO les $ \unlift -> do

105+ seqUnliftEff les $ \unlift -> do

107 (`unEff` es) $ k $ unsafeEff_ . unlift

106 (`unEff` es) $ k $ unsafeEff_ . unlift

108 ConcUnlift p l -> unsafeEff $ \es -> do

107 ConcUnlift p l -> unsafeEff $ \es -> do

109− concUnliftIO les p l $ \unlift -> do

108+ concUnliftEff les p l $ \unlift -> do

110 (`unEff` es) $ k $ unsafeEff_ . unlift

109 (`unEff` es) $ k $ unsafeEff_ . unlift

111

110

112-- | Create a local unlifting function with the given strategy.

111-- | Create a local unlifting function with the given strategy.

@@ -119,10 +118,10 @@ localUnliftIO

119 -- ^ Continuation with the unlifting function in scope.

118 -- ^ Continuation with the unlifting function in scope.

120 -> Eff es a

119 -> Eff es a

121localUnliftIO (LocalEnv les) strategy k = case strategy of

120localUnliftIO (LocalEnv les) strategy k = case strategy of

122− SeqUnlift -> liftIO $ seqUnliftIO les k

121+ SeqUnlift -> liftIO $ seqUnliftEff les k

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

122+ ConcUnlift p l -> liftIO $ concUnliftEff les p l k

124

123

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

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

126--

125--

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

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

128--

127--

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

130--

129--

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

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

132--

131--

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

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

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

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

135withLiftMap

134withLiftMap

136 :: (HasCallStack, SuffixOf es handlerEs)

135 :: (HasCallStack, SuffixOf es handlerEs)

@@ -143,10 +142,10 @@ withLiftMap !_ k = unsafeEff $ \es -> do

143 -- The LocalEnv parameter is not used, but we need it to constraint the

142 -- The LocalEnv parameter is not used, but we need it to constraint the

144 -- localEs type variable. It's also strict so that callers don't cheat.

143 -- localEs type variable. It's also strict so that callers don't cheat.

145 (`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do

144 (`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do

146− seqUnliftIO localEs $ \unlift -> do

145+ seqUnliftEff localEs $ \unlift -> do

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

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

148

147

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

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

150--

149--

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

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

152--

151--

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

154--

153--

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

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

156--

155--

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

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

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

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

159--

158--

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

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

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

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

162--

161--

163-- >>> :{

162-- >>> :{

164-- data Fork :: Effect where

163-- data Fork :: Effect where

@@ -181,17 +180,17 @@ withLiftMapIO

181withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do

180withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do

182 -- The LocalEnv parameter is not used, but we need it to constraint the

181 -- The LocalEnv parameter is not used, but we need it to constraint the

183 -- localEs type variable. It's also strict so that callers don't cheat.

182 -- localEs type variable. It's also strict so that callers don't cheat.

184− seqUnliftIO es $ \unlift -> mapIO $ unlift m

183+ seqUnliftEff es $ \unlift -> mapIO $ unlift m

185

184

186----------------------------------------

185----------------------------------------

187-- Bidirectional lifts

186-- Bidirectional lifts

188

187

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

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

190--

189--

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

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

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

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

193--

192--

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

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

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

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

196localLiftUnlift

195localLiftUnlift

197 :: (HasCallStack, SuffixOf es handlerEs)

196 :: (HasCallStack, SuffixOf es handlerEs)

@@ -203,22 +202,22 @@ localLiftUnlift

203 -> Eff es a

202 -> Eff es a

204localLiftUnlift (LocalEnv les) strategy k = case strategy of

203localLiftUnlift (LocalEnv les) strategy k = case strategy of

205 SeqUnlift -> unsafeEff $ \es -> do

204 SeqUnlift -> unsafeEff $ \es -> do

206− seqUnliftIO es $ \unliftEs -> do

205+ seqUnliftEff es $ \unliftEs -> do

207− seqUnliftIO les $ \unliftLocalEs -> do

206+ seqUnliftEff les $ \unliftLocalEs -> do

208 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)

207 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)

209 ConcUnlift p l -> unsafeEff $ \es -> do

208 ConcUnlift p l -> unsafeEff $ \es -> do

210− concUnliftIO es p l $ \unliftEs -> do

209+ concUnliftEff es p l $ \unliftEs -> do

211− concUnliftIO les p l $ \unliftLocalEs -> do

210+ concUnliftEff les p l $ \unliftLocalEs -> do

212 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)

211 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)

213

212

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

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

215-- unrestricted lifting function.

214-- unrestricted lifting function.

216--

215--

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

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

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

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

219--

218--

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

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

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

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

222localLiftUnliftIO

221localLiftUnliftIO

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

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

224 => LocalEnv localEs handlerEs

223 => LocalEnv localEs handlerEs

@@ -228,19 +227,8 @@ localLiftUnliftIO

228 -- ^ Continuation with the lifting and unlifting function in scope.

227 -- ^ Continuation with the lifting and unlifting function in scope.

229 -> Eff es a

228 -> Eff es a

230localLiftUnliftIO (LocalEnv les) strategy k = case strategy of

229localLiftUnliftIO (LocalEnv les) strategy k = case strategy of

231− SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_

230+ SeqUnlift -> liftIO $ seqUnliftEff les $ k unsafeEff_

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

231+ ConcUnlift p l -> liftIO $ concUnliftEff les p l $ k unsafeEff_

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

232

245-- $setup

233-- $setup

246-- >>> import Control.Concurrent

234-- >>> import Control.Concurrent

effectful-core/src/Effectful/Internal/Effect.hs+23−7

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

8module Effectful.Internal.Effect

9 ( Effect

10 , (:>)(..)

11+ , IdE(..)

12+

13+ -- * Utils

14+ , SuffixOf

11

15

12 -- * Re-exports

16 -- * Re-exports

13 , Type

17 , Type

@@ -19,16 +23,20 @@ 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+-- | Adapter for statically dispatched effects.

27+newtype IdE :: Effect -> Type where

28+ IdE :: (forall m r. e m r) -> IdE 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

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

31+-- the type-level list @es@. This is used to parameterize an

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

32+-- 'Effectful.Monad.Eff' operation over an arbitrary list of effects, so long as

25−-- in the list.

33+-- @e@ is /somewhere/ in the list.

26--

34--

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

35+-- For example, an operation that only needs access to a cell of mutable state

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

36+-- containing an '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+40−59

@@ -1,38 +1,25 @@

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

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

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

6-- in subsequent releases.

5-- in subsequent releases.

7module Effectful.Internal.Env

6module Effectful.Internal.Env

8− ( -- * The environment

9− Env(..)

7+ ( Env

10− , Forks(..)

11− , EnvRef(..)

12−

13− -- ** ForkId

14− , ForkId(..)

15− , ForkIdGen(..)

16− , newForkIdGen

17− , cloneForkIdGen

18− , newForkId

19−

20− -- ** Relinker

21 , Relinker(..)

8 , Relinker(..)

22 , noRelinker

9 , noRelinker

23

10

24− -- * Operations

11+ -- * Operations

25 , emptyEnv

12 , emptyEnv

26 , cloneEnv

13 , cloneEnv

27 , forkEnv

14 , forkEnv

28 , sizeEnv

15 , sizeEnv

29 , checkSizeEnv

16 , checkSizeEnv

30

17

31− -- ** Extending and shrinking

18+ -- ** Extending and shrinking

32 , unsafeConsEnv

19 , unsafeConsEnv

33 , unsafeTailEnv

20 , unsafeTailEnv

34

21

35− -- ** Data retrieval and update

22+ -- ** Data retrieval and update

36 , getEnv

23 , getEnv

37 , putEnv

24 , putEnv

38 , stateEnv

25 , stateEnv

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

43import Control.Monad.Primitive

30import Control.Monad.Primitive

44import Data.IORef

31import Data.IORef

45import Data.Primitive.SmallArray

32import Data.Primitive.SmallArray

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

33+import GHC.Exts (Any)

47import GHC.Stack (HasCallStack)

34import GHC.Stack (HasCallStack)

48import Unsafe.Coerce

35import Unsafe.Coerce

49import qualified Data.IntMap.Strict as IM

36import qualified Data.IntMap.Strict as IM

@@ -81,17 +68,17 @@ type role Env nominal

81-- @

68-- @

82--

69--

83-- The point of execution is currently at (*), i.e. the mainline. Moreover,

70-- The point of execution is currently at (*), i.e. the mainline. Moreover,

84−-- currently (brackets represent forks):

71+-- currently:

85--

72--

86-- - Mainline sees @[e00, e01, e05, e07]@.

73-- - Mainline sees @[e00, e01, e05, e07]@.

87--

74--

88−-- - @e01@ is an interpreted effect, its handler sees @[e00][e02, e03]@.

75+-- - @e01@ is an interpreted effect, its handler sees @[e00, e02, e03]@.

89--

76--

90−-- - @e03@ is an interpreted effect, its handler sees @[e00][e02][e04]@.

77+-- - @e03@ is an interpreted effect, its handler sees @[e00, e02, e04]@.

91--

78--

92−-- - @e05@ is an interpreted effect, its handler sees @[e00, e01][e06]@.

79+-- - @e05@ is an interpreted effect, its handler sees @[e00, e01, e06]@.

93--

80--

94−-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05][e08,

81+-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05, e08,

95-- e09]@.

82-- e09]@.

96--

83--

97-- If an operation from @e01@ is invoked, the environment in the middle of

84-- If an operation from @e01@ is invoked, the environment in the middle of

@@ -114,11 +101,11 @@ type role Env nominal

114-- introduced @e12@), so its local environment was temporarily extended with

101-- introduced @e12@), so its local environment was temporarily extended with

115-- it. Moreover, currently:

102-- it. Moreover, currently:

116--

103--

117−-- - Handler of @e01@ sees @[e00][e02, e03, e10]@.

104+-- - Handler of @e01@ sees @[e00, e02, e03, e10]@.

118--

105--

119−-- - Handler of @e10@ sees @[e00][e02, e03][e11]@.

106+-- - Handler of @e10@ sees @[e00, e02, e03, e11]@.

120--

107--

121−-- - Handler of @e11@ sees @[e00][e02, e03][e12]@.

108+-- - Handler of @e11@ sees @[e00, e02, e03, e12]@.

122--

109--

123data Env (es :: [Effect]) = Env

110data Env (es :: [Effect]) = Env

124 { _forks :: !Forks

111 { _forks :: !Forks

@@ -129,7 +116,6 @@ data Env (es :: [Effect]) = Env

129-- | Local forks of the environment.

116-- | Local forks of the environment.

130data Forks = Forks !ForkId !Int !(IORef EnvRef) Forks | NoFork

117data Forks = Forks !ForkId !Int !(IORef EnvRef) Forks | NoFork

131

118

132−-- | Data held in the environment.

133data EnvRef = EnvRef

119data EnvRef = EnvRef

134 { _size :: !Int

120 { _size :: !Int

135 , _data :: !(SmallMutableArray RealWorld Any)

121 , _data :: !(SmallMutableArray RealWorld Any)

@@ -139,7 +125,6 @@ data EnvRef = EnvRef

139----------------------------------------

125----------------------------------------

140-- ForkId

126-- ForkId

141

127

142−-- | Internal id of the fork.

143newtype ForkId = ForkId { unForkId :: Int }

128newtype ForkId = ForkId { unForkId :: Int }

144

129

145-- | 'ForkId' generation.

130-- | 'ForkId' generation.

@@ -167,11 +152,11 @@ newForkId (ForkIdGen ref) = do

167-- the environment.

152-- the environment.

168newtype Relinker :: (Effect -> Type) -> Effect -> Type where

153newtype Relinker :: (Effect -> Type) -> Effect -> Type where

169 Relinker

154 Relinker

170− :: ((forall es. Env es -> IO (Env es)) -> adapter e -> IO (adapter e))

155+ :: ((forall es. Env es -> IO (Env es)) -> handler e -> IO (handler e))

171− -> Relinker adapter e

156+ -> Relinker handler e

172

157

173-- | A dummy 'Relinker' that does nothing.

158-- | A dummy 'Relinker' that does nothing.

174−noRelinker :: Relinker adapter e

159+noRelinker :: Relinker handler e

175noRelinker = Relinker $ \_ -> pure

160noRelinker = Relinker $ \_ -> pure

176

161

177----------------------------------------

162----------------------------------------

@@ -359,7 +344,7 @@ checkSizeEnv k (Env (Forks _ baseIx lref _) _ _) = do

359-- This function is __highly unsafe__ because it renders the input 'Env'

344-- This function is __highly unsafe__ because it renders the input 'Env'

360-- unusable until the corresponding 'unsafeTailEnv' call is made, but it's not

345-- unusable until the corresponding 'unsafeTailEnv' call is made, but it's not

361-- checked anywhere.

346-- checked anywhere.

362−unsafeConsEnv :: adapter e -> Relinker adapter e -> Env es -> IO (Env (e : es))

347+unsafeConsEnv :: handler e -> Relinker handler e -> Env es -> IO (Env (e : es))

363unsafeConsEnv e f (Env fork gref gen) = case fork of

348unsafeConsEnv e f (Env fork gref gen) = case fork of

364 NoFork -> do

349 NoFork -> do

365 extendEnvRef gref

350 extendEnvRef gref

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

418

403

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

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

420getEnv

405getEnv

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

406+ :: forall e es handler. e :> es

422 => Env es

407 => Env es

423− -> IO (adapter e)

408+ -> IO (handler e)

424getEnv env = do

409getEnv env = do

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

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

426 fromAny <$> readSmallArray es i

411 fromAny <$> readSmallArray es i

427

412

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

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

429putEnv

414putEnv

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

415+ :: forall e es handler. e :> es

431 => Env es

416 => Env es

432− -> adapter e

417+ -> handler e

433 -> IO ()

418 -> IO ()

434putEnv env e = do

419putEnv env e = do

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

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

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

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

437

422

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

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

439stateEnv

424stateEnv

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

425+ :: forall e es handler a. e :> es

441 => Env es

426 => Env es

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

427+ -> (handler e -> (a, handler e))

443 -> IO a

428 -> IO a

444stateEnv env f = do

429stateEnv env f = do

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

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

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

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

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

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

448 pure a

433 pure a

449

434

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

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

451modifyEnv

436modifyEnv

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

437+ :: forall e es handler. e :> es

453 => Env es

438 => Env es

454− -> (adapter e -> adapter e)

439+ -> (handler e -> handler e)

455 -> IO ()

440 -> IO ()

456modifyEnv env f = do

441modifyEnv env f = do

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

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

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

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

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

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

460

445

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

470 fs <- newSmallArray 0 undefinedData

455 fs <- newSmallArray 0 undefinedData

471 newIORef $ EnvRef 0 es fs

456 newIORef $ EnvRef 0 es fs

472

457

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.

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

478getLocation

459getLocation

479 :: Int

460 :: Int

480 -> Env es

461 -> Env es

481− -> IO Location

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

482getLocation ixE (Env fork ref _) = do

463getLocation ixE (Env fork ref _) = do

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

464+ EnvRef n es _ <- readIORef ref

484 -- Optimized for the common access pattern:

465 -- Optimized for the common access pattern:

485 --

466 --

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

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

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

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

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

490 -- specific effects for reinterpretation.

471 -- specific effects for reinterpretation.

491 case fork of

472 case fork of

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

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

493 Forks _ baseIx lref forks -> do

474 Forks _ baseIx lref forks -> do

494 EnvRef ln les _ <- readIORef lref

475 EnvRef ln les _ <- readIORef lref

495 let i = ix (baseIx + ln)

476 let i = ix (baseIx + ln)

496 if i >= baseIx

477 if i >= baseIx

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

478+ then pure (i - baseIx, les)

498− else go es# i forks

479+ else go es i forks

499 where

480 where

500− go :: SmallMutableArray# RealWorld Any

481+ go :: SmallMutableArray RealWorld Any

501 -> Int

482 -> Int

502 -> Forks

483 -> Forks

503− -> IO Location

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

504− go es# i = \case

485+ go es i = \case

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

486+ NoFork -> pure (i, es)

506 Forks _ baseIx lref forks -> do

487 Forks _ baseIx lref forks -> do

507 EnvRef _ les _ <- readIORef lref

488 EnvRef _ les _ <- readIORef lref

508 if i >= baseIx

489 if i >= baseIx

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

490+ then pure (i - baseIx, les)

510− else go es# i forks

491+ else go es i forks

511

492

512 ix :: Int -> Int

493 ix :: Int -> Int

513 ix n = n - ixE - 1

494 ix n = n - ixE - 1

effectful-core/src/Effectful/Internal/Monad.hs+128−123

@@ -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,41 +22,48 @@ 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(..)

33 , unliftStrategy

34 , withUnliftStrategy

35 , withEffToIO

36+ , UnliftError(..)

36

37

37− -- ** Low-level unlifts

38+ --- *** Low-level helpers

38− , seqUnliftIO

39+ , unsafeLiftMapIO

39− , concUnliftIO

40+ , seqUnliftEff

41+ , concUnliftEff

40

42

41 -- * Effects

43 -- * Effects

42

44

43− -- ** Dynamic dispatch

45+ -- ** Handler

44 , EffectHandler

46 , EffectHandler

45 , LocalEnv(..)

47 , LocalEnv(..)

46− , HandlerA(..)

48+ , Handler(..)

47 , runHandler

49 , runHandler

50+

51+ -- *** Sending operations

48 , send

52 , send

49

53

50− -- ** Static dispatch

54+ -- ** Primitive

51− , DataA(..)

55+

52− , runData

56+ -- *** Running

53− , evalData

57+ , runEffect

54− , execData

58+ , evalEffect

55− , getData

59+ , execEffect

56− , putData

60+

57− , stateData

61+ -- *** Modification

58− , stateDataM

62+ , getEffect

59− , localData

63+ , putEffect

64+ , stateEffect

65+ , stateEffectM

66+ , localEffect

60 ) where

67 ) where

61

68

62import Control.Applicative (liftA2)

69import Control.Applicative (liftA2)

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

79

86

80type role Eff nominal representational

87type role Eff nominal representational

81

88

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

89+-- | The 'Eff' monad provides the implementation of an operation that performs

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

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

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

91+-- contains all the effects that the operation may perform. For example, an

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

92+-- operation that produces an 'Integer' by consuming a 'String' from the global

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

93+-- environment and acting upon a single mutable cell containing a 'Bool' would

87−-- would have the following type:

94+-- have the following type:

88--

95--

89-- @

96-- @

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

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

91-- @

98-- @

92--

99--

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

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

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

102+-- effects without coupling an operation to a concrete list of effects. For

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

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

104+-- following type:

97--

105--

98-- @

106-- @

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

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

100-- @

108-- @

101--

109--

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

110+-- This abstraction allows the operation to be used in functions that may

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

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

104-- order.

112-- order.

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

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

106 deriving (Monoid, Semigroup)

114 deriving (Monoid, Semigroup)

107

115

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

116+-- | Run a pure 'Eff' operation.

109--

117--

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

118+-- For running operations with side effects see 'runEff'.

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

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

112runPureEff (Eff m) =

120runPureEff (Eff m) =

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

121+ -- 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

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

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

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

116 --

124 --

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

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

118− -- cleanup actions to run.

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

119 unsafeDupablePerformIO $ m =<< emptyEnv

127 unsafeDupablePerformIO $ m =<< emptyEnv

120

128

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

129----------------------------------------

@@ -128,68 +136,86 @@ unEff (Eff m) = m

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

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

129--

137--

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

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

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

139+-- 'IO' actions into pure 'Eff' operations.

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

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

133unsafeEff m = Eff (oneShot m)

141unsafeEff m = Eff (oneShot m)

134

142

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

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

136--

144--

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

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

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

146+-- 'IO' actions into pure 'Eff' operations.

139unsafeEff_ :: IO a -> Eff es a

147unsafeEff_ :: IO a -> Eff es a

140unsafeEff_ m = unsafeEff $ \_ -> m

148unsafeEff_ m = unsafeEff $ \_ -> m

141

149

150+-- | Utility for lifting 'IO' operations of type

151+--

152+-- @'IO' a -> 'IO' b@

153+--

154+-- to

155+--

156+-- @'Eff' es a -> 'Eff' es b@

157+--

158+-- This function is __unsafe__ because:

159+--

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

161+-- operations.

162+--

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

164+-- not checked anywhere.

165+unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b

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

167+

142----------------------------------------

168----------------------------------------

143−-- Unlifting IO

169+-- Unlifting Eff

144

170

145-- | Get the current 'UnliftStrategy'.

171-- | Get the current 'UnliftStrategy'.

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

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

147unliftStrategy = do

173unliftStrategy = do

148− DataA (IOE unlift) <- getData

174+ IdE (IOE unlift) <- getEffect

149 pure unlift

175 pure unlift

150

176

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

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

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

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

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

179+withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)

154

180

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

181+-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').

156--

182--

157−-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'

183+-- Exceptions thrown by this function:

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

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

160--

184--

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

185+-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.

162−withEffToIO

186+seqUnliftEff

163− :: (HasCallStack, IOE :> es)

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

165− -- ^ Continuation with the unlifting function in scope.

166− -> Eff es a

167−withEffToIO f = unliftStrategy >>= \case

168− SeqUnlift -> unsafeEff $ \es -> seqUnliftIO es f

169− ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do

170− unsafeEff $ \es -> concUnliftIO es p b f

171−

172−-- | Create an unlifting function with the 'SeqUnlift' strategy.

173−seqUnliftIO

174 :: HasCallStack

187 :: HasCallStack

175 => Env es

188 => Env es

176− -- ^ The environment.

177 -> ((forall r. Eff es r -> IO r) -> IO a)

189 -> ((forall r. Eff es r -> IO r) -> IO a)

178− -- ^ Continuation with the unlifting function in scope.

179 -> IO a

190 -> IO a

180−seqUnliftIO es k = seqUnlift k es unEff

191+seqUnliftEff es k = seqUnliftIO k es unEff

181

192

182−-- | Create an unlifting function with the 'ConcUnlift' strategy.

193+-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').

183−concUnliftIO

194+concUnliftEff

184 :: HasCallStack

195 :: HasCallStack

185 => Env es

196 => Env es

186− -- ^ The environment.

187 -> Persistence

197 -> Persistence

188 -> Limit

198 -> Limit

189 -> ((forall r. Eff es r -> IO r) -> IO a)

199 -> ((forall r. Eff es r -> IO r) -> IO a)

190− -- ^ Continuation with the unlifting function in scope.

191 -> IO a

200 -> IO a

192−concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff

201+concUnliftEff es persistence limit k = concUnliftIO persistence limit k es unEff

202+

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

204+--

205+-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'

206+-- constraint for accurate stack traces in case an insufficiently powerful

207+-- 'UnliftStrategy' is used and the unlifting function fails.

208+--

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

210+withEffToIO

211+ :: (HasCallStack, IOE :> es)

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

213+ -- ^ Continuation with the unlifting function in scope.

214+ -> Eff es a

215+withEffToIO f = unliftStrategy >>= \case

216+ SeqUnlift -> unsafeEff $ \es -> seqUnliftEff es f

217+ ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do

218+ unsafeEff $ \es -> concUnliftEff es p b f

193

219

194----------------------------------------

220----------------------------------------

195-- Base

221-- Base

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

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

284----------------------------------------

259-- IO

285-- IO

260

286

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

287+-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.

262newtype IOE :: Effect where

288newtype IOE :: Effect where

263 IOE :: UnliftStrategy -> IOE m r

289 IOE :: UnliftStrategy -> IOE m r

264

290

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

291+-- | Run an 'Eff' operation with side effects.

266--

292--

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

293+-- For running pure operations see 'runPureEff'.

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

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

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

295+runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv

270

296

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

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

272 liftIO = unsafeEff_

298 liftIO = unsafeEff_

@@ -290,20 +316,20 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where

290----------------------------------------

316----------------------------------------

291-- Primitive

317-- Primitive

292

318

293−-- | Provide the ability to perform primitive state-transformer actions.

319+-- | An effect to perform primitive state-transformer actions.

294data Prim :: Effect where

320data Prim :: Effect where

295 Prim :: Prim m r

321 Prim :: Prim m r

296

322

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

323+-- | Run an 'Eff' operation with primitive state-transformer actions.

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

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

299−runPrim = evalData (DataA Prim)

325+runPrim = evalEffect (IdE Prim)

300

326

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

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

302 type PrimState (Eff es) = RealWorld

328 type PrimState (Eff es) = RealWorld

303 primitive = unsafeEff_ . IO

329 primitive = unsafeEff_ . IO

304

330

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

331----------------------------------------

306−-- Dynamic dispatch

332+-- Handler

307

333

308type role LocalEnv nominal nominal

334type role LocalEnv nominal nominal

309

335

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

319type EffectHandler e es

345type EffectHandler e es

320 = forall a localEs. HasCallStack

346 = forall a localEs. HasCallStack

321 => LocalEnv localEs es

347 => LocalEnv localEs es

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

348+ -- ^ Capture of the local environment for handling local 'Eff' operations when

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

349+ -- @e@ is a higher order effect.

324 -> e (Eff localEs) a

350 -> e (Eff localEs) a

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

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

326 -> Eff es a

352 -> Eff es a

327

353

328−-- | An adapter for dynamically dispatched effects.

329−--

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

354+-- | An effect handler bundled along with its environment.

331−data HandlerA :: Effect -> Type where

355+data Handler :: Effect -> Type where

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

356+ Handler :: !(Env es) -> !(EffectHandler e es) -> Handler e

333

357

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

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

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

359+runHandler :: Handler e -> Eff (e : es) a -> Eff es a

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

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

337 size0 <- sizeEnv es0

361 size0 <- sizeEnv es0

338 E.bracket (unsafeConsEnv e relinker es0)

362 E.bracket (unsafeConsEnv e relinker es0)

339 (unsafeTailEnv size0)

363 (unsafeTailEnv size0)

340 (\es -> unEff m es)

364 (\es -> unEff m es)

341 where

365 where

342− relinker :: Relinker HandlerA e

366+ relinker :: Relinker Handler e

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

367+ relinker = Relinker $ \relink (Handler env handle) -> do

344− newHandlerEs <- relink handlerEs

368+ newEnv <- relink env

345− pure $ HandlerA newHandlerEs handle

369+ pure $ Handler newEnv handle

346

370

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

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

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

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

349send op = unsafeEff $ \es -> do

373send op = unsafeEff $ \es -> do

350− HandlerA handlerEs handle <- getEnv es

374+ Handler env handle <- getEnv es

351− unEff (handle (LocalEnv es) op) handlerEs

375+ unEff (handle (LocalEnv es) op) env

352

376

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

377----------------------------------------

354−-- Static dispatch

378+-- Helpers

355

379

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)

380+runEffect :: handler e -> Eff (e : es) a -> Eff es (a, handler e)

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

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

367 size0 <- sizeEnv es0

382 size0 <- sizeEnv es0

368 E.bracket (unsafeConsEnv e0 noRelinker es0)

383 E.bracket (unsafeConsEnv e0 noRelinker es0)

369 (unsafeTailEnv size0)

384 (unsafeTailEnv size0)

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

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

371

386

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

387+evalEffect :: handler e -> Eff (e : es) a -> Eff es a

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

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

376 size0 <- sizeEnv es0

389 size0 <- sizeEnv es0

377 E.bracket (unsafeConsEnv e noRelinker es0)

390 E.bracket (unsafeConsEnv e noRelinker es0)

378 (unsafeTailEnv size0)

391 (unsafeTailEnv size0)

379 (\es -> unEff m es)

392 (\es -> unEff m es)

380

393

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)

394+execEffect :: handler e -> Eff (e : es) a -> Eff es (handler e)

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

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

385 size0 <- sizeEnv es0

396 size0 <- sizeEnv es0

386 E.bracket (unsafeConsEnv e0 noRelinker es0)

397 E.bracket (unsafeConsEnv e0 noRelinker es0)

387 (unsafeTailEnv size0)

398 (unsafeTailEnv size0)

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

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

389

400

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

401+getEffect :: e :> es => Eff es (handler e)

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

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

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

393

403

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

404+putEffect :: e :> es => handler e -> Eff es ()

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

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

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

397

406

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

407+stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a

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

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

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

401

409

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

410+stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a

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

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

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

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

407 putEnv es e

413 putEnv es e

408 pure a

414 pure a

409

415

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

416+localEffect :: e :> es => (handler e -> handler e) -> Eff es a -> Eff es a

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

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

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

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

414 (\e -> putEnv es e)

419 (\e -> putEnv es e)

415 (\_ -> unEff m es)

420 (\_ -> unEff m es)

effectful-core/src/Effectful/Internal/Unlift.hs+78−35

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

1+{-# LANGUAGE DeriveGeneric #-}

1{-# LANGUAGE MagicHash #-}

2{-# LANGUAGE MagicHash #-}

2{-# LANGUAGE UnboxedTuples #-}

3{-# LANGUAGE UnboxedTuples #-}

3{-# OPTIONS_HADDOCK not-home #-}

4{-# OPTIONS_HADDOCK not-home #-}

@@ -12,13 +13,17 @@ module Effectful.Internal.Unlift

12 , Limit(..)

13 , Limit(..)

13

14

14 -- * Unlifting functions

15 -- * Unlifting functions

15− , seqUnlift

16+ , seqUnliftIO

16− , concUnlift

17+ , concUnliftIO

17− , ephemeralConcUnlift

18+ , ephemeralConcUnliftIO

18− , persistentConcUnlift

19+ , persistentConcUnliftIO

20+

21+ -- * Unlifting errors

22+ , UnliftError(..)

19 ) where

23 ) where

20

24

21import Control.Concurrent

25import Control.Concurrent

26+import Control.Exception

22import Control.Monad

27import Control.Monad

23import GHC.Conc.Sync (ThreadId(..))

28import GHC.Conc.Sync (ThreadId(..))

24import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)

29import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)

@@ -35,9 +40,8 @@ import Effectful.Internal.Utils

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

40----------------------------------------

36-- Unlift strategies

41-- Unlift strategies

37

42

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

43+-- | The strategy to use when unlifting 'Eff' operations via 'withRunInIO' or

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

44+-- the 'Effectful.Interpreter.localUnlift' family.

40−-- family.

41data UnliftStrategy

45data UnliftStrategy

42 = SeqUnlift

46 = SeqUnlift

43 -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call

47 -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call

@@ -92,24 +96,26 @@ data Limit

92-- Unlift functions

96-- Unlift functions

93

97

94-- | Sequential unlift.

98-- | Sequential unlift.

95−seqUnlift

99+--

100+-- Exceptions thrown by this function:

101+--

102+-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.

103+seqUnliftIO

96 :: HasCallStack

104 :: HasCallStack

97 => ((forall r. m r -> IO r) -> IO a)

105 => ((forall r. m r -> IO r) -> IO a)

98 -> Env es

106 -> Env es

99 -> (forall r. m r -> Env es -> IO r)

107 -> (forall r. m r -> Env es -> IO r)

100 -> IO a

108 -> IO a

101−seqUnlift k es unEff = do

109+seqUnliftIO k es unEff = do

102 tid0 <- myThreadId

110 tid0 <- myThreadId

103 k $ \m -> do

111 k $ \m -> do

104 tid <- myThreadId

112 tid <- myThreadId

105 if tid `eqThreadId` tid0

113 if tid `eqThreadId` tid0

106 then unEff m es

114 then unEff m es

107− else error

115+ else throwIO InvalidUseOfSeqUnlift

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

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

110

116

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

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

112−concUnlift

118+concUnliftIO

113 :: HasCallStack

119 :: HasCallStack

114 => Persistence

120 => Persistence

115 -> Limit

121 -> Limit

@@ -117,18 +123,23 @@ concUnlift

117 -> Env es

123 -> Env es

118 -> (forall r. m r -> Env es -> IO r)

124 -> (forall r. m r -> Env es -> IO r)

119 -> IO a

125 -> IO a

120−concUnlift Ephemeral (Limited uses) k =

126+concUnliftIO Ephemeral (Limited uses) k =

121− ephemeralConcUnlift uses k

127+ ephemeralConcUnliftIO uses k

122−concUnlift Ephemeral Unlimited k =

128+concUnliftIO Ephemeral Unlimited k =

123− ephemeralConcUnlift maxBound k

129+ ephemeralConcUnliftIO maxBound k

124−concUnlift Persistent (Limited threads) k =

130+concUnliftIO Persistent (Limited threads) k =

125− persistentConcUnlift False threads k

131+ persistentConcUnliftIO False threads k

126−concUnlift Persistent Unlimited k =

132+concUnliftIO Persistent Unlimited k =

127− persistentConcUnlift True maxBound k

133+ persistentConcUnliftIO True maxBound k

128

134

129-- | Concurrent unlift that doesn't preserve the environment between calls to

135-- | Concurrent unlift that doesn't preserve the environment between calls to

130-- the unlifting function in threads other than its creator.

136-- the unlifting function in threads other than its creator.

131−ephemeralConcUnlift

137+--

138+-- Exceptions thrown by this function:

139+--

140+-- - 'InvalidNumberOfUses' if the number of uses is less or equal zero.

141+-- - 'ExceededNumberOfUses' if the unlift function is called too often.

142+ephemeralConcUnliftIO

132 :: HasCallStack

143 :: HasCallStack

133 => Int

144 => Int

134 -- ^ Number of permitted uses of the unlift function.

145 -- ^ Number of permitted uses of the unlift function.

@@ -136,9 +147,9 @@ ephemeralConcUnlift

136 -> Env es

147 -> Env es

137 -> (forall r. m r -> Env es -> IO r)

148 -> (forall r. m r -> Env es -> IO r)

138 -> IO a

149 -> IO a

139−ephemeralConcUnlift uses k es0 unEff = do

150+ephemeralConcUnliftIO uses k es0 unEff = do

140 unless (uses > 0) $ do

151 unless (uses > 0) $ do

141− error $ "Invalid number of uses: " ++ show uses

152+ throwIO $ InvalidNumberOfUses uses

142 tid0 <- myThreadId

153 tid0 <- myThreadId

143 -- Create a copy of the environment as a template for the other threads to

154 -- Create a copy of the environment as a template for the other threads to

144 -- use. This can't be done from inside the callback as the environment might

155 -- use. This can't be done from inside the callback as the environment might

@@ -149,10 +160,7 @@ ephemeralConcUnlift uses k es0 unEff = do

149 es <- myThreadId >>= \case

160 es <- myThreadId >>= \case

150 tid | tid0 `eqThreadId` tid -> pure es0

161 tid | tid0 `eqThreadId` tid -> pure es0

151 _ -> modifyMVar mvUses $ \case

162 _ -> modifyMVar mvUses $ \case

152− 0 -> error

163+ 0 -> throwIO $ ExceededNumberOfUses uses

153− $ "Number of permitted calls (" ++ show uses ++ ") to the unlifting "

154− ++ "function in other threads was exceeded. Please increase the limit "

155− ++ "or use the unlimited variant."

156 1 -> pure (0, esTemplate)

164 1 -> pure (0, esTemplate)

157 n -> do

165 n -> do

158 let newUses = n - 1

166 let newUses = n - 1

@@ -162,7 +170,13 @@ ephemeralConcUnlift uses k es0 unEff = do

162

170

163-- | Concurrent unlift that preserves the environment between calls to the

171-- | Concurrent unlift that preserves the environment between calls to the

164-- unlifting function within a particular thread.

172-- unlifting function within a particular thread.

165−persistentConcUnlift

173+--

174+-- Exceptions thrown by this function:

175+--

176+-- - 'InvalidNumberOfThreads' if the number of threads is less or equal zero.

177+-- - 'ExceededNumberOfThreads' if the unlift function is called by too many

178+-- threads.

179+persistentConcUnliftIO

166 :: HasCallStack

180 :: HasCallStack

167 => Bool

181 => Bool

168 -> Int

182 -> Int

@@ -171,9 +185,9 @@ persistentConcUnlift

171 -> Env es

185 -> Env es

172 -> (forall r. m r -> Env es -> IO r)

186 -> (forall r. m r -> Env es -> IO r)

173 -> IO a

187 -> IO a

174−persistentConcUnlift cleanUp threads k es0 unEff = do

188+persistentConcUnliftIO cleanUp threads k es0 unEff = do

175 unless (threads > 0) $ do

189 unless (threads > 0) $ do

176− error $ "Invalid number of threads: " ++ show threads

190+ throwIO $ InvalidNumberOfThreads threads

177 tid0 <- myThreadId

191 tid0 <- myThreadId

178 -- Create a copy of the environment as a template for the other threads to

192 -- Create a copy of the environment as a template for the other threads to

179 -- use. This can't be done from inside the callback as the environment might

193 -- use. This can't be done from inside the callback as the environment might

@@ -191,10 +205,7 @@ persistentConcUnlift cleanUp threads k es0 unEff = do

191 case mes of

205 case mes of

192 Just es -> pure (te, es)

206 Just es -> pure (te, es)

193 Nothing -> case teCapacity te of

207 Nothing -> case teCapacity te of

194− 0 -> error

208+ 0 -> throwIO $ ExceededNumberOfThreads threads

195− $ "Number of other threads (" ++ show threads ++ ") permitted to "

196− ++ "use the unlifting function was exceeded. Please increase the "

197− ++ "limit or use the unlimited variant."

198 1 -> do

209 1 -> do

199 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp

210 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp

200 let newEntries = ThreadEntries

211 let newEntries = ThreadEntries

@@ -212,6 +223,38 @@ persistentConcUnlift cleanUp threads k es0 unEff = do

212 newEntries `seq` pure (newEntries, es)

223 newEntries `seq` pure (newEntries, es)

213 unEff m es

224 unEff m es

214

225

226+----------------------------------------

227+-- Errors

228+

229+-- | An type used for errors occuring in unlifting functions.

230+--

231+-- Use the 'displayException' method of the 'Exception' type class to get

232+-- descriptive error messages.

233+data UnliftError

234+ = InvalidNumberOfThreads !Int

235+ | InvalidNumberOfUses !Int

236+ | InvalidUseOfSeqUnlift

237+ | ExceededNumberOfThreads !Int

238+ | ExceededNumberOfUses !Int

239+ deriving (Eq, Generic, Show)

240+

241+instance Exception UnliftError where

242+ displayException (InvalidNumberOfThreads threads) =

243+ "Invalid number of threads: " ++ show threads

244+ displayException (InvalidNumberOfUses uses) =

245+ "Invalid number of uses: " ++ show uses

246+ displayException (ExceededNumberOfThreads threads) =

247+ "Number of other threads (" ++ show threads ++ ") permitted to use the " ++

248+ "unlifting function was exceeded. Please increase the limit or use the " ++

249+ "unlimited variant."

250+ displayException (ExceededNumberOfUses uses) =

251+ "Number of permitted calls (" ++ show uses ++ ") to the unlifting " ++

252+ "function in other threads was exceeded. Please increase the limit or " ++

253+ "use the unlimited variant."

254+ displayException InvalidUseOfSeqUnlift =

255+ "If you want to use the unlifting function to run Eff operations in " ++

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

257+

215----------------------------------------

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

216-- Data types

259-- Data types

217

260

effectful-core/src/Effectful/Monad.hs+1

@@ -18,6 +18,7 @@ module Effectful.Monad

18 , unliftStrategy

19 , withUnliftStrategy

20 , withEffToIO

21+ , UnliftError(..)

21

22

22 -- * Re-exports

23 -- * Re-exports

23 , MonadIO(..)

24 , MonadIO(..)

effectful-core/src/Effectful/Prim.hs−1

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

1−-- | Provider of the 'MonadPrim' instance for 'Eff'.

2module Effectful.Prim

1module Effectful.Prim

3 ( Prim

2 ( Prim

4 , runPrim

3 , runPrim

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

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

1−-- | Support for access to a read only value of a particular type.

1+-- | The 'Reader' effect.

2module Effectful.Reader

3 ( Reader

4 , runReader

@@ -7,8 +7,8 @@ module Effectful.Reader

7 , local

8 ) where

9

10−import Effectful.Dispatch.Static

10+import Effectful.Internal.Effect

11−import Effectful.Monad

11+import Effectful.Internal.Monad

12

13-- | Provide access to a strict (WHNF), thread local, read only value of type

14-- @r@.

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

effectful-core/src/Effectful/Reader/Dynamic.hs+1−1

@@ -6,7 +6,7 @@ module Effectful.Reader.Dynamic

6 , local

7 ) where

8

9−import Effectful.Dispatch.Dynamic

9+import Effectful.Handler

10import Effectful.Monad

11import qualified Effectful.Reader as R

12

effectful-core/src/Effectful/State/Dynamic.hs+2−2

@@ -22,12 +22,12 @@ module Effectful.State.Dynamic

22 , modifyM

23 ) where

24

25−import Effectful.Dispatch.Dynamic

25+import Effectful.Handler

26import Effectful.Monad

27import qualified Effectful.State.Local as L

28import qualified Effectful.State.Shared as S

29

30−-- | Provide access to a mutable value of type @s@.

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

31data State s :: Effect where

32 Get :: State s m s

33 Put :: s -> State s m ()

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

@@ -1,29 +1,12 @@

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

1+-- | The 'State' effect.

2--

3+-- Represented as a pure value underneath, therefore:

4+--

3−-- - thread local (if you want the value to be shared between threads, have a

5+-- - thread local (if you need the state to be shared between threads, have a

4-- look at "Effectful.State.Shared"),

6-- look at "Effectful.State.Shared"),

5--

7--

6-- - very fast.

8-- - very fast.

7--

9--

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

10module Effectful.State.Local

28 ( State

11 ( State

29 , runState

12 , runState

@@ -38,10 +21,10 @@ module Effectful.State.Local

38 , modifyM

21 , modifyM

39 ) where

22 ) where

40

23

41−import Effectful.Dispatch.Static

24+import Effectful.Internal.Effect

42−import Effectful.Monad

25+import Effectful.Internal.Monad

43

26

44−-- | Provide access to a strict (WHNF), thread local, mutable value of type @s@.

27+-- | Provide access to a strict (WHNF), thread local, mutable state of type @s@.

45newtype State s :: Effect where

28newtype State s :: Effect where

46 State :: s -> State s m r

29 State :: s -> State s m r

47

30

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

52 -> Eff (State s : es) a

35 -> Eff (State s : es) a

53 -> Eff es (a, s)

36 -> Eff es (a, s)

54runState s0 m = do

37runState s0 m = do

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

38+ (a, IdE (State s)) <- runEffect (IdE (State s0)) m

56 pure (a, s)

39 pure (a, s)

57

40

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

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

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

61 :: s -- ^ An initial state.

44 :: s -- ^ An initial state.

62 -> Eff (State s : es) a

45 -> Eff (State s : es) a

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

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

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

47+evalState s = evalEffect (IdE (State s))

65

48

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

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

67-- state, discarding the final value.

50-- state, discarding the final value.

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

70 -> Eff (State s : es) a

53 -> Eff (State s : es) a

71 -> Eff es s

54 -> Eff es s

72execState s0 m = do

55execState s0 m = do

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

56+ IdE (State s) <- execEffect (IdE (State s0)) m

74 pure s

57 pure s

75

58

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

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

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

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

78get = do

61get = do

79− DataA (State s) <- getData

62+ IdE (State s) <- getEffect

80 pure s

63 pure s

81

64

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

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

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

90

73

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

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

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

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

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

76+put s = putEffect (IdE (State s))

94

77

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

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

96state

79state

97 :: State s :> es

80 :: State s :> es

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

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

99 -> Eff es a

82 -> Eff es a

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

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

101

84

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

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

103--

86--

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

113 :: State s :> es

96 :: State s :> es

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

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

115 -> Eff es a

98 -> Eff es a

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

99+stateM f = stateEffectM $ \(IdE (State s0)) -> do

117 (a, s) <- f s0

100 (a, s) <- f s0

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

101+ pure (a, IdE (State s))

119

102

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

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

121--

104--

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

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

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

126 -> Eff es ()

109 -> Eff es ()

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

110modifyM 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+15−63

@@ -1,29 +1,11 @@

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

1+-- | The 'State' effect.

2--

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

3+-- Represented as an 'MVar' underneath, therefore:

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

5--

4--

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

5+-- - shareable between multiple threads,

7--

6--

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

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

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

10−-- modifications when an exception is received:

11--

8--

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

9module Effectful.State.Shared

28 ( State

10 ( State

29 , runState

11 , runState

@@ -40,88 +22,58 @@ module Effectful.State.Shared

40

22

41import Control.Concurrent.MVar

23import Control.Concurrent.MVar

42

24

43−import Effectful.Dispatch.Static

25+import Effectful.Internal.Effect

26+import Effectful.Internal.Env

44−import Effectful.Monad

27+import Effectful.Internal.Monad

45

28

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

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

47newtype State s :: Effect where

30newtype State s :: Effect where

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

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

49

32

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

51−-- value along with the final state.

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

59−-- value, discarding the final state.

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

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

61evalState s m = do

40evalState s m = do

62 v <- unsafeEff_ $ newMVar s

41 v <- unsafeEff_ $ newMVar s

63− evalData (DataA (State v)) m

42+ evalEffect (IdE (State v)) m

64

43

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

66−-- state, discarding the final value.

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

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

68execState s m = do

45execState s m = do

69 v <- unsafeEff_ $ newMVar s

46 v <- unsafeEff_ $ newMVar s

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

47+ _ <- evalEffect (IdE (State v)) m

71 unsafeEff_ $ readMVar v

48 unsafeEff_ $ readMVar v

72

49

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

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

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

75get = unsafeEff $ \es -> do

51get = unsafeEff $ \es -> do

76− DataA (State v) <- getEnv es

52+ IdE (State v) <- getEnv es

77 readMVar v

53 readMVar v

78

54

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

80−--

81−-- @'gets' f ≡ f '<$>' 'get'@

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

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

83gets f = f <$> get

56gets f = f <$> get

84

57

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

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

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

87put s = unsafeEff $ \es -> do

59put s = unsafeEff $ \es -> do

88− DataA (State v) <- getEnv es

60+ IdE (State v) <- getEnv es

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

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

90

62

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

92−--

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

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

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

95state f = unsafeEff $ \es -> do

64state f = unsafeEff $ \es -> do

96− DataA (State v) <- getEnv es

65+ IdE (State v) <- getEnv es

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

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

98

67

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

100−--

101−-- @'modify' f ≡ 'state' (\\s -> ((), f s))@

102−--

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

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

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

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

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

106

70

107−-- | Apply the monadic function to the current state and return a value.

108−--

109−-- /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

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

111stateM f = unsafeEff $ \es -> do

72stateM f = unsafeEff $ \es -> do

112− DataA (State v) <- getEnv es

73+ IdE (State v) <- getEnv es

113 modifyMVar v $ \s0 -> do

74 modifyMVar v $ \s0 -> do

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

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

115 s `seq` pure (s, a)

76 s `seq` pure (s, a)

116

77

117−-- | Apply the monadic function to the current state.

118−--

119−-- @'modifyM' f ≡ 'stateM' (\\s -> ((), ) '<$>' f s)@

120−--

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

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

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

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

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

124−

125−-- $setup

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

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

effectful-core/src/Effectful/Writer/Dynamic.hs+1−1

@@ -15,7 +15,7 @@ module Effectful.Writer.Dynamic

15 , listens

16 ) where

17

18−import Effectful.Dispatch.Dynamic

18+import Effectful.Handler

19import Effectful.Monad

20import qualified Effectful.Writer.Local as L

21import qualified Effectful.Writer.Shared as S

effectful-core/src/Effectful/Writer/Local.hs+16−28

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

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

1+-- | The 'Writer' effect.

2--

3+-- Represented as a pure value underneath, therefore:

4+--

3−-- - thread local (if you want the value to be shared between threads, have a

5+-- - thread local (if you need the state to be shared between threads, have a

4-- look at "Effectful.Writer.Shared"),

6-- look at "Effectful.Writer.Shared"),

5--

7--

6-- - very fast.

8-- - very fast.

@@ -24,10 +26,11 @@ module Effectful.Writer.Local

24 , listens

26 , listens

25 ) where

27 ) where

26

28

27−import Control.Exception (onException, mask)

29+import Control.Exception

28

30

29−import Effectful.Dispatch.Static

31+import Effectful.Internal.Effect

32+import Effectful.Internal.Env

30−import Effectful.Monad

33+import Effectful.Internal.Monad

31

34

32-- | Provide access to a strict (WHNF), thread local, write only value of type

35-- | Provide access to a strict (WHNF), thread local, write only value of type

33-- @w@.

36-- @w@.

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

38-- output.

41-- output.

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

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

40runWriter m = do

43runWriter m = do

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

44+ (a, IdE (Writer w)) <- runEffect (IdE (Writer mempty)) m

42 pure (a, w)

45 pure (a, w)

43

46

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

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

45-- value.

48-- value.

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

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

47execWriter m = do

50execWriter m = do

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

51+ IdE (Writer w) <- execEffect (IdE (Writer mempty)) m

49 pure w

52 pure w

50

53

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

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

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

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

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

56+tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))

54

57

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

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

56-- 'Writer'.

59-- 'Writer'.

57--

60--

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

61+-- /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

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

60−-- 'Writer':

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

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

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

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

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

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

66+ w0 <- stateEnv es $ \(IdE (Writer w)) -> (w, IdE (Writer mempty))

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

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

76 (a, ) <$> merge es w0

68 (a, ) <$> merge es w0

77 where

69 where

78 merge es w0 =

70 merge es w0 =

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

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

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

72+ stateEnv es $ \(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))

81

73

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

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

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

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

88listens f m = do

80listens f m = do

89 (a, w) <- listen m

81 (a, w) <- listen m

90 pure (a, f w)

82 pure (a, f w)

91−

92−-- $setup

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

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

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

@@ -1,20 +1,3 @@

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

2−--

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

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

10−-- is inefficient. __This applies, in particular, to the standard list type__,

11−-- which makes the 'Writer' effect pretty niche.

12−--

13−-- /Note:/ while the 'Control.Monad.Trans.Writer.Strict.Writer' from the

14−-- @transformers@ package includes additional operations

15−-- 'Control.Monad.Trans.Writer.Strict.pass' and

16−-- 'Control.Monad.Trans.Writer.Strict.censor', they don't cooperate with runtime

17−-- exceptions very well, so they're deliberately omitted here.

18module Effectful.Writer.Shared

1module Effectful.Writer.Shared

19 ( Writer

2 ( Writer

20 , runWriter

3 , runWriter

@@ -25,54 +8,33 @@ module Effectful.Writer.Shared

25 ) where

8 ) where

26

9

27import Control.Concurrent.MVar

10import Control.Concurrent.MVar

28−import Control.Exception (onException, uninterruptibleMask)

11+import Control.Exception

29

12

30−import Effectful.Dispatch.Static

13+import Effectful.Internal.Effect

14+import Effectful.Internal.Env

31−import Effectful.Monad

15+import Effectful.Internal.Monad

32

16

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

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

34newtype Writer w :: Effect where

18newtype Writer w :: Effect where

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

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

36

20

37−-- | Run a 'Writer' effect and return the final value along with the final

38−-- output.

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

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

40runWriter m = do

22runWriter m = do

41 v <- unsafeEff_ $ newMVar mempty

23 v <- unsafeEff_ $ newMVar mempty

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

24+ a <- evalEffect (IdE (Writer v)) m

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

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

44

26

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

46−-- value.

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

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

48execWriter m = do

28execWriter m = do

49 v <- unsafeEff_ $ newMVar mempty

29 v <- unsafeEff_ $ newMVar mempty

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

30+ _ <- evalEffect (IdE (Writer v)) m

51 unsafeEff_ $ readMVar v

31 unsafeEff_ $ readMVar v

52

32

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

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

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

55tell w1 = unsafeEff $ \es -> do

34tell w1 = unsafeEff $ \es -> do

56− DataA (Writer v) <- getEnv es

35+ IdE (Writer v) <- getEnv es

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

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

58

37

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

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

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

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

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

77listen m = unsafeEff $ \es -> do

39listen m = unsafeEff $ \es -> do

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

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

@@ -81,28 +43,19 @@ listen m = unsafeEff $ \es -> do

81 uninterruptibleMask $ \restore -> do

43 uninterruptibleMask $ \restore -> do

82 v1 <- newMVar mempty

44 v1 <- newMVar mempty

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

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

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

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

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

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

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

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

87 where

49 where

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

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

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

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

90 merge es v0 v1 = do

52 merge es v0 v1 = do

91− putEnv es $ DataA (Writer v0)

53+ putEnv es $ IdE (Writer v0)

92 w1 <- readMVar v1

54 w1 <- readMVar v1

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

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

94 pure w1

56 pure w1

95

57

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

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

98−-- output.

99−--

100−-- @'listens' f m ≡ 'Data.Bifunctor.second' f '<$>' 'listen' m@

101listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)

58listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)

102listens f m = do

59listens f m = do

103 (a, w) <- listen m

60 (a, w) <- listen m

104 pure (a, f w)

61 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+16−19

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

@@ -40,7 +40,6 @@ common language

40 ConstraintKinds

41 DataKinds

42 DeriveFunctor

43− DeriveGeneric

44 FlexibleContexts

43 FlexibleContexts

45 FlexibleInstances

44 FlexibleInstances

46 GADTs

45 GADTs

@@ -61,19 +60,20 @@ common language

61library

60library

62 import: language

61 import: language

63

62

64− build-depends: base >= 4.13 && < 5

63+ build-depends: base >= 4.13 && <5

65− , async >= 2.2.2

64+ , async

66− , directory >= 1.3.2

65+ , directory

67− , effectful-core >= 0.1 && < 0.1.1

66+ , effectful-core >= 0.1 && <0.1.1

68− , process >= 1.6.9

67+ , process

69− , resourcet >= 1.2.4.3

68+ , resourcet

70− , time >= 1.9.2

69+ , time

71− , stm >= 2.5.0.0

70+ , stm >= 2.5.0.0

72− , unliftio >= 0.2.20

71+ , unliftio

73

72

74 hs-source-dirs: src

73 hs-source-dirs: src

75

74

76− exposed-modules: Effectful.Concurrent

75+ exposed-modules: Effectful

76+ Effectful.Concurrent

77 Effectful.Concurrent.Async

78 Effectful.Concurrent.Chan

79 Effectful.Concurrent.MVar

@@ -82,21 +82,17 @@ library

82 Effectful.Concurrent.QSemN

83 Effectful.Environment

84 Effectful.FileSystem

85− Effectful.FileSystem.IO

86 Effectful.Process

85 Effectful.Process

87 Effectful.Resource

86 Effectful.Resource

88 Effectful.Temporary

87 Effectful.Temporary

89 Effectful.Timeout

88 Effectful.Timeout

90

89

91 other-modules: Effectful.Concurrent.Effect

90 other-modules: Effectful.Concurrent.Effect

92− Effectful.FileSystem.Effect

93

91

94− reexported-modules: Effectful

92+ reexported-modules: Effectful.Error

95− , Effectful.Dispatch.Dynamic

96− , Effectful.Dispatch.Static

97− , Effectful.Error

98 , Effectful.Error.Dynamic

93 , Effectful.Error.Dynamic

99 , Effectful.Fail

94 , Effectful.Fail

95+ , Effectful.Handler

100 , Effectful.Monad

96 , Effectful.Monad

101 , Effectful.Prim

97 , Effectful.Prim

102 , Effectful.Reader

98 , Effectful.Reader

@@ -119,6 +115,7 @@ test-suite test

119 , effectful-core

115 , effectful-core

120 , exceptions

116 , exceptions

121 , lifted-base

117 , lifted-base

118+ , optics-core >= 0.4

122 , tasty

119 , tasty

123 , tasty-hunit

120 , tasty-hunit

124 , unliftio

121 , unliftio

@@ -154,7 +151,7 @@ benchmark bench

154 if impl(ghc < 9.2)

151 if impl(ghc < 9.2)

155 build-depends: fused-effects

152 build-depends: fused-effects

156

153

157− if impl(ghc < 9.3)

154+ if impl(ghc < 9.2)

158 build-depends: polysemy

155 build-depends: polysemy

159

156

160 build-depends: base

157 build-depends: base

effectful-core/src/Effectful.hs → effectful/src/Effectful.hsrenamed+5−4

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

8

9 -- * Running the 'Eff' monad

10

11− -- ** Pure computations

11+ -- ** Pure operations

12 , runPureEff

13

14− -- ** Computations with side effects

14+ -- ** Operations with side effects

15 , IOE

16 , runEff

17

@@ -22,6 +22,7 @@ module Effectful

22 , unliftStrategy

23 , withUnliftStrategy

24 , withEffToIO

25+ , UnliftError(..)

25

26

26 -- * 'Effect' handlers

27 -- * 'Effect' handlers

27

28

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

32 , interpret

33 , interpret

33 , reinterpret

34 , reinterpret

34

35

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

36+ -- ** Handling local 'Eff' operations

36 , LocalEnv

37 , LocalEnv

37

38

38 -- *** Unlifts

39 -- *** Unlifts

@@ -54,5 +55,5 @@ module Effectful

54 , MonadUnliftIO(..)

55 , MonadUnliftIO(..)

55 ) where

56 ) where

56

57

57−import Effectful.Dispatch.Dynamic

58+import Effectful.Handler

58import Effectful.Monad

59import Effectful.Monad

effectful/src/Effectful/Concurrent.hs+5−17

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

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

15module Effectful.Concurrent

1module Effectful.Concurrent

2+ ( -- * Concurrent effect

16− ( Concurrent

3+ Concurrent

17 , runConcurrent

4 , runConcurrent

18

5

19 -- * Basic concurrency operations

6 -- * Basic concurrency operations

@@ -65,8 +52,9 @@ import qualified Control.Concurrent as C

65import qualified GHC.Conc as GHC

52import qualified GHC.Conc as GHC

66

53

67import Effectful.Concurrent.Effect

54import Effectful.Concurrent.Effect

68−import Effectful.Dispatch.Static

55+import Effectful.Internal.Effect

56+import Effectful.Internal.Env

69−import Effectful.Monad

57+import Effectful.Internal.Monad

70

58

71----------------------------------------

59----------------------------------------

72-- Basic concurrency operations

60-- Basic concurrency operations

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

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

1{-# LANGUAGE UndecidableInstances #-}

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

3module Effectful.Concurrent.Async

2module Effectful.Concurrent.Async

3+ ( -- * Concurrent effect

4− ( Concurrent

4+ Concurrent

5 , runConcurrent

6

7 -- * Asynchronous actions

@@ -76,14 +76,14 @@ import Control.Concurrent (threadDelay)

76import Control.Concurrent.Async (Async)

77import Control.Exception (Exception, SomeException)

78import Control.Monad (forever)

79−import Data.Kind (Type)

80import qualified Control.Concurrent.Async as A

79import qualified Control.Concurrent.Async as A

81import qualified UnliftIO.Async as U

80import qualified UnliftIO.Async as U

82import qualified UnliftIO.Internals.Async as I

81import qualified UnliftIO.Internals.Async as I

83

82

84import Effectful.Concurrent.Effect

83import Effectful.Concurrent.Effect

85−import Effectful.Dispatch.Static

84+import Effectful.Internal.Effect

85+import Effectful.Internal.Env

86−import Effectful.Monad

86+import Effectful.Internal.Monad

87

88-- | Lifted 'A.async'.

89async :: Concurrent :> es => Eff es a -> Eff es (Async a)

effectful/src/Effectful/Concurrent/Chan.hs+3−7

@@ -1,10 +1,6 @@

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

2module Effectful.Concurrent.Chan

3− ( Concurrent

4− , runConcurrent

5−

6− -- * Chan

7− , Chan

3+ ( Chan

8 , newChan

4 , newChan

9 , writeChan

5 , writeChan

10 , readChan

6 , readChan

@@ -17,8 +13,8 @@ import Control.Concurrent.Chan (Chan)

17import qualified Control.Concurrent.Chan as C

13import qualified Control.Concurrent.Chan as C

18

14

19import Effectful.Concurrent.Effect

15import Effectful.Concurrent.Effect

20−import Effectful.Dispatch.Static

16+import Effectful.Internal.Effect

21−import Effectful.Monad

17+import Effectful.Internal.Monad

22

18

23-- | Lifted 'C.newChan'.

19-- | Lifted 'C.newChan'.

24newChan :: Concurrent :> es => Eff es (Chan a)

20newChan :: Concurrent :> es => Eff es (Chan a)

effectful/src/Effectful/Concurrent/Effect.hs+9−68

@@ -1,79 +1,20 @@

1module Effectful.Concurrent.Effect

2+ ( -- * Concurrent effect

2− ( Concurrent

3+ Concurrent

3 , runConcurrent

4 , runConcurrent

4 ) where

5 ) where

5

6

6−import Effectful.Dispatch.Static

7+import Effectful.Internal.Effect

7−import Effectful.Monad

8+import Effectful.Internal.Monad

8

9

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

10+-- | Run 'Eff' operations asynchronously via the @async@ library.

10−-- threads and communicate between them.

11--

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

12+-- /Note:/ thread local state changes in 'Eff' operations run asynchronously

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

13+-- will not affect the parent thread.

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.

69--

14--

15+-- /TODO:/ write about 'Concurrent' not respecting scoped operations.

70data Concurrent :: Effect where

16data Concurrent :: Effect where

71 Concurrent :: Concurrent m r

17 Concurrent :: Concurrent m r

72

18

73−-- | Run the 'Concurrent' effect.

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

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

75−runConcurrent = evalData (DataA Concurrent)

20+runConcurrent = evalEffect (IdE Concurrent)

76−

77−-- $setup

78−-- >>> import Effectful.Concurrent

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

effectful/src/Effectful/Concurrent/MVar.hs+10−21

@@ -1,10 +1,6 @@

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

2module Effectful.Concurrent.MVar

3− ( Concurrent

4− , runConcurrent

5−

6− -- * MVar

7− , MVar

3+ ( MVar

8 , newEmptyMVar

4 , newEmptyMVar

9 , newMVar

5 , newMVar

10 , takeMVar

6 , takeMVar

@@ -29,8 +25,8 @@ import Control.Concurrent.MVar (MVar)

29import qualified Control.Concurrent.MVar as M

25import qualified Control.Concurrent.MVar as M

30

26

31import Effectful.Concurrent.Effect

27import Effectful.Concurrent.Effect

32−import Effectful.Dispatch.Static

28+import Effectful.Internal.Effect

33−import Effectful.Monad

29+import Effectful.Internal.Monad

34

30

35-- | Lifted 'M.newEmptyMVar'.

31-- | Lifted 'M.newEmptyMVar'.

36newEmptyMVar :: Concurrent :> es => Eff es (MVar a)

32newEmptyMVar :: Concurrent :> es => Eff es (MVar a)

@@ -74,35 +70,28 @@ tryReadMVar = unsafeEff_ . M.tryReadMVar

74

70

75-- | Lifted 'M.withMVar'.

71-- | Lifted 'M.withMVar'.

76withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b

72withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b

77−withMVar var f = unsafeUnliftIO $ \unlift -> do

78− M.withMVar var $ unlift . f

73+withMVar var f = unsafeEff $ \es -> M.withMVar var ((`unEff` es) . f)

79

74

80-- | Lifted 'M.withMVarMasked'.

75-- | Lifted 'M.withMVarMasked'.

81withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b

76withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b

82−withMVarMasked var f = unsafeUnliftIO $ \unlift -> do

83− M.withMVarMasked var $ unlift . f

77+withMVarMasked var f = unsafeEff $ \es -> M.withMVarMasked var ((`unEff` es) . f)

84

78

85-- | Lifted 'M.modifyMVar_'.

79-- | Lifted 'M.modifyMVar_'.

86modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()

80modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()

87−modifyMVar_ var f = unsafeUnliftIO $ \unlift -> do

88− M.modifyMVar_ var $ unlift . f

81+modifyMVar_ var f = unsafeEff $ \es -> M.modifyMVar_ var ((`unEff` es) . f)

89

82

90-- | Lifted 'M.modifyMVar'.

83-- | Lifted 'M.modifyMVar'.

91modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b

84modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b

92−modifyMVar var f = unsafeUnliftIO $ \unlift -> do

93− M.modifyMVar var $ unlift . f

85+modifyMVar var f = unsafeEff $ \es -> M.modifyMVar var ((`unEff` es) . f)

94

86

95-- | Lifted 'M.modifyMVarMasked_'.

87-- | Lifted 'M.modifyMVarMasked_'.

96modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()

88modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()

97−modifyMVarMasked_ var f = unsafeUnliftIO $ \unlift -> do

98− M.modifyMVarMasked_ var $ unlift . f

89+modifyMVarMasked_ var f = unsafeEff $ \es -> M.modifyMVarMasked_ var ((`unEff` es) . f)

99

90

100-- | Lifted 'M.modifyMVarMasked'.

91-- | Lifted 'M.modifyMVarMasked'.

101modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b

92modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b

102−modifyMVarMasked var f = unsafeUnliftIO $ \unlift -> do

103− M.modifyMVarMasked var $ unlift . f

93+modifyMVarMasked var f = unsafeEff $ \es -> M.modifyMVarMasked var ((`unEff` es) . f)

104

94

105-- | Lifted 'M.mkWeakMVar'.

95-- | Lifted 'M.mkWeakMVar'.

106mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))

96mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))

107−mkWeakMVar var f = unsafeUnliftIO $ \unlift -> do

108− M.mkWeakMVar var $ unlift f

97+mkWeakMVar var f = unsafeEff $ \es -> M.mkWeakMVar var ((`unEff` es) f)

effectful/src/Effectful/Concurrent/QSem.hs+4−8

@@ -1,10 +1,6 @@

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

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

2module Effectful.Concurrent.QSem

3− ( Concurrent

4− , runConcurrent

5−

6− -- * QSem

7− , QSem

3+ ( QSem

8 , newQSem

4 , newQSem

9 , waitQSem

5 , waitQSem

10 , signalQSem

6 , signalQSem

@@ -14,8 +10,8 @@ import Control.Concurrent.QSem (QSem)

14import qualified Control.Concurrent.QSem as Q

10import qualified Control.Concurrent.QSem as Q

15

11

16import Effectful.Concurrent.Effect

12import Effectful.Concurrent.Effect

17−import Effectful.Dispatch.Static

13+import Effectful.Internal.Effect

18−import Effectful.Monad

14+import Effectful.Internal.Monad

19

15

20-- | Lifted 'Q.newQSem'.

16-- | Lifted 'Q.newQSem'.

21newQSem :: Concurrent :> es => Int -> Eff es QSem

17newQSem :: Concurrent :> es => Int -> Eff es QSem

effectful/src/Effectful/Concurrent/QSemN.hs+4−8

@@ -1,10 +1,6 @@

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

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

2module Effectful.Concurrent.QSemN

3− ( Concurrent

4− , runConcurrent

5−

6− -- * QSemN

7− , QSemN

3+ ( QSemN

8 , newQSemN

4 , newQSemN

9 , waitQSemN

5 , waitQSemN

10 , signalQSemN

6 , signalQSemN

@@ -14,8 +10,8 @@ import Control.Concurrent.QSemN (QSemN)

14import qualified Control.Concurrent.QSemN as Q

10import qualified Control.Concurrent.QSemN as Q

15

11

16import Effectful.Concurrent.Effect

12import Effectful.Concurrent.Effect

17−import Effectful.Dispatch.Static

13+import Effectful.Internal.Effect

18−import Effectful.Monad

14+import Effectful.Internal.Monad

19

15

20-- | Lifted 'Q.newQSemN'.

16-- | Lifted 'Q.newQSemN'.

21newQSemN :: Concurrent :> es => Int -> Eff es QSemN

17newQSemN :: Concurrent :> es => Int -> Eff es QSemN

effectful/src/Effectful/Concurrent/STM.hs+6−11

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

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

2module Effectful.Concurrent.STM

3− ( Concurrent

4− , runConcurrent

5−

6− -- * Core

3+ ( -- * Core

7− , STM.STM

4+ STM.STM

8 , atomically

5 , atomically

9 , STM.retry

6 , STM.retry

10 , STM.orElse

7 , STM.orElse

@@ -92,8 +89,8 @@ import System.Mem.Weak (Weak)

92import GHC.Natural (Natural)

89import GHC.Natural (Natural)

93

90

94import Effectful.Concurrent.Effect

91import Effectful.Concurrent.Effect

95−import Effectful.Dispatch.Static

92+import Effectful.Internal.Effect

96−import Effectful.Monad

93+import Effectful.Internal.Monad

97

94

98-- | Lifted version of 'STM.atomically'

95-- | Lifted version of 'STM.atomically'

99atomically :: Concurrent :> es => STM a -> Eff es a

96atomically :: Concurrent :> es => STM a -> Eff es a

@@ -113,8 +110,7 @@ registerDelay = unsafeEff_ . STM.registerDelay

113

110

114-- | Lifted version of 'STM.mkWeakTVar'

111-- | Lifted version of 'STM.mkWeakTVar'

115mkWeakTVar :: Concurrent :> es => TVar a -> Eff es () -> Eff es (Weak (TVar a))

112mkWeakTVar :: Concurrent :> es => TVar a -> Eff es () -> Eff es (Weak (TVar a))

116−mkWeakTVar var final = unsafeUnliftIO $ \unlift -> do

117− STM.mkWeakTVar var $ unlift final

113+mkWeakTVar var final = unsafeEff $ STM.mkWeakTVar var . unEff final

118

114

119-- | Lifted version of 'STM.newTMVarIO'

115-- | Lifted version of 'STM.newTMVarIO'

120newTMVarIO :: Concurrent :> es => a -> Eff es (TMVar a)

116newTMVarIO :: Concurrent :> es => a -> Eff es (TMVar a)

@@ -126,8 +122,7 @@ newEmptyTMVarIO = unsafeEff_ STM.newEmptyTMVarIO

126

122

127-- | Lifted version of 'STM.mkWeakTMVar'

123-- | Lifted version of 'STM.mkWeakTMVar'

128mkWeakTMVar :: Concurrent :> es => TMVar a -> Eff es () -> Eff es (Weak (TMVar a))

124mkWeakTMVar :: Concurrent :> es => TMVar a -> Eff es () -> Eff es (Weak (TMVar a))

129−mkWeakTMVar var final = unsafeUnliftIO $ \unlift -> do

130− STM.mkWeakTMVar var $ unlift final

125+mkWeakTMVar var final = unsafeEff $ STM.mkWeakTMVar var . unEff final

131

126

132-- | Lifted version of 'STM.newTChanIO'

127-- | Lifted version of 'STM.newTChanIO'

133newTChanIO :: Concurrent :> es => Eff es (TChan a)

128newTChanIO :: Concurrent :> es => Eff es (TChan a)

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

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

1module Effectful.Environment

2+ ( -- * Environment effect

2− ( Environment

3+ Environment

3 , runEnvironment

4 , runEnvironment

4

5

5 -- * Querying the environment

6 -- * Querying the environment

@@ -19,16 +20,15 @@ module Effectful.Environment

19

20

20import qualified System.Environment as E

21import qualified System.Environment as E

21

22

22−import Effectful.Dispatch.Static hiding (getEnv)

23+import Effectful.Internal.Effect

23−import Effectful.Monad

24+import Effectful.Internal.Monad

24

25

25-- | An effect for querying and modifying the system environment.

26-- | An effect for querying and modifying the system environment.

26data Environment :: Effect where

27data Environment :: Effect where

27 Environment :: Environment m r

28 Environment :: Environment m r

28

29

29−-- | Run the 'Environment' effect.

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

31−runEnvironment = evalData (DataA Environment)

31+runEnvironment = evalEffect (IdE Environment)

32

33-- | Lifted 'E.getArgs'.

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

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

@@ -1,98 +1,98 @@

1module Effectful.FileSystem

2− ( FileSystem

2+ ( FileSystem

3− , runFileSystem

3+ , runFileSystem

4−

4+

5− -- * Actions on directories

5+ -- * Actions on directories

6− , createDirectory

6+ , createDirectory

7− , createDirectoryIfMissing

7+ , createDirectoryIfMissing

8− , removeDirectory

8+ , removeDirectory

9− , removeDirectoryRecursive

9+ , removeDirectoryRecursive

10− , removePathForcibly

10+ , removePathForcibly

11− , renameDirectory

11+ , renameDirectory

12− , listDirectory

12+ , listDirectory

13− , getDirectoryContents

13+ , getDirectoryContents

14−

14+

15− -- ** Current working directory

15+ -- ** Current working directory

16− , getCurrentDirectory

16+ , getCurrentDirectory

17− , setCurrentDirectory

17+ , setCurrentDirectory

18− , withCurrentDirectory

18+ , withCurrentDirectory

19−

19+

20− -- * Pre-defined directories

20+ -- * Pre-defined directories

21− , getHomeDirectory

21+ , getHomeDirectory

22− , getXdgDirectory

22+ , getXdgDirectory

23− , getXdgDirectoryList

23+ , getXdgDirectoryList

24− , getAppUserDataDirectory

24+ , getAppUserDataDirectory

25− , getUserDocumentsDirectory

25+ , getUserDocumentsDirectory

26− , getTemporaryDirectory

26+ , getTemporaryDirectory

27−

27+

28− -- * Actions on files

28+ -- * Actions on files

29− , removeFile

29+ , removeFile

30− , renameFile

30+ , renameFile

31− , renamePath

31+ , renamePath

32− , copyFile

32+ , copyFile

33− , copyFileWithMetadata

33+ , copyFileWithMetadata

34− , getFileSize

34+ , getFileSize

35− , canonicalizePath

35+ , canonicalizePath

36− , makeAbsolute

36+ , makeAbsolute

37− , makeRelativeToCurrentDirectory

37+ , makeRelativeToCurrentDirectory

38−

38+

39− -- * Existence tests

39+ -- * Existence tests

40− , doesPathExist

40+ , doesPathExist

41− , doesFileExist

41+ , doesFileExist

42− , doesDirectoryExist

42+ , doesDirectoryExist

43− , findExecutable

43+ , findExecutable

44− , findExecutables

44+ , findExecutables

45− , findExecutablesInDirectories

45+ , findExecutablesInDirectories

46− , findFile

46+ , findFile

47− , findFiles

47+ , findFiles

48− , findFileWith

48+ , findFileWith

49− , findFilesWith

49+ , findFilesWith

50−

50+

51− -- * Symbolic links

51+ -- * Symbolic links

52− , createFileLink

52+ , createFileLink

53− , createDirectoryLink

53+ , createDirectoryLink

54− , removeDirectoryLink

54+ , removeDirectoryLink

55− , pathIsSymbolicLink

55+ , pathIsSymbolicLink

56− , getSymbolicLinkTarget

56+ , getSymbolicLinkTarget

57−

57+

58− -- * Permissions

58+ -- * Permissions

59− , getPermissions

59+ , getPermissions

60− , setPermissions

60+ , setPermissions

61− , copyPermissions

61+ , copyPermissions

62−

62+

63− -- * Timestamps

63+ -- * Timestamps

64− , getAccessTime

64+ , getAccessTime

65− , getModificationTime

65+ , getModificationTime

66− , setAccessTime

66+ , setAccessTime

67− , setModificationTime

67+ , setModificationTime

68−

68+

69− -- * Re-exports

69+ -- * Re-exports

70−

70+

71− -- ** Pre-defined directories

71+ -- ** Pre-defined directories

72− , D.XdgDirectory(..)

72+ , D.XdgDirectory(..)

73− , D.XdgDirectoryList(..)

73+ , D.XdgDirectoryList(..)

74−

74+

75− -- ** Existence tests

75+ -- ** Existence tests

76− , D.exeExtension

76+ , D.exeExtension

77−

77+

78− -- ** Permissions

78+ -- ** Permissions

79− , D.Permissions

79+ , D.Permissions

80− , D.emptyPermissions

80+ , D.emptyPermissions

81− , D.readable

81+ , D.readable

82− , D.writable

82+ , D.writable

83− , D.executable

83+ , D.executable

84− , D.searchable

84+ , D.searchable

85− , D.setOwnerReadable

85+ , D.setOwnerReadable

86− , D.setOwnerWritable

86+ , D.setOwnerWritable

87− , D.setOwnerExecutable

87+ , D.setOwnerExecutable

88− , D.setOwnerSearchable

88+ , D.setOwnerSearchable

89− ) where

89+ ) where

90

91import Data.Time (UTCTime)

92import qualified System.Directory as D

93

94−import Effectful.Dispatch.Static

94+import Effectful.Internal.Effect

95−import Effectful.Monad

95+import Effectful.Internal.Monad

96

97-- | An effect for interacting with the filesystem.

98data FileSystem :: Effect where

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

104

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

106-- Actions on directories

@@ -276,8 +276,8 @@ findFileWith

276 -> [FilePath]

277 -> String

278 -> Eff es (Maybe FilePath)

279−findFileWith p dirs n = unsafeUnliftIO $ \unlift -> do

279+findFileWith p dirs n = unsafeEff $ \es -> do

280− D.findFileWith (unlift . p) dirs n

280+ D.findFileWith ((`unEff` es) . p) dirs n

281

282-- | Lifted 'D.findFilesWith'.

283findFilesWith

@@ -286,8 +286,8 @@ findFilesWith

286 -> [FilePath]

287 -> String

288 -> Eff es [FilePath]

289−findFilesWith p dirs ns = unsafeUnliftIO $ \unlift -> do

289+findFilesWith p dirs ns = unsafeEff $ \es -> do

290− D.findFilesWith (unlift . p) dirs ns

290+ D.findFilesWith ((`unEff` es) . p) dirs ns

291

292----------------------------------------

293-- Symbolic links

effectful/src/Effectful/FileSystem/Effect.hsdeleted−15

@@ -1,15 +0,0 @@

1−module Effectful.FileSystem.Effect

2− ( FileSystem

3− , runFileSystem

4− ) where

5−

6−import Effectful.Dispatch.Static

7−import Effectful.Monad

8−

9−-- | An effect for interacting with the filesystem.

10−data FileSystem :: Effect where

11− FileSystem :: FileSystem m r

12−

13−-- | Run the 'FileSystem' effect.

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

15−runFileSystem = evalData (DataA FileSystem)

effectful/src/Effectful/FileSystem/IO.hsdeleted−143

@@ -1,143 +0,0 @@

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

2−module Effectful.FileSystem.IO

3− ( FileSystem

4− , runFileSystem

5−

6− -- * IO

7− , IOMode (..)

8− , Handle

9− , IO.stdin

10− , IO.stdout

11− , IO.stderr

12− , withFile

13− , withBinaryFile

14− , openFile

15− , hClose

16− , hFlush

17− , hFileSize

18− , hSetFileSize

19− , hIsEOF

20− , IO.BufferMode (..)

21− , hSetBuffering

22− , hGetBuffering

23− , hSeek

24− , IO.SeekMode (..)

25− , hTell

26− , hIsOpen

27− , hIsClosed

28− , hIsReadable

29− , hIsWritable

30− , hIsSeekable

31− , hIsTerminalDevice

32− , hSetEcho

33− , hGetEcho

34− , hWaitForInput

35− , hReady

36− ) where

37−

38−import qualified System.IO as IO

39−import System.IO (Handle, IOMode (..))

40−

41−import Effectful.Dispatch.Static

42−import Effectful.FileSystem.Effect

43−import Effectful.Monad

44−

45−-- | Lifted version of 'IO.withFile'.

46−withFile

47− :: FileSystem :> es

48− => FilePath

49− -> IOMode

50− -> (Handle -> Eff es a)

51− -> Eff es a

52−withFile fp mode inner = unsafeUnliftIO $ \unlift -> do

53− IO.withFile fp mode $ unlift . inner

54−

55−-- | Lifted version of 'IO.withBinaryFile'.

56−withBinaryFile

57− :: FileSystem :> es

58− => FilePath

59− -> IOMode

60− -> (Handle -> Eff es a)

61− -> Eff es a

62−withBinaryFile fp mode inner = unsafeUnliftIO $ \unlift -> do

63− IO.withBinaryFile fp mode $ unlift . inner

64−

65−-- | Lifted version of 'IO.openFile'

66−openFile :: FileSystem :> es => FilePath -> IOMode -> Eff es Handle

67−openFile fp = unsafeEff_ . IO.openFile fp

68−

69−-- | Lifted version of 'IO.hClose'

70−hClose :: FileSystem :> es => Handle -> Eff es ()

71−hClose = unsafeEff_ . IO.hClose

72−

73−-- | Lifted version of 'IO.hFlush'

74−hFlush :: FileSystem :> es => Handle -> Eff es ()

75−hFlush = unsafeEff_ . IO.hFlush

76−

77−-- | Lifted version of 'IO.hFileSize'

78−hFileSize :: FileSystem :> es => Handle -> Eff es Integer

79−hFileSize = unsafeEff_ . IO.hFileSize

80−

81−-- | Lifted version of 'IO.hSetFileSize'

82−hSetFileSize :: FileSystem :> es => Handle -> Integer -> Eff es ()

83−hSetFileSize h = unsafeEff_ . IO.hSetFileSize h

84−

85−-- | Lifted version of 'IO.hIsEOF'

86−hIsEOF :: FileSystem :> es => Handle -> Eff es Bool

87−hIsEOF = unsafeEff_ . IO.hIsEOF

88−

89−-- | Lifted version of 'IO.hSetBuffering'

90−hSetBuffering :: FileSystem :> es => Handle -> IO.BufferMode -> Eff es ()

91−hSetBuffering h = unsafeEff_ . IO.hSetBuffering h

92−

93−-- | Lifted version of 'IO.hGetBuffering'

94−hGetBuffering :: FileSystem :> es => Handle -> Eff es IO.BufferMode

95−hGetBuffering = unsafeEff_ . IO.hGetBuffering

96−

97−-- | Lifted version of 'IO.hSeek'

98−hSeek :: FileSystem :> es => Handle -> IO.SeekMode -> Integer -> Eff es ()

99−hSeek h s = unsafeEff_ . IO.hSeek h s

100−

101−-- | Lifted version of 'IO.hTell'

102−hTell :: FileSystem :> es => Handle -> Eff es Integer

103−hTell = unsafeEff_ . IO.hTell

104−

105−-- | Lifted version of 'IO.hIsOpen'

106−hIsOpen :: FileSystem :> es => Handle -> Eff es Bool

107−hIsOpen = unsafeEff_ . IO.hIsOpen

108−

109−-- | Lifted version of 'IO.hIsClosed'

110−hIsClosed :: FileSystem :> es => Handle -> Eff es Bool

111−hIsClosed = unsafeEff_ . IO.hIsClosed

112−

113−-- | Lifted version of 'IO.hIsReadable'

114−hIsReadable :: FileSystem :> es => Handle -> Eff es Bool

115−hIsReadable = unsafeEff_ . IO.hIsReadable

116−

117−-- | Lifted version of 'IO.hIsWritable'

118−hIsWritable :: FileSystem :> es => Handle -> Eff es Bool

119−hIsWritable = unsafeEff_ . IO.hIsWritable

120−

121−-- | Lifted version of 'IO.hIsSeekable'

122−hIsSeekable :: FileSystem :> es => Handle -> Eff es Bool

123−hIsSeekable = unsafeEff_ . IO.hIsSeekable

124−

125−-- | Lifted version of 'IO.hIsTerminalDevice'

126−hIsTerminalDevice :: FileSystem :> es => Handle -> Eff es Bool

127−hIsTerminalDevice = unsafeEff_ . IO.hIsTerminalDevice

128−

129−-- | Lifted version of 'IO.hSetEcho'

130−hSetEcho :: FileSystem :> es => Handle -> Bool -> Eff es ()

131−hSetEcho h = unsafeEff_ . IO.hSetEcho h

132−

133−-- | Lifted version of 'IO.hGetEcho'

134−hGetEcho :: FileSystem :> es => Handle -> Eff es Bool

135−hGetEcho = unsafeEff_ . IO.hGetEcho

136−

137−-- | Lifted version of 'IO.hWaitForInput'

138−hWaitForInput :: FileSystem :> es => Handle -> Int -> Eff es Bool

139−hWaitForInput h = unsafeEff_ . IO.hWaitForInput h

140−

141−-- | Lifted version of 'IO.hReady'

142−hReady :: FileSystem :> es => Handle -> Eff es Bool

143−hReady = unsafeEff_ . IO.hReady

effectful/src/Effectful/Process.hs+8−7

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

1{-# LANGUAGE CPP #-}

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

2+

3module Effectful.Process

4+ ( -- * Process effect

4− ( Process

5+ Process

5 , runProcess

6 , runProcess

6

7

7 -- * Running sub-processes

8 -- * Running sub-processes

@@ -50,15 +51,15 @@ import System.IO (Handle)

50import System.Posix.Internals (FD)

51import System.Posix.Internals (FD)

51import qualified System.Process as P

52import qualified System.Process as P

52

53

53−import Effectful.Dispatch.Static

54+import Effectful.Internal.Effect

54−import Effectful.Monad

55+import Effectful.Internal.Monad

55

56

56-- | An effect for running child processes using the @process@ library.

57-- | An effect for running child processes using the @process@ library.

57data Process :: Effect where

58data Process :: Effect where

58 Process :: Process m r

59 Process :: Process m r

59

60

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

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

61−runProcess = evalData (DataA Process)

62+runProcess = evalEffect (IdE Process)

62

63

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

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

64-- Running sub-processes

65-- Running sub-processes

@@ -128,8 +129,8 @@ withCreateProcess

128 => P.CreateProcess

129 => P.CreateProcess

129 -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> P.ProcessHandle -> Eff es a)

130 -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> P.ProcessHandle -> Eff es a)

130 -> Eff es a

131 -> Eff es a

131−withCreateProcess cp cb = unsafeUnliftIO $ \unlift -> do

132+withCreateProcess cp cb = unsafeEff $ \es -> do

132− P.withCreateProcess cp $ \inh outh errh ph -> unlift $ cb inh outh errh ph

133+ P.withCreateProcess cp $ \inh outh errh ph -> unEff (cb inh outh errh ph) es

133

134

134-- | Lifted 'P.cleanupProcess'.

135-- | Lifted 'P.cleanupProcess'.

135cleanupProcess

136cleanupProcess

effectful/src/Effectful/Resource.hs+7−6

@@ -24,8 +24,9 @@ import Control.Exception

24import qualified Control.Monad.Trans.Resource as R

25import qualified Control.Monad.Trans.Resource.Internal as RI

26

27−import Effectful.Dispatch.Static

27+import Effectful.Internal.Effect

28+import Effectful.Internal.Env

28−import Effectful.Monad

29+import Effectful.Internal.Monad

29

30

30-- | Data tag for a resource effect.

31-- | Data tag for a resource effect.

31newtype Resource :: Effect where

32newtype Resource :: Effect where

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

37 size0 <- sizeEnv es0

38 size0 <- sizeEnv es0

38 istate <- R.createInternalState

39 istate <- R.createInternalState

39 mask $ \restore -> do

40 mask $ \restore -> do

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

41+ es <- unsafeConsEnv (IdE (Resource istate)) noRelinker es0

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

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

42 unsafeTailEnv size0 es

43 unsafeTailEnv size0 es

43 RI.stateCleanupChecked (Just e) istate

44 RI.stateCleanupChecked (Just e) istate

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

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

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

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

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

54getInternalState = do

55getInternalState = do

55− DataA (Resource istate) <- getData

56+ IdE (Resource istate) <- getEffect

56 pure istate

57 pure istate

57

58

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

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

59--

60--

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

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

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

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

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

63+runInternalState istate = evalEffect $ IdE (Resource istate)

63

64

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

65----------------------------------------

65-- Orphan instance

66-- Orphan instance

66

67

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

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

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

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

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

70+ getEnv es >>= \(IdE (Resource istate)) -> m istate

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

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

10import System.IO

11import qualified UnliftIO.Temporary as T

12

13−import Effectful.Dispatch.Static

13+import Effectful.Internal.Effect

14−import Effectful.Monad

14+import Effectful.Internal.Monad

15

16-- | An effect for interacting with temporary files.

17data Temporary :: Effect where

@@ -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 (IdE Temporary)

23

24-- | Lifted 'T.withSystemTempFile'.

25withSystemTempFile

@@ -29,8 +29,8 @@ withSystemTempFile

29 -> (FilePath -> Handle -> Eff es a)

30 -- ^ Callback that can use the file.

31 -> Eff es a

32−withSystemTempFile template action = unsafeUnliftIO $ \unlift -> do

32+withSystemTempFile template action = unsafeEff $ \es -> do

33− T.withSystemTempFile template $ \fp handle -> unlift $ action fp handle

33+ T.withSystemTempFile template $ \fp handle -> unEff (action fp handle) es

34

35-- | Lifted 'T.withSystemTempDirectory'.

36withSystemTempDirectory

@@ -40,8 +40,8 @@ withSystemTempDirectory

40 -> (FilePath -> Eff es a)

41 -- ^ Callback that can use the directory.

42 -> Eff es a

43−withSystemTempDirectory template action = unsafeUnliftIO $ \unlift -> do

43+withSystemTempDirectory template action = unsafeEff $ \es -> do

44− T.withSystemTempDirectory template $ \fp -> unlift $ action fp

44+ T.withSystemTempDirectory template $ \fp -> unEff (action fp) es

45

46-- | Lifted 'T.withTempFile'.

47withTempFile

@@ -53,8 +53,8 @@ withTempFile

53 -> (FilePath -> Handle -> Eff es a)

54 -- ^ Callback that can use the file.

55 -> Eff es a

56−withTempFile tmpDir template action = unsafeUnliftIO $ \unlift -> do

56+withTempFile tmpDir template action = unsafeEff $ \es -> do

57− T.withTempFile tmpDir template $ \fp handle -> unlift $ action fp handle

57+ T.withTempFile tmpDir template $ \fp handle -> unEff (action fp handle) es

58

59-- | Lifted 'T.withTempDirectory'.

60withTempDirectory

@@ -66,5 +66,5 @@ withTempDirectory

66 -> (FilePath -> Eff es a)

67 -- ^ Callback that can use the directory.

68 -> Eff es a

69−withTempDirectory tmpDir template action = unsafeUnliftIO $ \unlift -> do

69+withTempDirectory tmpDir template action = unsafeEff $ \es -> do

70− T.withTempDirectory tmpDir template $ \fp -> unlift $ action fp

70+ T.withTempDirectory tmpDir template $ \fp -> unEff (action fp) es

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

@@ -6,8 +6,8 @@ module Effectful.Timeout

6

7import qualified System.Timeout as T

8

9−import Effectful.Dispatch.Static

9+import Effectful.Internal.Effect

10−import Effectful.Monad

10+import Effectful.Internal.Monad

11

12-- | An effect for timing out computations.

13data Timeout :: Effect where

@@ -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 (IdE Timeout)

19

20-- | Lifted 'T.timeout'.

21timeout

effectful/tests/EnvironmentTests.hs+6−11

@@ -9,17 +9,12 @@ import Effectful.Environment

9import qualified Utils as U

10

11environmentTests :: TestTree

12−environmentTests = testCaseSteps "Environment" $ \step -> do

12+environmentTests = testGroup "Environment"

13− -- These tests need to be run sequentially because of

14− -- https://github.com/arybczak/effectful/issues/39.

15− step "set and get an environment variable"

13+ [ testCase "set and get an environment variable" test_setAndGet

16− test_setAndGet

17− step "unset and try to get an environment variable"

14+ , testCase "unset and try to get an environment variable" test_unsetAndGet

18− test_unsetAndGet

19− step "execute effects with custom arguments"

15+ , testCase "execute effects with custom arguments" test_withArgs

20− test_withArgs

21− step "execute effects with custom program name"

16+ , testCase "execute effects with custom program name" test_withProg

22− test_withProg

17+ ]

23

18

24test_setAndGet :: Assertion

19test_setAndGet :: Assertion

25test_setAndGet = runEff . runEnvironment $ do

20test_setAndGet = runEff . runEnvironment $ do

effectful/tests/UnliftTests.hs+35−28

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

1+{-# LANGUAGE OverloadedLabels #-}

1module UnliftTests (unliftTests) where

2module UnliftTests (unliftTests) where

2

3

3−import Control.Exception

4+import Optics.Core

4import Test.Tasty

5import Test.Tasty

5import Test.Tasty.HUnit

6import Test.Tasty.HUnit

6import qualified UnliftIO.Async as A

7import qualified UnliftIO.Async as A

@@ -33,38 +34,43 @@ test_resetStrategy = runEff $ do

33

34

34test_seqUnliftInNewThread :: Assertion

35test_seqUnliftInNewThread :: Assertion

35test_seqUnliftInNewThread = runEff $ do

36test_seqUnliftInNewThread = runEff $ do

36− assertThrowsUnliftError "InvalidUseOfSeqUnlift error" $ do

37+ assertThrowsUnliftError "InvalidUseOfSeqUnlift error"

38+ (has #_InvalidUseOfSeqUnlift) $ do

37− withUnliftStrategy SeqUnlift $ do

39+ withUnliftStrategy SeqUnlift $ do

38− withEffToIO $ \runInIO -> do

40+ withEffToIO $ \runInIO -> do

39− inThread $ runInIO $ return ()

41+ inThread $ runInIO $ return ()

40

42

41test_ephemeralInvalid :: Assertion

43test_ephemeralInvalid :: Assertion

42test_ephemeralInvalid = runEff $ do

44test_ephemeralInvalid = runEff $ do

43− assertThrowsUnliftError "InvalidNumberOfUses error" $ do

45+ assertThrowsUnliftError "InvalidNumberOfUses error"

46+ (has #_InvalidNumberOfUses) $ do

44− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do

47+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do

45− withEffToIO $ \_ -> return ()

48+ withEffToIO $ \_ -> return ()

46

49

47test_ephemeralSameThread :: Assertion

50test_ephemeralSameThread :: Assertion

48test_ephemeralSameThread = runEff $ do

51test_ephemeralSameThread = runEff $ do

49− assertThrowsUnliftError "ExceededNumberOfUses error" $ do

52+ assertThrowsUnliftError "ExceededNumberOfUses error"

53+ (has #_ExceededNumberOfUses) $ do

50− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do

54+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do

51− withEffToIO $ \runInIO -> inThread $ do

55+ withEffToIO $ \runInIO -> inThread $ do

52− runInIO $ return ()

56+ runInIO $ return ()

53− runInIO $ return ()

57+ runInIO $ return ()

54

58

55test_ephemeralMultipleThreads :: Assertion

59test_ephemeralMultipleThreads :: Assertion

56test_ephemeralMultipleThreads = runEff $ do

60test_ephemeralMultipleThreads = runEff $ do

57− assertThrowsUnliftError "ExceededNumberOfUses error" $ do

61+ assertThrowsUnliftError "ExceededNumberOfUses error"

62+ (has #_ExceededNumberOfUses) $ do

58− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do

63+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do

59− withEffToIO $ \runInIO -> do

64+ withEffToIO $ \runInIO -> do

60− inThread $ runInIO $ return ()

65+ inThread $ runInIO $ return ()

61− inThread $ runInIO $ return ()

66+ inThread $ runInIO $ return ()

62

67

63test_persistentInvalid :: Assertion

68test_persistentInvalid :: Assertion

64test_persistentInvalid = runEff $ do

69test_persistentInvalid = runEff $ do

65− assertThrowsUnliftError "InvalidNumberOfThreads error" $ do

70+ assertThrowsUnliftError "InvalidNumberOfThreads error"

71+ (has #_InvalidNumberOfThreads) $ do

66− withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do

72+ withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do

67− withEffToIO $ \_ -> return ()

73+ withEffToIO $ \_ -> return ()

68

74

69test_persistentSameThread :: Assertion

75test_persistentSameThread :: Assertion

70test_persistentSameThread = runEff $ do

76test_persistentSameThread = runEff $ do

@@ -75,19 +81,20 @@ test_persistentSameThread = runEff $ do

75

81

76test_persistentMultipleThreads :: Assertion

82test_persistentMultipleThreads :: Assertion

77test_persistentMultipleThreads = runEff $ do

83test_persistentMultipleThreads = runEff $ do

78− assertThrowsUnliftError "ExceededNumberOfThreads error" $ do

84+ assertThrowsUnliftError "ExceededNumberOfThreads error"

85+ (has #_ExceededNumberOfThreads) $ do

79− withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do

86+ withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do

80− withEffToIO $ \runInIO -> do

87+ withEffToIO $ \runInIO -> do

81− inThread $ runInIO $ return ()

88+ inThread $ runInIO $ return ()

82− inThread $ runInIO $ return ()

89+ inThread $ runInIO $ return ()

83

90

84----------------------------------------

91----------------------------------------

85-- Helpers

92-- Helpers

86

93

87assertThrowsUnliftError

94assertThrowsUnliftError

88 :: IOE :> es

95 :: IOE :> es

89− => String -> Eff es a -> Eff es ()

96+ => String -> (UnliftError -> Bool) -> Eff es a -> Eff es ()

90−assertThrowsUnliftError err = U.assertThrows err (\ErrorCall{} -> True)

97+assertThrowsUnliftError = U.assertThrows

91

98

92inThread :: IO a -> IO a

99inThread :: IO a -> IO a

93inThread k = A.async k >>= A.wait

100inThread k = A.async k >>= A.wait