master..48138ff · effectful

git.iko.soy/effectful

on 48138ff help sign in

.github/workflows/haskell-ci.yml+40−41

since splitsnapshots

unifiedsplit

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

1# This GitHub workflow config has been generated by a script via

3−# haskell-ci 'github' '--config=cabal.haskell-ci' 'cabal.project'

3+# haskell-ci 'github' '--config=cabal.haskell-ci' 'effectful.cabal'

5# To regenerate the script (for example after adjusting tested-with) run

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

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

10#

11−# version: 0.13.20211116

11+# version: 0.13.20210621

12#

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

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

14#

15name: Haskell-CI

16on:

@@ -24,23 +24,26 @@ 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 }}

32 strategy:

30 strategy:

33 matrix:

31 matrix:

34 include:

32 include:

35− - compiler: ghc-9.2.1

33+ - compiler: ghc-9.2.0.20210422

36 compilerKind: ghc

34 compilerKind: ghc

37− compilerVersion: 9.2.1

35+ compilerVersion: 9.2.0.20210422

38 setup-method: ghcup

36 setup-method: ghcup

37+ allow-failure: true

38+ - compiler: ghc-9.0.1

39+ compilerKind: ghc

40+ compilerVersion: 9.0.1

41+ setup-method: hvr-ppa

39 allow-failure: false

42 allow-failure: false

40− - compiler: ghc-8.10.7

43+ - compiler: ghc-8.10.4

41 compilerKind: ghc

44 compilerKind: ghc

42− compilerVersion: 8.10.7

45+ compilerVersion: 8.10.4

43− setup-method: ghcup

46+ setup-method: hvr-ppa

44 allow-failure: false

47 allow-failure: false

45 - compiler: ghc-8.8.4

48 - compiler: ghc-8.8.4

46 compilerKind: ghc

49 compilerKind: ghc

@@ -55,18 +58,14 @@ jobs:

55 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5

58 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5

56 if [ "${{ matrix.setup-method }}" = ghcup ]; then

59 if [ "${{ matrix.setup-method }}" = ghcup ]; then

57 mkdir -p "$HOME/.ghcup/bin"

60 mkdir -p "$HOME/.ghcup/bin"

58− curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup"

61+ curl -sL https://downloads.haskell.org/ghcup/0.1.14.1/x86_64-linux-ghcup-0.1.14.1 > "$HOME/.ghcup/bin/ghcup"

59 chmod a+x "$HOME/.ghcup/bin/ghcup"

62 chmod a+x "$HOME/.ghcup/bin/ghcup"

60 "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"

63 "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"

61− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0

64+ "$HOME/.ghcup/bin/ghcup" install cabal 3.4.0.0

62 else

65 else

63 apt-add-repository -y 'ppa:hvr/ghc'

66 apt-add-repository -y 'ppa:hvr/ghc'

64 apt-get update

67 apt-get update

65− apt-get install -y "$HCNAME"

68+ apt-get install -y "$HCNAME" cabal-install-3.4

66− mkdir -p "$HOME/.ghcup/bin"

67− curl -sL https://downloads.haskell.org/ghcup/0.1.17.3/x86_64-linux-ghcup-0.1.17.3 > "$HOME/.ghcup/bin/ghcup"

68− chmod a+x "$HOME/.ghcup/bin/ghcup"

69− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0

70 fi

69 fi

71 env:

70 env:

72 HCKIND: ${{ matrix.compilerKind }}

71 HCKIND: ${{ matrix.compilerKind }}

@@ -84,20 +83,20 @@ jobs:

84 echo "HC=$HC" >> "$GITHUB_ENV"

83 echo "HC=$HC" >> "$GITHUB_ENV"

85 echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"

84 echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"

86 echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"

85 echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"

87− echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

86+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.4.0.0 -vnormal+nowrap" >> "$GITHUB_ENV"

88 else

87 else

89 HC=$HCDIR/bin/$HCKIND

88 HC=$HCDIR/bin/$HCKIND

90 echo "HC=$HC" >> "$GITHUB_ENV"

89 echo "HC=$HC" >> "$GITHUB_ENV"

91 echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"

90 echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"

92 echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"

91 echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"

93− echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

92+ echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> "$GITHUB_ENV"

94 fi

93 fi

96 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

95 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

97 echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"

96 echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"

98 echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

97 echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

99 echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"

98 echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"

100− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"

99+ if [ $((HCNUMVER >= 90200)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi

101 echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"

100 echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"

102 echo "GHCJSARITH=0" >> "$GITHUB_ENV"

101 echo "GHCJSARITH=0" >> "$GITHUB_ENV"

103 env:

102 env:

@@ -126,10 +125,17 @@ jobs:

126 repository hackage.haskell.org

125 repository hackage.haskell.org

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

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

128 EOF

127 EOF

128+ if $HEADHACKAGE; then

129 cat >> $CABAL_CONFIG <<EOF

130− program-default-options

130+ repository head.hackage.ghc.haskell.org

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

131+ url: https://ghc.gitlab.haskell.org/head.hackage/

132+ secure: True

133+ root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d

134+ 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329

135+ f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89

136+ key-threshold: 3

132 EOF

137 EOF

138+ fi

133 cat $CABAL_CONFIG

139 cat $CABAL_CONFIG

134 - name: versions

140 - name: versions

135 run: |

141 run: |

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

142 - name: cache (tools)

148 - name: cache (tools)

143 uses: actions/cache@v2

149 uses: actions/cache@v2

144 with:

150 with:

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

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

146 path: ~/.haskell-ci-tools

152 path: ~/.haskell-ci-tools

147 - name: install cabal-plan

153 - name: install cabal-plan

148 run: |

154 run: |

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

155 cabal-plan --version

161 cabal-plan --version

156 - name: install doctest

162 - name: install doctest

157 run: |

163 run: |

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

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

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

160 - name: checkout

166 - name: checkout

161 uses: actions/checkout@v2

167 uses: actions/checkout@v2

162 with:

168 with:

@@ -164,8 +170,7 @@ jobs:

164 - name: initial cabal.project for sdist

170 - name: initial cabal.project for sdist

165 run: |

171 run: |

166 touch cabal.project

172 touch cabal.project

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

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

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

169 cat cabal.project

174 cat cabal.project

170 - name: sdist

175 - name: sdist

171 run: |

176 run: |

@@ -179,22 +184,20 @@ jobs:

179 run: |

184 run: |

180 PKGDIR_effectful="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/effectful-[0-9.]*')"

185 PKGDIR_effectful="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/effectful-[0-9.]*')"

181 echo "PKGDIR_effectful=${PKGDIR_effectful}" >> "$GITHUB_ENV"

186 echo "PKGDIR_effectful=${PKGDIR_effectful}" >> "$GITHUB_ENV"

182− PKGDIR_effectful_core="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/effectful-core-[0-9.]*')"

183− echo "PKGDIR_effectful_core=${PKGDIR_effectful_core}" >> "$GITHUB_ENV"

184 rm -f cabal.project cabal.project.local

187 rm -f cabal.project cabal.project.local

185 touch cabal.project

188 touch cabal.project

186 touch cabal.project.local

189 touch cabal.project.local

187 echo "packages: ${PKGDIR_effectful}" >> cabal.project

190 echo "packages: ${PKGDIR_effectful}" >> cabal.project

188− echo "packages: ${PKGDIR_effectful_core}" >> cabal.project

189 echo "package effectful" >> cabal.project

191 echo "package effectful" >> cabal.project

190 echo " ghc-options: -Werror=missing-methods" >> cabal.project

192 echo " ghc-options: -Werror=missing-methods" >> cabal.project

191− echo "package effectful-core" >> cabal.project

192− echo " ghc-options: -Werror=missing-methods" >> cabal.project

193 cat >> cabal.project <<EOF

194 package effectful

195 flags: +benchmark-foreign-libraries

196 EOF

197+ if $HEADHACKAGE; then

198+ echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1,/g')" >> cabal.project

199+ fi

197− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(effectful|effectful-core)$/; }' >> cabal.project.local

200+ $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(effectful)$/; }' >> cabal.project.local

198 cat cabal.project

201 cat cabal.project

199 cat cabal.project.local

202 cat cabal.project.local

200 - name: dump install plan

203 - name: dump install plan

@@ -222,18 +225,14 @@ jobs:

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

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

223 - name: doctest

226 - name: doctest

224 run: |

227 run: |

225− cd ${PKGDIR_effectful} || false

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

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

227− cd ${PKGDIR_effectful_core} || false

230+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cd ${PKGDIR_effectful} || 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

229− cd ${PKGDIR_effectful_core} || false

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

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

231 - name: cabal check

232 - name: cabal check

232 run: |

233 run: |

233 cd ${PKGDIR_effectful} || false

234 cd ${PKGDIR_effectful} || false

234 ${CABAL} -vnormal check

235 ${CABAL} -vnormal check

235− cd ${PKGDIR_effectful_core} || false

236− ${CABAL} -vnormal check

237 - name: haddock

236 - name: haddock

238 run: |

237 run: |

239 $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

238 $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

README.md+4−25

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

1# effectful

