on 115aa0a help sign in
51 files changed+756−2716
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml+37−30 README.md+3−10 cabal.haskell-ci+3−1 doctest.sh+1−2 effectful-core/effectful-core.cabal+15−18 effectful-core/src/Effectful/Dispatch/Static.hs−82 effectful-core/src/Effectful/Error.hs+27−96 effectful-core/src/Effectful/Error/Dynamic.hs+1−1 effectful-core/src/Effectful/Fail.hs+1−11 effectful-core/src/Effectful/Dispatch/Dynamic.hs → effectful-core/src/Effectful/Handler.hs+101−78 effectful-core/src/Effectful/Internal/Effect.hs+12−7 effectful-core/src/Effectful/Internal/Env.hs+49−73 effectful-core/src/Effectful/Internal/Monad.hs+242−207 effectful-core/src/Effectful/Internal/Unlift.hs+10−115 effectful-core/src/Effectful/Prim.hs−1 effectful-core/src/Effectful/Reader.hs+12−29 effectful-core/src/Effectful/Reader/Dynamic.hs+1−1 effectful-core/src/Effectful/State/Dynamic.hs+15−4 effectful-core/src/Effectful/State/Local.hs+24−88 effectful-core/src/Effectful/State/Shared.hs+15−63 effectful-core/src/Effectful/Writer/Dynamic.hs+6−6 effectful-core/src/Effectful/Writer/Local.hs+10−56 effectful-core/src/Effectful/Writer/Shared.hs+10−57 effectful/bench/Concurrency.hs+8−8 effectful/bench/Main.hs+3−3 effectful/bench/Unlift.hs+11−11 effectful/effectful.cabal+24−42 effectful-core/src/Effectful.hs → effectful/src/Effectful.hs+4−4 effectful/src/Effectful/Concurrent/Async.hs → effectful/src/Effectful/Async.hs+88−72 effectful/src/Effectful/Concurrent.hs−218 effectful/src/Effectful/Concurrent/Chan.hs−45 effectful/src/Effectful/Concurrent/Effect.hs−79 effectful/src/Effectful/Concurrent/MVar.hs−108 effectful/src/Effectful/Concurrent/QSem.hs−30 effectful/src/Effectful/Concurrent/QSemN.hs−30 effectful/src/Effectful/Concurrent/STM.hs−146 effectful/src/Effectful/Environment.hs−71 effectful/src/Effectful/FileSystem.hs−347 effectful/src/Effectful/FileSystem/Effect.hs−15 effectful/src/Effectful/FileSystem/IO.hs−143 effectful/src/Effectful/Process.hs+10−8 effectful/src/Effectful/Resource.hs+7−6 effectful/src/Effectful/Temporary.hs−70 effectful/src/Effectful/Timeout.hs−28 effectful/tests/AsyncTests.hs+6−6 effectful/tests/EnvironmentTests.hs−48 effectful/tests/Main.hs−6 effectful/tests/StateTests.hs−1 effectful/tests/TimeoutTests.hs−25 effectful/tests/UnliftTests.hs−93 effectful/tests/Utils.hs−17
.github/workflows/haskell-ci.yml+37−30
@@ -8,9 +8,9 @@
88#
99# For more information, see https://github.com/haskell-CI/haskell-ci
1010#
11−# version: 0.13.20211116
11+# version: 0.13.20210621
1212#
13−# REGENDATA ("0.13.20211116",["github","--config=cabal.haskell-ci","cabal.project"])
13+# REGENDATA ("0.13.20210621",["github","--config=cabal.haskell-ci","cabal.project"])
1414#
1515name: Haskell-CI
1616on:
@@ -24,23 +24,26 @@ jobs:
2424 linux:
2525 name: Haskell-CI - Linux - ${{ matrix.compiler }}
2626 runs-on: ubuntu-18.04
27− timeout-minutes:
28− 60
2927 container:
3028 image: buildpack-deps:bionic
3129 continue-on-error: ${{ matrix.allow-failure }}
3230 strategy:
3331 matrix:
3432 include:
35− - compiler: ghc-9.2.1
33+ - compiler: ghc-9.2.0.20210422
3634 compilerKind: ghc
37− compilerVersion: 9.2.1
35+ compilerVersion: 9.2.0.20210422
3836 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
3942 allow-failure: false
40− - compiler: ghc-8.10.7
43+ - compiler: ghc-8.10.4
4144 compilerKind: ghc
42− compilerVersion: 8.10.7
43− setup-method: ghcup
45+ compilerVersion: 8.10.4
46+ setup-method: hvr-ppa
4447 allow-failure: false
4548 - compiler: ghc-8.8.4
4649 compilerKind: ghc
@@ -55,18 +58,14 @@ jobs:
5558 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
5659 if [ "${{ matrix.setup-method }}" = ghcup ]; then
5760 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"
5962 chmod a+x "$HOME/.ghcup/bin/ghcup"
6063 "$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
6265 else
6366 apt-add-repository -y 'ppa:hvr/ghc'
6467 apt-get update
65− apt-get install -y "$HCNAME"
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
68+ apt-get install -y "$HCNAME" cabal-install-3.4
7069 fi
7170 env:
7271 HCKIND: ${{ matrix.compilerKind }}
@@ -84,20 +83,20 @@ jobs:
8483 echo "HC=$HC" >> "$GITHUB_ENV"
8584 echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
8685 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"
8887 else
8988 HC=$HCDIR/bin/$HCKIND
9089 echo "HC=$HC" >> "$GITHUB_ENV"
9190 echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
9291 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"
9493 fi
9594
9695 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
9796 echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
9897 echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
9998 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
101100 echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
102101 echo "GHCJSARITH=0" >> "$GITHUB_ENV"
103102 env:
@@ -126,10 +125,17 @@ jobs:
126125 repository hackage.haskell.org
127126 url: http://hackage.haskell.org/
128127 EOF
128+ if $HEADHACKAGE; then
129129 cat >> $CABAL_CONFIG <<EOF
130− program-default-options
131− ghc-options: $GHCJOBS +RTS -M3G -RTS
130+ repository head.hackage.ghc.haskell.org
131+ url: https://ghc.gitlab.haskell.org/head.hackage/
132+ secure: True
133+ root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d
134+ 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329
135+ f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89
136+ key-threshold: 3
132137 EOF
138+ fi
133139 cat $CABAL_CONFIG
134140 - name: versions
135141 run: |
@@ -142,7 +148,7 @@ jobs:
142148 - name: cache (tools)
143149 uses: actions/cache@v2
144150 with:
145− key: ${{ runner.os }}-${{ matrix.compiler }}-tools-16fe7d6d
151+ key: ${{ runner.os }}-${{ matrix.compiler }}-tools-b692a344
146152 path: ~/.haskell-ci-tools
147153 - name: install cabal-plan
148154 run: |
@@ -155,8 +161,8 @@ jobs:
155161 cabal-plan --version
156162 - name: install doctest
157163 run: |
158− $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.20'
159− doctest --version
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
165+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then doctest --version ; fi
160166 - name: checkout
161167 uses: actions/checkout@v2
162168 with:
@@ -194,6 +200,9 @@ jobs:
194200 package effectful
195201 flags: +benchmark-foreign-libraries
196202 EOF
203+ if $HEADHACKAGE; then
204+ echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1,/g')" >> cabal.project
205+ fi
197206 $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(effectful|effectful-core)$/; }' >> cabal.project.local
198207 cat cabal.project
199208 cat cabal.project.local
@@ -222,12 +231,10 @@ jobs:
222231 $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
223232 - name: doctest
224233 run: |
225− cd ${PKGDIR_effectful} || false
226− doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src
227− cd ${PKGDIR_effectful_core} || false
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
234+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cd ${PKGDIR_effectful} || false ; fi
235+ 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
236+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cd ${PKGDIR_effectful_core} || false ; fi
237+ 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
231238 - name: cabal check
232239 run: |
233240 cd ${PKGDIR_effectful} || false
README.md+3−10
@@ -1,10 +1,7 @@
11# effectful
22
33[![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)
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">
4+[![Documentation](https://img.shields.io/static/v1?label=docs&message=0.0.0.0&color=informational)](https://rybczak.net/files/effectful/effectful-0.0.0.0-docs)
85
96*Note:* this is a pre-release.
107
@@ -20,8 +17,8 @@ Main features:
2017
21182. Easy to use API (no boilerplate code and dealing with arcane types).
2219
23−3. Correct semantics in presence of runtime exceptions (no more lost state
24− modifications).
20+3. Correct semantics in presence of runtime exceptions (no more lost or
21+ discarded state).
2522
26234. Seamless integration with the existing ecosystem (`exceptions`,
2724 `monad-control`, `unliftio-core`, `resourcet` etc.).
@@ -139,7 +136,3 @@ Blog posts:
139136* [ReaderT design pattern](https://www.fpcomplete.com/blog/2017/06/readert-design-pattern/) by Michael Snoyman.
140137
141138* [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>
cabal.haskell-ci+3−1
@@ -1,9 +1,11 @@
11branches: master
22
3−doctest: <9.3
3+doctest: <9.2
44tests: True
55benchmarks: True
66
7+ghcup-jobs: >=9.2
8+
79raw-project
810 package effectful
911 flags: +benchmark-foreign-libraries
doctest.sh+1−2
@@ -17,7 +17,6 @@ run_doctest() {
1717 -XConstraintKinds \
1818 -XDataKinds \
1919 -XDeriveFunctor \
20− -XDeriveGeneric \
2120 -XFlexibleContexts \
2221 -XFlexibleInstances \
2322 -XGADTs \
@@ -37,5 +36,5 @@ run_doctest() {
3736 popd
3837}
3938
40−run_doctest effectful-core src
4139run_doctest effectful src
40+run_doctest effectful-core src
effectful-core/effectful-core.cabal+15−18
@@ -12,13 +12,14 @@ synopsis: An easy to use, performant extensible effects library.
1212description: An easy to use, performant extensible effects library with seamless
1313 integration with the existing Haskell ecosystem.
1414 .
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.
15+ This library provides the core of the effect system and is quiet
16+ minimal. If you look for something more sophisticated have a look
17+ at the @<https://hackage.haskell.org/package/effectful effectful>@
18+ package.
1819
1920extra-source-files: CHANGELOG.md
2021
21−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1
22+tested-with: GHC ==8.8.4 || ==8.10.4 || ==9.0.1 || ==9.2.0.20210422
2223
2324bug-reports: https://github.com/arybczak/effectful/issues
2425source-repository head
@@ -34,7 +35,6 @@ common language
3435 ConstraintKinds
3536 DataKinds
3637 DeriveFunctor
37− DeriveGeneric
3838 FlexibleContexts
3939 FlexibleInstances
4040 GADTs
@@ -67,24 +67,21 @@ library
6767
6868 ghc-options: -O2
6969
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
70+ build-depends: base >= 4.13 && <5
71+ , containers
72+ , effectful-internal-utils
73+ , exceptions
74+ , monad-control
75+ , primitive
76+ , transformers-base
77+ , unliftio-core
7978
8079 hs-source-dirs: src
8180
82− exposed-modules: Effectful
83− Effectful.Dispatch.Dynamic
84− Effectful.Dispatch.Static
85− Effectful.Error
81+ exposed-modules: Effectful.Error
8682 Effectful.Error.Dynamic
8783 Effectful.Fail
84+ Effectful.Handler
8885 Effectful.Internal.Effect
8986 Effectful.Internal.Env
9087 Effectful.Internal.Monad
effectful-core/src/Effectful/Dispatch/Static.hsdeleted−82
@@ -1,82 +0,0 @@
1−module Effectful.Dispatch.Static
2− ( -- * Low level API
3− DataA(..)
4−
5− -- ** Extending the environment
6− , runData
7− , evalData
8− , execData
9−
10− -- ** Data retrieval and update
11− , getData
12− , putData
13− , stateData
14− , stateDataM
15− , localData
16−
17− -- ** Unlifts
18− , seqUnliftIO
19− , concUnliftIO
20−
21− -- ** Utils
22− , unEff
23− , unsafeEff
24− , unsafeEff_
25− , unsafeLiftMapIO
26− , unsafeUnliftIO
27−
28− -- * Primitive API
29− , Env
30− , Relinker(..)
31− , noRelinker
32−
33− -- ** Operations
34− , emptyEnv
35− , cloneEnv
36− , forkEnv
37− , sizeEnv
38− , checkSizeEnv
39−
40− -- ** Extending and shrinking
41− , unsafeConsEnv
42− , unsafeTailEnv
43−
44− -- ** Data retrieval and update
45− , getEnv
46− , putEnv
47− , stateEnv
48− , modifyEnv
49− ) where
50−
51−import Effectful.Internal.Env
52−import Effectful.Internal.Monad
53−
54−-- | Utility for lifting 'IO' computations of type
55−--
56−-- @'IO' a -> 'IO' b@
57−--
58−-- to
59−--
60−-- @'Eff' es a -> 'Eff' es b@
61−--
62−-- This function is __unsafe__ because:
63−--
64−-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
65−-- computations.
66−--
67−-- - The 'IO' computation must not run its argument in a separate thread, but
68−-- it's not checked anywhere.
69−unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
70−unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
71−
72−-- | Utility for running 'Eff' computations locally in the 'IO' monad.
73−--
74−-- This function is __unsafe__ because:
75−--
76−-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
77−-- computations.
78−--
79−-- - Unlifted 'Eff' computations must not be run in a thread distinct from the
80−-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
81−unsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
82−unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)
effectful-core/src/Effectful/Error.hs+27−96
@@ -1,78 +1,29 @@
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.
1+{- | Support for checked exceptions.
2+
3+The 'Error' effect provided by this module is a suitable replacement for the
4+'Control.Monad.Except.ExceptT' monad transformer found in the @mtl@ library. It
5+is __not__ intended to be a general mechanism for catching errors, that's what
6+functions from the "Control.Monad.Catch" module are for.
7+
8+For example, if you want to catch an unchecked exception like
9+'Control.Exception.SomeException' or 'Control.Exception.ErrorCall' you could use
10+'Control.Monad.Catch.catch':
11+
12+>>> import qualified Control.Monad.Catch as E
13+>>> :{
14+ let boom :: Eff es String
15+ boom = error "BOOM!"
16+ in
17+ runEff $ boom `E.catch` \(e :: ErrorCall) -> pure "caught some error"
18+:}
19+"caught some error"
20+
21+-}
7022module Effectful.Error
7123 ( Error
7224 , runError
7325 , throwError
7426 , catchError
75− , handleError
7627 , tryError
7728
7829 -- * Re-exports
@@ -87,14 +38,13 @@ import Data.Typeable
8738import Data.Unique
8839import GHC.Stack
8940
90−import Effectful.Dispatch.Static
91−import Effectful.Monad
41+import Effectful.Internal.Effect
42+import Effectful.Internal.Env
43+import Effectful.Internal.Monad
9244
93−-- | Provide the ability to handle errors of type @e@.
9445newtype Error e :: Effect where
9546 Error :: ErrorId -> Error e m r
9647
97−-- | Handle errors of type @e@.
9848runError
9949 :: forall e es a. Typeable e
10050 => Eff (Error e : es) a
@@ -102,7 +52,7 @@ runError
10252runError m = unsafeEff $ \es0 -> mask $ \release -> do
10353 eid <- newErrorId
10454 size0 <- sizeEnv es0
105− es <- unsafeConsEnv (DataA (Error @e eid)) noRelinker es0
55+ es <- unsafeConsEnv (IdE (Error @e eid)) noRelinker es0
10656 r <- tryErrorIO release eid es `onException` unsafeTailEnv size0 es
10757 unsafeTailEnv size0 es
10858 pure r
@@ -112,48 +62,29 @@ runError m = unsafeEff $ \es0 -> mask $ \release -> do
11262 Left ex -> tryHandler ex eid (\cs e -> Left (cs, e))
11363 $ throwIO ex
11464
115−-- | Throw an error of type @e@.
11665throwError
11766 :: forall e es a. (HasCallStack, Typeable e, Error e :> es)
11867 => e
119− -- ^ The error.
12068 -> Eff es a
12169throwError e = unsafeEff $ \es -> do
122− DataA (Error eid) <- getEnv @(Error e) es
70+ IdE (Error eid) <- getEnv @(Error e) es
12371 throwIO $ ErrorEx eid callStack e
12472
125−-- | Handle an error of type @e@.
12673catchError
12774 :: forall e es a. (Typeable e, Error e :> es)
12875 => Eff es a
129− -- ^ The inner computation.
13076 -> (CallStack -> e -> Eff es a)
131− -- ^ A handler for errors in the inner computation.
13277 -> Eff es a
13378catchError m handler = unsafeEff $ \es -> do
134− DataA (Error eid) <- getEnv @(Error e) es
79+ IdE (Error eid) <- getEnv @(Error e) es
13580 size <- sizeEnv es
13681 catchErrorIO eid (unEff m es) $ \cs e -> do
13782 checkSizeEnv size es
13883 unEff (handler cs e) es
13984
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.
15385tryError
15486 :: forall e es a. (Typeable e, Error e :> es)
15587 => Eff es a
156− -- ^ The inner computation.
15788 -> Eff es (Either (CallStack, e) a)
15889tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)
15990
effectful-core/src/Effectful/Error/Dynamic.hs+1−1
@@ -8,7 +8,7 @@ module Effectful.Error.Dynamic
88
99import Data.Typeable
1010
11−import Effectful.Dispatch.Dynamic
11+import Effectful.Handler
1212import Effectful.Monad
1313import qualified Effectful.Error as E
1414
effectful-core/src/Effectful/Fail.hs+1−11
@@ -1,16 +1,6 @@
1−-- | Provider of the 'MonadFail' instance for 'Eff'.
21module Effectful.Fail
3− ( Fail(..)
2+ ( Fail
43 , runFail
54 ) where
65
7−import Effectful.Dispatch.Dynamic
8−import Effectful.Error
96import 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/Dispatch/Dynamic.hs → effectful-core/src/Effectful/Handler.hsrenamed+101−78
@@ -1,4 +1,4 @@
1−module Effectful.Dispatch.Dynamic
1+module Effectful.Handler
22 ( -- * Sending operations to the handler
33 send
44
@@ -7,7 +7,7 @@ module Effectful.Dispatch.Dynamic
77 , interpret
88 , reinterpret
99
10− -- ** Handling local 'Eff' computations
10+ -- ** Handling local 'Eff' operations
1111 , LocalEnv
1212
1313 -- *** Unlifts
@@ -24,23 +24,62 @@ module Effectful.Dispatch.Dynamic
2424 , localLiftUnlift
2525 , localLiftUnliftIO
2626
27− -- *** Utils
28− , SuffixOf
29−
3027 -- * Re-exports
3128 , HasCallStack
3229 ) where
3330
3431import Control.Monad.IO.Unlift
35−import Data.Kind
36−import GHC.Stack (HasCallStack)
32+import GHC.Stack
33+import qualified Control.Exception as E
3734
3835import Effectful.Internal.Effect
3936import Effectful.Internal.Env
4037import Effectful.Internal.Monad
4138
4239----------------------------------------
43−-- Handling effects
40+-- Handler
41+
42+-- | Opaque representation of the 'Eff' environment at the point of calling the
43+-- 'send' function, i.e. right before the control is passed to the effect
44+-- handler.
45+newtype LocalEnv es = LocalEnv (Env es)
46+
47+-- | Type signature of the effect handler.
48+type EffectHandler e es
49+ = forall a localEs. HasCallStack
50+ => LocalEnv localEs
51+ -- ^ The environment for handling local 'Eff' operations with functions from
52+ -- the 'localUnlift' family when given a higher order effect.
53+ -> e (Eff localEs) a
54+ -- ^ The effect in the local environment.
55+ -> Eff es a
56+
57+data Handler :: Effect -> Type where
58+ Handler :: !(Env es) -> !(EffectHandler e es) -> Handler e
59+
60+runHandler :: Handler e -> Eff (e : es) a -> Eff es a
61+runHandler e m = unsafeEff $ \es0 -> do
62+ size0 <- sizeEnv es0
63+ E.bracket (unsafeConsEnv e relinker es0)
64+ (unsafeTailEnv size0)
65+ (\es -> unEff m es)
66+ where
67+ relinker :: Relinker Handler e
68+ relinker = Relinker $ \relink (Handler env handle) -> do
69+ newEnv <- relink env
70+ pure $ Handler newEnv handle
71+
72+----------------------------------------
73+-- Sending operations
74+
75+-- | Send an operation of a given effect to its handler for execution.
76+send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
77+send op = unsafeEff $ \es -> do
78+ Handler env handle <- getEnv es
79+ unEff (handle (LocalEnv es) op) env
80+
81+----------------------------------------
82+-- Interpretation
4483
4584-- | Interpret an effect.
4685interpret
@@ -50,7 +89,10 @@ interpret
5089 -> Eff es a
5190interpret handler m = unsafeEff $ \es -> do
5291 les <- forkEnv es
53− (`unEff` es) $ runHandler (HandlerA les handler) m
92+ (`unEff` es) $ runHandler (Handler les handler) m
93+
94+----------------------------------------
95+-- Reinterpretation
5496
5597-- | Interpret an effect using other effects.
5698reinterpret
@@ -63,7 +105,7 @@ reinterpret
63105reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
64106 les0 <- forkEnv es
65107 (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do
66− (`unEff` es) $ runHandler (HandlerA les handler) m
108+ (`unEff` es) $ runHandler (Handler les handler) m
67109
68110----------------------------------------
69111-- Unlifts
@@ -71,31 +113,31 @@ reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
71113-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
72114-- general version see 'localUnlift'.
73115localSeqUnlift
74− :: (HasCallStack, SuffixOf es handlerEs)
75− => LocalEnv localEs handlerEs
116+ :: HasCallStack
117+ => LocalEnv localEs
76118 -- ^ Local environment.
77119 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
78120 -- ^ Continuation with the unlifting function in scope.
79121 -> Eff es a
80122localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
81− seqUnliftIO les $ \unlift -> do
123+ unsafeSeqUnliftEff les $ \unlift -> do
82124 (`unEff` es) $ k $ unsafeEff_ . unlift
83125
84126-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
85127-- general version see 'localUnliftIO'.
86128localSeqUnliftIO
87− :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
88− => LocalEnv localEs handlerEs
129+ :: (HasCallStack, IOE :> es)
130+ => LocalEnv localEs
89131 -- ^ Local environment.
90132 -> ((forall r. Eff localEs r -> IO r) -> IO a)
91133 -- ^ Continuation with the unlifting function in scope.
92134 -> Eff es a
93−localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftIO les k
135+localSeqUnliftIO (LocalEnv les) k = liftIO $ unsafeSeqUnliftEff les k
94136
95137-- | Create a local unlifting function with the given strategy.
96138localUnlift
97− :: (HasCallStack, SuffixOf es handlerEs)
98− => LocalEnv localEs handlerEs
139+ :: HasCallStack
140+ => LocalEnv localEs
99141 -- ^ Local environment.
100142 -> UnliftStrategy
101143 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
@@ -103,62 +145,58 @@ localUnlift
103145 -> Eff es a
104146localUnlift (LocalEnv les) strategy k = case strategy of
105147 SeqUnlift -> unsafeEff $ \es -> do
106− seqUnliftIO les $ \unlift -> do
148+ unsafeSeqUnliftEff les $ \unlift -> do
107149 (`unEff` es) $ k $ unsafeEff_ . unlift
108150 ConcUnlift p l -> unsafeEff $ \es -> do
109− concUnliftIO les p l $ \unlift -> do
151+ unsafeConcUnliftEff les p l $ \unlift -> do
110152 (`unEff` es) $ k $ unsafeEff_ . unlift
111153
112154-- | Create a local unlifting function with the given strategy.
113155localUnliftIO
114− :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
115− => LocalEnv localEs handlerEs
156+ :: (HasCallStack, IOE :> es)
157+ => LocalEnv localEs
116158 -- ^ Local environment.
117159 -> UnliftStrategy
118160 -> ((forall r. Eff localEs r -> IO r) -> IO a)
119161 -- ^ Continuation with the unlifting function in scope.
120162 -> Eff es a
121163localUnliftIO (LocalEnv les) strategy k = case strategy of
122− SeqUnlift -> liftIO $ seqUnliftIO les k
123− ConcUnlift p l -> liftIO $ concUnliftIO les p l k
164+ SeqUnlift -> liftIO $ unsafeSeqUnliftEff les k
165+ ConcUnlift p l -> liftIO $ unsafeConcUnliftEff les p l k
124166
125−-- | Utility for lifting 'Eff' computations of type
167+-- | Utility for lifting 'Eff' operations of type
126168--
127169-- @'Eff' es a -> 'Eff' es b@
128170--
129171-- to
130172--
131−-- @'Eff' localEs a -> 'Eff' localEs b@
173+-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
132174--
133−-- /Note:/ the computation must not run its argument in a separate thread,
175+-- /Note:/ the operation must not run its argument in a separate thread,
134176-- attempting to do so will result in a runtime error.
135177withLiftMap
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)
178+ :: (HasCallStack, IOE :> es)
179+ => ((forall a b localEs. (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
140180 -- ^ Continuation with the lifting function in scope.
141181 -> 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.
182+withLiftMap k = unsafeEff $ \es -> do
145183 (`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
146− seqUnliftIO localEs $ \unlift -> do
147− (`unEff` es) . mapEff . unsafeEff_ $ unlift m
184+ unsafeSeqUnliftEff localEs $ \unlift -> do
185+ (`unEff` es) . mapEff . liftIO $ unlift m
148186
149−-- | Utility for lifting 'IO' computations of type
187+-- | Utility for lifting 'IO' operations of type
150188--
151189-- @'IO' a -> 'IO' b@
152190--
153191-- to
154192--
155−-- @'Eff' localEs a -> 'Eff' localEs b@
193+-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
156194--
157−-- /Note:/ the computation must not run its argument in a separate thread,
195+-- /Note:/ the operation must not run its argument in a separate thread,
158196-- attempting to do so will result in a runtime error.
159197--
160198-- Useful e.g. for lifting the unmasking function in
161−-- 'Control.Exception.mask'-like computations:
199+-- 'Control.Exception.mask'-like operations:
162200--
163201-- >>> :{
164202-- data Fork :: Effect where
@@ -167,35 +205,31 @@ withLiftMap !_ k = unsafeEff $ \es -> do
167205--
168206-- >>> :{
169207-- runFork :: IOE :> es => Eff (Fork : es) a -> Eff es a
170−-- runFork = interpret $ \env (ForkWithUnmask m) -> withLiftMapIO env $ \liftMap -> do
208+-- runFork = interpret $ \env (ForkWithUnmask m) -> withLiftMapIO $ \liftMap -> do
171209-- localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
172210-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
173211-- :}
174212withLiftMapIO
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)
213+ :: (HasCallStack, IOE :> es)
214+ => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
179215 -- ^ Continuation with the lifting function in scope.
180216 -> 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
217+withLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
218+ unsafeSeqUnliftEff es $ \unlift -> mapIO $ unlift m
185219
186220----------------------------------------
187221-- Bidirectional lifts
188222
189223-- | Create a local lifting and unlifting function with the given strategy.
190224--
191−-- Useful for lifting complicated 'Eff' computations where the monadic action
225+-- Useful for lifting complicated 'Eff' operations where the monadic action
192226-- shows in both positive (as a result) and negative (as an argument) position.
193227--
194−-- /Note:/ depending on the computation you're lifting 'localUnlift' along with
228+-- /Note:/ depending on the operation you're lifting 'localUnlift' along with
195229-- 'withLiftMap' might be enough and is more efficient.
196230localLiftUnlift
197− :: (HasCallStack, SuffixOf es handlerEs)
198− => LocalEnv localEs handlerEs
231+ :: (HasCallStack, IOE :> es)
232+ => LocalEnv localEs
199233 -- ^ Local environment.
200234 -> UnliftStrategy
201235 -> ((forall r. Eff es r -> Eff localEs r) -> (forall r. Eff localEs r -> Eff es r) -> Eff es a)
@@ -203,44 +237,33 @@ localLiftUnlift
203237 -> Eff es a
204238localLiftUnlift (LocalEnv les) strategy k = case strategy of
205239 SeqUnlift -> unsafeEff $ \es -> do
206− seqUnliftIO es $ \unliftEs -> do
207− seqUnliftIO les $ \unliftLocalEs -> do
208− (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
240+ unsafeSeqUnliftEff es $ \unliftEs -> do
241+ unsafeSeqUnliftEff les $ \unliftLocalEs -> do
242+ (`unEff` es) $ k (unsafeEff_ . unliftEs) (liftIO . unliftLocalEs)
209243 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)
244+ unsafeConcUnliftEff es p l $ \unliftEs -> do
245+ unsafeConcUnliftEff les p l $ \unliftLocalEs -> do
246+ (`unEff` es) $ k (unsafeEff_ . unliftEs) (liftIO . unliftLocalEs)
213247
214248-- | Create a local unlifting function with the given strategy along with an
215249-- unrestricted lifting function.
216250--
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.
251+-- Useful for lifting complicated 'IO' operations where the monadic action shows
252+-- in both positive (as a result) and negative (as an argument) position.
219253--
220−-- /Note:/ depending on the computation you're lifting 'localUnliftIO' along
221−-- with 'withLiftMapIO' might be enough and is more efficient.
254+-- /Note:/ depending on the operation you're lifting 'localUnliftIO' along with
255+-- 'withLiftMapIO' might be enough and is more efficient.
222256localLiftUnliftIO
223− :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
224− => LocalEnv localEs handlerEs
257+ :: (HasCallStack, IOE :> es)
258+ => LocalEnv localEs
225259 -- ^ Local environment.
226260 -> UnliftStrategy
227261 -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)
228262 -- ^ Continuation with the lifting and unlifting function in scope.
229263 -> Eff es a
230264localLiftUnliftIO (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
265+ SeqUnlift -> liftIO $ unsafeSeqUnliftEff les $ k unsafeEff_
266+ ConcUnlift p l -> liftIO $ unsafeConcUnliftEff les p l $ k unsafeEff_
244267
245268-- $setup
246269-- >>> import Control.Concurrent
effectful-core/src/Effectful/Internal/Effect.hs+12−7
@@ -8,6 +8,7 @@
88module Effectful.Internal.Effect
99 ( Effect
1010 , (:>)(..)
11+ , IdE(..)
1112
1213 -- * Re-exports
1314 , Type
@@ -19,16 +20,20 @@ import GHC.TypeLits
1920-- | The kind of effects.
2021type Effect = (Type -> Type) -> Type -> Type
2122
22−-- | A constraint that requires that a particular effect @e@ is a member of the
23−-- type-level list @es@. This is used to parameterize an 'Effectful.Monad.Eff'
24−-- computation over an arbitrary list of effects, so long as @e@ is /somewhere/
25−-- in the list.
23+-- | Adapter for statically dispatched effects.
24+newtype IdE :: Effect -> Type where
25+ IdE :: (forall m r. e m r) -> IdE e
26+
27+-- | A constraint that requires that a particular effect, @e@, is a member of
28+-- the type-level list @es@. This is used to parameterize an
29+-- 'Effectful.Monad.Eff' operation over an arbitrary list of effects, so long as
30+-- @e@ is /somewhere/ in the list.
2631--
27−-- For example, a computation that only needs access to a mutable value of type
28−-- 'Integer' would likely use the following type:
32+-- For example, an operation that only needs access to a cell of mutable state
33+-- containing an 'Integer' would likely use the following type:
2934--
3035-- @
31−-- 'Effectful.State.Local.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
36+-- 'Effectful.State.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
3237-- @
3338class (e :: Effect) :> (es :: [Effect]) where
3439 -- | Get the position of @e@ in @es@.
effectful-core/src/Effectful/Internal/Env.hs+49−73
@@ -1,38 +1,26 @@
1−{-# LANGUAGE MagicHash #-}
1+{-# LANGUAGE AllowAmbiguousTypes #-}
22{-# OPTIONS_HADDOCK not-home #-}
33-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.
44--
55-- This module is intended for internal use only, and may change without warning
66-- in subsequent releases.
77module Effectful.Internal.Env
8− ( -- * The environment
9− Env(..)
10− , Forks(..)
11− , EnvRef(..)
12−
13− -- ** ForkId
14− , ForkId(..)
15− , ForkIdGen(..)
16− , newForkIdGen
17− , cloneForkIdGen
18− , newForkId
19−
20− -- ** Relinker
8+ ( Env
219 , Relinker(..)
2210 , noRelinker
2311
24− -- * Operations
12+ -- * Operations
2513 , emptyEnv
2614 , cloneEnv
2715 , forkEnv
2816 , sizeEnv
2917 , checkSizeEnv
3018
31− -- ** Extending and shrinking
19+ -- ** Extending and shrinking
3220 , unsafeConsEnv
3321 , unsafeTailEnv
3422
35− -- ** Data retrieval and update
23+ -- ** Data retrieval and update
3624 , getEnv
3725 , putEnv
3826 , stateEnv
@@ -43,7 +31,7 @@ import Control.Monad
4331import Control.Monad.Primitive
4432import Data.IORef
4533import Data.Primitive.SmallArray
46−import GHC.Exts (Any, SmallMutableArray#)
34+import GHC.Exts (Any)
4735import GHC.Stack (HasCallStack)
4836import Unsafe.Coerce
4937import qualified Data.IntMap.Strict as IM
@@ -81,17 +69,17 @@ type role Env nominal
8169-- @
8270--
8371-- The point of execution is currently at (*), i.e. the mainline. Moreover,
84−-- currently (brackets represent forks):
72+-- currently:
8573--
8674-- - Mainline sees @[e00, e01, e05, e07]@.
8775--
88−-- - @e01@ is an interpreted effect, its handler sees @[e00][e02, e03]@.
76+-- - @e01@ is an interpreted effect, its handler sees @[e00, e02, e03]@.
8977--
90−-- - @e03@ is an interpreted effect, its handler sees @[e00][e02][e04]@.
78+-- - @e03@ is an interpreted effect, its handler sees @[e00, e02, e04]@.
9179--
92−-- - @e05@ is an interpreted effect, its handler sees @[e00, e01][e06]@.
80+-- - @e05@ is an interpreted effect, its handler sees @[e00, e01, e06]@.
9381--
94−-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05][e08,
82+-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05, e08,
9583-- e09]@.
9684--
9785-- If an operation from @e01@ is invoked, the environment in the middle of
@@ -114,11 +102,11 @@ type role Env nominal
114102-- introduced @e12@), so its local environment was temporarily extended with
115103-- it. Moreover, currently:
116104--
117−-- - Handler of @e01@ sees @[e00][e02, e03, e10]@.
105+-- - Handler of @e01@ sees @[e00, e02, e03, e10]@.
118106--
119−-- - Handler of @e10@ sees @[e00][e02, e03][e11]@.
107+-- - Handler of @e10@ sees @[e00, e02, e03, e11]@.
120108--
121−-- - Handler of @e11@ sees @[e00][e02, e03][e12]@.
109+-- - Handler of @e11@ sees @[e00, e02, e03, e12]@.
122110--
123111data Env (es :: [Effect]) = Env
124112 { _forks :: !Forks
@@ -129,7 +117,6 @@ data Env (es :: [Effect]) = Env
129117-- | Local forks of the environment.
130118data Forks = Forks !ForkId !Int !(IORef EnvRef) Forks | NoFork
131119
132−-- | Data held in the environment.
133120data EnvRef = EnvRef
134121 { _size :: !Int
135122 , _data :: !(SmallMutableArray RealWorld Any)
@@ -139,7 +126,6 @@ data EnvRef = EnvRef
139126----------------------------------------
140127-- ForkId
141128
142−-- | Internal id of the fork.
143129newtype ForkId = ForkId { unForkId :: Int }
144130
145131-- | 'ForkId' generation.
@@ -163,15 +149,12 @@ newForkId (ForkIdGen ref) = do
163149----------------------------------------
164150-- Relinker
165151
166−-- | A function for relinking 'Env' objects stored in the handlers when cloning
167−-- the environment.
168152newtype Relinker :: (Effect -> Type) -> Effect -> Type where
169153 Relinker
170− :: ((forall es. Env es -> IO (Env es)) -> adapter e -> IO (adapter e))
171− -> Relinker adapter e
154+ :: ((forall es. Env es -> IO (Env es)) -> handler e -> IO (handler e))
155+ -> Relinker handler e
172156
173−-- | A dummy 'Relinker' that does nothing.
174−noRelinker :: Relinker adapter e
157+noRelinker :: Relinker handler e
175158noRelinker = Relinker $ \_ -> pure
176159
177160----------------------------------------
@@ -356,10 +339,10 @@ checkSizeEnv k (Env (Forks _ baseIx lref _) _ _) = do
356339
357340-- | Extend the environment with a new data type (in place).
358341--
359−-- This function is __highly unsafe__ because it renders the input 'Env'
360−-- unusable until the corresponding 'unsafeTailEnv' call is made, but it's not
361−-- checked anywhere.
362−unsafeConsEnv :: adapter e -> Relinker adapter e -> Env es -> IO (Env (e : es))
342+-- /Note:/ this function is __unsafe__ because it renders the input 'Env'
343+-- unusable until the corresponding 'unsafeTailEnv' call, but it's not checked
344+-- anywhere.
345+unsafeConsEnv :: handler e -> Relinker handler e -> Env es -> IO (Env (e : es))
363346unsafeConsEnv e f (Env fork gref gen) = case fork of
364347 NoFork -> do
365348 extendEnvRef gref
@@ -395,11 +378,11 @@ unsafeConsEnv e f (Env fork gref gen) = case fork of
395378-- | Shrink the environment by one data type (in place). Makes sure the size of
396379-- the environment is as expected.
397380--
398−-- This function is __highly unsafe__ because it renders the input 'Env'
381+-- /Note:/ this function is __unsafe__ because it renders the input 'Env'
399382-- unusable, but it's not checked anywhere.
400383unsafeTailEnv :: Int -> Env (e : es) -> IO ()
401384unsafeTailEnv len (Env fork gref _) = case fork of
402− NoFork -> shrinkEnvRef len gref
385+ NoFork -> shrinkEnvRef len gref
403386 Forks _ baseIx lref _ -> shrinkEnvRef (len - baseIx) lref
404387 where
405388 shrinkEnvRef :: Int -> IORef EnvRef -> IO ()
@@ -417,44 +400,41 @@ unsafeTailEnv len (Env fork gref _) = case fork of
417400-- Data retrieval and update
418401
419402-- | Extract a specific data type from the environment.
420−getEnv
421− :: forall e adapter es. e :> es
422− => Env es
423− -> IO (adapter e)
403+getEnv :: forall e es handler. e :> es => Env es -> IO (handler e)
424404getEnv env = do
425− Location i es <- getLocation (reifyIndex @e @es) env
405+ (i, es) <- getLocation @e env
426406 fromAny <$> readSmallArray es i
427407
428408-- | Replace the data type in the environment with a new value (in place).
429409putEnv
430− :: forall e adapter es. e :> es
410+ :: forall e es handler. e :> es
431411 => Env es
432− -> adapter e
412+ -> handler e
433413 -> IO ()
434414putEnv env e = do
435− Location i es <- getLocation (reifyIndex @e @es) env
415+ (i, es) <- getLocation @e env
436416 e `seq` writeSmallArray es i (toAny e)
437417
438418-- | Modify the data type in the environment (in place) and return a value.
439419stateEnv
440− :: forall e adapter es a. e :> es
420+ :: forall e es handler a. e :> es
441421 => Env es
442− -> (adapter e -> (a, adapter e))
422+ -> (handler e -> (a, handler e))
443423 -> IO a
444424stateEnv env f = do
445− Location i es <- getLocation (reifyIndex @e @es) env
425+ (i, es) <- getLocation @e env
446426 (a, e) <- f . fromAny <$> readSmallArray es i
447427 e `seq` writeSmallArray es i (toAny e)
448428 pure a
449429
450430-- | Modify the data type in the environment (in place).
451431modifyEnv
452− :: forall e adapter es. e :> es
432+ :: forall e es handler. e :> es
453433 => Env es
454− -> (adapter e -> adapter e)
434+ -> (handler e -> handler e)
455435 -> IO ()
456436modifyEnv env f = do
457− Location i es <- getLocation (reifyIndex @e @es) env
437+ (i, es) <- getLocation @e env
458438 e <- f . fromAny <$> readSmallArray es i
459439 e `seq` writeSmallArray es i (toAny e)
460440
@@ -470,17 +450,13 @@ emptyEnvRef = do
470450 fs <- newSmallArray 0 undefinedData
471451 newIORef $ EnvRef 0 es fs
472452
473−-- | Location with unboxed fields to make GHC generate Core without unnecessary
474−-- reboxing around the local 'go' function from 'getLocation'.
475−data Location = Location !Int !(SmallMutableArray RealWorld Any)
476−
477453-- | Determine location of the data type in the environment.
478454getLocation
479− :: Int
480− -> Env es
481− -> IO Location
482−getLocation ixE (Env fork ref _) = do
483− EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref
455+ :: forall e es. e :> es
456+ => Env es
457+ -> IO (Int, SmallMutableArray RealWorld Any)
458+getLocation (Env fork ref _) = do
459+ EnvRef n es _ <- readIORef ref
484460 -- Optimized for the common access pattern:
485461 --
486462 -- - Most application code has no access to forks, in which case we look at
@@ -489,28 +465,28 @@ getLocation ixE (Env fork ref _) = do
489465 -- - Effect handlers will most likely access the newest fork with handler
490466 -- specific effects for reinterpretation.
491467 case fork of
492− NoFork -> pure $ Location (ix n) es
468+ NoFork -> pure (ix n, es)
493469 Forks _ baseIx lref forks -> do
494470 EnvRef ln les _ <- readIORef lref
495471 let i = ix (baseIx + ln)
496472 if i >= baseIx
497− then pure $ Location (i - baseIx) les
498− else go es# i forks
473+ then pure (i - baseIx, les)
474+ else go es i forks
499475 where
500− go :: SmallMutableArray# RealWorld Any
476+ go :: SmallMutableArray RealWorld Any
501477 -> Int
502478 -> Forks
503− -> IO Location
504− go es# i = \case
505− NoFork -> pure $ Location i (SmallMutableArray es#)
479+ -> IO (Int, SmallMutableArray RealWorld Any)
480+ go es i = \case
481+ NoFork -> pure (i, es)
506482 Forks _ baseIx lref forks -> do
507483 EnvRef _ les _ <- readIORef lref
508484 if i >= baseIx
509− then pure $ Location (i - baseIx) les
510− else go es# i forks
485+ then pure (i - baseIx, les)
486+ else go es i forks
511487
512488 ix :: Int -> Int
513− ix n = n - ixE - 1
489+ ix n = n - reifyIndex @e @es - 1
514490
515491toAny :: a -> Any
516492toAny = unsafeCoerce
effectful-core/src/Effectful/Internal/Monad.hs+242−207
@@ -6,7 +6,7 @@
66-- This module is intended for internal use only, and may change without warning
77-- in subsequent releases.
88module Effectful.Internal.Monad
9− ( -- * The 'Eff' monad
9+ ( -- * Monad
1010 Eff
1111 , runPureEff
1212
@@ -16,17 +16,18 @@ module Effectful.Internal.Monad
1616 , unsafeEff_
1717
1818 -- * Fail
19− , Fail(..)
19+ , Fail
20+ , runFail
2021
2122 -- * IO
2223 , IOE
2324 , runEff
2425
25− -- * Prim
26+ -- * Primitive
2627 , Prim
2728 , runPrim
2829
29− -- * Unlift strategies
30+ -- ** Unlift strategies
3031 , UnliftStrategy(..)
3132 , Persistence(..)
3233 , Limit(..)
@@ -34,88 +35,87 @@ module Effectful.Internal.Monad
3435 , withUnliftStrategy
3536 , withEffToIO
3637
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
38+ --- *** Low-level helpers
39+ , unsafeWithLiftMapIO
40+ , unsafeSeqUnliftEff
41+ , unsafeConcUnliftEff
42+
43+ -- * Primitive effects
44+
45+ -- ** Running
46+ , runEffect
47+ , evalEffect
48+ , execEffect
49+
50+ -- ** Modification
51+ , getEffect
52+ , putEffect
53+ , stateEffect
54+ , stateEffectM
55+ , localEffect
6056 ) where
6157
6258import Control.Applicative (liftA2)
59+import Control.Concurrent (myThreadId)
60+import Control.Exception
6361import Control.Monad.Base
6462import Control.Monad.Fix
6563import Control.Monad.IO.Class
6664import Control.Monad.IO.Unlift
6765import Control.Monad.Primitive
6866import Control.Monad.Trans.Control
67+import Data.Unique
6968import GHC.Exts (oneShot)
7069import GHC.IO (IO(..))
7170import GHC.Stack (HasCallStack)
7271import System.IO.Unsafe (unsafeDupablePerformIO)
73−import qualified Control.Exception as E
74−import qualified Control.Monad.Catch as C
72+import qualified Control.Monad.Catch as E
7573
7674import Effectful.Internal.Effect
7775import Effectful.Internal.Env
7876import Effectful.Internal.Unlift
77+import Effectful.Internal.Utils
7978
8079type role Eff nominal representational
8180
82−-- | The 'Eff' monad provides the implementation of a computation that performs
81+-- | The 'Eff' monad provides the implementation of an operation that performs
8382-- 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:
83+-- contains all the effects that the operation may perform. For example, an
84+-- operation that produces an 'Integer' by consuming a 'String' from the global
85+-- environment and acting upon a single mutable cell containing a 'Bool' would
86+-- have the following type:
8887--
8988-- @
90−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
89+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
9190-- @
9291--
9392-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
9493-- 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:
94+-- effects without coupling an operation to a concrete list of effects. For
95+-- example, the above example would more commonly be expressed with the
96+-- following type:
9797--
9898-- @
99−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
99+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
100100-- @
101101--
102−-- This abstraction allows the computation to be used in functions that may
102+-- This abstraction allows the operation to be used in functions that may
103103-- perform other effects, and it also allows the effects to be handled in any
104104-- order.
105105newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
106106 deriving (Monoid, Semigroup)
107107
108−-- | Run a pure 'Eff' computation.
108+-- | Run a pure 'Eff' operation.
109109--
110−-- For running computations with side effects see 'runEff'.
110+-- For running operations with side effects see 'runEff'.
111111runPureEff :: Eff '[] a -> a
112112runPureEff (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).
113+ -- unsafePerformIO is safe here since IOE was not on the stack, so no IO with
114+ -- side effects was performed (unless someone sneakily introduced side effects
115+ -- with unsafeEff, but then all bets are off).
116116 --
117117 -- Moreover, internals don't allocate any resources that require explicit
118− -- cleanup actions to run.
118+ -- cleanup actions to run, so the "Dupable" part should also be just fine.
119119 unsafeDupablePerformIO $ m =<< emptyEnv
120120
121121----------------------------------------
@@ -126,70 +126,62 @@ unEff :: Eff es a -> Env es -> IO a
126126unEff (Eff m) = m
127127
128128-- | 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.
132129unsafeEff :: (Env es -> IO a) -> Eff es a
133130unsafeEff m = Eff (oneShot m)
134131
135132-- | 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.
139133unsafeEff_ :: IO a -> Eff es a
140134unsafeEff_ m = unsafeEff $ \_ -> m
141135
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'.
136+-- | Utility for lifting 'IO' operations of type
156137--
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.
138+-- @'IO' a -> 'IO' b@
160139--
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
140+-- to
141+--
142+-- @forall localEs. 'Eff' localEs a -> 'Eff' localEs b@
143+--
144+-- /Note:/ the 'IO' operation must not run its argument in a separate thread,
145+-- attempting to do so will result in a runtime error.
146+unsafeWithLiftMapIO
147+ :: HasCallStack
148+ => ((forall a b localEs. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
149+ -> Eff es r
150+unsafeWithLiftMapIO k = k $ \mapIO m -> unsafeEff $ \es -> do
151+ unsafeSeqUnliftEff es $ \unlift -> mapIO $ unlift m
171152
172−-- | Create an unlifting function with the 'SeqUnlift' strategy.
173−seqUnliftIO
153+-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
154+unsafeSeqUnliftEff
174155 :: HasCallStack
175156 => Env es
176− -- ^ The environment.
177157 -> ((forall r. Eff es r -> IO r) -> IO a)
178− -- ^ Continuation with the unlifting function in scope.
179158 -> IO a
180−seqUnliftIO es k = seqUnlift k es unEff
181−
182−-- | Create an unlifting function with the 'ConcUnlift' strategy.
183−concUnliftIO
159+unsafeSeqUnliftEff es k = do
160+ tid0 <- myThreadId
161+ k $ \m -> do
162+ tid <- myThreadId
163+ if tid `eqThreadId` tid0
164+ then unEff m es
165+ else error
166+ $ "If you want to use the unlifting function to run Eff operations "
167+ ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
168+
169+-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
170+unsafeConcUnliftEff
184171 :: HasCallStack
185172 => Env es
186− -- ^ The environment.
187173 -> Persistence
188174 -> Limit
189175 -> ((forall r. Eff es r -> IO r) -> IO a)
190− -- ^ Continuation with the unlifting function in scope.
191176 -> IO a
192−concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
177+unsafeConcUnliftEff es Ephemeral (Limited uses) k =
178+ unsafeEphemeralConcUnliftIO uses k es unEff
179+unsafeConcUnliftEff es Ephemeral Unlimited k =
180+ unsafeEphemeralConcUnliftIO maxBound k es unEff
181+unsafeConcUnliftEff es Persistent (Limited threads) k =
182+ unsafePersistentConcUnliftIO False threads k es unEff
183+unsafeConcUnliftEff es Persistent Unlimited k =
184+ unsafePersistentConcUnliftIO True maxBound k es unEff
193185
194186----------------------------------------
195187-- Base
@@ -217,56 +209,84 @@ instance MonadFix (Eff es) where
217209----------------------------------------
218210-- Exception
219211
220−instance C.MonadThrow (Eff es) where
221− throwM = unsafeEff_ . E.throwIO
212+instance E.MonadThrow (Eff es) where
213+ throwM = unsafeEff_ . throwIO
222214
223−instance C.MonadCatch (Eff es) where
215+instance E.MonadCatch (Eff es) where
224216 catch m handler = unsafeEff $ \es -> do
225217 size <- sizeEnv es
226− unEff m es `E.catch` \e -> do
218+ unEff m es `catch` \e -> do
227219 checkSizeEnv size es
228220 unEff (handler e) es
229221
230−instance C.MonadMask (Eff es) where
231− mask k = unsafeEff $ \es -> E.mask $ \restore ->
222+instance E.MonadMask (Eff es) where
223+ mask k = unsafeEff $ \es -> mask $ \restore ->
232224 unEff (k $ \m -> unsafeEff $ restore . unEff m) es
233225
234− uninterruptibleMask k = unsafeEff $ \es -> E.uninterruptibleMask $ \restore ->
226+ uninterruptibleMask k = unsafeEff $ \es -> uninterruptibleMask $ \restore ->
235227 unEff (k $ \m -> unsafeEff $ restore . unEff m) es
236228
237− generalBracket acquire release use = unsafeEff $ \es -> E.mask $ \restore -> do
229+ generalBracket acquire release use = unsafeEff $ \es -> mask $ \restore -> do
238230 size <- sizeEnv es
239231 resource <- unEff acquire es
240− b <- restore (unEff (use resource) es) `E.catch` \e -> do
232+ b <- restore (unEff (use resource) es) `catch` \e -> do
241233 checkSizeEnv size es
242− _ <- unEff (release resource $ C.ExitCaseException e) es
243− E.throwIO e
234+ _ <- unEff (release resource $ E.ExitCaseException e) es
235+ throwIO e
244236 checkSizeEnv size es
245− c <- unEff (release resource $ C.ExitCaseSuccess b) es
237+ c <- unEff (release resource $ E.ExitCaseSuccess b) es
246238 pure (b, c)
247239
248240----------------------------------------
249241-- Fail
250242
251−-- | Provide the ability to use the 'MonadFail' instance of 'Eff'.
252−data Fail :: Effect where
253− Fail :: String -> Fail m a
243+newtype Fail :: Effect where
244+ Fail :: Unique -> Fail m r
245+
246+runFail :: Eff (Fail : es) a -> Eff es (Either String a)
247+runFail m = unsafeEff $ \es0 -> mask $ \release -> do
248+ -- A unique tag is picked so that different runFail handlers don't catch each
249+ -- other's exceptions.
250+ tag <- newUnique
251+ size0 <- sizeEnv es0
252+ es <- unsafeConsEnv (IdE (Fail tag)) noRelinker es0
253+ r <- tryFailIO tag (release $ unEff m es) `onException` unsafeTailEnv size0 es
254+ unsafeTailEnv size0 es
255+ pure r
254256
255257instance Fail :> es => MonadFail (Eff es) where
256− fail = send . Fail
258+ fail msg = do
259+ IdE (Fail tag) <- getEffect
260+ unsafeEff_ . throwIO $ FailEx tag msg
261+
262+--------------------
263+
264+data FailEx = FailEx !Unique String
265+instance Show FailEx where
266+ showsPrec p (FailEx _ msg)
267+ = ("Effectful.Internal.Monad.FailEx " ++)
268+ . showsPrec p msg
269+instance Exception FailEx
270+
271+tryFailIO :: Unique -> IO a -> IO (Either String a)
272+tryFailIO tag m =
273+ (Right <$> m) `catch` \err@(FailEx etag msg) -> do
274+ if tag == etag
275+ then pure $ Left msg
276+ else throwIO err
257277
258278----------------------------------------
259279-- IO
260280
261−-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
281+-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.
262282newtype IOE :: Effect where
263283 IOE :: UnliftStrategy -> IOE m r
264284
265−-- | Run an 'Eff' computation with side effects.
285+-- | Run an 'Eff' operation with side effects.
266286--
267−-- For running pure computations see 'runPureEff'.
287+-- For running pure operations see 'runPureEff'.
268288runEff :: Eff '[IOE] a -> IO a
269−runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv
289+runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
270290
271291instance IOE :> es => MonadIO (Eff es) where
272292 liftIO = unsafeEff_
@@ -290,126 +310,141 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where
290310----------------------------------------
291311-- Primitive
292312
293−-- | Provide the ability to perform primitive state-transformer actions.
313+-- | An effect to perform primitive state-transformer actions.
294314data Prim :: Effect where
295315 Prim :: Prim m r
296316
297−-- | Run an 'Eff' computation with primitive state-transformer actions.
317+-- | Run an 'Eff' operation with primitive state-transformer actions.
298318runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
299−runPrim = evalData (DataA Prim)
319+runPrim = evalEffect (IdE Prim)
300320
301321instance Prim :> es => PrimMonad (Eff es) where
302322 type PrimState (Eff es) = RealWorld
303323 primitive = unsafeEff_ . IO
304324
305325----------------------------------------
306−-- Dynamic dispatch
326+-- Unlift strategies
327+
328+-- | The strategy to use when unlifting 'Eff' operations via 'withRunInIO' or
329+-- the 'Effectful.Interpreter.localUnlift' family.
330+data UnliftStrategy
331+ = SeqUnlift
332+ -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
333+ -- the unlifting function in threads distinct from its creator will result in
334+ -- a runtime error.
335+ | ConcUnlift !Persistence !Limit
336+ -- ^ A strategy that makes it possible for the unlifting function to be called
337+ -- in threads distinct from its creator. See 'Persistence' and 'Limit'
338+ -- settings for more information.
339+ deriving (Eq, Ord, Show)
340+
341+-- | Persistence setting for the 'ConcUnlift' strategy.
342+--
343+-- Different functions require different persistence strategies. Examples:
344+--
345+-- - Lifting 'pooledMapConcurrentlyN' from the @unliftio@ library requires the
346+-- 'Ephemeral' strategy as we don't want jobs to share environment changes
347+-- made by previous jobs run in the same worker thread.
348+--
349+-- - Lifting 'Control.Concurrent.forkIOWithUnmask' requires the 'Persistent'
350+-- strategy, otherwise the unmasking function would start with a fresh
351+-- environment each time it's called.
352+data Persistence
353+ = Ephemeral
354+ -- ^ Don't persist the environment between calls to the unlifting function in
355+ -- threads distinct from its creator.
356+ | Persistent
357+ -- ^ Persist the environment between calls to the unlifting function within a
358+ -- particular thread.
359+ deriving (Eq, Ord, Show)
360+
361+-- | Limit setting for the 'ConcUnlift' strategy.
362+data Limit
363+ = Limited !Int
364+ -- ^ Behavior dependent on the 'Persistence' setting.
365+ --
366+ -- For 'Ephemeral', it limits the amount of uses of the unlifting function in
367+ -- threads distinct from its creator to @N@. The unlifting function will
368+ -- create @N@ copies of the environment when called @N@ times and @K+1@ copies
369+ -- when called @K < N@ times.
370+ --
371+ -- For 'Persistent', it limits the amount of threads, distinct from the
372+ -- creator of the unlifting function, it can be called in to @N@. The amount
373+ -- of calls to the unlifting function within a particular threads is
374+ -- unlimited. The unlifting function will create @N@ copies of the environment
375+ -- when called in @N@ threads and @K+1@ copies when called in @K < N@ threads.
376+ | Unlimited
377+ -- ^ Unlimited use of the unlifting function.
378+ deriving (Eq, Ord, Show)
307379
308−type role LocalEnv nominal nominal
380+-- | Get the current 'UnliftStrategy'.
381+unliftStrategy :: IOE :> es => Eff es UnliftStrategy
382+unliftStrategy = do
383+ IdE (IOE unlift) <- getEffect
384+ pure unlift
309385
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.
386+-- | Locally override the 'UnliftStrategy' with a given value.
313387--
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
388+-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
389+withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
390+withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
327391
328−-- | An adapter for dynamically dispatched effects.
392+-- | Create an unlifting function with the current 'UnliftStrategy'.
329393--
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
394+-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
395+-- constraint for accurate stack traces in case an insufficiently powerful
396+-- 'UnliftStrategy' is used and the unlifting function fails.
397+withEffToIO
398+ :: (HasCallStack, IOE :> es)
399+ => ((forall r. Eff es r -> IO r) -> IO a)
400+ -- ^ Continuation with the unlifting function in scope.
401+ -> Eff es a
402+withEffToIO f = unliftStrategy >>= \case
403+ SeqUnlift -> unsafeEff $ \es -> unsafeSeqUnliftEff es f
404+ ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
405+ unsafeEff $ \es -> unsafeConcUnliftEff es p b f
352406
353407----------------------------------------
354−-- Static dispatch
408+-- Helpers
355409
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
410+runEffect :: handler e -> Eff (e : es) a -> Eff es (a, handler e)
411+runEffect e0 m = unsafeEff $ \es0 -> do
367412 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
413+ bracket (unsafeConsEnv e0 noRelinker es0)
414+ (unsafeTailEnv size0)
415+ (\es -> (,) <$> unEff m es <*> getEnv es)
416+
417+evalEffect :: handler e -> Eff (e : es) a -> Eff es a
418+evalEffect e m = unsafeEff $ \es0 -> do
376419 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
420+ bracket (unsafeConsEnv e noRelinker es0)
421+ (unsafeTailEnv size0)
422+ (\es -> unEff m es)
423+
424+execEffect :: handler e -> Eff (e : es) a -> Eff es (handler e)
425+execEffect e0 m = unsafeEff $ \es0 -> do
385426 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
427+ bracket (unsafeConsEnv e0 noRelinker es0)
428+ (unsafeTailEnv size0)
429+ (\es -> unEff m es *> getEnv es)
430+
431+getEffect :: e :> es => Eff es (handler e)
432+getEffect = unsafeEff $ \es -> getEnv es
433+
434+putEffect :: e :> es => handler e -> Eff es ()
435+putEffect e = unsafeEff $ \es -> putEnv es e
436+
437+stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a
438+stateEffect f = unsafeEff $ \es -> stateEnv es f
439+
440+stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a
441+stateEffectM f = unsafeEff $ \es -> mask $ \release -> do
406442 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
407443 putEnv es e
408444 pure a
409445
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)
446+localEffect :: e :> es => (handler e -> handler e) -> Eff es a -> Eff es a
447+localEffect f m = unsafeEff $ \es -> do
448+ bracket (stateEnv es $ \e -> (e, f e))
449+ (\e -> putEnv es e)
450+ (\_ -> unEff m es)
effectful-core/src/Effectful/Internal/Unlift.hs+10−115
@@ -1,28 +1,19 @@
11{-# LANGUAGE MagicHash #-}
22{-# LANGUAGE UnboxedTuples #-}
33{-# OPTIONS_HADDOCK not-home #-}
4−-- | Implementation of sequential and concurrent unlifts.
4+-- | Implementation of concurrent unlifts.
55--
66-- This module is intended for internal use only, and may change without warning
77-- in subsequent releases.
88module Effectful.Internal.Unlift
9− ( -- * Unlifting strategies
10− UnliftStrategy(..)
11− , Persistence(..)
12− , Limit(..)
13−
14− -- * Unlifting functions
15− , seqUnlift
16− , concUnlift
17− , ephemeralConcUnlift
18− , persistentConcUnlift
9+ ( unsafeEphemeralConcUnliftIO
10+ , unsafePersistentConcUnliftIO
1911 ) where
2012
2113import Control.Concurrent
2214import Control.Monad
2315import GHC.Conc.Sync (ThreadId(..))
2416import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)
25−import GHC.Generics (Generic)
2617import GHC.IO (IO(..))
2718import GHC.Stack (HasCallStack)
2819import GHC.Weak (Weak(..))
@@ -32,111 +23,16 @@ import qualified Data.IntMap.Strict as IM
3223import Effectful.Internal.Env
3324import Effectful.Internal.Utils
3425
35−----------------------------------------
36−-- Unlift strategies
37−
38−-- | The strategy to use when unlifting 'Eff' computations via 'withRunInIO',
39−-- 'Effectful.Monad.withEffToIO' or the 'Effectful.Dispatch.Dynamic.localUnlift'
40−-- family.
41−data UnliftStrategy
42− = SeqUnlift
43− -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
44− -- the unlifting function in threads distinct from its creator will result in
45− -- a runtime error.
46− | ConcUnlift !Persistence !Limit
47− -- ^ A strategy that makes it possible for the unlifting function to be called
48− -- in threads distinct from its creator. See 'Persistence' and 'Limit'
49− -- settings for more information.
50− deriving (Eq, Generic, Ord, Show)
51−
52−-- | Persistence setting for the 'ConcUnlift' strategy.
53−--
54−-- Different functions require different persistence strategies. Examples:
55−--
56−-- - Lifting 'pooledMapConcurrentlyN' from the @unliftio@ library requires the
57−-- 'Ephemeral' strategy as we don't want jobs to share environment changes
58−-- made by previous jobs run in the same worker thread.
59−--
60−-- - Lifting 'Control.Concurrent.forkIOWithUnmask' requires the 'Persistent'
61−-- strategy, otherwise the unmasking function would start with a fresh
62−-- environment each time it's called.
63−data Persistence
64− = Ephemeral
65− -- ^ Don't persist the environment between calls to the unlifting function in
66− -- threads distinct from its creator.
67− | Persistent
68− -- ^ Persist the environment between calls to the unlifting function within a
69− -- particular thread.
70− deriving (Eq, Generic, Ord, Show)
71−
72−-- | Limit setting for the 'ConcUnlift' strategy.
73−data Limit
74− = Limited !Int
75− -- ^ Behavior dependent on the 'Persistence' setting.
76− --
77− -- For 'Ephemeral', it limits the amount of uses of the unlifting function in
78− -- threads distinct from its creator to @N@. The unlifting function will
79− -- create @N@ copies of the environment when called @N@ times and @K+1@ copies
80− -- when called @K < N@ times.
81− --
82− -- For 'Persistent', it limits the amount of threads, distinct from the
83− -- creator of the unlifting function, it can be called in to @N@. The amount
84− -- of calls to the unlifting function within a particular threads is
85− -- unlimited. The unlifting function will create @N@ copies of the environment
86− -- when called in @N@ threads and @K+1@ copies when called in @K < N@ threads.
87− | Unlimited
88− -- ^ Unlimited use of the unlifting function.
89− deriving (Eq, Generic, Ord, Show)
90−
91−----------------------------------------
92−-- Unlift functions
93−
94−-- | Sequential unlift.
95−seqUnlift
96− :: HasCallStack
97− => ((forall r. m r -> IO r) -> IO a)
98− -> Env es
99− -> (forall r. m r -> Env es -> IO r)
100− -> IO a
101−seqUnlift k es unEff = do
102− tid0 <- myThreadId
103− k $ \m -> do
104− tid <- myThreadId
105− if tid `eqThreadId` tid0
106− then unEff m es
107− else error
108− $ "If you want to use the unlifting function to run Eff computations "
109− ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
110−
111−-- | Concurrent unlift for various strategies and limits.
112−concUnlift
113− :: HasCallStack
114− => Persistence
115− -> Limit
116− -> ((forall r. m r -> IO r) -> IO a)
117− -> Env es
118− -> (forall r. m r -> Env es -> IO r)
119− -> IO a
120−concUnlift Ephemeral (Limited uses) k =
121− ephemeralConcUnlift uses k
122−concUnlift Ephemeral Unlimited k =
123− ephemeralConcUnlift maxBound k
124−concUnlift Persistent (Limited threads) k =
125− persistentConcUnlift False threads k
126−concUnlift Persistent Unlimited k =
127− persistentConcUnlift True maxBound k
128−
12926-- | Concurrent unlift that doesn't preserve the environment between calls to
13027-- the unlifting function in threads other than its creator.
131−ephemeralConcUnlift
28+unsafeEphemeralConcUnliftIO
13229 :: HasCallStack
13330 => Int
134− -- ^ Number of permitted uses of the unlift function.
13531 -> ((forall r. m r -> IO r) -> IO a)
13632 -> Env es
13733 -> (forall r. m r -> Env es -> IO r)
13834 -> IO a
139−ephemeralConcUnlift uses k es0 unEff = do
35+unsafeEphemeralConcUnliftIO uses k es0 unEff = do
14036 unless (uses > 0) $ do
14137 error $ "Invalid number of uses: " ++ show uses
14238 tid0 <- myThreadId
@@ -162,16 +58,15 @@ ephemeralConcUnlift uses k es0 unEff = do
16258
16359-- | Concurrent unlift that preserves the environment between calls to the
16460-- unlifting function within a particular thread.
165−persistentConcUnlift
61+unsafePersistentConcUnliftIO
16662 :: HasCallStack
16763 => Bool
16864 -> Int
169− -- ^ Number of threads that are allowed to use the unlift function.
17065 -> ((forall r. m r -> IO r) -> IO a)
17166 -> Env es
17267 -> (forall r. m r -> Env es -> IO r)
17368 -> IO a
174−persistentConcUnlift cleanUp threads k es0 unEff = do
69+unsafePersistentConcUnliftIO cleanUp threads k es0 unEff = do
17570 unless (threads > 0) $ do
17671 error $ "Invalid number of threads: " ++ show threads
17772 tid0 <- myThreadId
@@ -192,9 +87,9 @@ persistentConcUnlift cleanUp threads k es0 unEff = do
19287 Just es -> pure (te, es)
19388 Nothing -> case teCapacity te of
19489 0 -> error
195− $ "Number of other threads (" ++ show threads ++ ") permitted to "
196− ++ "use the unlifting function was exceeded. Please increase the "
197− ++ "limit or use the unlimited variant."
90+ $ "Number of other threads (" ++ show threads ++ ") permitted to "
91+ ++ "use the unlifting function was exceeded. Please increase the "
92+ ++ "limit or use the unlimited variant."
19893 1 -> do
19994 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp
20095 let newEntries = ThreadEntries
effectful-core/src/Effectful/Prim.hs−1
@@ -1,4 +1,3 @@
1−-- | Provider of the 'MonadPrim' instance for 'Eff'.
21module Effectful.Prim
32 ( Prim
43 , runPrim
effectful-core/src/Effectful/Reader.hs+12−29
@@ -1,4 +1,4 @@
1−-- | Support for access to a read only value of a particular type.
1+-- | The 'Reader' effect.
22module Effectful.Reader
33 ( Reader
44 , runReader
@@ -7,43 +7,26 @@ module Effectful.Reader
77 , local
88 ) where
99
10−import Effectful.Dispatch.Static
11−import Effectful.Monad
10+import Effectful.Internal.Effect
11+import Effectful.Internal.Monad
1212
1313-- | Provide access to a strict (WHNF), thread local, read only value of type
1414-- @r@.
1515newtype Reader r :: Effect where
1616 Reader :: r -> Reader r m a
1717
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))
18+runReader :: r -> Eff (Reader r : es) a -> Eff es a
19+runReader r = evalEffect (IdE (Reader r))
2420
25−-- | Fetch the value of the environment.
2621ask :: Reader r :> es => Eff es r
2722ask = do
28− DataA (Reader r) <- getData
23+ IdE (Reader r) <- getEffect
2924 pure r
3025
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
26+asks :: Reader r :> es => (r -> a) -> Eff es a
27+asks f = do
28+ IdE (Reader r) <- getEffect
29+ pure $ f r
3930
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))
31+local :: Reader r :> es => (r -> r) -> Eff es a -> Eff es a
32+local f = localEffect $ \(IdE (Reader r)) -> IdE (Reader (f r))
effectful-core/src/Effectful/Reader/Dynamic.hs+1−1
@@ -6,7 +6,7 @@ module Effectful.Reader.Dynamic
66 , local
77 ) where
88
9−import Effectful.Dispatch.Dynamic
9+import Effectful.Handler
1010import Effectful.Monad
1111import qualified Effectful.Reader as R
1212
effectful-core/src/Effectful/State/Dynamic.hs+15−4
@@ -1,4 +1,13 @@
11-- | The 'State' effect with dynamic dispatch.
2+--
3+-- It's not clear in which situation it's beneficial to use this instead of
4+-- "Effectful.State.Local" or "Effectful.State.Shared" as you either:
5+--
6+-- - Share state between threads and need the shared version.
7+--
8+-- - Don't share state between threads (or want it to be thread local) and are
9+-- free to use the faster, local version.
10+--
211module Effectful.State.Dynamic
312 ( State(..)
413
@@ -22,12 +31,14 @@ module Effectful.State.Dynamic
2231 , modifyM
2332 ) where
2433
25−import Effectful.Dispatch.Dynamic
34+import Effectful.Handler
2635import Effectful.Monad
2736import qualified Effectful.State.Local as L
2837import qualified Effectful.State.Shared as S
2938
30−-- | Provide access to a mutable value of type @s@.
39+-- | Provide access to a mutable state of type @s@.
40+--
41+-- Whether the state is local or shared depends on the interpretation.
3142data State s :: Effect where
3243 Get :: State s m s
3344 Put :: s -> State s m ()
@@ -48,7 +59,7 @@ execLocalState s0 = reinterpret (L.execState s0) localState
4859
4960localState
5061 :: L.State s :> es
51− => LocalEnv localEs es
62+ => LocalEnv localEs
5263 -> State s (Eff localEs) a
5364 -> Eff es a
5465localState env = \case
@@ -71,7 +82,7 @@ execSharedState s0 = reinterpret (S.execState s0) sharedState
7182
7283sharedState
7384 :: S.State s :> es
74− => LocalEnv localEs es
85+ => LocalEnv localEs
7586 -> State s (Eff localEs) a
7687 -> Eff es a
7788sharedState env = \case
effectful-core/src/Effectful/State/Local.hs+24−88
@@ -1,29 +1,12 @@
1−-- | Support for access to a mutable value of a particular type, which is:
1+-- | The 'State' effect.
22--
3−-- - thread local (if you want the value to be shared between threads, have a
3+-- Represented as a pure value underneath, therefore:
4+--
5+-- - thread local (if you need the state to be shared between threads, have a
46-- look at "Effectful.State.Shared"),
57--
68-- - very fast.
79--
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!"
2710module Effectful.State.Local
2811 ( State
2912 , runState
@@ -38,94 +21,47 @@ module Effectful.State.Local
3821 , modifyM
3922 ) where
4023
41−import Effectful.Dispatch.Static
42−import Effectful.Monad
24+import Effectful.Internal.Effect
25+import Effectful.Internal.Monad
4326
44−-- | Provide access to a strict (WHNF), thread local, mutable value of type @s@.
27+-- | Provide access to a strict (WHNF), thread local, mutable state of type @s@.
4528newtype State s :: Effect where
4629 State :: s -> State s m r
4730
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)
31+runState :: s -> Eff (State s : es) a -> Eff es (a, s)
5432runState s0 m = do
55− (a, DataA (State s)) <- runData (DataA (State s0)) m
33+ (a, IdE (State s)) <- runEffect (IdE (State s0)) m
5634 pure (a, s)
5735
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))
36+evalState :: s -> Eff (State s : es) a -> Eff es a
37+evalState s = evalEffect (IdE (State s))
6538
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
39+execState :: s -> Eff (State s : es) a -> Eff es s
7240execState s0 m = do
73− DataA (State s) <- execData (DataA (State s0)) m
41+ IdE (State s) <- execEffect (IdE (State s0)) m
7442 pure s
7543
76−-- | Fetch the current value of the state.
7744get :: State s :> es => Eff es s
7845get = do
79− DataA (State s) <- getData
46+ IdE (State s) <- getEffect
8047 pure s
8148
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
49+gets :: State s :> es => (s -> a) -> Eff es a
8950gets f = f <$> get
9051
91−-- | Set the current state to the given value.
9252put :: State s :> es => s -> Eff es ()
93−put s = putData (DataA (State s))
53+put s = putEffect (IdE (State s))
9454
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))
55+state :: State s :> es => (s -> (a, s)) -> Eff es a
56+state f = stateEffect $ \(IdE (State s0)) -> let (a, s) = f s0 in (a, IdE (State s))
10157
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)
58+modify :: State s :> es => (s -> s) -> Eff es ()
59+modify f = state (\s -> ((), f s))
11060
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
61+stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
62+stateM f = stateEffectM $ \(IdE (State s0)) -> do
11763 (a, s) <- f s0
118− pure (a, DataA (State s))
64+ pure (a, IdE (State s))
11965
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 ()
66+modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()
12767modifyM f = stateM (\s -> ((), ) <$> f s)
128−
129−-- $setup
130−-- >>> import Control.Exception (ErrorCall)
131−-- >>> import Control.Monad.Catch
effectful-core/src/Effectful/State/Shared.hs+15−63
@@ -1,29 +1,11 @@
1−-- | Support for access to a mutable value of a particular type, which is:
1+-- | The 'State' effect.
22--
3−-- - shared between multiple threads (if you want each thead to manage its own
4−-- version of the value, see "Effectful.State.Local").
3+-- Represented as an 'MVar' underneath, therefore:
54--
6−-- - slightly slower than "Effectful.State.Local".
5+-- - shareable between multiple threads,
76--
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:
7+-- - slower than "Effectful.State.Local".
118--
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!"
279module Effectful.State.Shared
2810 ( State
2911 , runState
@@ -40,88 +22,58 @@ module Effectful.State.Shared
4022
4123import Control.Concurrent.MVar
4224
43−import Effectful.Dispatch.Static
44−import Effectful.Monad
25+import Effectful.Internal.Effect
26+import Effectful.Internal.Env
27+import Effectful.Internal.Monad
4528
46−-- | Provide access to a strict (WHNF), shared, mutable value of type @s@.
29+-- | Provide access to a strict (WHNF), shareable, mutable state of type @s@.
4730newtype State s :: Effect where
4831 State :: MVar s -> State s m r
4932
50−-- | Run a 'State' effect with the given initial state and return the final
51−-- value along with the final state.
5233runState :: s -> Eff (State s : es) a -> Eff es (a, s)
5334runState s m = do
5435 v <- unsafeEff_ $ newMVar s
55− a <- evalData (DataA (State v)) m
36+ a <- evalEffect (IdE (State v)) m
5637 (a, ) <$> unsafeEff_ (readMVar v)
5738
58−-- | Run a 'State' effect with the given initial state and return the final
59−-- value, discarding the final state.
6039evalState :: s -> Eff (State s : es) a -> Eff es a
6140evalState s m = do
6241 v <- unsafeEff_ $ newMVar s
63− evalData (DataA (State v)) m
42+ evalEffect (IdE (State v)) m
6443
65−-- | Run a 'State' effect with the given initial state and return the final
66−-- state, discarding the final value.
6744execState :: s -> Eff (State s : es) a -> Eff es s
6845execState s m = do
6946 v <- unsafeEff_ $ newMVar s
70− _ <- evalData (DataA (State v)) m
47+ _ <- evalEffect (IdE (State v)) m
7148 unsafeEff_ $ readMVar v
7249
73−-- | Fetch the current value of the state.
7450get :: State s :> es => Eff es s
7551get = unsafeEff $ \es -> do
76− DataA (State v) <- getEnv es
52+ IdE (State v) <- getEnv es
7753 readMVar v
7854
79−-- | Get a function of the current state.
80−--
81−-- @'gets' f ≡ f '<$>' 'get'@
8255gets :: State s :> es => (s -> a) -> Eff es a
8356gets f = f <$> get
8457
85−-- | Set the current state to the given value.
8658put :: State s :> es => s -> Eff es ()
8759put s = unsafeEff $ \es -> do
88− DataA (State v) <- getEnv es
60+ IdE (State v) <- getEnv es
8961 modifyMVar_ v $ \_ -> s `seq` pure s
9062
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.
9463state :: State s :> es => (s -> (a, s)) -> Eff es a
9564state f = unsafeEff $ \es -> do
96− DataA (State v) <- getEnv es
65+ IdE (State v) <- getEnv es
9766 modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)
9867
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.
10468modify :: State s :> es => (s -> s) -> Eff es ()
10569modify f = state (\s -> ((), f s))
10670
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.
11071stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
11172stateM f = unsafeEff $ \es -> do
112− DataA (State v) <- getEnv es
73+ IdE (State v) <- getEnv es
11374 modifyMVar v $ \s0 -> do
11475 (a, s) <- unEff (f s0) es
11576 s `seq` pure (s, a)
11677
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.
12278modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()
12379modifyM f = stateM (\s -> ((), ) <$> f s)
124−
125−-- $setup
126−-- >>> import Control.Exception (ErrorCall)
127−-- >>> import Control.Monad.Catch
effectful-core/src/Effectful/Writer/Dynamic.hs+6−6
@@ -15,7 +15,7 @@ module Effectful.Writer.Dynamic
1515 , listens
1616 ) where
1717
18−import Effectful.Dispatch.Dynamic
18+import Effectful.Handler
1919import Effectful.Monad
2020import qualified Effectful.Writer.Local as L
2121import qualified Effectful.Writer.Shared as S
@@ -35,7 +35,7 @@ execLocalWriter = reinterpret L.execWriter localWriter
3535
3636localWriter
3737 :: (L.Writer w :> es, Monoid w)
38− => LocalEnv localEs es
38+ => LocalEnv localEs
3939 -> Writer w (Eff localEs) a
4040 -> Eff es a
4141localWriter env = \case
@@ -53,7 +53,7 @@ execSharedWriter = reinterpret S.execWriter sharedWriter
5353
5454sharedWriter
5555 :: (S.Writer w :> es, Monoid w)
56− => LocalEnv localEs es
56+ => LocalEnv localEs
5757 -> Writer w (Eff localEs) a
5858 -> Eff es a
5959sharedWriter env = \case
@@ -64,19 +64,19 @@ sharedWriter env = \case
6464-- Operations
6565
6666tell
67− :: (HasCallStack, Writer w :> es)
67+ :: (HasCallStack, Writer w :> es, Monoid w)
6868 => w
6969 -> Eff es ()
7070tell = send . Tell
7171
7272listen
73− :: (HasCallStack, Writer w :> es)
73+ :: (HasCallStack, Writer w :> es, Monoid w)
7474 => Eff es a
7575 -> Eff es (a, w)
7676listen = send . Listen
7777
7878listens
79− :: (HasCallStack, Writer w :> es)
79+ :: (HasCallStack, Writer w :> es, Monoid w)
8080 => (w -> b)
8181 -> Eff es a
8282 -> Eff es (a, b)
effectful-core/src/Effectful/Writer/Local.hs+10−56
@@ -1,20 +1,4 @@
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.
1+-- | The 'Writer' effect.
182module Effectful.Writer.Local
193 ( Writer
204 , runWriter
@@ -24,71 +8,41 @@ module Effectful.Writer.Local
248 , listens
259 ) where
2610
27−import Control.Exception (onException, mask)
11+import Control.Exception
2812
29−import Effectful.Dispatch.Static
30−import Effectful.Monad
13+import Effectful.Internal.Effect
14+import Effectful.Internal.Env
15+import Effectful.Internal.Monad
3116
3217-- | Provide access to a strict (WHNF), thread local, write only value of type
3318-- @w@.
3419newtype Writer w :: Effect where
3520 Writer :: w -> Writer w m r
3621
37−-- | Run a 'Writer' effect and return the final value along with the final
38−-- output.
3922runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
4023runWriter m = do
41− (a, DataA (Writer w)) <- runData (DataA (Writer mempty)) m
24+ (a, IdE (Writer w)) <- runEffect (IdE (Writer mempty)) m
4225 pure (a, w)
4326
44−-- | Run a 'Writer' effect and return the final output, discarding the final
45−-- value.
4627execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
4728execWriter m = do
48− DataA (Writer w) <- execData (DataA (Writer mempty)) m
29+ IdE (Writer w) <- execEffect (IdE (Writer mempty)) m
4930 pure w
5031
51−-- | Append the given output to the overall output of the 'Writer'.
5232tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
53−tell w = stateData $ \(DataA (Writer w0)) -> ((), DataA (Writer (w0 <> w)))
33+tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))
5434
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!"
7235listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
7336listen m = unsafeEff $ \es -> mask $ \restore -> do
74− w0 <- stateEnv es $ \(DataA (Writer w)) -> (w, DataA (Writer mempty))
37+ w0 <- stateEnv es $ \(IdE (Writer w)) -> (w, IdE (Writer mempty))
7538 a <- restore (unEff m es) `onException` merge es w0
7639 (a, ) <$> merge es w0
7740 where
7841 merge es w0 =
7942 -- If an exception is thrown, restore w0 and keep parts of w1.
80− stateEnv es $ \(DataA (Writer w1)) -> (w1, DataA (Writer (w0 <> w1)))
43+ stateEnv es $ \(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))
8144
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@
8745listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
8846listens f m = do
8947 (a, w) <- listen m
9048 pure (a, f w)
91−
92−-- $setup
93−-- >>> import Control.Exception (ErrorCall)
94−-- >>> import Control.Monad.Catch
effectful-core/src/Effectful/Writer/Shared.hs+10−57
@@ -1,20 +1,3 @@
1−-- | Support for access to a write only value of a particular type, which is:
2−--
3−-- - shared between multiple threads (if you want each thead to manage its own
4−-- version of the value, see "Effectful.Writer.Local").
5−--
6−-- - slightly slower than "Effectful.Writer.Local".
7−--
8−-- /Warning:/ 'Writer'\'s state will be accumulated via __left-associated__ uses
9−-- of '<>', which makes it unsuitable for use with types for which such pattern
10−-- is inefficient. __This applies, in particular, to the standard list type__,
11−-- which makes the 'Writer' effect pretty niche.
12−--
13−-- /Note:/ while the 'Control.Monad.Trans.Writer.Strict.Writer' from the
14−-- @transformers@ package includes additional operations
15−-- 'Control.Monad.Trans.Writer.Strict.pass' and
16−-- 'Control.Monad.Trans.Writer.Strict.censor', they don't cooperate with runtime
17−-- exceptions very well, so they're deliberately omitted here.
181module Effectful.Writer.Shared
192 ( Writer
203 , runWriter
@@ -25,54 +8,33 @@ module Effectful.Writer.Shared
258 ) where
269
2710import Control.Concurrent.MVar
28−import Control.Exception (onException, uninterruptibleMask)
11+import Control.Exception
2912
30−import Effectful.Dispatch.Static
31−import Effectful.Monad
13+import Effectful.Internal.Effect
14+import Effectful.Internal.Env
15+import Effectful.Internal.Monad
3216
33−-- | Provide access to a strict (WHNF), shared, write only value of type @w@.
17+-- | Provide access to a strict (WHNF), shareable, write only value of type @w@.
3418newtype Writer w :: Effect where
3519 Writer :: MVar w -> Writer w m r
3620
37−-- | Run a 'Writer' effect and return the final value along with the final
38−-- output.
3921runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
4022runWriter m = do
4123 v <- unsafeEff_ $ newMVar mempty
42− a <- evalData (DataA (Writer v)) m
24+ a <- evalEffect (IdE (Writer v)) m
4325 (a, ) <$> unsafeEff_ (readMVar v)
4426
45−-- | Run a 'Writer' effect and return the final output, discarding the final
46−-- value.
4727execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
4828execWriter m = do
4929 v <- unsafeEff_ $ newMVar mempty
50− _ <- evalData (DataA (Writer v)) m
30+ _ <- evalEffect (IdE (Writer v)) m
5131 unsafeEff_ $ readMVar v
5232
53−-- | Append the given output to the overall output of the 'Writer'.
5433tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
5534tell w1 = unsafeEff $ \es -> do
56− DataA (Writer v) <- getEnv es
35+ IdE (Writer v) <- getEnv es
5736 modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w
5837
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!"
7638listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
7739listen m = unsafeEff $ \es -> do
7840 -- The mask is uninterruptible because modifyMVar_ v0 in the merge function
@@ -81,28 +43,19 @@ listen m = unsafeEff $ \es -> do
8143 uninterruptibleMask $ \restore -> do
8244 v1 <- newMVar mempty
8345 -- Replace thread local MVar with a fresh one for isolated listening.
84− v0 <- stateEnv es $ \(DataA (Writer v)) -> (v, DataA (Writer v1))
46+ v0 <- stateEnv es $ \(IdE (Writer v)) -> (v, IdE (Writer v1))
8547 a <- restore (unEff m es) `onException` merge es v0 v1
8648 (a, ) <$> merge es v0 v1
8749 where
8850 -- Merge results accumulated in the local MVar with the mainline. If an
8951 -- exception was received while listening, merge results recorded so far.
9052 merge es v0 v1 = do
91− putEnv es $ DataA (Writer v0)
53+ putEnv es $ IdE (Writer v0)
9254 w1 <- readMVar v1
9355 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
9456 pure w1
9557
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@
10158listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
10259listens f m = do
10360 (a, w) <- listen m
10461 pure (a, f w)
105−
106−-- $setup
107−-- >>> import Control.Exception (ErrorCall)
108−-- >>> import Control.Monad.Catch
effectful/bench/Concurrency.hs+8−8
@@ -11,7 +11,7 @@ import Test.Tasty.Bench hiding (env)
1111
1212import Control.Concurrent.Async
1313import Control.Monad
14−import qualified Effectful.Concurrent.Async as A
14+import qualified Effectful.Async as A
1515
1616import Effectful
1717import Utils
@@ -25,7 +25,7 @@ concurrencyBenchmark = bgroup "concurrency"
2525shallowBench :: Int -> Benchmark
2626shallowBench n = bgroup ("unmask " ++ show n ++ "x")
2727 [ bench "async (IO)" $ nfAppIO (asyncBenchIO n) op
28− , bench "async (Eff)" $ nfAppIO (runShallow . A.runConcurrent . asyncBench n) op
28+ , bench "async (Eff)" $ nfAppIO (runShallow . A.runAsyncE . asyncBench n) op
2929 , bench "Fork (localUnliftIO/withLiftMapIO)" $
3030 nfAppIO (runShallow . runFork1 . forkBench n) op
3131 , bench "Fork (localUnlift/withLiftMap)" $
@@ -38,7 +38,7 @@ shallowBench n = bgroup ("unmask " ++ show n ++ "x")
3838
3939deepBench :: Int -> Benchmark
4040deepBench n = bgroup ("unmask " ++ show n ++ "x")
41− [ bench "async (Eff)" $ nfAppIO (runDeep . A.runConcurrent . asyncBench n) op
41+ [ bench "async (Eff)" $ nfAppIO (runDeep . A.runAsyncE . asyncBench n) op
4242 , bench "Fork (localUnliftIO/withLiftMapIO)" $
4343 nfAppIO (runDeep . runFork1 . forkBench n) op
4444 , bench "Fork (localUnlift/withLiftMap)" $
@@ -60,14 +60,14 @@ data Fork :: Effect where
6060-- | Uses 'localUnliftIO' and 'withLiftMapIO'.
6161runFork1 :: IOE :> es => Eff (Fork : es) a -> Eff es a
6262runFork1 = interpret $ \env -> \case
63− ForkWithUnmask m -> withLiftMapIO env $ \liftMap -> do
63+ ForkWithUnmask m -> withLiftMapIO $ \liftMap -> do
6464 localUnliftIO env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
6565 asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
6666
6767-- | Uses 'localUnlift' and 'withLiftMap'.
6868runFork2 :: IOE :> es => Eff (Fork : es) a -> Eff es a
69−runFork2 = reinterpret A.runConcurrent $ \env -> \case
70− ForkWithUnmask m -> withLiftMap env $ \liftMap -> do
69+runFork2 = reinterpret A.runAsyncE $ \env -> \case
70+ ForkWithUnmask m -> withLiftMap $ \liftMap -> do
7171 localUnlift env (ConcUnlift Ephemeral $ Limited 1) $ \unlift -> do
7272 A.asyncWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
7373
@@ -80,7 +80,7 @@ runFork3 = interpret $ \env -> \case
8080
8181-- | Uses 'localLiftUnlift'.
8282runFork4 :: IOE :> es => Eff (Fork : es) a -> Eff es a
83−runFork4 = reinterpret A.runConcurrent $ \env -> \case
83+runFork4 = reinterpret A.runAsyncE $ \env -> \case
8484 ForkWithUnmask m -> do
8585 localLiftUnlift env (ConcUnlift Persistent $ Limited 1) $ \lift unlift -> do
8686 A.asyncWithUnmask $ \unmask -> unlift $ m $ lift . unmask . unlift
@@ -94,7 +94,7 @@ asyncBenchIO n f = do
9494 wait a
9595{-# NOINLINE asyncBenchIO #-}
9696
97−asyncBench :: A.Concurrent :> es => Int -> Eff es Int -> Eff es Int
97+asyncBench :: A.AsyncE :> es => Int -> Eff es Int -> Eff es Int
9898asyncBench n f = do
9999 a <- A.asyncWithUnmask $ \unmask -> do
100100 sum <$> replicateM n (unmask f)
effectful/bench/Main.hs+3−3
@@ -97,11 +97,11 @@ filesize n = bgroup (show n)
9797#ifdef VERSION_eff
9898 , bench "eff" $ nfAppIO eff_calculateFileSizesDeep (take n files)
9999#endif
100−#ifdef VERSION_mtl
101− , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)
102−#endif
103100#ifdef VERSION_polysemy
104101 , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)
102+#endif
103+#ifdef VERSION_mtl
104+ , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)
105105#endif
106106 ]
107107 ]
effectful/bench/Unlift.hs+11−11
@@ -14,7 +14,7 @@ import qualified UnliftIO as U
1414import Effectful
1515import Effectful.State.Dynamic
1616import Utils
17−import qualified Effectful.Concurrent.Async as A
17+import qualified Effectful.Async as A
1818
1919unliftBenchmark :: Benchmark
2020unliftBenchmark = bgroup "unlifting"
@@ -29,7 +29,7 @@ unliftBenchmark = bgroup "unlifting"
2929 , bench "seq" $ nfAppIO runShallow benchDummy
3030 , shallowConc "conc" 1 benchDummyE benchDummy
3131 ]
32− , shallowConc "async" 1 benchAsyncEff benchAsync
32+ , shallowConc "async" 1 benchAsyncE benchAsync
3333 , shallowConc "concurrently" 2 benchConcurrentlyE benchConcurrently
3434 ]
3535 , bgroup "deep"
@@ -38,7 +38,7 @@ unliftBenchmark = bgroup "unlifting"
3838 , bench "seq" $ nfAppIO runDeep benchDummy
3939 , deepConc "conc" 1 benchDummyE benchDummy
4040 ]
41− , deepConc "async" 1 benchAsyncEff benchAsync
41+ , deepConc "async" 1 benchAsyncE benchAsync
4242 , deepConc "concurrently" 2 benchConcurrentlyE benchConcurrently
4343 ]
4444 ]
@@ -48,11 +48,11 @@ unliftBenchmark = bgroup "unlifting"
4848shallowConc
4949 :: String
5050 -> Int
51− -> Eff '[A.Concurrent, IOE] ()
51+ -> Eff '[A.AsyncE, IOE] ()
5252 -> Eff '[IOE] ()
5353 -> Benchmark
5454shallowConc name n r f = bgroup name
55− [ bench "Async" $ nfAppIO (runShallow . A.runConcurrent) r
55+ [ bench "AsyncE" $ nfAppIO (runShallow . A.runAsyncE) r
5656 , bench "ephemeral/limited" $ nfAppIO
5757 (runShallow . withUnliftStrategy (ConcUnlift Ephemeral $ Limited n)) f
5858 , bench "ephemeral/unlimited" $ nfAppIO
@@ -66,7 +66,7 @@ shallowConc name n r f = bgroup name
6666deepConc
6767 :: String
6868 -> Int
69− -> Eff '[ A.Concurrent
69+ -> Eff '[ A.AsyncE
7070 , State (), State (), State (), State (), State ()
7171 , State (), State (), State (), State (), State ()
7272 , IOE] ()
@@ -75,7 +75,7 @@ deepConc
7575 , IOE] ()
7676 -> Benchmark
7777deepConc name n r f = bgroup name
78− [ bench "Async" $ nfAppIO (runDeep . A.runConcurrent) r
78+ [ bench "AsyncE" $ nfAppIO (runDeep . A.runAsyncE) r
7979 , bench "ephemeral/limited" $ nfAppIO
8080 (runDeep . withUnliftStrategy (ConcUnlift Ephemeral $ Limited n)) f
8181 , bench "ephemeral/unlimited" $ nfAppIO
@@ -101,10 +101,10 @@ benchDummyE :: Eff es ()
101101benchDummyE = pure ()
102102{-# NOINLINE benchDummyE #-}
103103
104−benchAsyncEff :: A.Concurrent :> es => Eff es ()
105−benchAsyncEff = A.withAsync (pure ()) A.wait
106−{-# NOINLINE benchAsyncEff #-}
104+benchAsyncE :: A.AsyncE :> es => Eff es ()
105+benchAsyncE = A.withAsync (pure ()) A.wait
106+{-# NOINLINE benchAsyncE #-}
107107
108−benchConcurrentlyE :: A.Concurrent :> es => Eff es ()
108+benchConcurrentlyE :: A.AsyncE :> es => Eff es ()
109109benchConcurrentlyE = A.concurrently_ (pure ()) (pure ())
110110{-# NOINLINE benchConcurrentlyE #-}
effectful/effectful.cabal+24−42
@@ -10,17 +10,16 @@ author: Andrzej Rybczak
1010synopsis: An easy to use, performant extensible effects library.
1111
1212description: An easy to use, performant extensible effects library with seamless
13− integration with the existing Haskell ecosystem. See the main
14− module "Effectful" for the documentation.
13+ integration with the existing Haskell ecosystem.
1514 .
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.
15+ This is the "batteries included" variant; See the
16+ @<https://hackage.haskell.org/package/effectful-core effectful-core>@
17+ package for the effect system itself as well as the various other
18+ @effectful-*@ packages if you need a smaller dependency footprint.
2019
2120extra-source-files: CHANGELOG.md
2221
23−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1
22+tested-with: GHC ==8.8.4 || ==8.10.4 || ==9.0.1 || ==9.2.0.20210422
2423
2524bug-reports: https://github.com/arybczak/effectful/issues
2625source-repository head
@@ -40,7 +39,6 @@ common language
4039 ConstraintKinds
4140 DataKinds
4241 DeriveFunctor
43− DeriveGeneric
4442 FlexibleContexts
4543 FlexibleInstances
4644 GADTs
@@ -61,44 +59,32 @@ common language
6159library
6260 import: language
6361
64− build-depends: base >= 4.13 && < 5
65− , async >= 2.2.2
66− , directory >= 1.3.2
67− , effectful-core >= 0.1 && < 0.1.1
68− , process >= 1.6.9
69− , resourcet >= 1.2.4.3
70− , time >= 1.9.2
71− , stm >= 2.5.0.0
72− , unliftio >= 0.2.20
62+ ghc-options: -O2
63+
64+ build-depends: base >= 4.13 && <5
65+ , async
66+ , effectful-core >= 0.1 && <0.1.1
67+ , process
68+ , resourcet
69+ , unliftio
7370
7471 hs-source-dirs: src
7572
76− exposed-modules: Effectful.Concurrent
77− Effectful.Concurrent.Async
78− Effectful.Concurrent.Chan
79− Effectful.Concurrent.MVar
80− Effectful.Concurrent.STM
81− Effectful.Concurrent.QSem
82− Effectful.Concurrent.QSemN
83− Effectful.Environment
84− Effectful.FileSystem
85− Effectful.FileSystem.IO
73+ exposed-modules: Effectful
74+ Effectful.Async
8675 Effectful.Process
8776 Effectful.Resource
88− Effectful.Temporary
89− Effectful.Timeout
9077
91− other-modules: Effectful.Concurrent.Effect
92− Effectful.FileSystem.Effect
93−
94− reexported-modules: Effectful
95− , Effectful.Dispatch.Dynamic
96− , Effectful.Dispatch.Static
97− , Effectful.Error
78+ reexported-modules: Effectful.Error
9879 , Effectful.Error.Dynamic
9980 , Effectful.Fail
81+ , Effectful.Handler
82+ , Effectful.Internal.Effect
83+ , Effectful.Internal.Env
84+ , Effectful.Internal.Monad
85+ , Effectful.Internal.Unlift
86+ , Effectful.Internal.Utils
10087 , Effectful.Monad
101− , Effectful.Prim
10288 , Effectful.Reader
10389 , Effectful.Reader.Dynamic
10490 , Effectful.State.Dynamic
@@ -116,7 +102,6 @@ test-suite test
116102 build-depends: base
117103 , containers
118104 , effectful
119− , effectful-core
120105 , exceptions
121106 , lifted-base
122107 , tasty
@@ -130,11 +115,8 @@ test-suite test
130115
131116 other-modules: AsyncTests
132117 ConcurrencyTests
133− EnvironmentTests
134118 ErrorTests
135119 StateTests
136− TimeoutTests
137− UnliftTests
138120 Utils
139121 -- These are examples; We do not actually run them but list
140122 -- them here in order to check if they compile.
@@ -154,7 +136,7 @@ benchmark bench
154136 if impl(ghc < 9.2)
155137 build-depends: fused-effects
156138
157− if impl(ghc < 9.3)
139+ if impl(ghc < 9.2)
158140 build-depends: polysemy
159141
160142 build-depends: base
effectful-core/src/Effectful.hs → effectful/src/Effectful.hsrenamed+4−4
@@ -8,10 +8,10 @@ module Effectful
88
99 -- * Running the 'Eff' monad
1010
11− -- ** Pure computations
11+ -- ** Pure operations
1212 , runPureEff
1313
14− -- ** Computations with side effects
14+ -- ** Operations with side effects
1515 , IOE
1616 , runEff
1717
@@ -32,7 +32,7 @@ module Effectful
3232 , interpret
3333 , reinterpret
3434
35− -- ** Handling local 'Eff' computations
35+ -- ** Handling local 'Eff' operations
3636 , LocalEnv
3737
3838 -- *** Unlifts
@@ -54,5 +54,5 @@ module Effectful
5454 , MonadUnliftIO(..)
5555 ) where
5656
57−import Effectful.Dispatch.Dynamic
57+import Effectful.Handler
5858import Effectful.Monad
effectful/src/Effectful/Concurrent/Async.hs → effectful/src/Effectful/Async.hsrenamed+88−72
@@ -1,8 +1,8 @@
11{-# LANGUAGE UndecidableInstances #-}
2−-- | Lifted version of "Control.Concurrent.Async".
3−module Effectful.Concurrent.Async
4− ( Concurrent
5− , runConcurrent
2+module Effectful.Async
3+ ( -- * Async effect
4+ AsyncE
5+ , runAsyncE
66
77 -- * Asynchronous actions
88 , Async
@@ -76,37 +76,51 @@ import Control.Concurrent (threadDelay)
7676import Control.Concurrent.Async (Async)
7777import Control.Exception (Exception, SomeException)
7878import Control.Monad (forever)
79−import Data.Kind (Type)
8079import qualified Control.Concurrent.Async as A
8180import qualified UnliftIO.Async as U
8281import qualified UnliftIO.Internals.Async as I
8382
84−import Effectful.Concurrent.Effect
85−import Effectful.Dispatch.Static
86−import Effectful.Monad
83+import Effectful.Internal.Effect
84+import Effectful.Internal.Env
85+import Effectful.Internal.Monad
86+
87+-- | Run 'Eff' operations asynchronously via the @async@ library.
88+--
89+-- /Note:/ thread local state changes in 'Eff' operations run asynchronously
90+-- will not affect the parent thread.
91+--
92+-- /TODO:/ write about 'AsyncE' not respecting scoped operations.
93+data AsyncE :: Effect where
94+ AsyncE :: AsyncE m r
95+
96+runAsyncE :: IOE :> es => Eff (AsyncE : es) a -> Eff es a
97+runAsyncE = evalEffect (IdE AsyncE)
98+
99+----------------------------------------
100+-- Operations
87101
88102-- | Lifted 'A.async'.
89−async :: Concurrent :> es => Eff es a -> Eff es (Async a)
103+async :: AsyncE :> es => Eff es a -> Eff es (Async a)
90104async = liftAsync A.async
91105
92106-- | Lifted 'A.asyncBound'.
93−asyncBound :: Concurrent :> es => Eff es a -> Eff es (Async a)
107+asyncBound :: AsyncE :> es => Eff es a -> Eff es (Async a)
94108asyncBound = liftAsync A.asyncBound
95109
96110-- | Lifted 'A.asyncOn'.
97−asyncOn :: Concurrent :> es => Int -> Eff es a -> Eff es (Async a)
111+asyncOn :: AsyncE :> es => Int -> Eff es a -> Eff es (Async a)
98112asyncOn cpu = liftAsync (A.asyncOn cpu)
99113
100114-- | Lifted 'A.asyncWithUnmask'.
101115asyncWithUnmask
102− :: Concurrent :> es
116+ :: AsyncE :> es
103117 => ((forall b. Eff es b -> Eff es b) -> Eff es a)
104118 -> Eff es (Async a)
105119asyncWithUnmask = liftAsyncWithUnmask A.asyncWithUnmask
106120
107121-- | Lifted 'A.asyncOnWithUnmask'.
108122asyncOnWithUnmask
109− :: Concurrent :> es
123+ :: AsyncE :> es
110124 => Int
111125 -> ((forall b. Eff es b -> Eff es b) -> Eff es a)
112126 -> Eff es (Async a)
@@ -114,7 +128,7 @@ asyncOnWithUnmask cpu = liftAsyncWithUnmask (A.asyncOnWithUnmask cpu)
114128
115129-- | Lifted 'A.withAsync'.
116130withAsync
117− :: Concurrent :> es
131+ :: AsyncE :> es
118132 => Eff es a
119133 -> (Async a -> Eff es b)
120134 -> Eff es b
@@ -122,7 +136,7 @@ withAsync = liftWithAsync A.withAsync
122136
123137-- | Lifted 'A.withAsyncBound'.
124138withAsyncBound
125− :: Concurrent :> es
139+ :: AsyncE :> es
126140 => Eff es a
127141 -> (Async a -> Eff es b)
128142 -> Eff es b
@@ -130,7 +144,7 @@ withAsyncBound = liftWithAsync A.withAsyncBound
130144
131145-- | Lifted 'A.withAsyncOn'.
132146withAsyncOn
133− :: Concurrent :> es
147+ :: AsyncE :> es
134148 => Int
135149 -> Eff es a
136150 -> (Async a -> Eff es b)
@@ -139,7 +153,7 @@ withAsyncOn cpu = liftWithAsync (A.withAsyncOn cpu)
139153
140154-- | Lifted 'A.withAsyncWithUnmask'.
141155withAsyncWithUnmask
142− :: Concurrent :> es
156+ :: AsyncE :> es
143157 => ((forall c. Eff es c -> Eff es c) -> Eff es a)
144158 -> (Async a -> Eff es b)
145159 -> Eff es b
@@ -147,7 +161,7 @@ withAsyncWithUnmask = liftWithAsyncWithUnmask A.withAsyncWithUnmask
147161
148162-- | Lifted 'A.withAsyncOnWithUnmask'.
149163withAsyncOnWithUnmask
150− :: Concurrent :> es
164+ :: AsyncE :> es
151165 => Int
152166 -> ((forall c. Eff es c -> Eff es c) -> Eff es a)
153167 -> (Async a -> Eff es b)
@@ -155,60 +169,60 @@ withAsyncOnWithUnmask
155169withAsyncOnWithUnmask cpu = liftWithAsyncWithUnmask (A.withAsyncOnWithUnmask cpu)
156170
157171-- | Lifted 'A.wait'.
158−wait :: Concurrent :> es => Async a -> Eff es a
172+wait :: AsyncE :> es => Async a -> Eff es a
159173wait = unsafeEff_ . A.wait
160174
161175-- | Lifted 'A.poll'.
162176poll
163− :: Concurrent :> es
177+ :: AsyncE :> es
164178 => Async a
165179 -> Eff es (Maybe (Either SomeException a))
166180poll = unsafeEff_ . A.poll
167181
168182-- | Lifted 'A.cancel'.
169−cancel :: Concurrent :> es => Async a -> Eff es ()
183+cancel :: AsyncE :> es => Async a -> Eff es ()
170184cancel = unsafeEff_ . A.cancel
171185
172186-- | Lifted 'A.cancelWith'.
173−cancelWith :: (Exception e, Concurrent :> es) => Async a -> e -> Eff es ()
187+cancelWith :: (Exception e, AsyncE :> es) => Async a -> e -> Eff es ()
174188cancelWith a = unsafeEff_ . A.cancelWith a
175189
176190-- | Lifted 'A.uninterruptibleCancel'.
177−uninterruptibleCancel :: Concurrent :> es => Async a -> Eff es ()
191+uninterruptibleCancel :: AsyncE :> es => Async a -> Eff es ()
178192uninterruptibleCancel = unsafeEff_ . A.uninterruptibleCancel
179193
180194-- | Lifted 'A.waitCatch'.
181195waitCatch
182− :: Concurrent :> es
196+ :: AsyncE :> es
183197 => Async a
184198 -> Eff es (Either SomeException a)
185199waitCatch = unsafeEff_ . A.waitCatch
186200
187201-- | Lifted 'A.waitAny'.
188−waitAny :: Concurrent :> es => [Async a] -> Eff es (Async a, a)
202+waitAny :: AsyncE :> es => [Async a] -> Eff es (Async a, a)
189203waitAny = unsafeEff_ . A.waitAny
190204
191205-- | Lifted 'A.waitAnyCatch'.
192206waitAnyCatch
193− :: Concurrent :> es
207+ :: AsyncE :> es
194208 => [Async a]
195209 -> Eff es (Async a, Either SomeException a)
196210waitAnyCatch = unsafeEff_ . A.waitAnyCatch
197211
198212-- | Lifted 'A.waitAnyCancel'.
199−waitAnyCancel :: Concurrent :> es => [Async a] -> Eff es (Async a, a)
213+waitAnyCancel :: AsyncE :> es => [Async a] -> Eff es (Async a, a)
200214waitAnyCancel = unsafeEff_ . A.waitAnyCancel
201215
202216-- | Lifted 'A.waitAnyCatchCancel'.
203217waitAnyCatchCancel
204− :: Concurrent :> es
218+ :: AsyncE :> es
205219 => [Async a]
206220 -> Eff es (Async a, Either SomeException a)
207221waitAnyCatchCancel = unsafeEff_ . A.waitAnyCatchCancel
208222
209223-- | Lifted 'A.waitEither'.
210224waitEither
211− :: Concurrent :> es
225+ :: AsyncE :> es
212226 => Async a
213227 -> Async b
214228 -> Eff es (Either a b)
@@ -216,7 +230,7 @@ waitEither a b = unsafeEff_ $ A.waitEither a b
216230
217231-- | Lifted 'A.waitEitherCatch'.
218232waitEitherCatch
219− :: Concurrent :> es
233+ :: AsyncE :> es
220234 => Async a
221235 -> Async b
222236 -> Eff es (Either (Either SomeException a) (Either SomeException b))
@@ -224,7 +238,7 @@ waitEitherCatch a b = unsafeEff_ $ A.waitEitherCatch a b
224238
225239-- | Lifted 'A.waitEitherCancel'.
226240waitEitherCancel
227− :: Concurrent :> es
241+ :: AsyncE :> es
228242 => Async a
229243 -> Async b
230244 -> Eff es (Either a b)
@@ -232,53 +246,53 @@ waitEitherCancel a b = unsafeEff_ $ A.waitEitherCancel a b
232246
233247-- | Lifted 'A.waitEitherCatchCancel'.
234248waitEitherCatchCancel
235− :: Concurrent :> es
249+ :: AsyncE :> es
236250 => Async a
237251 -> Async b
238252 -> Eff es (Either (Either SomeException a) (Either SomeException b))
239253waitEitherCatchCancel a b = unsafeEff_ $ A.waitEitherCatch a b
240254
241255-- | Lifted 'A.waitEither_'.
242−waitEither_ :: Concurrent :> es => Async a -> Async b -> Eff es ()
256+waitEither_ :: AsyncE :> es => Async a -> Async b -> Eff es ()
243257waitEither_ a b = unsafeEff_ $ A.waitEither_ a b
244258
245259-- | Lifted 'A.waitBoth'.
246−waitBoth :: Concurrent :> es => Async a -> Async b -> Eff es (a, b)
260+waitBoth :: AsyncE :> es => Async a -> Async b -> Eff es (a, b)
247261waitBoth a b = unsafeEff_ $ A.waitBoth a b
248262
249263-- | Lifted 'A.link'.
250−link :: Concurrent :> es => Async a -> Eff es ()
264+link :: AsyncE :> es => Async a -> Eff es ()
251265link = unsafeEff_ . A.link
252266
253267-- | Lifted 'A.linkOnly'.
254−linkOnly :: Concurrent :> es => (SomeException -> Bool) -> Async a -> Eff es ()
268+linkOnly :: AsyncE :> es => (SomeException -> Bool) -> Async a -> Eff es ()
255269linkOnly f = unsafeEff_ . A.linkOnly f
256270
257271-- | Lifted 'A.link2'.
258−link2 :: Concurrent :> es => Async a -> Async b -> Eff es ()
272+link2 :: AsyncE :> es => Async a -> Async b -> Eff es ()
259273link2 a b = unsafeEff_ $ A.link2 a b
260274
261275-- | Lifted 'A.link2Only'.
262−link2Only :: Concurrent :> es => (SomeException -> Bool) -> Async a -> Async b -> Eff es ()
276+link2Only :: AsyncE :> es => (SomeException -> Bool) -> Async a -> Async b -> Eff es ()
263277link2Only f a b = unsafeEff_ $ A.link2Only f a b
264278
265279-- | Lifted 'A.race'.
266−race :: Concurrent :> es => Eff es a -> Eff es b -> Eff es (Either a b)
280+race :: AsyncE :> es => Eff es a -> Eff es b -> Eff es (Either a b)
267281race ma mb = unsafeEff $ \es -> do
268282 A.race (unEff ma =<< cloneEnv es) (unEff mb =<< cloneEnv es)
269283
270284-- | Lifted 'A.race_'.
271−race_ :: Concurrent :> es => Eff es a -> Eff es b -> Eff es ()
285+race_ :: AsyncE :> es => Eff es a -> Eff es b -> Eff es ()
272286race_ ma mb = unsafeEff $ \es -> do
273287 A.race_ (unEff ma =<< cloneEnv es) (unEff mb =<< cloneEnv es)
274288
275289-- | Lifted 'A.concurrently'.
276−concurrently :: Concurrent :> es => Eff es a -> Eff es b -> Eff es (a, b)
290+concurrently :: AsyncE :> es => Eff es a -> Eff es b -> Eff es (a, b)
277291concurrently ma mb = unsafeEff $ \es -> do
278292 A.concurrently (unEff ma =<< cloneEnv es) (unEff mb =<< cloneEnv es)
279293
280294-- | Lifted 'A.concurrently_'.
281−concurrently_ :: Concurrent :> es => Eff es a -> Eff es b -> Eff es ()
295+concurrently_ :: AsyncE :> es => Eff es a -> Eff es b -> Eff es ()
282296concurrently_ ma mb = unsafeEff $ \es -> do
283297 A.concurrently_ (unEff ma =<< cloneEnv es) (unEff mb =<< cloneEnv es)
284298
@@ -288,7 +302,7 @@ concurrently_ ma mb = unsafeEff $ \es -> do
288302
289303-- | Lifted 'A.mapConcurrently'.
290304mapConcurrently
291− :: (Traversable f, Concurrent :> es)
305+ :: (Traversable f, AsyncE :> es)
292306 => (a -> Eff es b)
293307 -> f a
294308 -> Eff es (f b)
@@ -297,7 +311,7 @@ mapConcurrently f t = unsafeEff $ \es -> do
297311
298312-- | Lifted 'A.mapConcurrently_'.
299313mapConcurrently_
300− :: (Foldable f, Concurrent :> es)
314+ :: (Foldable f, AsyncE :> es)
301315 => (a -> Eff es b)
302316 -> f a
303317 -> Eff es ()
@@ -306,7 +320,7 @@ mapConcurrently_ f t = unsafeEff $ \es -> do
306320
307321-- | Lifted 'A.forConcurrently'.
308322forConcurrently
309− :: (Traversable f, Concurrent :> es)
323+ :: (Traversable f, AsyncE :> es)
310324 => f a
311325 -> (a -> Eff es b)
312326 -> Eff es (f b)
@@ -315,7 +329,7 @@ forConcurrently t f = unsafeEff $ \es -> do
315329
316330-- | Lifted 'A.forConcurrently_'.
317331forConcurrently_
318− :: (Foldable f, Concurrent :> es)
332+ :: (Foldable f, AsyncE :> es)
319333 => f a
320334 -> (a -> Eff es b)
321335 -> Eff es ()
@@ -323,12 +337,12 @@ forConcurrently_ t f = unsafeEff $ \es -> do
323337 U.forConcurrently_ t (\a -> unEff (f a) =<< cloneEnv es)
324338
325339-- | Lifted 'A.replicateConcurrently'.
326−replicateConcurrently :: Concurrent :> es => Int -> Eff es a -> Eff es [a]
340+replicateConcurrently :: AsyncE :> es => Int -> Eff es a -> Eff es [a]
327341replicateConcurrently n f = unsafeEff $ \es -> do
328342 U.replicateConcurrently n (unEff f =<< cloneEnv es)
329343
330344-- | Lifted 'A.replicateConcurrently_'.
331−replicateConcurrently_ :: Concurrent :> es => Int -> Eff es a -> Eff es ()
345+replicateConcurrently_ :: AsyncE :> es => Int -> Eff es a -> Eff es ()
332346replicateConcurrently_ n f = unsafeEff $ \es -> do
333347 U.replicateConcurrently_ n (unEff f =<< cloneEnv es)
334348
@@ -337,7 +351,7 @@ replicateConcurrently_ n f = unsafeEff $ \es -> do
337351
338352-- | Lifted 'U.pooledMapConcurrentlyN'.
339353pooledMapConcurrentlyN
340− :: (Concurrent :> es, Traversable t)
354+ :: (AsyncE :> es, Traversable t)
341355 => Int
342356 -> (a -> Eff es b)
343357 -> t a
@@ -347,7 +361,7 @@ pooledMapConcurrentlyN threads f t = unsafeEff $ \es -> do
347361
348362-- | Lifted 'U.pooledMapConcurrently'.
349363pooledMapConcurrently
350− :: (Concurrent :> es, Traversable t)
364+ :: (AsyncE :> es, Traversable t)
351365 => (a -> Eff es b)
352366 -> t a
353367 -> Eff es (t b)
@@ -356,7 +370,7 @@ pooledMapConcurrently f t = unsafeEff $ \es -> do
356370
357371-- | Lifted 'U.pooledMapConcurrentlyN'.
358372pooledMapConcurrentlyN_
359− :: (Concurrent :> es, Foldable f)
373+ :: (AsyncE :> es, Foldable f)
360374 => Int
361375 -> (a -> Eff es b)
362376 -> f a
@@ -366,7 +380,7 @@ pooledMapConcurrentlyN_ threads f t = unsafeEff $ \es -> do
366380
367381-- | Lifted 'U.pooledMapConcurrently_'.
368382pooledMapConcurrently_
369− :: (Concurrent :> es, Foldable f)
383+ :: (AsyncE :> es, Foldable f)
370384 => (a -> Eff es b)
371385 -> f a
372386 -> Eff es ()
@@ -375,7 +389,7 @@ pooledMapConcurrently_ f t = unsafeEff $ \es -> do
375389
376390-- | Lifted 'U.pooledForConcurrentlyN'.
377391pooledForConcurrentlyN
378− :: (Concurrent :> es, Traversable t)
392+ :: (AsyncE :> es, Traversable t)
379393 => Int
380394 -> t a
381395 -> (a -> Eff es b)
@@ -385,7 +399,7 @@ pooledForConcurrentlyN threads t f = unsafeEff $ \es -> do
385399
386400-- | Lifted 'U.pooledForConcurrently'.
387401pooledForConcurrently
388− :: (Concurrent :> es, Traversable t)
402+ :: (AsyncE :> es, Traversable t)
389403 => t a
390404 -> (a -> Eff es b)
391405 -> Eff es (t b)
@@ -394,7 +408,7 @@ pooledForConcurrently t f = unsafeEff $ \es -> do
394408
395409-- | Lifted 'U.pooledForConcurrentlyN'.
396410pooledForConcurrentlyN_
397− :: (Concurrent :> es, Foldable f)
411+ :: (AsyncE :> es, Foldable f)
398412 => Int
399413 -> f a
400414 -> (a -> Eff es b)
@@ -404,7 +418,7 @@ pooledForConcurrentlyN_ threads t f = unsafeEff $ \es -> do
404418
405419-- | Lifted 'U.pooledForConcurrently_'.
406420pooledForConcurrently_
407− :: (Concurrent :> es, Foldable f)
421+ :: (AsyncE :> es, Foldable f)
408422 => f a
409423 -> (a -> Eff es b)
410424 -> Eff es ()
@@ -412,22 +426,22 @@ pooledForConcurrently_ t f = unsafeEff $ \es -> do
412426 U.pooledForConcurrently_ t (\a -> unEff (f a) =<< cloneEnv es)
413427
414428-- | Lifted 'U.pooledReplicateConcurrentlyN'.
415−pooledReplicateConcurrentlyN :: Concurrent :> es => Int -> Int -> Eff es a -> Eff es [a]
429+pooledReplicateConcurrentlyN :: AsyncE :> es => Int -> Int -> Eff es a -> Eff es [a]
416430pooledReplicateConcurrentlyN threads n f = unsafeEff $ \es -> do
417431 U.pooledReplicateConcurrentlyN threads n (unEff f =<< cloneEnv es)
418432
419433-- | Lifted 'U.pooledReplicateConcurrently'.
420−pooledReplicateConcurrently :: Concurrent :> es => Int -> Eff es a -> Eff es [a]
434+pooledReplicateConcurrently :: AsyncE :> es => Int -> Eff es a -> Eff es [a]
421435pooledReplicateConcurrently n f = unsafeEff $ \es -> do
422436 U.pooledReplicateConcurrently n (unEff f =<< cloneEnv es)
423437
424438-- | Lifted 'U.pooledReplicateConcurrentlyN_'.
425−pooledReplicateConcurrentlyN_ :: Concurrent :> es => Int -> Int -> Eff es a -> Eff es ()
439+pooledReplicateConcurrentlyN_ :: AsyncE :> es => Int -> Int -> Eff es a -> Eff es ()
426440pooledReplicateConcurrentlyN_ threads n f = unsafeEff $ \es -> do
427441 U.pooledReplicateConcurrentlyN_ threads n (unEff f =<< cloneEnv es)
428442
429443-- | Lifted 'U.pooledReplicateConcurrently_'.
430−pooledReplicateConcurrently_ :: Concurrent :> es => Int -> Eff es a -> Eff es ()
444+pooledReplicateConcurrently_ :: AsyncE :> es => Int -> Eff es a -> Eff es ()
431445pooledReplicateConcurrently_ n f = unsafeEff $ \es -> do
432446 U.pooledReplicateConcurrently_ n (unEff f =<< cloneEnv es)
433447
@@ -467,7 +481,7 @@ conc :: Eff es a -> Conc es a
467481conc = Action
468482
469483-- | Lifted 'U.runConc'.
470−runConc :: Concurrent :> es => Conc es a -> Eff es a
484+runConc :: AsyncE :> es => Conc es a -> Eff es a
471485runConc m = unsafeEff $ \es -> U.runConc (unliftConc es m)
472486 where
473487 unliftConc :: Env es -> Conc es a -> U.Conc IO a
@@ -488,20 +502,20 @@ newtype Concurrently es a = Concurrently { runConcurrently :: Eff es a }
488502instance Functor (Concurrently es) where
489503 fmap f (Concurrently a) = Concurrently (fmap f a)
490504
491−instance Concurrent :> es => Applicative (Concurrently es) where
505+instance AsyncE :> es => Applicative (Concurrently es) where
492506 pure = Concurrently . pure
493507 Concurrently fs <*> Concurrently as =
494508 Concurrently ((\(f, a) -> f a) <$> concurrently fs as)
495509
496−instance Concurrent :> es => Alternative (Concurrently es) where
510+instance AsyncE :> es => Alternative (Concurrently es) where
497511 empty = Concurrently . unsafeEff_ . forever $ threadDelay maxBound
498512 Concurrently as <|> Concurrently bs =
499513 Concurrently (either id id <$> race as bs)
500514
501−instance (Concurrent :> es, Semigroup a) => Semigroup (Concurrently es a) where
515+instance (AsyncE :> es, Semigroup a) => Semigroup (Concurrently es a) where
502516 (<>) = liftA2 (<>)
503517
504−instance (Concurrent :> es, Monoid a) => Monoid (Concurrently es a) where
518+instance (AsyncE :> es, Monoid a) => Monoid (Concurrently es a) where
505519 mempty = pure mempty
506520
507521----------------------------------------
@@ -519,9 +533,10 @@ liftAsyncWithUnmask
519533 :: (((forall b. IO b -> IO b) -> IO a) -> IO (Async a))
520534 -> ((forall b. Eff es b -> Eff es b) -> Eff es a)
521535 -> Eff es (Async a)
522−liftAsyncWithUnmask fork action = unsafeEff $ \es -> do
523− esA <- cloneEnv es
524− fork $ \unmask -> unEff (action $ unsafeLiftMapIO unmask) esA
536+liftAsyncWithUnmask fork action = do
537+ unsafeWithLiftMapIO $ \liftMap -> unsafeEff $ \es -> do
538+ esA <- cloneEnv es
539+ fork $ \unmask -> unEff (action $ liftMap unmask) esA
525540
526541liftWithAsync
527542 :: (IO a -> (Async a -> IO b) -> IO b)
@@ -538,7 +553,8 @@ liftWithAsyncWithUnmask
538553 -> ((forall c. Eff es c -> Eff es c) -> Eff es a)
539554 -> (Async a -> Eff es b)
540555 -> Eff es b
541−liftWithAsyncWithUnmask withA action k = unsafeEff $ \es -> do
542− esA <- cloneEnv es
543− withA (\unmask -> unEff (action $ unsafeLiftMapIO unmask) esA)
544− (\a -> unEff (k a) es)
556+liftWithAsyncWithUnmask withA action k = do
557+ unsafeWithLiftMapIO $ \liftMap -> unsafeEff $ \es -> do
558+ esA <- cloneEnv es
559+ withA (\unmask -> unEff (action $ liftMap unmask) esA)
560+ (\a -> unEff (k a) es)
effectful/src/Effectful/Concurrent.hsdeleted−218
@@ -1,218 +0,0 @@
1−-- | Lifted version of "Control.Concurrent".
2−--
3−-- For functions that spawn threads, the order of preference for their usage is
4−-- recommended as follows:
5−--
6−-- 1) High level functions from "Effectful.Concurrent.Async" such as
7−-- 'Effectful.Concurrent.Async.withAsync',
8−-- 'Effectful.Concurrent.Async.concurrently' or
9−-- 'Effectful.Concurrent.Async.mapConcurrently'.
10−--
11−-- 2) Low level functions from "Effectful.Concurrent.Async" such as
12−-- 'Effectful.Concurrent.Async.async'.
13−--
14−-- 3) Low level functions from "Effectful.Concurrent" such as 'forkIO'.
15−module Effectful.Concurrent
16− ( Concurrent
17− , runConcurrent
18−
19− -- * Basic concurrency operations
20− , myThreadId
21− , forkIO
22− , forkFinally
23− , forkIOWithUnmask
24− , killThread
25− , throwTo
26−
27− -- ** Threads with affinity
28− , forkOn
29− , forkOnWithUnmask
30− , getNumCapabilities
31− , setNumCapabilities
32− , getNumProcessors
33− , threadCapability
34−
35− -- * Scheduling
36− , yield
37−
38− -- ** Waiting
39− , threadDelay
40− , threadWaitRead
41− , threadWaitWrite
42− , threadWaitReadSTM
43− , threadWaitWriteSTM
44−
45− -- * Bound threads
46− , forkOS
47− , forkOSWithUnmask
48− , isCurrentThreadBound
49− , runInBoundThread
50− , runInUnboundThread
51−
52− -- * Weak references to ThreadIds
53− , mkWeakThreadId
54−
55− -- * Re-exports
56− , C.rtsSupportsBoundThreads
57− ) where
58−
59−import Control.Exception (Exception, SomeException)
60−import Data.Bifunctor (second)
61−import System.Mem.Weak (Weak)
62−import System.Posix.Types (Fd)
63−import UnliftIO.STM (STM)
64−import qualified Control.Concurrent as C
65−import qualified GHC.Conc as GHC
66−
67−import Effectful.Concurrent.Effect
68−import Effectful.Dispatch.Static
69−import Effectful.Monad
70−
71−----------------------------------------
72−-- Basic concurrency operations
73−
74−-- | Lifted 'C.myThreadId'.
75−myThreadId :: Concurrent :> es => Eff es C.ThreadId
76−myThreadId = unsafeEff_ C.myThreadId
77−
78−-- | Lifted 'C.forkIO'.
79−forkIO :: Concurrent :> es => Eff es () -> Eff es C.ThreadId
80−forkIO k = unsafeEff $ \es -> do
81− esF <- cloneEnv es
82− C.forkIO $ unEff k esF
83−
84−-- | Lifted 'C.forkFinally'.
85−forkFinally
86− :: Concurrent :> es
87− => Eff es a
88− -> (Either SomeException a -> Eff es ())
89− -> Eff es C.ThreadId
90−forkFinally k cleanup = unsafeEff $ \es -> do
91− esF <- cloneEnv es
92− C.forkFinally (unEff k esF) ((`unEff` esF) . cleanup)
93−
94−-- | Lifted 'C.forkIOWithUnmask'.
95−forkIOWithUnmask
96− :: Concurrent :> es
97− => ((forall a es'. IOE :> es' => Eff es' a -> Eff es' a)
98− -> Eff es ())
99− -> Eff es C.ThreadId
100−forkIOWithUnmask f = unsafeEff $ \es -> do
101− esF <- cloneEnv es
102− C.forkIOWithUnmask (\restore -> unEff (f (unsafeLiftMapIO restore)) esF)
103−
104−-- | Lifted 'C.killThread'.
105−killThread :: Concurrent :> es => C.ThreadId -> Eff es ()
106−killThread = unsafeEff_ . C.killThread
107−
108−-- | Lifted 'C.throwTo'.
109−throwTo :: (Concurrent :> es, Exception e) => C.ThreadId -> e -> Eff es ()
110−throwTo tid = unsafeEff_ . C.throwTo tid
111−
112−----------------------------------------
113−-- Threads with affinity
114−
115−-- | Lifted 'C.forkOn'.
116−forkOn :: Concurrent :> es => Int -> Eff es () -> Eff es C.ThreadId
117−forkOn n k = unsafeEff $ \es -> do
118− esF <- cloneEnv es
119− C.forkOn n (unEff k esF)
120−
121−-- | Lifted 'C.forkOnWithUnmask'.
122−forkOnWithUnmask
123− :: Concurrent :> es
124− => Int
125− -> ((forall a es'. IOE :> es' => Eff es' a -> Eff es' a) -> Eff es ())
126− -> Eff es C.ThreadId
127−forkOnWithUnmask n f = unsafeEff $ \es -> do
128− esF <- cloneEnv es
129− C.forkOnWithUnmask n (\restore -> unEff (f (unsafeLiftMapIO restore)) esF)
130−
131−-- | Lifted 'C.getNumCapabilities'.
132−getNumCapabilities :: Concurrent :> es => Eff es Int
133−getNumCapabilities = unsafeEff_ C.getNumCapabilities
134−
135−-- | Lifted 'C.setNumCapabilities'.
136−setNumCapabilities :: Concurrent :> es => Int -> Eff es ()
137−setNumCapabilities = unsafeEff_ . C.setNumCapabilities
138−
139−-- | Lifted 'GHC.getNumProcessors'.
140−getNumProcessors :: Concurrent :> es => Eff es Int
141−getNumProcessors = unsafeEff_ GHC.getNumProcessors
142−
143−-- | Lifted 'C.threadCapability'.
144−threadCapability :: Concurrent :> es => C.ThreadId -> Eff es (Int, Bool)
145−threadCapability = unsafeEff_ . C.threadCapability
146−
147−----------------------------------------
148−-- Scheduling
149−
150−-- | Lifted 'C.yield'.
151−yield :: Concurrent :> es => Eff es ()
152−yield = unsafeEff_ C.yield
153−
154−----------------------------------------
155−-- Waiting
156−
157−-- | Lifted 'C.threadDelay'.
158−threadDelay :: Concurrent :> es => Int -> Eff es ()
159−threadDelay = unsafeEff_ . C.threadDelay
160−
161−-- | Lifted 'C.threadWaitRead'.
162−threadWaitRead :: Concurrent :> es => Fd -> Eff es ()
163−threadWaitRead = unsafeEff_ . C.threadWaitRead
164−
165−-- | Lifted 'C.threadWaitWrite'.
166−threadWaitWrite :: Concurrent :> es => Fd -> Eff es ()
167−threadWaitWrite = unsafeEff_ . C.threadWaitWrite
168−
169−-- | Lifted 'C.threadWaitReadSTM'.
170−threadWaitReadSTM :: Concurrent :> es => Fd -> Eff es (STM (), Eff es ())
171−threadWaitReadSTM fd = unsafeEff_ $ do
172− second unsafeEff_ <$> C.threadWaitReadSTM fd
173−
174−-- | Lifted 'C.threadWaitWriteSTM'.
175−threadWaitWriteSTM :: Concurrent :> es => Fd -> Eff es (STM (), Eff es ())
176−threadWaitWriteSTM fd = unsafeEff_ $ do
177− second unsafeEff_ <$> C.threadWaitWriteSTM fd
178−
179−----------------------------------------
180−-- Bound threads
181−
182−-- | Lifted 'C.forkOS'.
183−forkOS :: Concurrent :> es => Eff es () -> Eff es C.ThreadId
184−forkOS k = unsafeEff $ \es -> do
185− esF <- cloneEnv es
186− C.forkOS $ unEff k esF
187−
188−-- | Lifted 'E.forkOSWithUnmask'.
189−forkOSWithUnmask
190− :: Concurrent :> es
191− => ((forall a es'. IOE :> es' => Eff es' a -> Eff es' a) -> Eff es ())
192− -> Eff es C.ThreadId
193−forkOSWithUnmask f = unsafeEff $ \es -> do
194− esF <- cloneEnv es
195− C.forkOSWithUnmask (\restore -> unEff (f (unsafeLiftMapIO restore)) esF)
196−
197−-- | Lifted 'C.isCurrentThreadBound'.
198−isCurrentThreadBound :: Concurrent :> es => Eff es Bool
199−isCurrentThreadBound = unsafeEff_ C.isCurrentThreadBound
200−
201−-- | Lifted 'C.runInBoundThread'.
202−runInBoundThread :: Concurrent :> es => Eff es a -> Eff es a
203−runInBoundThread k = unsafeEff $ \es -> do
204− esF <- cloneEnv es
205− C.runInBoundThread $ unEff k esF
206−
207−-- | Lifted 'C.runInUnboundThread'.
208−runInUnboundThread :: Concurrent :> es => Eff es a -> Eff es a
209−runInUnboundThread k = unsafeEff $ \es -> do
210− esF <- cloneEnv es
211− C.runInUnboundThread $ unEff k esF
212−
213−----------------------------------------
214−-- Weak references to ThreadIds
215−
216−-- | Lifted 'C.mkWeakThreadId'.
217−mkWeakThreadId :: Concurrent :> es => C.ThreadId -> Eff es (Weak C.ThreadId)
218−mkWeakThreadId = unsafeEff_ . C.mkWeakThreadId
effectful/src/Effectful/Concurrent/Chan.hsdeleted−45
@@ -1,45 +0,0 @@
1−-- | Lifted version of "Control.Concurrent.Chan".
2−module Effectful.Concurrent.Chan
3− ( Concurrent
4− , runConcurrent
5−
6− -- * Chan
7− , Chan
8− , newChan
9− , writeChan
10− , readChan
11− , dupChan
12− , getChanContents
13− , writeList2Chan
14− ) where
15−
16−import Control.Concurrent.Chan (Chan)
17−import qualified Control.Concurrent.Chan as C
18−
19−import Effectful.Concurrent.Effect
20−import Effectful.Dispatch.Static
21−import Effectful.Monad
22−
23−-- | Lifted 'C.newChan'.
24−newChan :: Concurrent :> es => Eff es (Chan a)
25−newChan = unsafeEff_ C.newChan
26−
27−-- | Lifted 'C.writeChan'.
28−writeChan :: Concurrent :> es => Chan a -> a -> Eff es ()
29−writeChan c = unsafeEff_ . C.writeChan c
30−
31−-- | Lifted 'C.readChan'.
32−readChan :: Concurrent :> es => Chan a -> Eff es a
33−readChan = unsafeEff_ . C.readChan
34−
35−-- | Lifted 'C.dupChan'.
36−dupChan :: Concurrent :> es => Chan a -> Eff es (Chan a)
37−dupChan = unsafeEff_ . C.dupChan
38−
39−-- | Lifted 'C.getChanContents'.
40−getChanContents :: Concurrent :> es => Chan a -> Eff es [a]
41−getChanContents = unsafeEff_ . C.getChanContents
42−
43−-- | Lifted 'C.writeList2Chan'.
44−writeList2Chan :: Concurrent :> es => Chan a -> [a] -> Eff es ()
45−writeList2Chan c = unsafeEff_ . C.writeList2Chan c
effectful/src/Effectful/Concurrent/Effect.hsdeleted−79
@@ -1,79 +0,0 @@
1−module Effectful.Concurrent.Effect
2− ( Concurrent
3− , runConcurrent
4− ) where
5−
6−import Effectful.Dispatch.Static
7−import Effectful.Monad
8−
9−-- | Provide the ability to run 'Eff' computations concurrently in multiple
10−-- threads and communicate between them.
11−--
12−-- /Warning:/ unless you stick to high level functions from the
13−-- 'Effectful.Concurrent.Async.withAsync' family, the 'Concurrent' effect makes
14−-- it possible to escape the scope of any scoped effect operation. Consider the
15−-- following:
16−--
17−-- >>> import qualified Effectful.Reader as R
18−-- >>> let printAsk msg = liftIO . putStrLn . (msg ++) . (": " ++) =<< R.ask
19−-- >>> :{
20−-- runEff . R.runReader "GLOBAL" . runConcurrent $ do
21−-- a <- R.local (const "LOCAL") $ do
22−-- a <- async $ do
23−-- printAsk "child (first)"
24−-- threadDelay 20000
25−-- printAsk "child (second)"
26−-- threadDelay 10000
27−-- printAsk "parent (inside)"
28−-- pure a
29−-- printAsk "parent (outside)"
30−-- wait a
31−-- :}
32−-- child (first): LOCAL
33−-- parent (inside): LOCAL
34−-- parent (outside): GLOBAL
35−-- child (second): LOCAL
36−--
37−-- Note that the asynchronous computation doesn't respect the scope of
38−-- 'Effectful.Reader.local', i.e. the child thread still behaves like it's
39−-- inside the 'Effectful.Reader.local' block, even though the parent thread
40−-- already got out of it.
41−--
42−-- This is because the value provided by the 'Effectful.Reader.Reader' effect is
43−-- thread local, i.e. each thread manages its own version of it. For the
44−-- 'Effectful.Reader.Reader' it is the only reasonable behavior, it wouldn't be
45−-- very useful if its "read only" value was affected by calls to
46−-- 'Effectful.Reader.local' from its parent or child threads.
47−--
48−-- However, the cut isn't so clear if it comes to effects that provide access to
49−-- a mutable state. That's why primitive @State@ and @Writer@ effects come in
50−-- two flavors, local and shared:
51−--
52−-- >>> import qualified Effectful.State.Local as SL
53−-- >>> :{
54−-- runEff . SL.execState "Hi" . runConcurrent $ do
55−-- replicateConcurrently_ 3 $ SL.modify (++ "!")
56−-- :}
57−-- "Hi"
58−--
59−-- >>> import qualified Effectful.State.Shared as SS
60−-- >>> :{
61−-- runEff . SS.execState "Hi" . runConcurrent $ do
62−-- replicateConcurrently_ 3 $ SS.modify (++ "!")
63−-- :}
64−-- "Hi!!!"
65−--
66−-- In the first example state modification made concurrently are not reflected
67−-- in the parent thread because the value is thread local, but in the second
68−-- example they are, because the value is shared.
69−--
70−data Concurrent :: Effect where
71− Concurrent :: Concurrent m r
72−
73−-- | Run the 'Concurrent' effect.
74−runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a
75−runConcurrent = evalData (DataA Concurrent)
76−
77−-- $setup
78−-- >>> import Effectful.Concurrent
79−-- >>> import Effectful.Concurrent.Async
effectful/src/Effectful/Concurrent/MVar.hsdeleted−108
@@ -1,108 +0,0 @@
1−-- | Lifted version of "Control.Concurrent.MVar".
2−module Effectful.Concurrent.MVar
3− ( Concurrent
4− , runConcurrent
5−
6− -- * MVar
7− , MVar
8− , newEmptyMVar
9− , newMVar
10− , takeMVar
11− , putMVar
12− , readMVar
13− , swapMVar
14− , tryTakeMVar
15− , tryPutMVar
16− , isEmptyMVar
17− , withMVar
18− , withMVarMasked
19− , modifyMVar
20− , modifyMVar_
21− , modifyMVarMasked
22− , modifyMVarMasked_
23− , tryReadMVar
24− , mkWeakMVar
25− ) where
26−
27−import System.Mem.Weak (Weak)
28−import Control.Concurrent.MVar (MVar)
29−import qualified Control.Concurrent.MVar as M
30−
31−import Effectful.Concurrent.Effect
32−import Effectful.Dispatch.Static
33−import Effectful.Monad
34−
35−-- | Lifted 'M.newEmptyMVar'.
36−newEmptyMVar :: Concurrent :> es => Eff es (MVar a)
37−newEmptyMVar = unsafeEff_ M.newEmptyMVar
38−
39−-- | Lifted 'M.newMVar'.
40−newMVar :: Concurrent :> es => a -> Eff es (MVar a)
41−newMVar = unsafeEff_ . M.newMVar
42−
43−-- | Lifted 'M.takeMVar'.
44−takeMVar :: Concurrent :> es => MVar a -> Eff es a
45−takeMVar = unsafeEff_ . M.takeMVar
46−
47−-- | Lifted 'M.putMVar'.
48−putMVar :: Concurrent :> es => MVar a -> a -> Eff es ()
49−putMVar var = unsafeEff_ . M.putMVar var
50−
51−-- | Lifted 'M.readMVar'.
52−readMVar :: Concurrent :> es => MVar a -> Eff es a
53−readMVar = unsafeEff_ . M.readMVar
54−
55−-- | Lifted 'M.swapMVar'.
56−swapMVar :: Concurrent :> es => MVar a -> a -> Eff es a
57−swapMVar var = unsafeEff_ . M.swapMVar var
58−
59−-- | Lifted 'M.tryTakeMVar'.
60−tryTakeMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)
61−tryTakeMVar = unsafeEff_ . M.tryTakeMVar
62−
63−-- | Lifted 'M.tryPutMVar'.
64−tryPutMVar :: Concurrent :> es => MVar a -> a -> Eff es Bool
65−tryPutMVar var = unsafeEff_ . M.tryPutMVar var
66−
67−-- | Lifted 'M.isEmptyMVar'.
68−isEmptyMVar :: Concurrent :> es => MVar a -> Eff es Bool
69−isEmptyMVar = unsafeEff_ . M.isEmptyMVar
70−
71−-- | Lifted 'M.tryReadMVar'.
72−tryReadMVar :: Concurrent :> es => MVar a -> Eff es (Maybe a)
73−tryReadMVar = unsafeEff_ . M.tryReadMVar
74−
75−-- | Lifted 'M.withMVar'.
76−withMVar :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
77−withMVar var f = unsafeUnliftIO $ \unlift -> do
78− M.withMVar var $ unlift . f
79−
80−-- | Lifted 'M.withMVarMasked'.
81−withMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es b) -> Eff es b
82−withMVarMasked var f = unsafeUnliftIO $ \unlift -> do
83− M.withMVarMasked var $ unlift . f
84−
85−-- | Lifted 'M.modifyMVar_'.
86−modifyMVar_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
87−modifyMVar_ var f = unsafeUnliftIO $ \unlift -> do
88− M.modifyMVar_ var $ unlift . f
89−
90−-- | Lifted 'M.modifyMVar'.
91−modifyMVar :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
92−modifyMVar var f = unsafeUnliftIO $ \unlift -> do
93− M.modifyMVar var $ unlift . f
94−
95−-- | Lifted 'M.modifyMVarMasked_'.
96−modifyMVarMasked_ :: Concurrent :> es => MVar a -> (a -> Eff es a) -> Eff es ()
97−modifyMVarMasked_ var f = unsafeUnliftIO $ \unlift -> do
98− M.modifyMVarMasked_ var $ unlift . f
99−
100−-- | Lifted 'M.modifyMVarMasked'.
101−modifyMVarMasked :: Concurrent :> es => MVar a -> (a -> Eff es (a, b)) -> Eff es b
102−modifyMVarMasked var f = unsafeUnliftIO $ \unlift -> do
103− M.modifyMVarMasked var $ unlift . f
104−
105−-- | Lifted 'M.mkWeakMVar'.
106−mkWeakMVar :: Concurrent :> es => MVar a -> Eff es () -> Eff es (Weak (MVar a))
107−mkWeakMVar var f = unsafeUnliftIO $ \unlift -> do
108− M.mkWeakMVar var $ unlift f
effectful/src/Effectful/Concurrent/QSem.hsdeleted−30
@@ -1,30 +0,0 @@
1−-- | Lifted version of "Control.Concurrent.QSem".
2−module Effectful.Concurrent.QSem
3− ( Concurrent
4− , runConcurrent
5−
6− -- * QSem
7− , QSem
8− , newQSem
9− , waitQSem
10− , signalQSem
11− ) where
12−
13−import Control.Concurrent.QSem (QSem)
14−import qualified Control.Concurrent.QSem as Q
15−
16−import Effectful.Concurrent.Effect
17−import Effectful.Dispatch.Static
18−import Effectful.Monad
19−
20−-- | Lifted 'Q.newQSem'.
21−newQSem :: Concurrent :> es => Int -> Eff es QSem
22−newQSem = unsafeEff_ . Q.newQSem
23−
24−-- | Lifted 'Q.waitQSem'.
25−waitQSem :: Concurrent :> es => QSem -> Eff es ()
26−waitQSem = unsafeEff_ . Q.waitQSem
27−
28−-- | Lifted 'Q.signalQSem'.
29−signalQSem :: Concurrent :> es => QSem -> Eff es ()
30−signalQSem = unsafeEff_ . Q.signalQSem
effectful/src/Effectful/Concurrent/QSemN.hsdeleted−30
@@ -1,30 +0,0 @@
1−-- | Lifted version of "Control.Concurrent.QSemN".
2−module Effectful.Concurrent.QSemN
3− ( Concurrent
4− , runConcurrent
5−
6− -- * QSemN
7− , QSemN
8− , newQSemN
9− , waitQSemN
10− , signalQSemN
11− ) where
12−
13−import Control.Concurrent.QSemN (QSemN)
14−import qualified Control.Concurrent.QSemN as Q
15−
16−import Effectful.Concurrent.Effect
17−import Effectful.Dispatch.Static
18−import Effectful.Monad
19−
20−-- | Lifted 'Q.newQSemN'.
21−newQSemN :: Concurrent :> es => Int -> Eff es QSemN
22−newQSemN = unsafeEff_ . Q.newQSemN
23−
24−-- | Lifted 'Q.waitQSemN'.
25−waitQSemN :: Concurrent :> es => QSemN -> Int -> Eff es ()
26−waitQSemN x = unsafeEff_ . Q.waitQSemN x
27−
28−-- | Lifted 'Q.signalQSemN'.
29−signalQSemN :: Concurrent :> es => QSemN -> Int -> Eff es ()
30−signalQSemN x = unsafeEff_ . Q.signalQSemN x
effectful/src/Effectful/Concurrent/STM.hsdeleted−146
@@ -1,146 +0,0 @@
1−-- | Lifted version of "Control.Concurrent.STM".
2−module Effectful.Concurrent.STM
3− ( Concurrent
4− , runConcurrent
5−
6− -- * Core
7− , STM.STM
8− , atomically
9− , STM.retry
10− , STM.orElse
11− , STM.check
12− , STM.throwSTM
13− , STM.catchSTM
14−
15− -- * TVar
16− , STM.TVar
17− , newTVarIO
18− , readTVarIO
19− , STM.newTVar
20− , STM.readTVar
21− , STM.writeTVar
22− , STM.modifyTVar
23− , STM.modifyTVar'
24− , STM.swapTVar
25− , registerDelay
26− , mkWeakTVar
27−
28− -- * TMVar
29− , STM.TMVar
30− , STM.newTMVar
31− , STM.newEmptyTMVar
32− , newTMVarIO
33− , newEmptyTMVarIO
34− , STM.takeTMVar
35− , STM.putTMVar
36− , STM.readTMVar
37− , STM.tryReadTMVar
38− , STM.swapTMVar
39− , STM.tryTakeTMVar
40− , STM.tryPutTMVar
41− , STM.isEmptyTMVar
42− , mkWeakTMVar
43−
44− -- * TChan
45− , STM.TChan
46− , STM.newTChan
47− , newTChanIO
48− , STM.newBroadcastTChan
49− , newBroadcastTChanIO
50− , STM.dupTChan
51− , STM.cloneTChan
52− , STM.readTChan
53− , STM.tryReadTChan
54− , STM.peekTChan
55− , STM.tryPeekTChan
56− , STM.writeTChan
57− , STM.unGetTChan
58− , STM.isEmptyTChan
59−
60− -- * TQueue
61− , STM.TQueue
62− , STM.newTQueue
63− , newTQueueIO
64− , STM.readTQueue
65− , STM.tryReadTQueue
66− , STM.peekTQueue
67− , STM.tryPeekTQueue
68− , STM.flushTQueue
69− , STM.writeTQueue
70− , STM.unGetTQueue
71− , STM.isEmptyTQueue
72−
73− -- * TBQueue
74− , STM.TBQueue
75− , STM.newTBQueue
76− , newTBQueueIO
77− , STM.readTBQueue
78− , STM.tryReadTBQueue
79− , STM.peekTBQueue
80− , STM.tryPeekTBQueue
81− , STM.flushTBQueue
82− , STM.writeTBQueue
83− , STM.unGetTBQueue
84− , STM.lengthTBQueue
85− , STM.isEmptyTBQueue
86− , STM.isFullTBQueue
87− ) where
88−
89−import Control.Concurrent.STM (STM, TVar, TMVar, TChan, TQueue, TBQueue)
90−import qualified Control.Concurrent.STM as STM
91−import System.Mem.Weak (Weak)
92−import GHC.Natural (Natural)
93−
94−import Effectful.Concurrent.Effect
95−import Effectful.Dispatch.Static
96−import Effectful.Monad
97−
98−-- | Lifted version of 'STM.atomically'
99−atomically :: Concurrent :> es => STM a -> Eff es a
100−atomically = unsafeEff_ . STM.atomically
101−
102−-- | Lifted version of 'STM.newTVarIO'
103−newTVarIO :: Concurrent :> es => a -> Eff es (TVar a)
104−newTVarIO = unsafeEff_ . STM.newTVarIO
105−
106−-- | Lifted version of 'STM.readTVarIO'
107−readTVarIO :: Concurrent :> es => TVar a -> Eff es a
108−readTVarIO = unsafeEff_ . STM.readTVarIO
109−
110−-- | Lifted version of 'STM.registerDelay'
111−registerDelay :: Concurrent :> es => Int -> Eff es (TVar Bool)
112−registerDelay = unsafeEff_ . STM.registerDelay
113−
114−-- | Lifted version of 'STM.mkWeakTVar'
115−mkWeakTVar :: Concurrent :> es => TVar a -> Eff es () -> Eff es (Weak (TVar a))
116−mkWeakTVar var final = unsafeUnliftIO $ \unlift -> do
117− STM.mkWeakTVar var $ unlift final
118−
119−-- | Lifted version of 'STM.newTMVarIO'
120−newTMVarIO :: Concurrent :> es => a -> Eff es (TMVar a)
121−newTMVarIO = unsafeEff_ . STM.newTMVarIO
122−
123−-- | Lifted version of 'STM.newEmptyTMVarIO'
124−newEmptyTMVarIO :: Concurrent :> es => Eff es (TMVar a)
125−newEmptyTMVarIO = unsafeEff_ STM.newEmptyTMVarIO
126−
127−-- | Lifted version of 'STM.mkWeakTMVar'
128−mkWeakTMVar :: Concurrent :> es => TMVar a -> Eff es () -> Eff es (Weak (TMVar a))
129−mkWeakTMVar var final = unsafeUnliftIO $ \unlift -> do
130− STM.mkWeakTMVar var $ unlift final
131−
132−-- | Lifted version of 'STM.newTChanIO'
133−newTChanIO :: Concurrent :> es => Eff es (TChan a)
134−newTChanIO = unsafeEff_ STM.newTChanIO
135−
136−-- | Lifted version of 'STM.newBroadcastTChanIO'
137−newBroadcastTChanIO :: Concurrent :> es => Eff es (TChan a)
138−newBroadcastTChanIO = unsafeEff_ STM.newBroadcastTChanIO
139−
140−-- | Lifted version of 'STM.newTQueueIO'
141−newTQueueIO :: Concurrent :> es => Eff es (TQueue a)
142−newTQueueIO = unsafeEff_ STM.newTQueueIO
143−
144−-- | Lifted version of 'STM.newTBQueueIO'
145−newTBQueueIO :: Concurrent :> es => Natural -> Eff es (TBQueue a)
146−newTBQueueIO = unsafeEff_ . STM.newTBQueueIO
effectful/src/Effectful/Environment.hsdeleted−71
@@ -1,71 +0,0 @@
1−module Effectful.Environment
2− ( Environment
3− , runEnvironment
4−
5− -- * Querying the environment
6− , getArgs
7− , getProgName
8− , getExecutablePath
9− , getEnv
10− , getEnvironment
11− , lookupEnv
12−
13− -- * Modifying the environment
14− , setEnv
15− , unsetEnv
16− , withArgs
17− , withProgName
18− ) where
19−
20−import qualified System.Environment as E
21−
22−import Effectful.Dispatch.Static hiding (getEnv)
23−import Effectful.Monad
24−
25−-- | An effect for querying and modifying the system environment.
26−data Environment :: Effect where
27− Environment :: Environment m r
28−
29−-- | Run the 'Environment' effect.
30−runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a
31−runEnvironment = evalData (DataA Environment)
32−
33−-- | Lifted 'E.getArgs'.
34−getArgs :: Environment :> es => Eff es [String]
35−getArgs = unsafeEff_ E.getArgs
36−
37−-- | Lifted 'E.getEnv'.
38−getEnv :: Environment :> es => String -> Eff es String
39−getEnv = unsafeEff_ . E.getEnv
40−
41−-- | Lifted 'E.getEnvironment'.
42−getEnvironment :: Environment :> es => Eff es [(String, String)]
43−getEnvironment = unsafeEff_ E.getEnvironment
44−
45−-- | Lifted 'E.getExecutablePath'.
46−getExecutablePath :: Environment :> es => Eff es FilePath
47−getExecutablePath = unsafeEff_ E.getExecutablePath
48−
49−-- | Lifted 'E.getProgName'.
50−getProgName :: Environment :> es => Eff es String
51−getProgName = unsafeEff_ E.getProgName
52−
53−-- | Lifted 'E.lookupEnv'.
54−lookupEnv :: Environment :> es => String -> Eff es (Maybe String)
55−lookupEnv = unsafeEff_ . E.lookupEnv
56−
57−-- | Lifted 'E.setEnv'.
58−setEnv :: Environment :> es => String -> String -> Eff es ()
59−setEnv n = unsafeEff_ . E.setEnv n
60−
61−-- | Lifted 'E.unsetEnv'.
62−unsetEnv :: Environment :> es => String -> Eff es ()
63−unsetEnv = unsafeEff_ . E.unsetEnv
64−
65−-- | Lifted 'E.withArgs'.
66−withArgs :: Environment :> es => [String] -> Eff es a -> Eff es a
67−withArgs = unsafeLiftMapIO . E.withArgs
68−
69−-- | Lifted 'E.withProgName'.
70−withProgName :: Environment :> es => String -> Eff es a -> Eff es a
71−withProgName = unsafeLiftMapIO . E.withProgName
effectful/src/Effectful/FileSystem.hsdeleted−347
@@ -1,347 +0,0 @@
1−module Effectful.FileSystem
2− ( FileSystem
3− , runFileSystem
4−
5− -- * Actions on directories
6− , createDirectory
7− , createDirectoryIfMissing
8− , removeDirectory
9− , removeDirectoryRecursive
10− , removePathForcibly
11− , renameDirectory
12− , listDirectory
13− , getDirectoryContents
14−
15− -- ** Current working directory
16− , getCurrentDirectory
17− , setCurrentDirectory
18− , withCurrentDirectory
19−
20− -- * Pre-defined directories
21− , getHomeDirectory
22− , getXdgDirectory
23− , getXdgDirectoryList
24− , getAppUserDataDirectory
25− , getUserDocumentsDirectory
26− , getTemporaryDirectory
27−
28− -- * Actions on files
29− , removeFile
30− , renameFile
31− , renamePath
32− , copyFile
33− , copyFileWithMetadata
34− , getFileSize
35− , canonicalizePath
36− , makeAbsolute
37− , makeRelativeToCurrentDirectory
38−
39− -- * Existence tests
40− , doesPathExist
41− , doesFileExist
42− , doesDirectoryExist
43− , findExecutable
44− , findExecutables
45− , findExecutablesInDirectories
46− , findFile
47− , findFiles
48− , findFileWith
49− , findFilesWith
50−
51− -- * Symbolic links
52− , createFileLink
53− , createDirectoryLink
54− , removeDirectoryLink
55− , pathIsSymbolicLink
56− , getSymbolicLinkTarget
57−
58− -- * Permissions
59− , getPermissions
60− , setPermissions
61− , copyPermissions
62−
63− -- * Timestamps
64− , getAccessTime
65− , getModificationTime
66− , setAccessTime
67− , setModificationTime
68−
69− -- * Re-exports
70−
71− -- ** Pre-defined directories
72− , D.XdgDirectory(..)
73− , D.XdgDirectoryList(..)
74−
75− -- ** Existence tests
76− , D.exeExtension
77−
78− -- ** Permissions
79− , D.Permissions
80− , D.emptyPermissions
81− , D.readable
82− , D.writable
83− , D.executable
84− , D.searchable
85− , D.setOwnerReadable
86− , D.setOwnerWritable
87− , D.setOwnerExecutable
88− , D.setOwnerSearchable
89− ) where
90−
91−import Data.Time (UTCTime)
92−import qualified System.Directory as D
93−
94−import Effectful.Dispatch.Static
95−import Effectful.Monad
96−
97−-- | An effect for interacting with the filesystem.
98−data FileSystem :: Effect where
99− FileSystem :: FileSystem m r
100−
101−-- | Run the 'FileSystem' effect.
102−runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a
103−runFileSystem = evalData (DataA FileSystem)
104−
105−----------------------------------------
106−-- Actions on directories
107−
108−-- | Lifted 'D.createDirectory'.
109−createDirectory :: FileSystem :> es => FilePath -> Eff es ()
110−createDirectory = unsafeEff_ . D.createDirectory
111−
112−-- | Lifted 'D.createDirectoryIfMissing'.
113−createDirectoryIfMissing :: FileSystem :> es => Bool -> FilePath -> Eff es ()
114−createDirectoryIfMissing doCreateParents =
115− unsafeEff_ . D.createDirectoryIfMissing doCreateParents
116−
117−-- | Lifted 'D.removeDirectory'.
118−removeDirectory :: FileSystem :> es => FilePath -> Eff es ()
119−removeDirectory = unsafeEff_ . D.removeDirectory
120−
121−-- | Lifted 'D.removeDirectoryRecursive'.
122−removeDirectoryRecursive :: FileSystem :> es => FilePath -> Eff es ()
123−removeDirectoryRecursive = unsafeEff_ . D.removeDirectoryRecursive
124−
125−-- | Lifted 'D.removePathForcibly'.
126−removePathForcibly :: FileSystem :> es => FilePath -> Eff es ()
127−removePathForcibly = unsafeEff_ . D.removePathForcibly
128−
129−-- | Lifted 'D.renameDirectory'.
130−renameDirectory :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
131−renameDirectory old = unsafeEff_ . D.renameDirectory old
132−
133−-- | Lifted 'D.listDirectory'.
134−listDirectory :: FileSystem :> es => FilePath -> Eff es [FilePath]
135−listDirectory = unsafeEff_ . D.listDirectory
136−
137−-- | Lifted 'D.getDirectoryContents'.
138−getDirectoryContents :: FileSystem :> es => FilePath -> Eff es [FilePath]
139−getDirectoryContents = unsafeEff_ . D.getDirectoryContents
140−
141−----------------------------------------
142−-- Current working directory
143−
144−-- | Lifted 'D.getCurrentDirectory'.
145−getCurrentDirectory :: FileSystem :> es => Eff es FilePath
146−getCurrentDirectory = unsafeEff_ D.getCurrentDirectory
147−
148−-- | Lifted 'D.setCurrentDirectory'.
149−setCurrentDirectory :: FileSystem :> es => FilePath -> Eff es ()
150−setCurrentDirectory = unsafeEff_ . D.setCurrentDirectory
151−
152−-- | Lifted 'D.withCurrentDirectory'.
153−withCurrentDirectory :: FileSystem :> es => FilePath -> Eff es a -> Eff es a
154−withCurrentDirectory path = unsafeLiftMapIO (D.withCurrentDirectory path)
155−
156−----------------------------------------
157−-- Pre-defined directories
158−
159−-- | Lifted 'D.getHomeDirectory'.
160−getHomeDirectory :: FileSystem :> es => Eff es FilePath
161−getHomeDirectory = unsafeEff_ D.getHomeDirectory
162−
163−-- | Lifted 'D.getXdgDirectory'.
164−getXdgDirectory
165− :: FileSystem :> es
166− => D.XdgDirectory
167− -> FilePath
168− -> Eff es FilePath
169−getXdgDirectory xdgDir = unsafeEff_ . D.getXdgDirectory xdgDir
170−
171−-- | Lifted 'D.getXdgDirectoryList'.
172−getXdgDirectoryList
173− :: FileSystem :> es
174− => D.XdgDirectoryList
175− -> Eff es [FilePath]
176−getXdgDirectoryList = unsafeEff_ . D.getXdgDirectoryList
177−
178−-- | Lifted 'D.getAppUserDataDirectory'.
179−getAppUserDataDirectory :: FileSystem :> es => FilePath -> Eff es FilePath
180−getAppUserDataDirectory = unsafeEff_ . D.getAppUserDataDirectory
181−
182−-- | Lifted 'D.getUserDocumentsDirectory'.
183−getUserDocumentsDirectory :: FileSystem :> es => Eff es FilePath
184−getUserDocumentsDirectory = unsafeEff_ D.getUserDocumentsDirectory
185−
186−-- | Lifted 'D.getTemporaryDirectory'.
187−getTemporaryDirectory :: FileSystem :> es => Eff es FilePath
188−getTemporaryDirectory = unsafeEff_ D.getTemporaryDirectory
189−
190−----------------------------------------
191−-- Actions on files
192−
193−-- | Lifted 'D.removeFile'.
194−removeFile :: FileSystem :> es => FilePath -> Eff es ()
195−removeFile = unsafeEff_ . D.removeFile
196−
197−-- | Lifted 'D.renameFile'.
198−renameFile :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
199−renameFile old = unsafeEff_ . D.renameFile old
200−
201−-- | Lifted 'D.renamePath'.
202−renamePath :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
203−renamePath old = unsafeEff_ . D.renamePath old
204−
205−-- | Lifted 'D.copyFile'.
206−copyFile :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
207−copyFile src = unsafeEff_ . D.copyFile src
208−
209−-- | Lifted 'D.copyFileWithMetadata'.
210−copyFileWithMetadata :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
211−copyFileWithMetadata src = unsafeEff_ . D.copyFileWithMetadata src
212−
213−-- | Lifted 'D.getFileSize'.
214−getFileSize :: FileSystem :> es => FilePath -> Eff es Integer
215−getFileSize = unsafeEff_ . D.getFileSize
216−
217−-- | Lifted 'D.canonicalizePath'.
218−canonicalizePath :: FileSystem :> es => FilePath -> Eff es FilePath
219−canonicalizePath = unsafeEff_ . D.canonicalizePath
220−
221−-- | Lifted 'D.makeAbsolute'.
222−makeAbsolute :: FileSystem :> es => FilePath -> Eff es FilePath
223−makeAbsolute = unsafeEff_ . D.makeAbsolute
224−
225−-- | Lifted 'D.makeRelativeToCurrentDirectory'.
226−makeRelativeToCurrentDirectory
227− :: FileSystem :> es
228− => FilePath
229− -> Eff es FilePath
230−makeRelativeToCurrentDirectory = unsafeEff_ . D.makeRelativeToCurrentDirectory
231−
232−----------------------------------------
233−-- Existence tests
234−
235−-- | Lifted 'D.doesPathExist'.
236−doesPathExist :: FileSystem :> es => FilePath -> Eff es Bool
237−doesPathExist = unsafeEff_ . D.doesPathExist
238−
239−-- | Lifted 'D.doesFileExist'.
240−doesFileExist :: FileSystem :> es => FilePath -> Eff es Bool
241−doesFileExist = unsafeEff_ . D.doesFileExist
242−
243−-- | Lifted 'D.doesDirectoryExist'.
244−doesDirectoryExist :: FileSystem :> es => FilePath -> Eff es Bool
245−doesDirectoryExist = unsafeEff_ . D.doesDirectoryExist
246−
247−-- | Lifted 'D.findExecutable'.
248−findExecutable :: FileSystem :> es => String -> Eff es (Maybe FilePath)
249−findExecutable = unsafeEff_ . D.findExecutable
250−
251−-- | Lifted 'D.findExecutables'.
252−findExecutables :: FileSystem :> es => String -> Eff es [FilePath]
253−findExecutables = unsafeEff_ . D.findExecutables
254−
255−-- | Lifted 'D.findExecutablesInDirectories'.
256−findExecutablesInDirectories
257− :: FileSystem :> es
258− => [FilePath]
259− -> String
260− -> Eff es [FilePath]
261−findExecutablesInDirectories dirs =
262− unsafeEff_ . D.findExecutablesInDirectories dirs
263−
264−-- | Lifted 'D.findFile'.
265−findFile :: FileSystem :> es => [FilePath] -> String -> Eff es (Maybe FilePath)
266−findFile dirs = unsafeEff_ . D.findFile dirs
267−
268−-- | Lifted 'D.findFiles'.
269−findFiles :: FileSystem :> es => [FilePath] -> String -> Eff es [FilePath]
270−findFiles dirs = unsafeEff_ . D.findFiles dirs
271−
272−-- | Lifted 'D.findFileWith'.
273−findFileWith
274− :: FileSystem :> es
275− => (FilePath -> Eff es Bool)
276− -> [FilePath]
277− -> String
278− -> Eff es (Maybe FilePath)
279−findFileWith p dirs n = unsafeUnliftIO $ \unlift -> do
280− D.findFileWith (unlift . p) dirs n
281−
282−-- | Lifted 'D.findFilesWith'.
283−findFilesWith
284− :: FileSystem :> es
285− => (FilePath -> Eff es Bool)
286− -> [FilePath]
287− -> String
288− -> Eff es [FilePath]
289−findFilesWith p dirs ns = unsafeUnliftIO $ \unlift -> do
290− D.findFilesWith (unlift . p) dirs ns
291−
292−----------------------------------------
293−-- Symbolic links
294−
295−-- | Lifted 'D.createFileLink'.
296−createFileLink :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
297−createFileLink target = unsafeEff_ . D.createFileLink target
298−
299−-- | Lifted 'D.createDirectoryLink'.
300−createDirectoryLink :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
301−createDirectoryLink target = unsafeEff_ . D.createDirectoryLink target
302−
303−-- | Lifted 'D.removeDirectoryLink'.
304−removeDirectoryLink :: FileSystem :> es => FilePath -> Eff es ()
305−removeDirectoryLink = unsafeEff_ . D.removeDirectoryLink
306−
307−-- | Lifted 'D.pathIsSymbolicLink'.
308−pathIsSymbolicLink :: FileSystem :> es => FilePath -> Eff es Bool
309−pathIsSymbolicLink = unsafeEff_ . D.pathIsSymbolicLink
310−
311−-- | Lifted 'D.getSymbolicLinkTarget'.
312−getSymbolicLinkTarget :: FileSystem :> es => FilePath -> Eff es FilePath
313−getSymbolicLinkTarget = unsafeEff_ . D.getSymbolicLinkTarget
314−
315−----------------------------------------
316−-- Permissions
317−
318−-- | Lifted 'D.getPermissions'.
319−getPermissions :: FileSystem :> es => FilePath -> Eff es D.Permissions
320−getPermissions = unsafeEff_ . D.getPermissions
321−
322−-- | Lifted 'D.setPermissions'.
323−setPermissions :: FileSystem :> es => FilePath -> D.Permissions -> Eff es ()
324−setPermissions path = unsafeEff_ . D.setPermissions path
325−
326−-- | Lifted 'D.copyPermissions'.
327−copyPermissions :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
328−copyPermissions src = unsafeEff_ . D.copyPermissions src
329−
330−----------------------------------------
331−-- Timestamps
332−
333−-- | Lifted 'D.getAccessTime'.
334−getAccessTime :: FileSystem :> es => FilePath -> Eff es UTCTime
335−getAccessTime = unsafeEff_ . D.getAccessTime
336−
337−-- | Lifted 'D.getModificationTime'.
338−getModificationTime :: FileSystem :> es => FilePath -> Eff es UTCTime
339−getModificationTime = unsafeEff_ . D.getModificationTime
340−
341−-- | Lifted 'D.setAccessTime'.
342−setAccessTime :: FileSystem :> es => FilePath -> UTCTime -> Eff es ()
343−setAccessTime path = unsafeEff_ . D.setAccessTime path
344−
345−-- | Lifted 'D.setModificationTime'.
346−setModificationTime :: FileSystem :> es => FilePath -> UTCTime -> Eff es ()
347−setModificationTime path = unsafeEff_ . D.setModificationTime path
effectful/src/Effectful/FileSystem/Effect.hsdeleted−15
@@ -1,15 +0,0 @@
1−module Effectful.FileSystem.Effect
2− ( FileSystem
3− , runFileSystem
4− ) where
5−
6−import Effectful.Dispatch.Static
7−import Effectful.Monad
8−
9−-- | An effect for interacting with the filesystem.
10−data FileSystem :: Effect where
11− FileSystem :: FileSystem m r
12−
13−-- | Run the 'FileSystem' effect.
14−runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a
15−runFileSystem = evalData (DataA FileSystem)
effectful/src/Effectful/FileSystem/IO.hsdeleted−143
@@ -1,143 +0,0 @@
1−-- | Lifted version of "System.IO".
2−module Effectful.FileSystem.IO
3− ( FileSystem
4− , runFileSystem
5−
6− -- * IO
7− , IOMode (..)
8− , Handle
9− , IO.stdin
10− , IO.stdout
11− , IO.stderr
12− , withFile
13− , withBinaryFile
14− , openFile
15− , hClose
16− , hFlush
17− , hFileSize
18− , hSetFileSize
19− , hIsEOF
20− , IO.BufferMode (..)
21− , hSetBuffering
22− , hGetBuffering
23− , hSeek
24− , IO.SeekMode (..)
25− , hTell
26− , hIsOpen
27− , hIsClosed
28− , hIsReadable
29− , hIsWritable
30− , hIsSeekable
31− , hIsTerminalDevice
32− , hSetEcho
33− , hGetEcho
34− , hWaitForInput
35− , hReady
36− ) where
37−
38−import qualified System.IO as IO
39−import System.IO (Handle, IOMode (..))
40−
41−import Effectful.Dispatch.Static
42−import Effectful.FileSystem.Effect
43−import Effectful.Monad
44−
45−-- | Lifted version of 'IO.withFile'.
46−withFile
47− :: FileSystem :> es
48− => FilePath
49− -> IOMode
50− -> (Handle -> Eff es a)
51− -> Eff es a
52−withFile fp mode inner = unsafeUnliftIO $ \unlift -> do
53− IO.withFile fp mode $ unlift . inner
54−
55−-- | Lifted version of 'IO.withBinaryFile'.
56−withBinaryFile
57− :: FileSystem :> es
58− => FilePath
59− -> IOMode
60− -> (Handle -> Eff es a)
61− -> Eff es a
62−withBinaryFile fp mode inner = unsafeUnliftIO $ \unlift -> do
63− IO.withBinaryFile fp mode $ unlift . inner
64−
65−-- | Lifted version of 'IO.openFile'
66−openFile :: FileSystem :> es => FilePath -> IOMode -> Eff es Handle
67−openFile fp = unsafeEff_ . IO.openFile fp
68−
69−-- | Lifted version of 'IO.hClose'
70−hClose :: FileSystem :> es => Handle -> Eff es ()
71−hClose = unsafeEff_ . IO.hClose
72−
73−-- | Lifted version of 'IO.hFlush'
74−hFlush :: FileSystem :> es => Handle -> Eff es ()
75−hFlush = unsafeEff_ . IO.hFlush
76−
77−-- | Lifted version of 'IO.hFileSize'
78−hFileSize :: FileSystem :> es => Handle -> Eff es Integer
79−hFileSize = unsafeEff_ . IO.hFileSize
80−
81−-- | Lifted version of 'IO.hSetFileSize'
82−hSetFileSize :: FileSystem :> es => Handle -> Integer -> Eff es ()
83−hSetFileSize h = unsafeEff_ . IO.hSetFileSize h
84−
85−-- | Lifted version of 'IO.hIsEOF'
86−hIsEOF :: FileSystem :> es => Handle -> Eff es Bool
87−hIsEOF = unsafeEff_ . IO.hIsEOF
88−
89−-- | Lifted version of 'IO.hSetBuffering'
90−hSetBuffering :: FileSystem :> es => Handle -> IO.BufferMode -> Eff es ()
91−hSetBuffering h = unsafeEff_ . IO.hSetBuffering h
92−
93−-- | Lifted version of 'IO.hGetBuffering'
94−hGetBuffering :: FileSystem :> es => Handle -> Eff es IO.BufferMode
95−hGetBuffering = unsafeEff_ . IO.hGetBuffering
96−
97−-- | Lifted version of 'IO.hSeek'
98−hSeek :: FileSystem :> es => Handle -> IO.SeekMode -> Integer -> Eff es ()
99−hSeek h s = unsafeEff_ . IO.hSeek h s
100−
101−-- | Lifted version of 'IO.hTell'
102−hTell :: FileSystem :> es => Handle -> Eff es Integer
103−hTell = unsafeEff_ . IO.hTell
104−
105−-- | Lifted version of 'IO.hIsOpen'
106−hIsOpen :: FileSystem :> es => Handle -> Eff es Bool
107−hIsOpen = unsafeEff_ . IO.hIsOpen
108−
109−-- | Lifted version of 'IO.hIsClosed'
110−hIsClosed :: FileSystem :> es => Handle -> Eff es Bool
111−hIsClosed = unsafeEff_ . IO.hIsClosed
112−
113−-- | Lifted version of 'IO.hIsReadable'
114−hIsReadable :: FileSystem :> es => Handle -> Eff es Bool
115−hIsReadable = unsafeEff_ . IO.hIsReadable
116−
117−-- | Lifted version of 'IO.hIsWritable'
118−hIsWritable :: FileSystem :> es => Handle -> Eff es Bool
119−hIsWritable = unsafeEff_ . IO.hIsWritable
120−
121−-- | Lifted version of 'IO.hIsSeekable'
122−hIsSeekable :: FileSystem :> es => Handle -> Eff es Bool
123−hIsSeekable = unsafeEff_ . IO.hIsSeekable
124−
125−-- | Lifted version of 'IO.hIsTerminalDevice'
126−hIsTerminalDevice :: FileSystem :> es => Handle -> Eff es Bool
127−hIsTerminalDevice = unsafeEff_ . IO.hIsTerminalDevice
128−
129−-- | Lifted version of 'IO.hSetEcho'
130−hSetEcho :: FileSystem :> es => Handle -> Bool -> Eff es ()
131−hSetEcho h = unsafeEff_ . IO.hSetEcho h
132−
133−-- | Lifted version of 'IO.hGetEcho'
134−hGetEcho :: FileSystem :> es => Handle -> Eff es Bool
135−hGetEcho = unsafeEff_ . IO.hGetEcho
136−
137−-- | Lifted version of 'IO.hWaitForInput'
138−hWaitForInput :: FileSystem :> es => Handle -> Int -> Eff es Bool
139−hWaitForInput h = unsafeEff_ . IO.hWaitForInput h
140−
141−-- | Lifted version of 'IO.hReady'
142−hReady :: FileSystem :> es => Handle -> Eff es Bool
143−hReady = unsafeEff_ . IO.hReady
effectful/src/Effectful/Process.hs+10−8
@@ -1,7 +1,8 @@
11{-# LANGUAGE CPP #-}
2−-- | Lifted version of "System.Process".
2+
33module Effectful.Process
4− ( Process
4+ ( -- * Process effect
5+ Process
56 , runProcess
67
78 -- * Running sub-processes
@@ -50,15 +51,15 @@ import System.IO (Handle)
5051import System.Posix.Internals (FD)
5152import qualified System.Process as P
5253
53−import Effectful.Dispatch.Static
54−import Effectful.Monad
54+import Effectful.Internal.Effect
55+import Effectful.Internal.Monad
5556
5657-- | An effect for running child processes using the @process@ library.
5758data Process :: Effect where
58− Process :: Process m r
59+ Process :: Process m r
5960
6061runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a
61−runProcess = evalData (DataA Process)
62+runProcess = evalEffect (IdE Process)
6263
6364----------------------------------------
6465-- Running sub-processes
@@ -128,8 +129,9 @@ withCreateProcess
128129 => P.CreateProcess
129130 -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> P.ProcessHandle -> Eff es a)
130131 -> Eff es a
131−withCreateProcess cp cb = unsafeUnliftIO $ \unlift -> do
132− P.withCreateProcess cp $ \inh outh errh ph -> unlift $ cb inh outh errh ph
132+withCreateProcess cp cb = unsafeEff $ \es ->
133+ unsafeSeqUnliftEff es $ \runInIO ->
134+ P.withCreateProcess cp (\inh outh errh ph -> runInIO $ cb inh outh errh ph)
133135
134136-- | Lifted 'P.cleanupProcess'.
135137cleanupProcess
effectful/src/Effectful/Resource.hs+7−6
@@ -24,8 +24,9 @@ import Control.Exception
2424import qualified Control.Monad.Trans.Resource as R
2525import qualified Control.Monad.Trans.Resource.Internal as RI
2626
27−import Effectful.Dispatch.Static
28−import Effectful.Monad
27+import Effectful.Internal.Effect
28+import Effectful.Internal.Env
29+import Effectful.Internal.Monad
2930
3031-- | Data tag for a resource effect.
3132newtype Resource :: Effect where
@@ -37,7 +38,7 @@ runResource m = unsafeEff $ \es0 -> do
3738 size0 <- sizeEnv es0
3839 istate <- R.createInternalState
3940 mask $ \restore -> do
40− es <- unsafeConsEnv (DataA (Resource istate)) noRelinker es0
41+ es <- unsafeConsEnv (IdE (Resource istate)) noRelinker es0
4142 a <- restore (unEff m es) `catch` \e -> do
4243 unsafeTailEnv size0 es
4344 RI.stateCleanupChecked (Just e) istate
@@ -52,18 +53,18 @@ runResource m = unsafeEff $ \es0 -> do
5253-- | Get the 'R.InternalState' of the current 'Resource' effect.
5354getInternalState :: Resource :> es => Eff es R.InternalState
5455getInternalState = do
55− DataA (Resource istate) <- getData
56+ IdE (Resource istate) <- getEffect
5657 pure istate
5758
5859-- | Run the 'Resource' effect with existing 'R.InternalState'.
5960--
6061-- /Note:/ the 'R.InternalState' will not be closed at the end.
6162runInternalState :: R.InternalState -> Eff (Resource : es) a -> Eff es a
62−runInternalState istate = evalData (DataA (Resource istate))
63+runInternalState istate = evalEffect $ IdE (Resource istate)
6364
6465----------------------------------------
6566-- Orphan instance
6667
6768instance (IOE :> es, Resource :> es) => R.MonadResource (Eff es) where
6869 liftResourceT (RI.ResourceT m) = unsafeEff $ \es -> do
69− getEnv es >>= \(DataA (Resource istate)) -> m istate
70+ getEnv es >>= \(IdE (Resource istate)) -> m istate
effectful/src/Effectful/Temporary.hsdeleted−70
@@ -1,70 +0,0 @@
1−module Effectful.Temporary
2− ( Temporary
3− , runTemporary
4− , withSystemTempFile
5− , withSystemTempDirectory
6− , withTempFile
7− , withTempDirectory
8− ) where
9−
10−import System.IO
11−import qualified UnliftIO.Temporary as T
12−
13−import Effectful.Dispatch.Static
14−import Effectful.Monad
15−
16−-- | An effect for interacting with temporary files.
17−data Temporary :: Effect where
18− Temporary :: Temporary m r
19−
20−-- | Run the 'Temporary' effect.
21−runTemporary :: IOE :> es => Eff (Temporary : es) a -> Eff es a
22−runTemporary = evalData (DataA Temporary)
23−
24−-- | Lifted 'T.withSystemTempFile'.
25−withSystemTempFile
26− :: Temporary :> es
27− => String
28− -- ^ File name template. See 'openTempFile'.
29− -> (FilePath -> Handle -> Eff es a)
30− -- ^ Callback that can use the file.
31− -> Eff es a
32−withSystemTempFile template action = unsafeUnliftIO $ \unlift -> do
33− T.withSystemTempFile template $ \fp handle -> unlift $ action fp handle
34−
35−-- | Lifted 'T.withSystemTempDirectory'.
36−withSystemTempDirectory
37− :: Temporary :> es
38− => String
39− -- ^ Directory name template. See 'openTempFile'.
40− -> (FilePath -> Eff es a)
41− -- ^ Callback that can use the directory.
42− -> Eff es a
43−withSystemTempDirectory template action = unsafeUnliftIO $ \unlift -> do
44− T.withSystemTempDirectory template $ \fp -> unlift $ action fp
45−
46−-- | Lifted 'T.withTempFile'.
47−withTempFile
48− :: Temporary :> es
49− => FilePath
50− -- ^ Temp dir to create the file in.
51− -> String
52− -- ^ File name template. See 'openTempFile'.
53− -> (FilePath -> Handle -> Eff es a)
54− -- ^ Callback that can use the file.
55− -> Eff es a
56−withTempFile tmpDir template action = unsafeUnliftIO $ \unlift -> do
57− T.withTempFile tmpDir template $ \fp handle -> unlift $ action fp handle
58−
59−-- | Lifted 'T.withTempDirectory'.
60−withTempDirectory
61− :: Temporary :> es
62− => FilePath
63− -- ^ Temp directory to create the directory in.
64− -> String
65− -- ^ Directory name template. See 'openTempFile'.
66− -> (FilePath -> Eff es a)
67− -- ^ Callback that can use the directory.
68− -> Eff es a
69−withTempDirectory tmpDir template action = unsafeUnliftIO $ \unlift -> do
70− T.withTempDirectory tmpDir template $ \fp -> unlift $ action fp
effectful/src/Effectful/Timeout.hsdeleted−28
@@ -1,28 +0,0 @@
1−module Effectful.Timeout
2− ( Timeout
3− , runTimeout
4− , timeout
5− ) where
6−
7−import qualified System.Timeout as T
8−
9−import Effectful.Dispatch.Static
10−import Effectful.Monad
11−
12−-- | An effect for timing out computations.
13−data Timeout :: Effect where
14− Timeout :: Timeout m r
15−
16−-- | Run the 'Timeout' effect.
17−runTimeout :: IOE :> es => Eff (Timeout : es) a -> Eff es a
18−runTimeout = evalData (DataA Timeout)
19−
20−-- | Lifted 'T.timeout'.
21−timeout
22− :: Timeout :> es
23− => Int
24− -- ^ The timeout in microseconds (1/10^6 seconds).
25− -> Eff es a
26− -- ^ The computation the timeout applies to.
27− -> Eff es (Maybe a)
28−timeout = unsafeLiftMapIO . T.timeout
effectful/tests/AsyncTests.hs+6−6
@@ -7,7 +7,7 @@ import Test.Tasty.HUnit
77import qualified Data.Set as S
88
99import Effectful
10−import Effectful.Concurrent.Async
10+import Effectful.Async
1111import Effectful.Error
1212import Effectful.State.Dynamic
1313
@@ -23,7 +23,7 @@ asyncTests = testGroup "Async"
2323 ]
2424
2525test_localState :: Assertion
26−test_localState = runEff . runConcurrent . evalLocalState x $ do
26+test_localState = runEff . runAsyncE . evalLocalState x $ do
2727 replicateConcurrently_ 2 $ do
2828 r <- goDownward 0
2929 U.assertEqual "expected result" x r
@@ -41,7 +41,7 @@ test_localState = runEff . runConcurrent . evalLocalState x $ do
4141 else goDownward $ acc + 1
4242
4343test_sharedState :: Assertion
44−test_sharedState = runEff . runConcurrent . evalSharedState (S.empty @Int) $ do
44+test_sharedState = runEff . runAsyncE . evalSharedState (S.empty @Int) $ do
4545 concurrently_ (addWhen even x) (addWhen odd x)
4646 U.assertEqual "expected result" (S.fromList [1..x]) =<< get
4747 where
@@ -57,7 +57,7 @@ test_sharedState = runEff . runConcurrent . evalSharedState (S.empty @Int) $ do
5757 addWhen f $ n - 1
5858
5959test_errorHandling :: Assertion
60−test_errorHandling = runEff . runConcurrent . evalSharedState (0::Int) $ do
60+test_errorHandling = runEff . runAsyncE . evalSharedState (0::Int) $ do
6161 r <- runError $ concurrently_
6262 (liftIO (threadDelay 10000) >> throwError err)
6363 (modify (+x))
@@ -73,7 +73,7 @@ test_errorHandling = runEff . runConcurrent . evalSharedState (0::Int) $ do
7373 err = "thrown from async"
7474
7575test_asyncWithUnmask :: Assertion
76−test_asyncWithUnmask = runEff . runConcurrent . evalLocalState "initial" $ do
76+test_asyncWithUnmask = runEff . runAsyncE . evalLocalState "initial" $ do
7777 x <- asyncWithUnmask $ \unmask -> do
7878 liftIO $ threadDelay 10000
7979 r1 <- get @String -- 2
@@ -88,7 +88,7 @@ test_asyncWithUnmask = runEff . runConcurrent . evalLocalState "initial" $ do
8888 (inner1, inner2, outer)
8989
9090test_pooledWorkers :: Assertion
91−test_pooledWorkers = runEff . runConcurrent . evalLocalState (0::Int) $ do
91+test_pooledWorkers = runEff . runAsyncE . evalLocalState (0::Int) $ do
9292 x <- pooledForConcurrentlyN threads [1..n] $ \k -> do
9393 r <- get @Int
9494 modify @Int (+1)
effectful/tests/EnvironmentTests.hsdeleted−48
@@ -1,48 +0,0 @@
1−module EnvironmentTests (environmentTests) where
2−
3−import Test.Tasty
4−import Test.Tasty.HUnit
5−import System.IO.Error (isDoesNotExistError)
6−
7−import Effectful
8−import Effectful.Environment
9−import qualified Utils as U
10−
11−environmentTests :: TestTree
12−environmentTests = testCaseSteps "Environment" $ \step -> do
13− -- These tests need to be run sequentially because of
14− -- https://github.com/arybczak/effectful/issues/39.
15− step "set and get an environment variable"
16− test_setAndGet
17− step "unset and try to get an environment variable"
18− test_unsetAndGet
19− step "execute effects with custom arguments"
20− test_withArgs
21− step "execute effects with custom program name"
22− test_withProg
23−
24−test_setAndGet :: Assertion
25−test_setAndGet = runEff . runEnvironment $ do
26− let expected = "value"
27− n = "EFFECTFUL_TEST1"
28− setEnv n expected
29− v <- getEnv n
30− U.assertEqual "environment variable not set" expected v
31−
32−test_unsetAndGet :: Assertion
33−test_unsetAndGet = runEff . runEnvironment $ do
34− let n = "EFFECTFUL_TEST2"
35− unsetEnv n
36− U.assertThrows "environment variable is set" isDoesNotExistError (getEnv n)
37−
38−test_withArgs :: Assertion
39−test_withArgs = runEff . runEnvironment $ do
40− let expected = ["effectful-test"]
41− args <- withArgs expected getArgs
42− U.assertEqual "correct arguments" expected args
43−
44−test_withProg :: Assertion
45−test_withProg = runEff . runEnvironment $ do
46− let expected = "effectful-test"
47− n <- withProgName expected getProgName
48− U.assertEqual "correct program name" expected n
effectful/tests/Main.hs−6
@@ -4,19 +4,13 @@ import Test.Tasty
44
55import AsyncTests
66import ConcurrencyTests
7−import EnvironmentTests
87import ErrorTests
98import StateTests
10−import TimeoutTests
11−import UnliftTests
129
1310main :: IO ()
1411main = defaultMain $ testGroup "effectful"
1512 [ asyncTests
1613 , concurrencyTests
17− , environmentTests
1814 , errorTests
1915 , stateTests
20− , timeoutTests
21− , unliftTests
2216 ]
effectful/tests/StateTests.hs−1
@@ -97,7 +97,6 @@ test_localEffects = runEff $ do
9797 where
9898 expected :: Int
9999 expected = 4
100−
101100----------------------------------------
102101-- Helpers
103102
effectful/tests/TimeoutTests.hsdeleted−25
@@ -1,25 +0,0 @@
1−module TimeoutTests (timeoutTests) where
2−
3−import Control.Concurrent (threadDelay)
4−import Test.Tasty
5−import Test.Tasty.HUnit
6−
7−import Effectful
8−import Effectful.Timeout
9−import qualified Utils as U
10−
11−timeoutTests :: TestTree
12−timeoutTests = testGroup "Timeout"
13− [ testCase "return before timeout" test_returnBeforeTimeout
14− , testCase "timeout before return" test_timeoutBeforeReturn
15− ]
16−
17−test_returnBeforeTimeout :: Assertion
18−test_returnBeforeTimeout = runEff $ do
19− result <- runTimeout $ timeout 1000 $ return ()
20− U.assertEqual "return value" (Just ()) result
21−
22−test_timeoutBeforeReturn :: Assertion
23−test_timeoutBeforeReturn = runEff $ do
24− result <- runTimeout $ timeout 0 $ liftIO $ threadDelay 1000
25− U.assertEqual "no return value" Nothing result
effectful/tests/UnliftTests.hsdeleted−93
@@ -1,93 +0,0 @@
1−module UnliftTests (unliftTests) where
2−
3−import Control.Exception
4−import Test.Tasty
5−import Test.Tasty.HUnit
6−import qualified UnliftIO.Async as A
7−
8−import Effectful
9−import qualified Utils as U
10−
11−unliftTests :: TestTree
12−unliftTests = testGroup "Unlift"
13− [ testCase "Reset strategy in new thread" test_resetStrategy
14− , testCase "SeqUnlift in new thread" test_seqUnliftInNewThread
15− , testGroup "Ephemeral strategy"
16− [ testCase "Invalid limit" test_ephemeralInvalid
17− , testCase "Uses in same thread" test_ephemeralSameThread
18− , testCase "Uses in multiple threads" test_ephemeralMultipleThreads
19− ]
20− , testGroup "Persistent strategy"
21− [ testCase "Invalid limit" test_persistentInvalid
22− , testCase "Uses in same thread" test_persistentSameThread
23− , testCase "Uses in multiple threads" test_persistentMultipleThreads
24− ]
25− ]
26−
27−test_resetStrategy :: Assertion
28−test_resetStrategy = runEff $ do
29− s <- withUnliftStrategy (ConcUnlift Ephemeral Unlimited) $ do
30− withEffToIO $ \runInIO -> do
31− inThread $ runInIO unliftStrategy
32− U.assertEqual "correct strategy" SeqUnlift s
33−
34−test_seqUnliftInNewThread :: Assertion
35−test_seqUnliftInNewThread = runEff $ do
36− assertThrowsUnliftError "InvalidUseOfSeqUnlift error" $ do
37− withUnliftStrategy SeqUnlift $ do
38− withEffToIO $ \runInIO -> do
39− inThread $ runInIO $ return ()
40−
41−test_ephemeralInvalid :: Assertion
42−test_ephemeralInvalid = runEff $ do
43− assertThrowsUnliftError "InvalidNumberOfUses error" $ do
44− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do
45− withEffToIO $ \_ -> return ()
46−
47−test_ephemeralSameThread :: Assertion
48−test_ephemeralSameThread = runEff $ do
49− assertThrowsUnliftError "ExceededNumberOfUses error" $ do
50− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
51− withEffToIO $ \runInIO -> inThread $ do
52− runInIO $ return ()
53− runInIO $ return ()
54−
55−test_ephemeralMultipleThreads :: Assertion
56−test_ephemeralMultipleThreads = runEff $ do
57− assertThrowsUnliftError "ExceededNumberOfUses error" $ do
58− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
59− withEffToIO $ \runInIO -> do
60− inThread $ runInIO $ return ()
61− inThread $ runInIO $ return ()
62−
63−test_persistentInvalid :: Assertion
64−test_persistentInvalid = runEff $ do
65− assertThrowsUnliftError "InvalidNumberOfThreads error" $ do
66− withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do
67− withEffToIO $ \_ -> return ()
68−
69−test_persistentSameThread :: Assertion
70−test_persistentSameThread = runEff $ do
71− withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
72− withEffToIO $ \runInIO -> inThread $ do
73− runInIO $ return ()
74− runInIO $ return ()
75−
76−test_persistentMultipleThreads :: Assertion
77−test_persistentMultipleThreads = runEff $ do
78− assertThrowsUnliftError "ExceededNumberOfThreads error" $ do
79− withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
80− withEffToIO $ \runInIO -> do
81− inThread $ runInIO $ return ()
82− inThread $ runInIO $ return ()
83−
84−----------------------------------------
85−-- Helpers
86−
87−assertThrowsUnliftError
88− :: IOE :> es
89− => String -> Eff es a -> Eff es ()
90−assertThrowsUnliftError err = U.assertThrows err (\ErrorCall{} -> True)
91−
92−inThread :: IO a -> IO a
93−inThread k = A.async k >>= A.wait
effectful/tests/Utils.hs−17
@@ -2,12 +2,10 @@ module Utils
22 ( assertBool
33 , assertEqual
44 , assertFailure
5− , assertThrows
65 , Ex(..)
76 ) where
87
98import Control.Exception
10−import Control.Monad
119import GHC.Stack
1210import qualified Test.Tasty.HUnit as T
1311
@@ -27,20 +25,5 @@ assertEqual msg expected given = liftIO $ T.assertEqual msg expected given
2725assertFailure :: (HasCallStack, IOE :> es) => String -> Eff es a
2826assertFailure msg = liftIO $ T.assertFailure msg
2927
30−assertThrows
31− :: (Exception e, IOE :> es)
32− => String
33− -> (e -> Bool)
34− -> Eff es a
35− -> Eff es ()
36−assertThrows msg p k = withEffToIO $ \runInIO -> do
37− let k' = do
38− void $ runInIO k
39− T.assertFailure msg
40−
41− k' `catch` \e -> if p e
42− then return ()
43− else throwIO e
44−
4528data Ex = Ex deriving (Eq, Show)
4629instance Exception Ex