3[![Build Status](https://github.com/arybczak/effectful/workflows/Haskell-CI/badge.svg?branch=master)](https://github.com/arybczak/effectful/actions?query=branch%3Amaster)

4−[![Documentation](https://img.shields.io/static/v1?label=docs&message=effectful-core-0.1&color=informational)](https://rybczak.net/files/effectful/effectful-core-0.1-docs)

4+[![Hackage](https://img.shields.io/hackage/v/effectful.svg)](https://hackage.haskell.org/package/effectful)

5−[![Documentation](https://img.shields.io/static/v1?label=docs&message=effectful-0.1&color=informational)](https://rybczak.net/files/effectful/effectful-0.1-docs)

6−

7−<img src="https://user-images.githubusercontent.com/387658/127747903-f728437f-2ee4-47b8-9f0c-5102fd44c8e4.png" width="128">

9*Note:* this is a pre-release.

6*Note:* this is a pre-release.

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

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

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

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

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

24− modifications).

21+ discarded state).

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

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

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

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

@@ -103,25 +100,11 @@ to "boring" transformer stacks, most of which are a dozen of newtype'd `StateT`

103or `ReaderT` transformers, each with a few associated operations (usually tied

100or `ReaderT` transformers, each with a few associated operations (usually tied

104to a type class), not to replace monad transformers altogether.

101to a type class), not to replace monad transformers altogether.

105

102

106−## Usage

107−

108−The effect system and its effects are split among several libraries:

109−

110−- The `effectful-core` library contains the main machinery of the effect system

111− itself and a few basic effects.

112− It aims for a small dependency footprint and provides the building blocks for

113− more advanced effects.

114−

115−- _TBD_ `effectful-resource`, `effectful-process`, ...

116−

117−- Finally, the `effectful` library which comes with 'batteries included'. It is

118− build on top of the other libraries and re-exports the functionality of those.

119−

120## Example

103## Example

121

104

122A `Filesystem` effect with two handlers, one that runs in `IO` and another that

105A `Filesystem` effect with two handlers, one that runs in `IO` and another that

123uses an in-memory virtual file system can be found

106uses an in-memory virtual file system can be found

124−[here](https://github.com/arybczak/effectful/blob/master/effectful/examples/FileSystem.hs).

107+[here](https://github.com/arybczak/effectful/blob/master/examples/FileSystem.hs).

125

108

126## Resources

109## Resources

127

110

@@ -139,7 +122,3 @@ Blog posts:

139* [ReaderT design pattern](https://www.fpcomplete.com/blog/2017/06/readert-design-pattern/) by Michael Snoyman.

122* [ReaderT design pattern](https://www.fpcomplete.com/blog/2017/06/readert-design-pattern/) by Michael Snoyman.

140

123

141* [Exceptions Best Practices](https://www.fpcomplete.com/blog/2016/11/exceptions-best-practices-haskell/) by Michael Snoyman.

124* [Exceptions Best Practices](https://www.fpcomplete.com/blog/2016/11/exceptions-best-practices-haskell/) by Michael Snoyman.

142−

143−----------------------------------------

144−

145−<div>Icons made by <a href="https://www.freepik.com" title="Freepik">Freepik</a> from <a href="https://www.flaticon.com/" title="Flaticon">www.flaticon.com</a></div>

effectful/bench/Concurrency.hs → bench/Concurrency.hsrenamed+13−11

@@ -2,7 +2,8 @@

2module Concurrency (concurrencyBenchmark) where

4#ifdef VERSION_criterion

5−import Criterion hiding (env)

5+import Criterion

6+import Criterion.Main

6#endif

7#endif

8#ifdef VERSION_tasty_bench

9#ifdef VERSION_tasty_bench

@@ -11,7 +12,8 @@ import Test.Tasty.Bench hiding (env)

12import Control.Concurrent.Async

13import Control.Concurrent.Async

13import Control.Monad

14import Control.Monad

15+import Control.Monad.IO.Class

14−import qualified Effectful.Concurrent.Async as A

16+import qualified Effectful.Async as A

16import Effectful

18import Effectful

17import Utils

19import Utils

@@ -25,7 +27,7 @@ concurrencyBenchmark = bgroup "concurrency"

25shallowBench :: Int -> Benchmark

27shallowBench :: Int -> Benchmark

26shallowBench n = bgroup ("unmask " ++ show n ++ "x")

28shallowBench n = bgroup ("unmask " ++ show n ++ "x")

27 [ bench "async (IO)" $ nfAppIO (asyncBenchIO n) op

29 [ bench "async (IO)" $ nfAppIO (asyncBenchIO n) op

28− , bench "async (Eff)" $ nfAppIO (runShallow . A.runConcurrent . asyncBench n) op

30+ , bench "async (Eff)" $ nfAppIO (runShallow . A.runAsyncE . asyncBench n) op

29 , bench "Fork (localUnliftIO/withLiftMapIO)" $

31 , bench "Fork (localUnliftIO/withLiftMapIO)" $

30 nfAppIO (runShallow . runFork1 . forkBench n) op

32 nfAppIO (runShallow . runFork1 . forkBench n) op

31 , bench "Fork (localUnlift/withLiftMap)" $

33 , bench "Fork (localUnlift/withLiftMap)" $

@@ -38,7 +40,7 @@ shallowBench n = bgroup ("unmask " ++ show n ++ "x")

39deepBench :: Int -> Benchmark

41deepBench :: Int -> Benchmark

40deepBench n = bgroup ("unmask " ++ show n ++ "x")

42deepBench n = bgroup ("unmask " ++ show n ++ "x")

41− [ bench "async (Eff)" $ nfAppIO (runDeep . A.runConcurrent . asyncBench n) op

43+ [ bench "async (Eff)" $ nfAppIO (runDeep . A.runAsyncE . asyncBench n) op

42 , bench "Fork (localUnliftIO/withLiftMapIO)" $

44 , bench "Fork (localUnliftIO/withLiftMapIO)" $

43 nfAppIO (runDeep . runFork1 . forkBench n) op

45 nfAppIO (runDeep . runFork1 . forkBench n) op

44 , bench "Fork (localUnlift/withLiftMap)" $

46 , bench "Fork (localUnlift/withLiftMap)" $

@@ -59,28 +61,28 @@ data Fork :: Effect where

60-- | Uses 'localUnliftIO' and 'withLiftMapIO'.

62-- | Uses 'localUnliftIO' and 'withLiftMapIO'.

61runFork1 :: IOE :> es => Eff (Fork : es) a -> Eff es a

63runFork1 :: IOE :> es => Eff (Fork : es) a -> Eff es a

62−runFork1 = interpret $ \env -> \case

64+runFork1 = interpretM $ \env -> \case

63− ForkWithUnmask m -> withLiftMapIO env $ \liftMap -> do

65+ ForkWithUnmask m -> withLiftMapIO $ \liftMap -> do

64 localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do

66 localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do

65 asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask

67 asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask

67-- | Uses 'localUnlift' and 'withLiftMap'.

69-- | Uses 'localUnlift' and 'withLiftMap'.

68runFork2 :: IOE :> es => Eff (Fork : es) a -> Eff es a

70runFork2 :: IOE :> es => Eff (Fork : es) a -> Eff es a

69−runFork2 = reinterpret A.runConcurrent $ \env -> \case

71+runFork2 = reinterpretM A.runAsyncE $ \env -> \case

70− ForkWithUnmask m -> withLiftMap env $ \liftMap -> do

72+ ForkWithUnmask m -> withLiftMap $ \liftMap -> do

71 localUnlift env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do

73 localUnlift env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do

72 A.asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask

74 A.asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask

74-- | Uses 'localLiftUnliftIO'.

76-- | Uses 'localLiftUnliftIO'.

75runFork3 :: IOE :> es => Eff (Fork : es) a -> Eff es a

77runFork3 :: IOE :> es => Eff (Fork : es) a -> Eff es a

76−runFork3 = interpret $ \env -> \case

78+runFork3 = interpretM $ \env -> \case

77 ForkWithUnmask m -> do

79 ForkWithUnmask m -> do

78 localLiftUnliftIO env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do

80 localLiftUnliftIO env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do

79 asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift

81 asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift

81-- | Uses 'localLiftUnlift'.

83-- | Uses 'localLiftUnlift'.

82runFork4 :: IOE :> es => Eff (Fork : es) a -> Eff es a

84runFork4 :: IOE :> es => Eff (Fork : es) a -> Eff es a

83−runFork4 = reinterpret A.runConcurrent $ \env -> \case

85+runFork4 = reinterpretM A.runAsyncE $ \env -> \case

84 ForkWithUnmask m -> do

86 ForkWithUnmask m -> do

85 localLiftUnlift env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do

87 localLiftUnlift env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do

86 A.asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift

88 A.asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift

@@ -94,7 +96,7 @@ asyncBenchIO n f = do

94 wait a

96 wait a

95{-# NOINLINE asyncBenchIO #-}

97{-# NOINLINE asyncBenchIO #-}

97−asyncBench :: A.Concurrent :> es => Int -> Eff es Int -> Eff es Int

99+asyncBench :: A.AsyncE :> es => Int -> Eff es Int -> Eff es Int

98asyncBench n f = do

100asyncBench n f = do

99 a <- A.asyncWithUnmask $ \unmask -> do

101 a <- A.asyncWithUnmask $ \unmask -> do

100 sum <$> replicateM n (unmask f)

102 sum <$> replicateM n (unmask f)

effectful/bench/Countdown.hs → bench/Countdown.hsrenamed+40−42

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

12-- effectful

13import qualified Effectful as E

14import qualified Effectful.Reader as E

15−import qualified Effectful.State.Dynamic as ED

15+import qualified Effectful.State as E

16+import qualified Effectful.State.Dynamic as DE

16−import qualified Effectful.State.Local as EL

17+import qualified Effectful.State.MVar as ME

17−import qualified Effectful.State.Shared as ES

19-- freer-simple

20#ifdef VERSION_freer_simple

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

103----------------------------------------

104-- effectful (pure)

105

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

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

107−programEffectfulLocal = do

107+programEffectfulStatic = do

108− n <- EL.get @Integer

108+ n <- E.get @Integer

109 if n <= 0

110 then pure n

111 else do

112− EL.put (n - 1)

112+ E.put (n - 1)

113− programEffectfulLocal

113+ programEffectfulStatic

114−{-# NOINLINE programEffectfulLocal #-}

114+{-# NOINLINE programEffectfulStatic #-}

115

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

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

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

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

118

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

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

120−countdownEffectfulLocalDeep n = E.runPureEff

120+countdownEffectfulStaticDeep n = E.runPureEff

121 . runR . runR . runR . runR . runR

122− . EL.runState n

122+ . E.runState n

123 . runR . runR . runR . runR . runR

124− $ programEffectfulLocal

124+ $ programEffectfulStatic

125 where

126 runR = E.runReader ()

127

128----------------------------------------

129-- effectful (mvar)

130

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

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

132−programEffectfulShared = do

132+programEffectfulMVar = do

133− n <- ES.get @Integer

133+ n <- ME.get @Integer

134 if n <= 0

135 then pure n

136 else do

137− ES.put (n - 1)

137+ ME.put (n - 1)

138− programEffectfulShared

138+ programEffectfulMVar

139−{-# NOINLINE programEffectfulShared #-}

139+{-# NOINLINE programEffectfulMVar #-}

140

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

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

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

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

143

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

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

145−countdownEffectfulSharedDeep n = E.runPureEff

145+countdownEffectfulMVarDeep n = E.runPureEff

146 . runR . runR . runR . runR . runR

147− . ES.runState n

147+ . ME.runState n

148 . runR . runR . runR . runR . runR

149− $ programEffectfulShared

149+ $ programEffectfulMVar

150 where

151 runR = E.runReader ()

152

153----------------------------------------

154-- effectful (dynamic)

155

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

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

157programEffectfulDynamic = do

158− n <- ED.get @Integer

158+ n <- DE.get @Integer

159 if n <= 0

160 then pure n

161 else do

162− ED.put (n - 1)

162+ DE.put (n - 1)

163 programEffectfulDynamic

164{-# NOINLINE programEffectfulDynamic #-}

165

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

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

167−countdownEffectfulDynLocal n =

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

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

169

168

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

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

171−countdownEffectfulDynShared n =

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

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

173

171

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

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

175−countdownEffectfulDynLocalDeep n = E.runPureEff

173+countdownEffectfulDynPureDeep n = E.runPureEff

176 . runR . runR . runR . runR . runR

174 . runR . runR . runR . runR . runR

177− . ED.runLocalState n

175+ . DE.runState n

178 . runR . runR . runR . runR . runR

176 . runR . runR . runR . runR . runR

179 $ programEffectfulDynamic

177 $ programEffectfulDynamic

180 where

178 where

181 runR = E.runReader ()

179 runR = E.runReader ()

182

180

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

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

184−countdownEffectfulDynSharedDeep n = E.runPureEff

182+countdownEffectfulDynMVarDeep n = E.runPureEff

185 . runR . runR . runR . runR . runR

183 . runR . runR . runR . runR . runR

186− . ED.runSharedState n

184+ . DE.runStateMVar n

187 . runR . runR . runR . runR . runR

185 . runR . runR . runR . runR . runR

188 $ programEffectfulDynamic

186 $ programEffectfulDynamic

189 where

187 where

effectful/bench/FileSizes.hs → bench/FileSizes.hsrenamed+3−3

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

11-- effectful

12import qualified Effectful as E

13import qualified Effectful.Reader as E

14−import qualified Effectful.State.Local as E

14+import qualified Effectful.State as E

16-- eff

17#ifdef VERSION_eff

@@ -81,7 +81,7 @@ effectful_tryFileSize :: Effectful_File E.:> es => FilePath -> E.Eff es (Maybe I

81effectful_tryFileSize = E.send . Effectful_tryFileSize

83effectful_runFile :: E.IOE E.:> es => E.Eff (Effectful_File : es) a -> E.Eff es a

84−effectful_runFile = E.interpret \_ -> \case

84+effectful_runFile = E.interpret \case

85 Effectful_tryFileSize path -> liftIO $ tryGetFileSize path

87data Effectful_Logging :: E.Effect where

@@ -93,7 +93,7 @@ effectful_logMsg = E.send . Effectful_logMsg

93effectful_runLogging

94 :: E.Eff (Effectful_Logging : es) a

95 -> E.Eff es (a, [String])

96−effectful_runLogging = E.reinterpret (E.runState []) \_ -> \case

96+effectful_runLogging = E.reinterpret (E.runState []) \case

97 Effectful_logMsg msg -> E.modify (msg :)

99----------

effectful/bench/Main.hs → bench/Main.hsrenamed+23−23

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

26countdown :: Integer -> Benchmark

27countdown n = bgroup (show n)

28 [ bgroup "shallow"

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

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

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

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

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

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

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

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

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

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

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

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

35#ifdef VERSION_freer_simple

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

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

37#endif

38#ifdef VERSION_eff

39− , bench "eff" $ nf countdownEff n

39+ , bench "eff" $ nf countdownEff n

40#endif

41#ifdef VERSION_mtl

42− , bench "mtl" $ nf countdownMtl n

42+ , bench "mtl" $ nf countdownMtl n

43#endif

44#ifdef VERSION_fused_effects

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

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

46#endif

47#ifdef VERSION_polysemy

48− , bench "polysemy" $ nf countdownPolysemy n

48+ , bench "polysemy" $ nf countdownPolysemy n

49#endif

50 ]

51 , bgroup "deep"

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

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

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

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

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

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

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

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

56#ifdef VERSION_freer_simple

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

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

58#endif

59#ifdef VERSION_eff

60− , bench "eff" $ nf countdownEffDeep n

60+ , bench "eff" $ nf countdownEffDeep n

61#endif

62#ifdef VERSION_polysemy

63− , bench "polysemy" $ nf countdownPolysemyDeep n

63+ , bench "polysemy" $ nf countdownPolysemyDeep n

64#endif

65#ifdef VERSION_mtl

66− , bench "mtl" $ nf countdownMtlDeep n

66+ , bench "mtl" $ nf countdownMtlDeep n

67#endif

68#ifdef VERSION_fused_effects

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

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

70#endif

71 ]

72 ]

@@ -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/bench/Unlift.hs → bench/Unlift.hsrenamed+15−14

@@ -3,18 +3,19 @@ module Unlift (unliftBenchmark) where

4#ifdef VERSION_criterion

5import Criterion

6+import Criterion.Main

6#endif

7#endif

8#ifdef VERSION_tasty_bench

9#ifdef VERSION_tasty_bench

9import Test.Tasty.Bench

10import Test.Tasty.Bench

10#endif

11#endif

12−import qualified UnliftIO as U

13+import UnliftIO

14import Effectful

15import Effectful

15import Effectful.State.Dynamic

16import Effectful.State.Dynamic

16import Utils

17import Utils

17−import qualified Effectful.Concurrent.Async as A

18+import qualified Effectful.Async as A

19unliftBenchmark :: Benchmark

20unliftBenchmark :: Benchmark

20unliftBenchmark = bgroup "unlifting"

21unliftBenchmark = bgroup "unlifting"

@@ -29,7 +30,7 @@ unliftBenchmark = bgroup "unlifting"

29 , bench "seq" $ nfAppIO runShallow benchDummy

30 , bench "seq" $ nfAppIO runShallow benchDummy

30 , shallowConc "conc" 1 benchDummyE benchDummy

31 , shallowConc "conc" 1 benchDummyE benchDummy

31 ]

32 ]

32− , shallowConc "async" 1 benchAsyncEff benchAsync

33+ , shallowConc "async" 1 benchAsyncE benchAsync

33 , shallowConc "concurrently" 2 benchConcurrentlyE benchConcurrently

34 , shallowConc "concurrently" 2 benchConcurrentlyE benchConcurrently

34 ]

35 ]

35 , bgroup "deep"

36 , bgroup "deep"

@@ -38,7 +39,7 @@ unliftBenchmark = bgroup "unlifting"

38 , bench "seq" $ nfAppIO runDeep benchDummy

39 , bench "seq" $ nfAppIO runDeep benchDummy

39 , deepConc "conc" 1 benchDummyE benchDummy

40 , deepConc "conc" 1 benchDummyE benchDummy

40 ]

41 ]

41− , deepConc "async" 1 benchAsyncEff benchAsync

42+ , deepConc "async" 1 benchAsyncE benchAsync

42 , deepConc "concurrently" 2 benchConcurrentlyE benchConcurrently

43 , deepConc "concurrently" 2 benchConcurrentlyE benchConcurrently

43 ]

44 ]

45 ]

@@ -48,11 +49,11 @@ unliftBenchmark = bgroup "unlifting"

48shallowConc

49shallowConc

49 :: String

50 :: String

50 -> Int

51 -> Int

51− -> Eff '[A.Concurrent, IOE] ()

52+ -> Eff '[A.AsyncE, IOE] ()

52 -> Eff '[IOE] ()

53 -> Eff '[IOE] ()

53 -> Benchmark

54 -> Benchmark

54shallowConc name n r f = bgroup name

55shallowConc name n r f = bgroup name

55− [ bench "Async" $ nfAppIO (runShallow . A.runConcurrent) r

56+ [ bench "AsyncE" $ nfAppIO (runShallow . A.runAsyncE) r

56 , bench "ephemeral/limited" $ nfAppIO

57 , bench "ephemeral/limited" $ nfAppIO

57 (runShallow . withUnliftStrategy (ConcUnlift Ephemeral $ Limited n)) f

58 (runShallow . withUnliftStrategy (ConcUnlift Ephemeral $ Limited n)) f

58 , bench "ephemeral/unlimited" $ nfAppIO

59 , bench "ephemeral/unlimited" $ nfAppIO

@@ -66,7 +67,7 @@ shallowConc name n r f = bgroup name

66deepConc

67deepConc

67 :: String

68 :: String

68 -> Int

69 -> Int

69− -> Eff '[ A.Concurrent

70+ -> Eff '[ A.AsyncE

70 , State (), State (), State (), State (), State ()

71 , State (), State (), State (), State (), State ()

72 , State (), State (), State (), State (), State ()

72 , IOE] ()

73 , IOE] ()

@@ -75,7 +76,7 @@ deepConc

75 , IOE] ()

76 , IOE] ()

76 -> Benchmark

77 -> Benchmark

77deepConc name n r f = bgroup name

78deepConc name n r f = bgroup name

78− [ bench "Async" $ nfAppIO (runDeep . A.runConcurrent) r

79+ [ bench "AsyncE" $ nfAppIO (runDeep . A.runAsyncE) r

79 , bench "ephemeral/limited" $ nfAppIO

80 , bench "ephemeral/limited" $ nfAppIO

80 (runDeep . withUnliftStrategy (ConcUnlift Ephemeral $ Limited n)) f

81 (runDeep . withUnliftStrategy (ConcUnlift Ephemeral $ Limited n)) f

81 , bench "ephemeral/unlimited" $ nfAppIO

82 , bench "ephemeral/unlimited" $ nfAppIO

@@ -92,19 +93,19 @@ benchDummy :: MonadUnliftIO m => m ()

92benchDummy = withRunInIO $ \runIO -> runIO $ pure ()

93benchDummy = withRunInIO $ \runIO -> runIO $ pure ()

94benchAsync :: MonadUnliftIO m => m ()

95benchAsync :: MonadUnliftIO m => m ()

95−benchAsync = U.withAsync (pure ()) U.wait

96+benchAsync = withAsync (pure ()) wait

97benchConcurrently :: MonadUnliftIO m => m ()

98benchConcurrently :: MonadUnliftIO m => m ()

98−benchConcurrently = U.concurrently_ (pure ()) (pure ())

99+benchConcurrently = concurrently_ (pure ()) (pure ())

100

100benchDummyE :: Eff es ()

101benchDummyE :: Eff es ()

101benchDummyE = pure ()

102benchDummyE = pure ()

102{-# NOINLINE benchDummyE #-}

103{-# NOINLINE benchDummyE #-}

103

104

104−benchAsyncEff :: A.Concurrent :> es => Eff es ()

105+benchAsyncE :: A.AsyncE :> es => Eff es ()

105−benchAsyncEff = A.withAsync (pure ()) A.wait

106+benchAsyncE = A.withAsync (pure ()) A.wait

106−{-# NOINLINE benchAsyncEff #-}

107+{-# NOINLINE benchAsyncE #-}

107

108

108−benchConcurrentlyE :: A.Concurrent :> es => Eff es ()

109+benchConcurrentlyE :: A.AsyncE :> es => Eff es ()

109benchConcurrentlyE = A.concurrently_ (pure ()) (pure ())

110benchConcurrentlyE = A.concurrently_ (pure ()) (pure ())

110{-# NOINLINE benchConcurrentlyE #-}

111{-# NOINLINE benchConcurrentlyE #-}

effectful/bench/Utils.hs → bench/Utils.hsrenamed+2−3

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

16 ] a

17 -> IO a

18runDeep = runEff

19− . evalLocalState () . evalLocalState () . evalLocalState () . evalLocalState ()

19+ . evalState () . evalState () . evalState () . evalState () . evalState ()

20− . evalLocalState () . evalLocalState () . evalLocalState () . evalLocalState ()

20+ . evalState () . evalState () . evalState () . evalState () . evalState ()

21− . evalLocalState () . evalLocalState ()

cabal.haskell-ci+3−1

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

1branches: master

3−doctest: <9.3

3+doctest: <9.2

4tests: True

5benchmarks: True

7+ghcup-jobs: >=9.2

7raw-project

9raw-project

8 package effectful

10 package effectful

9 flags: +benchmark-foreign-libraries

11 flags: +benchmark-foreign-libraries

cabal.projectdeleted−3

@@ -1,3 +0,0 @@

1−packages:

2− effectful/effectful.cabal

3− effectful-core/effectful-core.cabal

doctest.sh+22−32

@@ -7,35 +7,25 @@

7# - Compile doctest with the same GHC version the project currently uses.

10−set -eu

11−

12−run_doctest() {

13− pushd "${1}"

14− doctest \

10+doctest src \

15− "${2}" \

16− -XBangPatterns \

11+ -XBangPatterns \

17− -XConstraintKinds \

12+ -XConstraintKinds \

18− -XDataKinds \

13+ -XDataKinds \

19− -XDeriveFunctor \

14+ -XDeriveFunctor \

20− -XDeriveGeneric \

21− -XFlexibleContexts \

15+ -XFlexibleContexts \

22− -XFlexibleInstances \

16+ -XFlexibleInstances \

23− -XGADTs \

17+ -XGADTs \

24− -XGeneralizedNewtypeDeriving \

18+ -XGeneralizedNewtypeDeriving \

25− -XLambdaCase \

19+ -XLambdaCase \

26− -XMultiParamTypeClasses \

20+ -XMultiParamTypeClasses \

27− -XNoStarIsType \

21+ -XNoStarIsType \

28− -XRankNTypes \

22+ -XRankNTypes \

29− -XRecordWildCards \

23+ -XRecordWildCards \

30− -XRoleAnnotations \

24+ -XRoleAnnotations \

31− -XScopedTypeVariables \

25+ -XScopedTypeVariables \

32− -XStandaloneDeriving \

26+ -XStandaloneDeriving \

27+ -XStrictData \

33− -XTupleSections \

28+ -XTupleSections \

34− -XTypeApplications \

29+ -XTypeApplications \

35− -XTypeFamilies \

30+ -XTypeFamilies \

36− -XTypeOperators

31+ -XTypeOperators

37− popd

38−}

39−

40−run_doctest effectful-core src

41−run_doctest effectful src

effectful-core/CHANGELOG.mddeleted−2

@@ -1,2 +0,0 @@

1−# effectful-core-0.0.0.0 (2021-06-13)

2−* Initial alpha release.

effectful-core/LICENSEdeleted−30

@@ -1,30 +0,0 @@

2−

4−

5−Redistribution and use in source and binary forms, with or without

6−modification, are permitted provided that the following conditions are met:

7−

8− * Redistributions of source code must retain the above copyright

9− notice, this list of conditions and the following disclaimer.

10−

11− * Redistributions in binary form must reproduce the above

12− copyright notice, this list of conditions and the following

13− disclaimer in the documentation and/or other materials provided

14− with the distribution.

15−

16− * Neither the name of Andrzej Rybczak nor the names of other

17− contributors may be used to endorse or promote products derived

18− from this software without specific prior written permission.

19−

20−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS

21−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

22−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR

23−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT

24−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

25−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT

26−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,

27−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY

28−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT

29−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE

30−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

effectful-core/effectful-core.cabaldeleted−103

@@ -1,103 +0,0 @@

1−cabal-version: 2.4

2−build-type: Simple

3−name: effectful-core

4−version: 0.1

5−license: BSD-3-Clause

6−license-file: LICENSE

7−category: Control

8−maintainer: andrzej@rybczak.net

9−author: Andrzej Rybczak

10−synopsis: An easy to use, performant extensible effects library.

11−

12−description: An easy to use, performant extensible effects library with seamless

13− integration with the existing Haskell ecosystem.

14− .

15− This library provides core definitions with a minimal dependency

16− footprint. See the @<https://hackage.haskell.org/package/effectful effectful>@

17− package for documentation and the "batteries-included" variant.

18−

19−extra-source-files: CHANGELOG.md

20−

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

22−

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

24−source-repository head

25− type: git

26− location: https://github.com/arybczak/effectful.git

27−

28−common language

29− ghc-options: -Wall -Wcompat

30−

31− default-language: Haskell2010

32−

33− default-extensions: BangPatterns

34− ConstraintKinds

35− DataKinds

36− DeriveFunctor

37− DeriveGeneric

38− FlexibleContexts

39− FlexibleInstances

40− GADTs

41− GeneralizedNewtypeDeriving

42− LambdaCase

43− MultiParamTypeClasses

44− NoStarIsType

45− RankNTypes

46− RecordWildCards

47− RoleAnnotations

48− ScopedTypeVariables

49− StandaloneDeriving

50− TupleSections

51− TypeApplications

52− TypeFamilies

53− TypeOperators

54−

55−library effectful-internal-utils

56− import: language

57−

58− build-depends: base

59−

60− hs-source-dirs: utils

61− c-sources: utils/utils.c

62−

63− exposed-modules: Effectful.Internal.Utils

64−

65−library

66− import: language

67−

68− ghc-options: -O2

69−

70− build-depends: effectful-internal-utils

71−

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

73− , containers >= 0.6

74− , exceptions >= 0.10.4

75− , monad-control >= 1.0.3

76− , primitive >= 0.7.3.0

77− , transformers-base >= 0.4.6

78− , unliftio-core >= 0.2.0.1

79−

80− hs-source-dirs: src

81−

82− exposed-modules: Effectful

83− Effectful.Dispatch.Dynamic

84− Effectful.Dispatch.Static

85− Effectful.Error

86− Effectful.Error.Dynamic

87− Effectful.Fail

88− Effectful.Internal.Effect

89− Effectful.Internal.Env

90− Effectful.Internal.Monad

91− Effectful.Internal.Unlift

92− Effectful.Monad

93− Effectful.Prim

94− Effectful.Reader

95− Effectful.Reader.Dynamic

96− Effectful.State.Dynamic

97− Effectful.State.Local

98− Effectful.State.Shared

99− Effectful.Writer.Dynamic

100− Effectful.Writer.Local

101− Effectful.Writer.Shared

102−

103− reexported-modules: Effectful.Internal.Utils

effectful-core/src/Effectful/Dispatch/Dynamic.hsdeleted−246

@@ -1,246 +0,0 @@

1−module Effectful.Dispatch.Dynamic

2− ( -- * Sending operations to the handler

3− send

4−

5− -- * Handling effects

6− , EffectHandler

7− , interpret

8− , reinterpret

9−

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

11− , LocalEnv

12−

13− -- *** Unlifts

14− , localSeqUnlift

15− , localSeqUnliftIO

16− , localUnlift

17− , localUnliftIO

18−

19− -- *** Lifts

20− , withLiftMap

21− , withLiftMapIO

22−

23− -- *** Bidirectional lifts

24− , localLiftUnlift

25− , localLiftUnliftIO

26−

27− -- *** Utils

28− , SuffixOf

29−

30− -- * Re-exports

31− , HasCallStack

32− ) where

33−

34−import Control.Monad.IO.Unlift

35−import Data.Kind

36−import GHC.Stack (HasCallStack)

37−

38−import Effectful.Internal.Effect

39−import Effectful.Internal.Env

40−import Effectful.Internal.Monad

41−

42−----------------------------------------

43−-- Handling effects

44−

45−-- | Interpret an effect.

46−interpret

47− :: EffectHandler e es

48− -- ^ The effect handler.

49− -> Eff (e : es) a

50− -> Eff es a

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

52− les <- forkEnv es

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

54−

55−-- | Interpret an effect using other effects.

56−reinterpret

57− :: (Eff handlerEs a -> Eff es b)

58− -- ^ Introduction of effects encapsulated within the handler.

59− -> EffectHandler e handlerEs

60− -- ^ The effect handler.

61− -> Eff (e : es) a

62− -> Eff es b

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

64− les0 <- forkEnv es

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

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

67−

68−----------------------------------------

69−-- Unlifts

70−

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

72−-- general version see 'localUnlift'.

73−localSeqUnlift

74− :: (HasCallStack, SuffixOf es handlerEs)

75− => LocalEnv localEs handlerEs

76− -- ^ Local environment.

77− -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)

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

79− -> Eff es a

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

81− seqUnliftIO les $ \unlift -> do

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

83−

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

85−-- general version see 'localUnliftIO'.

86−localSeqUnliftIO

87− :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)

88− => LocalEnv localEs handlerEs

89− -- ^ Local environment.

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

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

92− -> Eff es a

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

94−

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

96−localUnlift

97− :: (HasCallStack, SuffixOf es handlerEs)

98− => LocalEnv localEs handlerEs

99− -- ^ Local environment.

100− -> UnliftStrategy

101− -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)

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

103− -> Eff es a

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

105− SeqUnlift -> unsafeEff $ \es -> do

106− seqUnliftIO les $ \unlift -> do

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

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

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

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

111−

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

113−localUnliftIO

114− :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)

115− => LocalEnv localEs handlerEs

116− -- ^ Local environment.

117− -> UnliftStrategy

118− -> ((forall r. Eff localEs r -> IO r) -> IO a)

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

120− -> Eff es a

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

122− SeqUnlift -> liftIO $ seqUnliftIO les k

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

124−

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

126−--

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

128−--

129−-- to

130−--

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

132−--

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

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

135−withLiftMap

136− :: (HasCallStack, SuffixOf es handlerEs)

137− => LocalEnv localEs handlerEs

138− -- ^ Local environment.

139− -> ((forall a b. (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b) -> Eff es r)

140− -- ^ Continuation with the lifting function in scope.

141− -> Eff es r

142−withLiftMap !_ k = unsafeEff $ \es -> do

143− -- 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.

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

146− seqUnliftIO localEs $ \unlift -> do

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

148−

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

150−--

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

152−--

153−-- to

154−--

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

156−--

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

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

159−--

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

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

162−--

163−-- >>> :{

164−-- data Fork :: Effect where

165−-- ForkWithUnmask :: ((forall a. m a -> m a) -> m ()) -> Fork m ThreadId

166−-- :}

167−--

168−-- >>> :{

169−-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a

170−-- runFork = interpret $ \env (ForkWithUnmask m) -> withLiftMapIO env $ \liftMap -> do

171−-- localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do

172−-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftMap unmask

173−-- :}

174−withLiftMapIO

175− :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)

176− => LocalEnv localEs handlerEs

177− -- ^ Local environment.

178− -> ((forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)

179− -- ^ Continuation with the lifting function in scope.

180− -> Eff es r

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

182− -- 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.

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

185−

186−----------------------------------------

187−-- Bidirectional lifts

188−

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

190−--

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

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

193−--

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

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

196−localLiftUnlift

197− :: (HasCallStack, SuffixOf es handlerEs)

198− => LocalEnv localEs handlerEs

199− -- ^ Local environment.

200− -> UnliftStrategy

201− -> ((forall r. Eff es r -> Eff localEs r) -> (forall r. Eff localEs r -> Eff es r) -> Eff es a)

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

203− -> Eff es a

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

205− SeqUnlift -> unsafeEff $ \es -> do

206− seqUnliftIO es $ \unliftEs -> do

207− seqUnliftIO les $ \unliftLocalEs -> do

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

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

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

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

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

213−

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

215−-- unrestricted lifting function.

216−--

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

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

219−--

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

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

222−localLiftUnliftIO

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

224− => LocalEnv localEs handlerEs

225− -- ^ Local environment.

226− -> UnliftStrategy

227− -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)

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

229− -> Eff es a

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

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

232− ConcUnlift p l -> liftIO $ concUnliftIO 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−

245−-- $setup

246−-- >>> import Control.Concurrent

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.hsdeleted−198

@@ -1,198 +0,0 @@

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

2−--

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

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

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

6−--

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

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

18−--

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:

25−--

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

27−-- >>> :{

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

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

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

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

32−-- :}

33−-- Beginning.

34−-- Computing.

35−-- Cleaning up.

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.

70−module Effectful.Error

71− ( Error

72− , runError

73− , throwError

74− , catchError

75− , handleError

76− , tryError

77−

78− -- * Re-exports

79− , HasCallStack

80− , CallStack

81− , getCallStack

82− , prettyCallStack

83− ) where

84−

85−import Control.Exception

86−import Data.Typeable

87−import Data.Unique

88−import GHC.Stack

89−

90−import Effectful.Dispatch.Static

91−import Effectful.Monad

92−

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

94−newtype Error e :: Effect where

95− Error :: ErrorId -> Error e m r

96−

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

98−runError

99− :: forall e es a. Typeable e

100− => Eff (Error e : es) a

101− -> Eff es (Either (CallStack, e) a)

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

103− eid <- newErrorId

104− size0 <- sizeEnv es0

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

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

107− unsafeTailEnv size0 es

108− pure r

109− where

110− tryErrorIO release eid es = try (release $ unEff m es) >>= \case

111− Right a -> pure $ Right a

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

113− $ throwIO ex

114−

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

116−throwError

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

118− => e

119− -- ^ The error.

120− -> Eff es a

121−throwError e = unsafeEff $ \es -> do

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

123− throwIO $ ErrorEx eid callStack e

124−

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

126−catchError

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

128− => Eff es a

129− -- ^ The inner computation.

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

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

132− -> Eff es a

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

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

135− size <- sizeEnv es

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

137− checkSizeEnv size es

138− unEff (handler cs e) es

139−

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.

153−tryError

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

155− => Eff es a

156− -- ^ The inner computation.

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

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

159−

160−----------------------------------------

161−-- Helpers

162−

163−newtype ErrorId = ErrorId Unique

164− deriving Eq

165−

166−-- | A unique is picked so that distinct 'Error' handlers for the same type

167−-- don't catch each other's exceptions.

168−newErrorId :: IO ErrorId

169−newErrorId = ErrorId <$> newUnique

170−

171−tryHandler

172− :: Typeable e

173− => SomeException

174− -> ErrorId

175− -> (CallStack -> e -> r)

176− -> IO r

177− -> IO r

178−tryHandler ex eid0 handler next = case fromException ex of

179− Just (ErrorEx eid cs e)

180− | eid0 == eid -> pure $ handler cs e

181− | otherwise -> next

182− Nothing -> next

183−

184−data ErrorEx e = ErrorEx !ErrorId CallStack e

185−instance Typeable e => Show (ErrorEx e) where

186− showsPrec p (ErrorEx _ cs e)

187− = ("Effectful.Error.ErrorEx (" ++)

188− . showsPrec p (typeOf e)

189− . (") " ++)

190− . showsPrec p cs

191−instance Typeable e => Exception (ErrorEx e)

192−

193−catchErrorIO :: Typeable e => ErrorId -> IO a -> (CallStack -> e -> IO a) -> IO a

194−catchErrorIO eid m handler = do

195− m `catch` \err@(ErrorEx etag e cs) -> do

196− if eid == etag

197− then handler e cs

198− else throwIO err

effectful-core/src/Effectful/Error/Dynamic.hsdeleted−45

@@ -1,45 +0,0 @@

1−module Effectful.Error.Dynamic

2− ( Error(..)

3− , runError

4− , throwError

5− , catchError

6− , tryError

7− ) where

8−

9−import Data.Typeable

10−

11−import Effectful.Dispatch.Dynamic

12−import Effectful.Monad

13−import qualified Effectful.Error as E

14−

15−data Error e :: Effect where

16− ThrowError :: e -> Error e m a

17− CatchError :: m a -> (E.CallStack -> e -> m a) -> Error e m a

18−

19−runError

20− :: Typeable e

21− => Eff (Error e : es) a

22− -> Eff es (Either (E.CallStack, e) a)

23−runError = reinterpret E.runError $ \env -> \case

24− ThrowError e -> E.throwError e

25− CatchError m h -> localSeqUnlift env $ \unlift -> do

26− E.catchError (unlift m) (\cs -> unlift . h cs)

27−

28−throwError

29− :: (HasCallStack, Error e :> es)

30− => e

31− -> Eff es a

32−throwError = send . ThrowError

33−

34−catchError

35− :: (HasCallStack, Error e :> es)

36− => Eff es a

37− -> (E.CallStack -> e -> Eff es a)

38− -> Eff es a

39−catchError m = send . CatchError m

40−

41−tryError

42− :: (HasCallStack, Error e :> es)

43− => Eff es a

44− -> Eff es (Either (E.CallStack, e) a)

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

effectful-core/src/Effectful/Fail.hsdeleted−16

@@ -1,16 +0,0 @@

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

2−module Effectful.Fail

3− ( Fail(..)

4− , runFail

5− ) where

6−

7−import Effectful.Dispatch.Dynamic

8−import Effectful.Error

9−import Effectful.Internal.Monad

10−

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

12−runFail :: Eff (Fail : es) a -> Eff es (Either String a)

13−runFail = reinterpret eff $ \_ -> \case

14− Fail msg -> throwError msg

15− where

16− eff = fmap (either (Left . snd) Right) . runError

effectful-core/src/Effectful/Internal/Monad.hsdeleted−415

@@ -1,415 +0,0 @@

1−{-# LANGUAGE UndecidableInstances #-}

2−{-# OPTIONS_GHC -Wno-noncanonical-monad-instances #-}

3−{-# OPTIONS_HADDOCK not-home #-}

4−-- | The 'Eff' monad.

5−--

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

7−-- in subsequent releases.

8−module Effectful.Internal.Monad

9− ( -- * The 'Eff' monad

10− Eff

11− , runPureEff

12−

13− -- ** Access to the internal representation

14− , unEff

15− , unsafeEff

16− , unsafeEff_

17−

18− -- * Fail

19− , Fail(..)

20−

21− -- * IO

22− , IOE

23− , runEff

24−

25− -- * Prim

26− , Prim

27− , runPrim

28−

29− -- * Unlift strategies

30− , UnliftStrategy(..)

31− , Persistence(..)

32− , Limit(..)

33− , unliftStrategy

34− , withUnliftStrategy

35− , withEffToIO

36−

37− -- ** Low-level unlifts

38− , seqUnliftIO

39− , concUnliftIO

40−

41− -- * Effects

42−

43− -- ** Dynamic dispatch

44− , EffectHandler

45− , LocalEnv(..)

46− , HandlerA(..)

47− , runHandler

48− , send

49−

50− -- ** Static dispatch

51− , DataA(..)

52− , runData

53− , evalData

54− , execData

55− , getData

56− , putData

57− , stateData

58− , stateDataM

59− , localData

60− ) where

61−

62−import Control.Applicative (liftA2)

63−import Control.Monad.Base

64−import Control.Monad.Fix

65−import Control.Monad.IO.Class

66−import Control.Monad.IO.Unlift

67−import Control.Monad.Primitive

68−import Control.Monad.Trans.Control

69−import GHC.Exts (oneShot)

70−import GHC.IO (IO(..))

71−import GHC.Stack (HasCallStack)

72−import System.IO.Unsafe (unsafeDupablePerformIO)

73−import qualified Control.Exception as E

74−import qualified Control.Monad.Catch as C

75−

76−import Effectful.Internal.Effect

77−import Effectful.Internal.Env

78−import Effectful.Internal.Unlift

79−

80−type role Eff nominal representational

81−

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

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

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

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

87−-- would have the following type:

88−--

89−-- @

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

91−-- @

92−--

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

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

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

97−--

98−-- @

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

100−-- @

101−--

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

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

104−-- order.

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

106− deriving (Monoid, Semigroup)

107−

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

109−--

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

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

112−runPureEff (Eff m) =

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

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

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

116− --

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

118− -- cleanup actions to run.

119− unsafeDupablePerformIO $ m =<< emptyEnv

120−

121−----------------------------------------

122−-- Access to the internal representation

123−

124−-- | Peel off the constructor of 'Eff'.

125−unEff :: Eff es a -> Env es -> IO a

126−unEff (Eff m) = m

127−

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

129−--

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

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

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

133−unsafeEff m = Eff (oneShot m)

134−

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

136−--

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

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

139−unsafeEff_ :: IO a -> Eff es a

140−unsafeEff_ m = unsafeEff $ \_ -> m

141−

142−----------------------------------------

143−-- Unlifting IO

144−

145−-- | Get the current 'UnliftStrategy'.

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

147−unliftStrategy = do

148− DataA (IOE unlift) <- getData

149− pure unlift

150−

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

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

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

154−

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

156−--

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

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

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

160−--

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

162−withEffToIO

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

175− => Env es

176− -- ^ The environment.

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

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

179− -> IO a

180−seqUnliftIO es k = seqUnlift k es unEff

181−

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

183−concUnliftIO

184− :: HasCallStack

185− => Env es

186− -- ^ The environment.

187− -> Persistence

188− -> Limit

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

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

191− -> IO a

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

193−

194−----------------------------------------

195−-- Base

196−

197−instance Functor (Eff es) where

198− fmap f (Eff m) = unsafeEff $ \es -> f <$> m es

199− a <$ Eff fb = unsafeEff $ \es -> a <$ fb es

200−

201−instance Applicative (Eff es) where

202− pure = unsafeEff_ . pure

203− Eff mf <*> Eff mx = unsafeEff $ \es -> mf es <*> mx es

204− Eff ma *> Eff mb = unsafeEff $ \es -> ma es *> mb es

205− Eff ma <* Eff mb = unsafeEff $ \es -> ma es <* mb es

206− liftA2 f (Eff ma) (Eff mb) = unsafeEff $ \es -> liftA2 f (ma es) (mb es)

207−

208−instance Monad (Eff es) where

209− return = unsafeEff_ . pure

210− Eff m >>= k = unsafeEff $ \es -> m es >>= \a -> unEff (k a) es

211− -- https://gitlab.haskell.org/ghc/ghc/-/issues/20008

212− Eff ma >> Eff mb = unsafeEff $ \es -> ma es >> mb es

213−

214−instance MonadFix (Eff es) where

215− mfix f = unsafeEff $ \es -> mfix $ \a -> unEff (f a) es

216−

217−----------------------------------------

218−-- Exception

219−

220−instance C.MonadThrow (Eff es) where

221− throwM = unsafeEff_ . E.throwIO

222−

223−instance C.MonadCatch (Eff es) where

224− catch m handler = unsafeEff $ \es -> do

225− size <- sizeEnv es

226− unEff m es `E.catch` \e -> do

227− checkSizeEnv size es

228− unEff (handler e) es

229−

230−instance C.MonadMask (Eff es) where

231− mask k = unsafeEff $ \es -> E.mask $ \restore ->

232− unEff (k $ \m -> unsafeEff $ restore . unEff m) es

233−

234− uninterruptibleMask k = unsafeEff $ \es -> E.uninterruptibleMask $ \restore ->

235− unEff (k $ \m -> unsafeEff $ restore . unEff m) es

236−

237− generalBracket acquire release use = unsafeEff $ \es -> E.mask $ \restore -> do

238− size <- sizeEnv es

239− resource <- unEff acquire es

240− b <- restore (unEff (use resource) es) `E.catch` \e -> do

241− checkSizeEnv size es

242− _ <- unEff (release resource $ C.ExitCaseException e) es

243− E.throwIO e

244− checkSizeEnv size es

245− c <- unEff (release resource $ C.ExitCaseSuccess b) es

246− pure (b, c)

247−

248−----------------------------------------

249−-- Fail

250−

251−-- | Provide the ability to use the 'MonadFail' instance of 'Eff'.

252−data Fail :: Effect where

253− Fail :: String -> Fail m a

254−

255−instance Fail :> es => MonadFail (Eff es) where

256− fail = send . Fail

257−

258−----------------------------------------

259−-- IO

260−

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

262−newtype IOE :: Effect where

263− IOE :: UnliftStrategy -> IOE m r

264−

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

266−--

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

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

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

270−

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

272− liftIO = unsafeEff_

273−

274−-- | Use 'withEffToIO' if you want accurate stack traces on errors.

275−instance IOE :> es => MonadUnliftIO (Eff es) where

276− withRunInIO = withEffToIO

277−

278−-- | Instance included for compatibility with existing code, usage of 'liftIO'

279−-- is preferrable.

280−instance IOE :> es => MonadBase IO (Eff es) where

281− liftBase = unsafeEff_

282−

283−-- | Instance included for compatibility with existing code, usage of

284−-- 'withRunInIO' is preferrable.

285−instance IOE :> es => MonadBaseControl IO (Eff es) where

286− type StM (Eff es) a = a

287− liftBaseWith = withEffToIO

288− restoreM = pure

289−

290−----------------------------------------

291−-- Primitive

292−

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

294−data Prim :: Effect where

295− Prim :: Prim m r

296−

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

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

299−runPrim = evalData (DataA Prim)

300−

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

302− type PrimState (Eff es) = RealWorld

303− primitive = unsafeEff_ . IO

304−

305−----------------------------------------

306−-- Dynamic dispatch

307−

308−type role LocalEnv nominal nominal

309−

310−-- | Opaque representation of the 'Eff' environment at the point of calling the

311−-- 'send' function, i.e. right before the control is passed to the effect

312−-- handler.

313−--

314−-- The second type variable represents effects of a handler and is needed for

315−-- technical reasons to guarantee soundness.

316−newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env localEs)

317−

318−-- | Type signature of the effect handler.

319−type EffectHandler e es

320− = forall a localEs. HasCallStack

321− => LocalEnv localEs es

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

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

324− -> e (Eff localEs) a

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

326− -> Eff es a

327−

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

329−--

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

331−data HandlerA :: Effect -> Type where

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

333−

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

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

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

337− size0 <- sizeEnv es0

338− E.bracket (unsafeConsEnv e relinker es0)

339− (unsafeTailEnv size0)

340− (\es -> unEff m es)

341− where

342− relinker :: Relinker HandlerA e

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

344− newHandlerEs <- relink handlerEs

345− pure $ HandlerA newHandlerEs handle

346−

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

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

349−send op = unsafeEff $ \es -> do

350− HandlerA handlerEs handle <- getEnv es

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

352−

353−----------------------------------------

354−-- Static dispatch

355−

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

357−--

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

359−-- parameters.

360−newtype DataA :: Effect -> Type where

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

362−

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

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

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

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

367− size0 <- sizeEnv es0

368− E.bracket (unsafeConsEnv e0 noRelinker es0)

369− (unsafeTailEnv size0)

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

371−

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

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

376− size0 <- sizeEnv es0

377− E.bracket (unsafeConsEnv e noRelinker es0)

378− (unsafeTailEnv size0)

379− (\es -> unEff m es)

380−

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)

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

385− size0 <- sizeEnv es0

386− E.bracket (unsafeConsEnv e0 noRelinker es0)

387− (unsafeTailEnv size0)

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

389−

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

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

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

393−

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

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

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

397−

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

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

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

401−

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

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

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

407− putEnv es e

408− pure a

409−

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

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

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

414− (\e -> putEnv es e)

415− (\_ -> unEff m es)

effectful-core/src/Effectful/Prim.hsdeleted−7

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

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

2−module Effectful.Prim

3− ( Prim

4− , runPrim

5− ) where

6−

7−import Effectful.Internal.Monad

effectful-core/src/Effectful/Reader.hsdeleted−49

@@ -1,49 +0,0 @@

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

2−module Effectful.Reader

3− ( Reader

4− , runReader

5− , ask

6− , asks

7− , local

8− ) where

9−

10−import Effectful.Dispatch.Static

11−import Effectful.Monad

12−

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

14−-- @r@.

15−newtype Reader r :: Effect where

16− Reader :: r -> Reader r m a

17−

18−-- | Run a 'Reader' effect with the given initial environment.

19−runReader

20− :: r -- ^ An initial environment.

21− -> Eff (Reader r : es) a

22− -> Eff es a

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

24−

25−-- | Fetch the value of the environment.

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

27−ask = do

28− DataA (Reader r) <- getData

29− pure r

30−

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

32−--

33−-- @'asks' f ≡ f '<$>' 'ask'@

34−asks

35− :: Reader r :> es

36− => (r -> a) -- ^ The function to apply to the environment.

37− -> Eff es a

38−asks f = f <$> ask

39−

40−-- | Execute a computation in a modified environment.

41−--

42−-- @'runReader' r ('local' f m) ≡ 'runReader' (f r) m@

43−--

44−local

45− :: Reader r :> es

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

effectful-core/src/Effectful/Reader/Dynamic.hsdeleted−32

@@ -1,32 +0,0 @@

1−module Effectful.Reader.Dynamic

2− ( Reader(..)

3− , runReader

4− , ask

5− , asks

6− , local

7− ) where

8−

9−import Effectful.Dispatch.Dynamic

10−import Effectful.Monad

11−import qualified Effectful.Reader as R

12−

13−data Reader r :: Effect where

14− Ask :: Reader r m r

15− Local :: (r -> r) -> m a -> Reader r m a

16−

17−runReader :: r -> Eff (Reader r : es) a -> Eff es a

18−runReader r = reinterpret (R.runReader r) $ \env -> \case

19− Ask -> R.ask

20− Local f m -> localSeqUnlift env $ \unlift -> R.local f (unlift m)

21−

22−----------------------------------------

23−-- Operations

24−

25−ask :: (HasCallStack, Reader r :> es) => Eff es r

26−ask = send Ask

27−

28−asks :: (HasCallStack, Reader r :> es) => (r -> a) -> Eff es a

29−asks f = f <$> ask

30−

31−local :: (HasCallStack, Reader r :> es ) => (r -> r) -> Eff es a -> Eff es a

32−local f = send . Local f

effectful-core/src/Effectful/State/Dynamic.hsdeleted−125

@@ -1,125 +0,0 @@

1−-- | The 'State' effect with dynamic dispatch.

2−module Effectful.State.Dynamic

3− ( State(..)

4−

5− -- * Local

6− , runLocalState

7− , evalLocalState

8− , execLocalState

9−

10− -- * Shared

11− , runSharedState

12− , evalSharedState

13− , execSharedState

14−

15− -- * Operations

16− , get

17− , gets

18− , put

19− , state

20− , modify

21− , stateM

22− , modifyM

23− ) where

24−

25−import Effectful.Dispatch.Dynamic

26−import Effectful.Monad

27−import qualified Effectful.State.Local as L

28−import qualified Effectful.State.Shared as S

29−

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

31−data State s :: Effect where

32− Get :: State s m s

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

34− State :: (s -> (a, s)) -> State s m a

35− StateM :: (s -> m (a, s)) -> State s m a

36−

37−----------------------------------------

38−-- Local

39−

40−runLocalState :: s -> Eff (State s : es) a -> Eff es (a, s)

41−runLocalState s0 = reinterpret (L.runState s0) localState

42−

43−evalLocalState :: s -> Eff (State s : es) a -> Eff es a

44−evalLocalState s0 = reinterpret (L.evalState s0) localState

45−

46−execLocalState :: s -> Eff (State s : es) a -> Eff es s

47−execLocalState s0 = reinterpret (L.execState s0) localState

48−

49−localState

50− :: L.State s :> es

51− => LocalEnv localEs es

52− -> State s (Eff localEs) a

53− -> Eff es a

54−localState env = \case

55− Get -> L.get

56− Put s -> L.put s

57− State f -> L.state f

58− StateM f -> localSeqUnlift env $ \unlift -> L.stateM (unlift . f)

59−

60−----------------------------------------

61−-- Shared

62−

63−runSharedState :: s -> Eff (State s : es) a -> Eff es (a, s)

64−runSharedState s0 = reinterpret (S.runState s0) sharedState

65−

66−evalSharedState :: s -> Eff (State s : es) a -> Eff es a

67−evalSharedState s0 = reinterpret (S.evalState s0) sharedState

68−

69−execSharedState :: s -> Eff (State s : es) a -> Eff es s

70−execSharedState s0 = reinterpret (S.execState s0) sharedState

71−

72−sharedState

73− :: S.State s :> es

74− => LocalEnv localEs es

75− -> State s (Eff localEs) a

76− -> Eff es a

77−sharedState env = \case

78− Get -> S.get

79− Put s -> S.put s

80− State f -> S.state f

81− StateM f -> localSeqUnlift env $ \unlift -> S.stateM (unlift . f)

82−

83−----------------------------------------

84−-- Operations

85−

86−get

87− :: (HasCallStack, State s :> es)

88− => Eff es s

89−get = send Get

90−

91−gets

92− :: (HasCallStack, State s :> es)

93− => (s -> a)

94− -> Eff es a

95−gets f = f <$> get

96−

97−put

98− :: (HasCallStack, State s :> es)

99− => s

100− -> Eff es ()

101−put = send . Put

102−

103−state

104− :: (HasCallStack, State s :> es)

105− => (s -> (a, s))

106− -> Eff es a

107−state = send . State

108−

109−modify

110− :: (HasCallStack, State s :> es)

111− => (s -> s)

112− -> Eff es ()

113−modify f = state (\s -> ((), f s))

114−

115−stateM

116− :: (HasCallStack, State s :> es)

117− => (s -> Eff es (a, s))

118− -> Eff es a

119−stateM = send . StateM

120−

121−modifyM

122− :: (HasCallStack, State s :> es)

123− => (s -> Eff es s)

124− -> Eff es ()

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

effectful-core/src/Effectful/State/Local.hsdeleted−131

@@ -1,131 +0,0 @@

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

2−--

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

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

5−--

6−-- - very fast.

7−--

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

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

10−-- modifications when an exception is received:

11−--

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

13−--

14−-- >>> :{

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

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

17−-- error "oops"

18−-- :}

19−-- "Hi"

20−--

21−-- >>> :{

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

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

24−-- error "oops"

25−-- :}

26−-- "Hi there!"

27−module Effectful.State.Local

28− ( State

29− , runState

30− , evalState

31− , execState

32− , get

33− , gets

34− , put

35− , state

36− , modify

37− , stateM

38− , modifyM

39− ) where

40−

41−import Effectful.Dispatch.Static

42−import Effectful.Monad

43−

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

45−newtype State s :: Effect where

46− State :: s -> State s m r

47−

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

49−-- value along with the final state.

50−runState

51− :: s -- ^ An initial state.

52− -> Eff (State s : es) a

53− -> Eff es (a, s)

54−runState s0 m = do

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

56− pure (a, s)

57−

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

59−-- value, discarding the final state.

60−evalState

61− :: s -- ^ An initial state.

62− -> Eff (State s : es) a

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

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

65−

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

67−-- state, discarding the final value.

68−execState

69− :: s -- ^ An initial state.

70− -> Eff (State s : es) a

71− -> Eff es s

72−execState s0 m = do

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

74− pure s

75−

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

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

78−get = do

79− DataA (State s) <- getData

80− pure s

81−

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

83−--

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

85−gets

86− :: State s :> es

87− => (s -> a) -- ^ The function to apply to the state.

88− -> Eff es a

89−gets f = f <$> get

90−

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

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

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

94−

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

96−state

97− :: State s :> es

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

99− -> Eff es a

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

101−

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

103−--

104−-- @'modify' f ≡ 'state' (\\s -> ((), f s))@

105−modify

106− :: State s :> es

107− => (s -> s) -- ^ The function to modify the state.

108− -> Eff es ()

109−modify f = state $ \s -> ((), f s)

110−

111−-- | Apply the monadic function to the current state and return a value.

112−stateM

113− :: State s :> es

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

115− -> Eff es a

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

117− (a, s) <- f s0

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

119−

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

121−--

122−-- @'modifyM' f ≡ 'stateM' (\\s -> ((), ) '<$>' f s)@

123−modifyM

124− :: State s :> es

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

126− -> Eff es ()

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

128−

129−-- $setup

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

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

effectful-core/src/Effectful/State/Shared.hsdeleted−127

@@ -1,127 +0,0 @@

1−-- | Support for access to a mutable 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.State.Local").

5−--

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

7−--

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

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

10−-- modifications when an exception is received:

11−--

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

13−--

14−-- >>> :{

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

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

17−-- error "oops"

18−-- :}

19−-- "Hi"

20−--

21−-- >>> :{

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

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

24−-- error "oops"

25−-- :}

26−-- "Hi there!"

27−module Effectful.State.Shared

28− ( State

29− , runState

30− , evalState

31− , execState

32− , get

33− , gets

34− , put

35− , state

36− , modify

37− , stateM

38− , modifyM

39− ) where

40−

41−import Control.Concurrent.MVar

42−

43−import Effectful.Dispatch.Static

44−import Effectful.Monad

45−

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

47−newtype State s :: Effect where

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

49−

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

51−-- value along with the final state.

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

53−runState s m = do

54− v <- unsafeEff_ $ newMVar s

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

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

57−

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

59−-- value, discarding the final state.

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

61−evalState s m = do

62− v <- unsafeEff_ $ newMVar s

63− evalData (DataA (State v)) m

64−

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

66−-- state, discarding the final value.

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

68−execState s m = do

69− v <- unsafeEff_ $ newMVar s

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

71− unsafeEff_ $ readMVar v

72−

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

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

75−get = unsafeEff $ \es -> do

76− DataA (State v) <- getEnv es

77− readMVar v

78−

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

80−--

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

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

83−gets f = f <$> get

84−

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

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

87−put s = unsafeEff $ \es -> do

88− DataA (State v) <- getEnv es

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

90−

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.

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

95−state f = unsafeEff $ \es -> do

96− DataA (State v) <- getEnv es

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

98−

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.

104−modify :: State s :> es => (s -> s) -> Eff es ()

105−modify f = state (\s -> ((), f s))

106−

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.

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

111−stateM f = unsafeEff $ \es -> do

112− DataA (State v) <- getEnv es

113− modifyMVar v $ \s0 -> do

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

115− s `seq` pure (s, a)

116−

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.

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

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

124−

125−-- $setup

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

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

effectful-core/src/Effectful/Writer/Dynamic.hsdeleted−85

@@ -1,85 +0,0 @@

1−module Effectful.Writer.Dynamic

2− ( Writer(..)

3−

4− -- * Local

5− , runLocalWriter

6− , execLocalWriter

7−

8− -- * Shared

9− , runSharedWriter

10− , execSharedWriter

11−

12− -- * Operations

13− , tell

14− , listen

15− , listens

16− ) where

17−

18−import Effectful.Dispatch.Dynamic

19−import Effectful.Monad

20−import qualified Effectful.Writer.Local as L

21−import qualified Effectful.Writer.Shared as S

22−

23−data Writer w :: Effect where

24− Tell :: w -> Writer w m ()

25− Listen :: m a -> Writer w m (a, w)

26−

27−----------------------------------------

28−-- Local

29−

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

31−runLocalWriter = reinterpret L.runWriter localWriter

32−

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

34−execLocalWriter = reinterpret L.execWriter localWriter

35−

36−localWriter

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

38− => LocalEnv localEs es

39− -> Writer w (Eff localEs) a

40− -> Eff es a

41−localWriter env = \case

42− Tell w -> L.tell w

43− Listen m -> localSeqUnlift env $ \unlift -> L.listen (unlift m)

44−

45−----------------------------------------

46−-- Shared

47−

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

49−runSharedWriter = reinterpret S.runWriter sharedWriter

50−

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

52−execSharedWriter = reinterpret S.execWriter sharedWriter

53−

54−sharedWriter

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

56− => LocalEnv localEs es

57− -> Writer w (Eff localEs) a

58− -> Eff es a

59−sharedWriter env = \case

60− Tell w -> S.tell w

61− Listen m -> localSeqUnlift env $ \unlift -> S.listen (unlift m)

62−

63−----------------------------------------

64−-- Operations

65−

66−tell

67− :: (HasCallStack, Writer w :> es)

68− => w

69− -> Eff es ()

70−tell = send . Tell

71−

72−listen

73− :: (HasCallStack, Writer w :> es)

74− => Eff es a

75− -> Eff es (a, w)

76−listen = send . Listen

77−

78−listens

79− :: (HasCallStack, Writer w :> es)

80− => (w -> b)

81− -> Eff es a

82− -> Eff es (a, b)

83−listens f m = do

84− (a, w) <- listen m

85− pure (a, f w)

effectful-core/src/Effectful/Writer/Local.hsdeleted−94

@@ -1,94 +0,0 @@

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

2−--

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

4−-- look at "Effectful.Writer.Shared"),

5−--

6−-- - very fast.

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.

18−module Effectful.Writer.Local

19− ( Writer

20− , runWriter

21− , execWriter

22− , tell

23− , listen

24− , listens

25− ) where

26−

27−import Control.Exception (onException, mask)

28−

29−import Effectful.Dispatch.Static

30−import Effectful.Monad

31−

32−-- | Provide access to a strict (WHNF), thread local, write only value of type

33−-- @w@.

34−newtype Writer w :: Effect where

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

36−

37−-- | Run a 'Writer' effect and return the final value along with the final

38−-- output.

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

40−runWriter m = do

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

42− pure (a, w)

43−

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

45−-- value.

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

47−execWriter m = do

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

49− pure w

50−

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

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

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

54−

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

56−-- 'Writer'.

57−--

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

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

60−-- 'Writer':

61−--

62−-- >>> :{

63−-- runEff . execWriter @String $ do

64−-- tell "Hi"

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

66−-- tell " there"

67−-- listen $ do

68−-- tell "!"

69−-- error "oops"

70−-- :}

71−-- "Hi there!"

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

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

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

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

76− (a, ) <$> merge es w0

77− where

78− merge es w0 =

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

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

81−

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

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

84−-- output.

85−--

86−-- @'listens' f m ≡ 'Data.Bifunctor.second' f '<$>' 'listen' m@

87−listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)

88−listens f m = do

89− (a, w) <- listen m

90− pure (a, f w)

91−

92−-- $setup

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

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

effectful-core/src/Effectful/Writer/Shared.hsdeleted−108

@@ -1,108 +0,0 @@

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.

18−module Effectful.Writer.Shared

19− ( Writer

20− , runWriter

21− , execWriter

22− , tell

23− , listen

24− , listens

25− ) where

26−

27−import Control.Concurrent.MVar

28−import Control.Exception (onException, uninterruptibleMask)

29−

30−import Effectful.Dispatch.Static

31−import Effectful.Monad

32−

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

34−newtype Writer w :: Effect where

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

36−

37−-- | Run a 'Writer' effect and return the final value along with the final

38−-- output.

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

40−runWriter m = do

41− v <- unsafeEff_ $ newMVar mempty

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

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

44−

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

46−-- value.

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

48−execWriter m = do

49− v <- unsafeEff_ $ newMVar mempty

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

51− unsafeEff_ $ readMVar v

52−

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

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

55−tell w1 = unsafeEff $ \es -> do

56− DataA (Writer v) <- getEnv es

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

58−

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

60−-- 'Writer'.

61−--

62−-- /Note:/ if 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!"

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

77−listen m = unsafeEff $ \es -> do

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

79− -- might block and if an async exception is received while waiting, w1 will be

80− -- lost.

81− uninterruptibleMask $ \restore -> do

82− v1 <- newMVar mempty

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

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

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

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

87− where

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

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

90− merge es v0 v1 = do

91− putEnv es $ DataA (Writer v0)

92− w1 <- readMVar v1

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

94− pure w1

95−

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@

101−listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)

102−listens f m = do

103− (a, w) <- listen m

104− pure (a, f w)

105−

106−-- $setup

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

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

effectful/effectful.cabal → effectful.cabalrenamed+51−62

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

1cabal-version: 2.4

2build-type: Simple

3name: effectful

4−version: 0.1

4+version: 0.0.0.0

5license: BSD-3-Clause

6license-file: LICENSE

7category: Control

@@ -10,17 +10,12 @@ author: Andrzej Rybczak

10synopsis: An easy to use, performant extensible effects library.

12description: An easy to use, performant extensible effects library with seamless

13− integration with the existing Haskell ecosystem. See the main

13+ integration with the existing Haskell ecosystem.

14− module "Effectful" for the documentation.

15− .

16− This is the "batteries-included" variant with many dependencies;

17− See the @<https://hackage.haskell.org/package/effectful-core

18− effectful-core>@ package and other @effectful-*@ packages if you

19− need a more limited dependency footprint.

21extra-source-files: CHANGELOG.md

15extra-source-files: CHANGELOG.md

16+ README.md

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

18+tested-with: GHC ==8.8.4 || ==8.10.4 || ==9.0.1 || ==9.2.0.20210422

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

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

26source-repository head

21source-repository head

@@ -40,7 +35,6 @@ common language

40 ConstraintKinds

35 ConstraintKinds

41 DataKinds

36 DataKinds

42 DeriveFunctor

37 DeriveFunctor

43− DeriveGeneric

44 FlexibleContexts

38 FlexibleContexts

45 FlexibleInstances

39 FlexibleInstances

46 GADTs

40 GADTs

@@ -53,60 +47,62 @@ common language

53 RoleAnnotations

47 RoleAnnotations

54 ScopedTypeVariables

48 ScopedTypeVariables

55 StandaloneDeriving

49 StandaloneDeriving

50+ StrictData

56 TupleSections

51 TupleSections

57 TypeApplications

52 TypeApplications

58 TypeFamilies

53 TypeFamilies

59 TypeOperators

54 TypeOperators

56+library effectful-internal-utils

57+ import: language

58+

59+ build-depends: base

60+

61+ hs-source-dirs: utils

62+ c-sources: utils/utils.c

63+

64+ exposed-modules: Effectful.Internal.Utils

65+

61library

66library

62 import: language

67 import: language

69+ ghc-options: -O2

70+

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

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

65− , async >= 2.2.2

72+ , async

66− , directory >= 1.3.2

73+ , containers

67− , effectful-core >= 0.1 && < 0.1.1

74+ , effectful-internal-utils

68− , process >= 1.6.9

75+ , exceptions

76+ , monad-control

77+ , primitive

69− , resourcet >= 1.2.4.3

78+ , resourcet

70− , time >= 1.9.2

71− , stm >= 2.5.0.0

79+ , stm

80+ , transformers-base

72− , unliftio >= 0.2.20

81+ , unliftio-core

82+ , unliftio

74 hs-source-dirs: src

84 hs-source-dirs: src

76− exposed-modules: Effectful.Concurrent

86+ exposed-modules: Effectful

77− Effectful.Concurrent.Async

87+ Effectful.Async

78− Effectful.Concurrent.Chan

88+ Effectful.Error

79− Effectful.Concurrent.MVar

89+ Effectful.Fail

80− Effectful.Concurrent.STM

90+ Effectful.Handler

81− Effectful.Concurrent.QSem

91+ Effectful.Internal.Effect

82− Effectful.Concurrent.QSemN

92+ Effectful.Internal.Env

83− Effectful.Environment

93+ Effectful.Internal.Monad

84− Effectful.FileSystem

94+ Effectful.Internal.Unlift

85− Effectful.FileSystem.IO

95+ Effectful.Monad

86− Effectful.Process

96+ Effectful.Reader

87 Effectful.Resource

97 Effectful.Resource

88− Effectful.Temporary

98+ Effectful.State

89− Effectful.Timeout

99+ Effectful.State.Dynamic

90−

100+ Effectful.State.MVar

91− other-modules: Effectful.Concurrent.Effect

101+ Effectful.Writer

102+ Effectful.Writer.Dynamic

92− Effectful.FileSystem.Effect

103+ Effectful.Writer.MVar

93−

104+

94− reexported-modules: Effectful

105+ reexported-modules: Effectful.Internal.Utils

95− , Effectful.Dispatch.Dynamic

96− , Effectful.Dispatch.Static

97− , Effectful.Error

98− , Effectful.Error.Dynamic

99− , Effectful.Fail

100− , Effectful.Monad

101− , Effectful.Prim

102− , Effectful.Reader

103− , Effectful.Reader.Dynamic

104− , Effectful.State.Dynamic

105− , Effectful.State.Local

106− , Effectful.State.Shared

107− , Effectful.Writer.Dynamic

108− , Effectful.Writer.Local

109− , Effectful.Writer.Shared

110

106

111test-suite test

107test-suite test

112 import: language

108 import: language

@@ -116,29 +112,22 @@ test-suite test

116 build-depends: base

112 build-depends: base

117 , containers

113 , containers

118 , effectful

114 , effectful

119− , effectful-core

120 , exceptions

115 , exceptions

121 , lifted-base

116 , lifted-base

122 , tasty

117 , tasty

123 , tasty-hunit

118 , tasty-hunit

124 , unliftio

119 , unliftio

125

120

126− hs-source-dirs: tests examples

121+ hs-source-dirs: tests

127

122

128 type: exitcode-stdio-1.0

123 type: exitcode-stdio-1.0

129 main-is: Main.hs

124 main-is: Main.hs

130

125

131 other-modules: AsyncTests

126 other-modules: AsyncTests

132 ConcurrencyTests

127 ConcurrencyTests

133− EnvironmentTests

134 ErrorTests

128 ErrorTests

135 StateTests

129 StateTests

136− TimeoutTests

137− UnliftTests

138 Utils

130 Utils

139− -- These are examples; We do not actually run them but list

140− -- them here in order to check if they compile.

141− FileSystem

142

131

143benchmark bench

132benchmark bench

144 import: language

133 import: language

@@ -154,15 +143,15 @@ benchmark bench

154 if impl(ghc < 9.2)

143 if impl(ghc < 9.2)

155 build-depends: fused-effects

144 build-depends: fused-effects

156

145

157− if impl(ghc < 9.3)

146+ if impl(ghc < 9)

158 build-depends: polysemy

147 build-depends: polysemy

159

148

160 build-depends: base

149 build-depends: base

161− , async

162 , effectful

150 , effectful

163 , tasty-bench

151 , tasty-bench

164 , unix

152 , unix

165 , unliftio

153 , unliftio

154+ , async

166

155

167 hs-source-dirs: bench

156 hs-source-dirs: bench

168

157

effectful/CHANGELOG.mddeleted−2

@@ -1,2 +0,0 @@

1−# effectful-0.0.0.0 (2021-06-13)

2−* Initial alpha release.

effectful/LICENSEdeleted−30