on master help sign in
42 files changed+893−617
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml+19−18 README.md+2−2 cabal.haskell-ci+1−3 doctest.sh+2−1 effectful-core/effectful-core.cabal+13−10 effectful/src/Effectful.hs → effectful-core/src/Effectful.hs+3−4 effectful-core/src/Effectful/Dispatch/Dynamic.hs+41−29 effectful-core/src/Effectful/Dispatch/Static.hs+52−21 effectful-core/src/Effectful/Error.hs+94−23 effectful-core/src/Effectful/Fail.hs+1 effectful-core/src/Effectful/Internal/Effect.hs+7−23 effectful-core/src/Effectful/Internal/Env.hs+51−32 effectful-core/src/Effectful/Internal/Monad.hs+120−143 effectful-core/src/Effectful/Internal/Unlift.hs+35−78 effectful-core/src/Effectful/Monad.hs−1 effectful-core/src/Effectful/Prim.hs+1 effectful-core/src/Effectful/Reader.hs+4−4 effectful-core/src/Effectful/State/Dynamic.hs+1−1 effectful-core/src/Effectful/State/Local.hs+34−13 effectful-core/src/Effectful/State/Shared.hs+61−12 effectful-core/src/Effectful/Writer/Local.hs+26−13 effectful-core/src/Effectful/Writer/Shared.hs+55−7 effectful/bench/Main.hs+3−3 effectful/effectful.cabal+15−15 effectful/src/Effectful/Concurrent.hs+15−2 effectful/src/Effectful/Concurrent/Async.hs+2−2 effectful/src/Effectful/Concurrent/Chan.hs+5−1 effectful/src/Effectful/Concurrent/Effect.hs+65−5 effectful/src/Effectful/Concurrent/MVar.hs+5−1 effectful/src/Effectful/Concurrent/QSem.hs+6−2 effectful/src/Effectful/Concurrent/QSemN.hs+6−2 effectful/src/Effectful/Concurrent/STM.hs+5−2 effectful/src/Effectful/Environment.hs+3−3 effectful/src/Effectful/FileSystem.hs+89−89 effectful/src/Effectful/FileSystem/Effect.hs+1−1 effectful/src/Effectful/FileSystem/IO.hs+2 effectful/src/Effectful/Process.hs+3−4 effectful/src/Effectful/Resource.hs+4−4 effectful/src/Effectful/Temporary.hs+1−1 effectful/src/Effectful/Timeout.hs+1−1 effectful/tests/EnvironmentTests.hs+11−6 effectful/tests/UnliftTests.hs+28−35
.github/workflows/haskell-ci.yml+19−18
@@ -8,9 +8,9 @@
88#
99# For more information, see https://github.com/haskell-CI/haskell-ci
1010#
11−# version: 0.13.20211030
11+# version: 0.13.20211116
1212#
13−# REGENDATA ("0.13.20211030",["github","--config=cabal.haskell-ci","cabal.project"])
13+# REGENDATA ("0.13.20211116",["github","--config=cabal.haskell-ci","cabal.project"])
1414#
1515name: Haskell-CI
1616on:
@@ -24,6 +24,8 @@ jobs:
2424 linux:
2525 name: Haskell-CI - Linux - ${{ matrix.compiler }}
2626 runs-on: ubuntu-18.04
27+ timeout-minutes:
28+ 60
2729 container:
2830 image: buildpack-deps:bionic
2931 continue-on-error: ${{ matrix.allow-failure }}
@@ -35,11 +37,6 @@ jobs:
3537 compilerVersion: 9.2.1
3638 setup-method: ghcup
3739 allow-failure: false
38− - compiler: ghc-9.0.1
39− compilerKind: ghc
40− compilerVersion: 9.0.1
41− setup-method: hvr-ppa
42− allow-failure: false
4340 - compiler: ghc-8.10.7
4441 compilerKind: ghc
4542 compilerVersion: 8.10.7
@@ -129,6 +126,10 @@ jobs:
129126 repository hackage.haskell.org
130127 url: http://hackage.haskell.org/
131128 EOF
129+ cat >> $CABAL_CONFIG <<EOF
130+ program-default-options
131+ ghc-options: $GHCJOBS +RTS -M3G -RTS
132+ EOF
132133 cat $CABAL_CONFIG
133134 - name: versions
134135 run: |
@@ -141,7 +142,7 @@ jobs:
141142 - name: cache (tools)
142143 uses: actions/cache@v2
143144 with:
144− key: ${{ runner.os }}-${{ matrix.compiler }}-tools-b692a344
145+ key: ${{ runner.os }}-${{ matrix.compiler }}-tools-16fe7d6d
145146 path: ~/.haskell-ci-tools
146147 - name: install cabal-plan
147148 run: |
@@ -154,8 +155,8 @@ jobs:
154155 cabal-plan --version
155156 - name: install doctest
156157 run: |
157− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.18' ; fi
158− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then doctest --version ; fi
158+ $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.20'
159+ doctest --version
159160 - name: checkout
160161 uses: actions/checkout@v2
161162 with:
@@ -163,8 +164,8 @@ jobs:
163164 - name: initial cabal.project for sdist
164165 run: |
165166 touch cabal.project
166− echo "packages: $GITHUB_WORKSPACE/source/./effectful" >> cabal.project
167− echo "packages: $GITHUB_WORKSPACE/source/./effectful-core" >> cabal.project
167+ echo "packages: $GITHUB_WORKSPACE/source/effectful" >> cabal.project
168+ echo "packages: $GITHUB_WORKSPACE/source/effectful-core" >> cabal.project
168169 cat cabal.project
169170 - name: sdist
170171 run: |
@@ -221,12 +222,12 @@ jobs:
221222 $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
222223 - name: doctest
223224 run: |
224− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cd ${PKGDIR_effectful} || false ; fi
225− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi
226− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cd ${PKGDIR_effectful_core} || false ; fi
227− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src ; fi
228− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cd ${PKGDIR_effectful_core} || false ; fi
229− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators utils ; fi
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
230231 - name: cabal check
231232 run: |
232233 cd ${PKGDIR_effectful} || false
README.md+2−2
@@ -20,8 +20,8 @@ Main features:
2020
21212. Easy to use API (no boilerplate code and dealing with arcane types).
2222
23−3. Correct semantics in presence of runtime exceptions (no more lost or
24− discarded state).
23+3. Correct semantics in presence of runtime exceptions (no more lost state
24+ modifications).
2525
26264. Seamless integration with the existing ecosystem (`exceptions`,
2727 `monad-control`, `unliftio-core`, `resourcet` etc.).
cabal.haskell-ci+1−3
@@ -1,11 +1,9 @@
11branches: master
22
3−doctest: <9.2
3+doctest: <9.3
44tests: True
55benchmarks: True
66
7−ghcup-jobs: ==8.10.7 || >=9.2
8−
97raw-project
108 package effectful
119 flags: +benchmark-foreign-libraries
doctest.sh+2−1
@@ -17,6 +17,7 @@ run_doctest() {
1717 -XConstraintKinds \
1818 -XDataKinds \
1919 -XDeriveFunctor \
20+ -XDeriveGeneric \
2021 -XFlexibleContexts \
2122 -XFlexibleInstances \
2223 -XGADTs \
@@ -36,5 +37,5 @@ run_doctest() {
3637 popd
3738}
3839
39−run_doctest effectful src
4040run_doctest effectful-core src
41+run_doctest effectful src
effectful-core/effectful-core.cabal+13−10
@@ -18,7 +18,7 @@ description: An easy to use, performant extensible effects library with seamless
1818
1919extra-source-files: CHANGELOG.md
2020
21−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1
21+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1
2222
2323bug-reports: https://github.com/arybczak/effectful/issues
2424source-repository head
@@ -34,6 +34,7 @@ common language
3434 ConstraintKinds
3535 DataKinds
3636 DeriveFunctor
37+ DeriveGeneric
3738 FlexibleContexts
3839 FlexibleInstances
3940 GADTs
@@ -66,18 +67,20 @@ library
6667
6768 ghc-options: -O2
6869
69− build-depends: base >= 4.13 && <5
70− , containers
71− , effectful-internal-utils
72− , exceptions
73− , monad-control
74− , primitive
75− , transformers-base
76− , unliftio-core
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
7779
7880 hs-source-dirs: src
7981
80− exposed-modules: Effectful.Dispatch.Dynamic
82+ exposed-modules: Effectful
83+ Effectful.Dispatch.Dynamic
8184 Effectful.Dispatch.Static
8285 Effectful.Error
8386 Effectful.Error.Dynamic
effectful/src/Effectful.hs → effectful-core/src/Effectful.hsrenamed+3−4
@@ -8,10 +8,10 @@ module Effectful
88
99 -- * Running the 'Eff' monad
1010
11− -- ** Pure operations
11+ -- ** Pure computations
1212 , runPureEff
1313
14− -- ** Operations with side effects
14+ -- ** Computations with side effects
1515 , IOE
1616 , runEff
1717
@@ -22,7 +22,6 @@ module Effectful
2222 , unliftStrategy
2323 , withUnliftStrategy
2424 , withEffToIO
25− , UnliftError(..)
2625
2726 -- * 'Effect' handlers
2827
@@ -33,7 +32,7 @@ module Effectful
3332 , interpret
3433 , reinterpret
3534
36− -- ** Handling local 'Eff' operations
35+ -- ** Handling local 'Eff' computations
3736 , LocalEnv
3837
3938 -- *** Unlifts
effectful-core/src/Effectful/Dispatch/Dynamic.hs+41−29
@@ -7,7 +7,7 @@ module Effectful.Dispatch.Dynamic
77 , interpret
88 , reinterpret
99
10− -- ** Handling local 'Eff' operations
10+ -- ** Handling local 'Eff' computations
1111 , LocalEnv
1212
1313 -- *** Unlifts
@@ -32,7 +32,8 @@ module Effectful.Dispatch.Dynamic
3232 ) where
3333
3434import Control.Monad.IO.Unlift
35−import GHC.Stack
35+import Data.Kind
36+import GHC.Stack (HasCallStack)
3637
3738import Effectful.Internal.Effect
3839import Effectful.Internal.Env
@@ -49,7 +50,7 @@ interpret
4950 -> Eff es a
5051interpret handler m = unsafeEff $ \es -> do
5152 les <- forkEnv es
52− (`unEff` es) $ runHandler (Handler les handler) m
53+ (`unEff` es) $ runHandler (HandlerA les handler) m
5354
5455-- | Interpret an effect using other effects.
5556reinterpret
@@ -62,7 +63,7 @@ reinterpret
6263reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
6364 les0 <- forkEnv es
6465 (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do
65− (`unEff` es) $ runHandler (Handler les handler) m
66+ (`unEff` es) $ runHandler (HandlerA les handler) m
6667
6768----------------------------------------
6869-- Unlifts
@@ -77,7 +78,7 @@ localSeqUnlift
7778 -- ^ Continuation with the unlifting function in scope.
7879 -> Eff es a
7980localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
80− seqUnliftEff les $ \unlift -> do
81+ seqUnliftIO les $ \unlift -> do
8182 (`unEff` es) $ k $ unsafeEff_ . unlift
8283
8384-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
@@ -89,7 +90,7 @@ localSeqUnliftIO
8990 -> ((forall r. Eff localEs r -> IO r) -> IO a)
9091 -- ^ Continuation with the unlifting function in scope.
9192 -> Eff es a
92−localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftEff les k
93+localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftIO les k
9394
9495-- | Create a local unlifting function with the given strategy.
9596localUnlift
@@ -102,10 +103,10 @@ localUnlift
102103 -> Eff es a
103104localUnlift (LocalEnv les) strategy k = case strategy of
104105 SeqUnlift -> unsafeEff $ \es -> do
105− seqUnliftEff les $ \unlift -> do
106+ seqUnliftIO les $ \unlift -> do
106107 (`unEff` es) $ k $ unsafeEff_ . unlift
107108 ConcUnlift p l -> unsafeEff $ \es -> do
108− concUnliftEff les p l $ \unlift -> do
109+ concUnliftIO les p l $ \unlift -> do
109110 (`unEff` es) $ k $ unsafeEff_ . unlift
110111
111112-- | Create a local unlifting function with the given strategy.
@@ -118,10 +119,10 @@ localUnliftIO
118119 -- ^ Continuation with the unlifting function in scope.
119120 -> Eff es a
120121localUnliftIO (LocalEnv les) strategy k = case strategy of
121− SeqUnlift -> liftIO $ seqUnliftEff les k
122− ConcUnlift p l -> liftIO $ concUnliftEff les p l k
122+ SeqUnlift -> liftIO $ seqUnliftIO les k
123+ ConcUnlift p l -> liftIO $ concUnliftIO les p l k
123124
124−-- | Utility for lifting 'Eff' operations of type
125+-- | Utility for lifting 'Eff' computations of type
125126--
126127-- @'Eff' es a -> 'Eff' es b@
127128--
@@ -129,7 +130,7 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of
129130--
130131-- @'Eff' localEs a -> 'Eff' localEs b@
131132--
132−-- /Note:/ the operation must not run its argument in a separate thread,
133+-- /Note:/ the computation must not run its argument in a separate thread,
133134-- attempting to do so will result in a runtime error.
134135withLiftMap
135136 :: (HasCallStack, SuffixOf es handlerEs)
@@ -142,10 +143,10 @@ withLiftMap !_ k = unsafeEff $ \es -> do
142143 -- The LocalEnv parameter is not used, but we need it to constraint the
143144 -- localEs type variable. It's also strict so that callers don't cheat.
144145 (`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
145− seqUnliftEff localEs $ \unlift -> do
146+ seqUnliftIO localEs $ \unlift -> do
146147 (`unEff` es) . mapEff . unsafeEff_ $ unlift m
147148
148−-- | Utility for lifting 'IO' operations of type
149+-- | Utility for lifting 'IO' computations of type
149150--
150151-- @'IO' a -> 'IO' b@
151152--
@@ -153,11 +154,11 @@ withLiftMap !_ k = unsafeEff $ \es -> do
153154--
154155-- @'Eff' localEs a -> 'Eff' localEs b@
155156--
156−-- /Note:/ the operation must not run its argument in a separate thread,
157+-- /Note:/ the computation must not run its argument in a separate thread,
157158-- attempting to do so will result in a runtime error.
158159--
159160-- Useful e.g. for lifting the unmasking function in
160−-- 'Control.Exception.mask'-like operations:
161+-- 'Control.Exception.mask'-like computations:
161162--
162163-- >>> :{
163164-- data Fork :: Effect where
@@ -180,17 +181,17 @@ withLiftMapIO
180181withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do
181182 -- The LocalEnv parameter is not used, but we need it to constraint the
182183 -- localEs type variable. It's also strict so that callers don't cheat.
183− seqUnliftEff es $ \unlift -> mapIO $ unlift m
184+ seqUnliftIO es $ \unlift -> mapIO $ unlift m
184185
185186----------------------------------------
186187-- Bidirectional lifts
187188
188189-- | Create a local lifting and unlifting function with the given strategy.
189190--
190−-- Useful for lifting complicated 'Eff' operations where the monadic action
191+-- Useful for lifting complicated 'Eff' computations where the monadic action
191192-- shows in both positive (as a result) and negative (as an argument) position.
192193--
193−-- /Note:/ depending on the operation you're lifting 'localUnlift' along with
194+-- /Note:/ depending on the computation you're lifting 'localUnlift' along with
194195-- 'withLiftMap' might be enough and is more efficient.
195196localLiftUnlift
196197 :: (HasCallStack, SuffixOf es handlerEs)
@@ -202,22 +203,22 @@ localLiftUnlift
202203 -> Eff es a
203204localLiftUnlift (LocalEnv les) strategy k = case strategy of
204205 SeqUnlift -> unsafeEff $ \es -> do
205− seqUnliftEff es $ \unliftEs -> do
206− seqUnliftEff les $ \unliftLocalEs -> do
206+ seqUnliftIO es $ \unliftEs -> do
207+ seqUnliftIO les $ \unliftLocalEs -> do
207208 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
208209 ConcUnlift p l -> unsafeEff $ \es -> do
209− concUnliftEff es p l $ \unliftEs -> do
210− concUnliftEff les p l $ \unliftLocalEs -> do
210+ concUnliftIO es p l $ \unliftEs -> do
211+ concUnliftIO les p l $ \unliftLocalEs -> do
211212 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
212213
213214-- | Create a local unlifting function with the given strategy along with an
214215-- unrestricted lifting function.
215216--
216−-- Useful for lifting complicated 'IO' operations where the monadic action shows
217−-- in both positive (as a result) and negative (as an argument) position.
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.
218219--
219−-- /Note:/ depending on the operation you're lifting 'localUnliftIO' along with
220−-- 'withLiftMapIO' might be enough and is more efficient.
220+-- /Note:/ depending on the computation you're lifting 'localUnliftIO' along
221+-- with 'withLiftMapIO' might be enough and is more efficient.
221222localLiftUnliftIO
222223 :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
223224 => LocalEnv localEs handlerEs
@@ -227,8 +228,19 @@ localLiftUnliftIO
227228 -- ^ Continuation with the lifting and unlifting function in scope.
228229 -> Eff es a
229230localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
230− SeqUnlift -> liftIO $ seqUnliftEff les $ k unsafeEff_
231− ConcUnlift p l -> liftIO $ concUnliftEff les p l $ k unsafeEff_
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
232244
233245-- $setup
234246-- >>> import Control.Concurrent
effectful-core/src/Effectful/Dispatch/Static.hs+52−21
@@ -1,18 +1,29 @@
11module Effectful.Dispatch.Static
22 ( -- * Low level API
3− IdE(..)
3+ DataA(..)
44
5− -- ** Running
6− , runEffect
7− , evalEffect
8− , execEffect
5+ -- ** Extending the environment
6+ , runData
7+ , evalData
8+ , execData
99
10− -- ** Modification
11− , getEffect
12− , putEffect
13− , stateEffect
14− , stateEffectM
15− , localEffect
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
1627
1728 -- * Primitive API
1829 , Env
@@ -35,17 +46,37 @@ module Effectful.Dispatch.Static
3546 , putEnv
3647 , stateEnv
3748 , modifyEnv
38−
39− -- * Unsafe 'Eff' operations
40− , unsafeEff
41− , unsafeEff_
42− , unsafeLiftMapIO
43− , unsafeUnliftIO
44−
45− -- * Utils
46− , unEff
4749 ) where
4850
49−import Effectful.Internal.Effect
5051import Effectful.Internal.Env
5152import 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+94−23
@@ -1,28 +1,78 @@
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.ErrorCall' you could use 'Control.Monad.Catch.catch':
10−
11−>>> import qualified Control.Monad.Catch as E
12−>>> :{
13− let boom :: Eff es String
14− boom = error "BOOM!"
15− in
16− runEff $ boom `E.catch` \(e :: ErrorCall) -> pure "caught some error"
17−:}
18−"caught some error"
19−
20−-}
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.
2170module Effectful.Error
2271 ( Error
2372 , runError
2473 , throwError
2574 , catchError
75+ , handleError
2676 , tryError
2777
2878 -- * Re-exports
@@ -40,9 +90,11 @@ import GHC.Stack
4090import Effectful.Dispatch.Static
4191import Effectful.Monad
4292
93+-- | Provide the ability to handle errors of type @e@.
4394newtype Error e :: Effect where
4495 Error :: ErrorId -> Error e m r
4596
97+-- | Handle errors of type @e@.
4698runError
4799 :: forall e es a. Typeable e
48100 => Eff (Error e : es) a
@@ -50,7 +102,7 @@ runError
50102runError m = unsafeEff $ \es0 -> mask $ \release -> do
51103 eid <- newErrorId
52104 size0 <- sizeEnv es0
53− es <- unsafeConsEnv (IdE (Error @e eid)) noRelinker es0
105+ es <- unsafeConsEnv (DataA (Error @e eid)) noRelinker es0
54106 r <- tryErrorIO release eid es `onException` unsafeTailEnv size0 es
55107 unsafeTailEnv size0 es
56108 pure r
@@ -60,29 +112,48 @@ runError m = unsafeEff $ \es0 -> mask $ \release -> do
60112 Left ex -> tryHandler ex eid (\cs e -> Left (cs, e))
61113 $ throwIO ex
62114
115+-- | Throw an error of type @e@.
63116throwError
64117 :: forall e es a. (HasCallStack, Typeable e, Error e :> es)
65118 => e
119+ -- ^ The error.
66120 -> Eff es a
67121throwError e = unsafeEff $ \es -> do
68− IdE (Error eid) <- getEnv @(Error e) es
122+ DataA (Error eid) <- getEnv @(Error e) es
69123 throwIO $ ErrorEx eid callStack e
70124
125+-- | Handle an error of type @e@.
71126catchError
72127 :: forall e es a. (Typeable e, Error e :> es)
73128 => Eff es a
129+ -- ^ The inner computation.
74130 -> (CallStack -> e -> Eff es a)
131+ -- ^ A handler for errors in the inner computation.
75132 -> Eff es a
76133catchError m handler = unsafeEff $ \es -> do
77− IdE (Error eid) <- getEnv @(Error e) es
134+ DataA (Error eid) <- getEnv @(Error e) es
78135 size <- sizeEnv es
79136 catchErrorIO eid (unEff m es) $ \cs e -> do
80137 checkSizeEnv size es
81138 unEff (handler cs e) es
82139
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.
83153tryError
84154 :: forall e es a. (Typeable e, Error e :> es)
85155 => Eff es a
156+ -- ^ The inner computation.
86157 -> Eff es (Either (CallStack, e) a)
87158tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)
88159
effectful-core/src/Effectful/Fail.hs+1
@@ -1,3 +1,4 @@
1+-- | Provider of the 'MonadFail' instance for 'Eff'.
12module Effectful.Fail
23 ( Fail(..)
34 , runFail
effectful-core/src/Effectful/Internal/Effect.hs+7−23
@@ -8,10 +8,6 @@
88module Effectful.Internal.Effect
99 ( Effect
1010 , (:>)(..)
11− , IdE(..)
12−
13− -- * Utils
14− , SuffixOf
1511
1612 -- * Re-exports
1713 , Type
@@ -23,20 +19,16 @@ import GHC.TypeLits
2319-- | The kind of effects.
2420type Effect = (Type -> Type) -> Type -> Type
2521
26−-- | An adapter for statically dispatched effects.
27−newtype IdE :: Effect -> Type where
28− IdE :: (forall m r. e m r) -> IdE e
29−
30−-- | A constraint that requires that a particular effect, @e@, is a member of
31−-- the type-level list @es@. This is used to parameterize an
32−-- 'Effectful.Monad.Eff' operation over an arbitrary list of effects, so long as
33−-- @e@ is /somewhere/ in the list.
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.
3426--
35−-- For example, an operation that only needs access to a cell of mutable state
36−-- containing an 'Integer' would likely use the following type:
27+-- For example, a computation that only needs access to a mutable value of type
28+-- 'Integer' would likely use the following type:
3729--
3830-- @
39−-- 'Effectful.State.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
31+-- 'Effectful.State.Local.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
4032-- @
4133class (e :: Effect) :> (es :: [Effect]) where
4234 -- | Get the position of @e@ in @es@.
@@ -59,11 +51,3 @@ instance {-# OVERLAPPING #-} e :> (e : es) where
5951
6052instance e :> es => e :> (x : es) where
6153 reifyIndex = 1 + reifyIndex @e @es
62−
63−-- | Require that the second list of effects is a suffix of the first one.
64−--
65−-- In other words, 'SuffixOf' @es@ @baseEs@ means "a suffix of @es@ is
66−-- @baseEs@".
67−type family SuffixOf (es :: [Effect]) (baseEs :: [Effect]) :: Constraint where
68− SuffixOf baseEs baseEs = ()
69− SuffixOf (e : es) baseEs = SuffixOf es baseEs
effectful-core/src/Effectful/Internal/Env.hs+51−32
@@ -1,25 +1,38 @@
1+{-# LANGUAGE MagicHash #-}
12{-# OPTIONS_HADDOCK not-home #-}
23-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.
34--
45-- This module is intended for internal use only, and may change without warning
56-- in subsequent releases.
67module Effectful.Internal.Env
7− ( 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
821 , Relinker(..)
922 , noRelinker
1023
11− -- * Operations
24+ -- * Operations
1225 , emptyEnv
1326 , cloneEnv
1427 , forkEnv
1528 , sizeEnv
1629 , checkSizeEnv
1730
18− -- ** Extending and shrinking
31+ -- ** Extending and shrinking
1932 , unsafeConsEnv
2033 , unsafeTailEnv
2134
22− -- ** Data retrieval and update
35+ -- ** Data retrieval and update
2336 , getEnv
2437 , putEnv
2538 , stateEnv
@@ -30,7 +43,7 @@ import Control.Monad
3043import Control.Monad.Primitive
3144import Data.IORef
3245import Data.Primitive.SmallArray
33−import GHC.Exts (Any)
46+import GHC.Exts (Any, SmallMutableArray#)
3447import GHC.Stack (HasCallStack)
3548import Unsafe.Coerce
3649import qualified Data.IntMap.Strict as IM
@@ -68,17 +81,17 @@ type role Env nominal
6881-- @
6982--
7083-- The point of execution is currently at (*), i.e. the mainline. Moreover,
71−-- currently:
84+-- currently (brackets represent forks):
7285--
7386-- - Mainline sees @[e00, e01, e05, e07]@.
7487--
75−-- - @e01@ is an interpreted effect, its handler sees @[e00, e02, e03]@.
88+-- - @e01@ is an interpreted effect, its handler sees @[e00][e02, e03]@.
7689--
77−-- - @e03@ is an interpreted effect, its handler sees @[e00, e02, e04]@.
90+-- - @e03@ is an interpreted effect, its handler sees @[e00][e02][e04]@.
7891--
79−-- - @e05@ is an interpreted effect, its handler sees @[e00, e01, e06]@.
92+-- - @e05@ is an interpreted effect, its handler sees @[e00, e01][e06]@.
8093--
81−-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05, e08,
94+-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05][e08,
8295-- e09]@.
8396--
8497-- If an operation from @e01@ is invoked, the environment in the middle of
@@ -101,11 +114,11 @@ type role Env nominal
101114-- introduced @e12@), so its local environment was temporarily extended with
102115-- it. Moreover, currently:
103116--
104−-- - Handler of @e01@ sees @[e00, e02, e03, e10]@.
117+-- - Handler of @e01@ sees @[e00][e02, e03, e10]@.
105118--
106−-- - Handler of @e10@ sees @[e00, e02, e03, e11]@.
119+-- - Handler of @e10@ sees @[e00][e02, e03][e11]@.
107120--
108−-- - Handler of @e11@ sees @[e00, e02, e03, e12]@.
121+-- - Handler of @e11@ sees @[e00][e02, e03][e12]@.
109122--
110123data Env (es :: [Effect]) = Env
111124 { _forks :: !Forks
@@ -116,6 +129,7 @@ data Env (es :: [Effect]) = Env
116129-- | Local forks of the environment.
117130data Forks = Forks !ForkId !Int !(IORef EnvRef) Forks | NoFork
118131
132+-- | Data held in the environment.
119133data EnvRef = EnvRef
120134 { _size :: !Int
121135 , _data :: !(SmallMutableArray RealWorld Any)
@@ -125,6 +139,7 @@ data EnvRef = EnvRef
125139----------------------------------------
126140-- ForkId
127141
142+-- | Internal id of the fork.
128143newtype ForkId = ForkId { unForkId :: Int }
129144
130145-- | 'ForkId' generation.
@@ -403,43 +418,43 @@ unsafeTailEnv len (Env fork gref _) = case fork of
403418
404419-- | Extract a specific data type from the environment.
405420getEnv
406− :: forall e es adapter. e :> es
421+ :: forall e adapter es. e :> es
407422 => Env es
408423 -> IO (adapter e)
409424getEnv env = do
410− (i, es) <- getLocation (reifyIndex @e @es) env
425+ Location i es <- getLocation (reifyIndex @e @es) env
411426 fromAny <$> readSmallArray es i
412427
413428-- | Replace the data type in the environment with a new value (in place).
414429putEnv
415− :: forall e es adapter. e :> es
430+ :: forall e adapter es. e :> es
416431 => Env es
417432 -> adapter e
418433 -> IO ()
419434putEnv env e = do
420− (i, es) <- getLocation (reifyIndex @e @es) env
435+ Location i es <- getLocation (reifyIndex @e @es) env
421436 e `seq` writeSmallArray es i (toAny e)
422437
423438-- | Modify the data type in the environment (in place) and return a value.
424439stateEnv
425− :: forall e es adapter a. e :> es
440+ :: forall e adapter es a. e :> es
426441 => Env es
427442 -> (adapter e -> (a, adapter e))
428443 -> IO a
429444stateEnv env f = do
430− (i, es) <- getLocation (reifyIndex @e @es) env
445+ Location i es <- getLocation (reifyIndex @e @es) env
431446 (a, e) <- f . fromAny <$> readSmallArray es i
432447 e `seq` writeSmallArray es i (toAny e)
433448 pure a
434449
435450-- | Modify the data type in the environment (in place).
436451modifyEnv
437− :: forall e es adapter. e :> es
452+ :: forall e adapter es. e :> es
438453 => Env es
439454 -> (adapter e -> adapter e)
440455 -> IO ()
441456modifyEnv env f = do
442− (i, es) <- getLocation (reifyIndex @e @es) env
457+ Location i es <- getLocation (reifyIndex @e @es) env
443458 e <- f . fromAny <$> readSmallArray es i
444459 e `seq` writeSmallArray es i (toAny e)
445460
@@ -455,13 +470,17 @@ emptyEnvRef = do
455470 fs <- newSmallArray 0 undefinedData
456471 newIORef $ EnvRef 0 es fs
457472
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+
458477-- | Determine location of the data type in the environment.
459478getLocation
460479 :: Int
461480 -> Env es
462− -> IO (Int, SmallMutableArray RealWorld Any)
481+ -> IO Location
463482getLocation ixE (Env fork ref _) = do
464− EnvRef n es _ <- readIORef ref
483+ EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref
465484 -- Optimized for the common access pattern:
466485 --
467486 -- - Most application code has no access to forks, in which case we look at
@@ -470,25 +489,25 @@ getLocation ixE (Env fork ref _) = do
470489 -- - Effect handlers will most likely access the newest fork with handler
471490 -- specific effects for reinterpretation.
472491 case fork of
473− NoFork -> pure (ix n, es)
492+ NoFork -> pure $ Location (ix n) es
474493 Forks _ baseIx lref forks -> do
475494 EnvRef ln les _ <- readIORef lref
476495 let i = ix (baseIx + ln)
477496 if i >= baseIx
478− then pure (i - baseIx, les)
479− else go es i forks
497+ then pure $ Location (i - baseIx) les
498+ else go es# i forks
480499 where
481− go :: SmallMutableArray RealWorld Any
500+ go :: SmallMutableArray# RealWorld Any
482501 -> Int
483502 -> Forks
484− -> IO (Int, SmallMutableArray RealWorld Any)
485− go es i = \case
486− NoFork -> pure (i, es)
503+ -> IO Location
504+ go es# i = \case
505+ NoFork -> pure $ Location i (SmallMutableArray es#)
487506 Forks _ baseIx lref forks -> do
488507 EnvRef _ les _ <- readIORef lref
489508 if i >= baseIx
490− then pure (i - baseIx, les)
491− else go es i forks
509+ then pure $ Location (i - baseIx) les
510+ else go es# i forks
492511
493512 ix :: Int -> Int
494513 ix n = n - ixE - 1
effectful-core/src/Effectful/Internal/Monad.hs+120−143
@@ -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− ( -- * Monad
9+ ( -- * The 'Eff' monad
1010 Eff
1111 , runPureEff
1212
@@ -22,49 +22,41 @@ module Effectful.Internal.Monad
2222 , IOE
2323 , runEff
2424
25− -- * Primitive
25+ -- * Prim
2626 , Prim
2727 , runPrim
2828
29− -- ** Unlift strategies
29+ -- * Unlift strategies
3030 , UnliftStrategy(..)
3131 , Persistence(..)
3232 , Limit(..)
3333 , unliftStrategy
3434 , withUnliftStrategy
3535 , withEffToIO
36− , UnliftError(..)
3736
38− --- *** Low-level helpers
39− , unsafeLiftMapIO
40− , unsafeUnliftIO
41− , seqUnliftEff
42− , concUnliftEff
37+ -- ** Low-level unlifts
38+ , seqUnliftIO
39+ , concUnliftIO
4340
4441 -- * Effects
4542
46− -- ** Handler
43+ -- ** Dynamic dispatch
4744 , EffectHandler
4845 , LocalEnv(..)
49− , Handler(..)
46+ , HandlerA(..)
5047 , runHandler
51−
52− -- *** Sending operations
5348 , send
5449
55− -- ** Primitive
56−
57− -- *** Running
58− , runEffect
59− , evalEffect
60− , execEffect
61−
62− -- *** Modification
63− , getEffect
64− , putEffect
65− , stateEffect
66− , stateEffectM
67− , localEffect
50+ -- ** Static dispatch
51+ , DataA(..)
52+ , runData
53+ , evalData
54+ , execData
55+ , getData
56+ , putData
57+ , stateData
58+ , stateDataM
59+ , localData
6860 ) where
6961
7062import Control.Applicative (liftA2)
@@ -87,44 +79,43 @@ import Effectful.Internal.Unlift
8779
8880type role Eff nominal representational
8981
90−-- | The 'Eff' monad provides the implementation of an operation that performs
82+-- | The 'Eff' monad provides the implementation of a computation that performs
9183-- an arbitrary set of effects. In @'Eff' es a@, @es@ is a type-level list that
92−-- contains all the effects that the operation may perform. For example, an
93−-- operation that produces an 'Integer' by consuming a 'String' from the global
94−-- environment and acting upon a single mutable cell containing a 'Bool' would
95−-- have the following type:
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:
9688--
9789-- @
98−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
90+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
9991-- @
10092--
10193-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
10294-- Instead, the '(:>)' type class is used to express constraints on the list of
103−-- effects without coupling an operation to a concrete list of effects. For
104−-- example, the above example would more commonly be expressed with the
105−-- following type:
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:
10697--
10798-- @
108−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
99+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
109100-- @
110101--
111−-- This abstraction allows the operation to be used in functions that may
102+-- This abstraction allows the computation to be used in functions that may
112103-- perform other effects, and it also allows the effects to be handled in any
113104-- order.
114105newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
115106 deriving (Monoid, Semigroup)
116107
117−-- | Run a pure 'Eff' operation.
108+-- | Run a pure 'Eff' computation.
118109--
119−-- For running operations with side effects see 'runEff'.
110+-- For running computations with side effects see 'runEff'.
120111runPureEff :: Eff '[] a -> a
121112runPureEff (Eff m) =
122− -- unsafePerformIO is safe here since IOE was not on the stack, so no IO with
123− -- side effects was performed (unless someone sneakily introduced side effects
124− -- with unsafeEff, but then all bets are off).
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).
125116 --
126117 -- Moreover, internals don't allocate any resources that require explicit
127− -- cleanup actions to run, so the "Dupable" part should also be just fine.
118+ -- cleanup actions to run.
128119 unsafeDupablePerformIO $ m =<< emptyEnv
129120
130121----------------------------------------
@@ -137,84 +128,29 @@ unEff (Eff m) = m
137128-- | Access the underlying 'IO' monad along with the environment.
138129--
139130-- This function is __unsafe__ because it can be used to introduce arbitrary
140−-- 'IO' actions into pure 'Eff' operations.
131+-- 'IO' actions into pure 'Eff' computations.
141132unsafeEff :: (Env es -> IO a) -> Eff es a
142133unsafeEff m = Eff (oneShot m)
143134
144135-- | Access the underlying 'IO' monad.
145136--
146137-- This function is __unsafe__ because it can be used to introduce arbitrary
147−-- 'IO' actions into pure 'Eff' operations.
138+-- 'IO' actions into pure 'Eff' computations.
148139unsafeEff_ :: IO a -> Eff es a
149140unsafeEff_ m = unsafeEff $ \_ -> m
150141
151−-- | Utility for lifting 'IO' operations of type
152−--
153−-- @'IO' a -> 'IO' b@
154−--
155−-- to
156−--
157−-- @'Eff' es a -> 'Eff' es b@
158−--
159−-- This function is __unsafe__ because:
160−--
161−-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
162−-- operations.
163−--
164−-- - The 'IO' operation must not run its argument in a separate thread, but it's
165−-- not checked anywhere.
166−unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
167−unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
168−
169−-- | Utility for running 'Eff' computations locally in the 'IO' monad.
170−--
171−-- This function is __unsafe__ because:
172−--
173−-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
174−-- operations.
175−--
176−-- - Unlifted 'Eff' operations must not be run in a thread distinct from the
177−-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
178−unsafeUnliftIO
179− :: HasCallStack
180− => ((forall r. Eff es r -> IO r) -> IO a)
181− -> Eff es a
182−unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)
183−
184142----------------------------------------
185−-- Unlifting Eff
143+-- Unlifting IO
186144
187145-- | Get the current 'UnliftStrategy'.
188146unliftStrategy :: IOE :> es => Eff es UnliftStrategy
189147unliftStrategy = do
190− IdE (IOE unlift) <- getEffect
148+ DataA (IOE unlift) <- getData
191149 pure unlift
192150
193151-- | Locally override the 'UnliftStrategy' with the given value.
194152withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
195−withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
196−
197−-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
198−--
199−-- Exceptions thrown by this function:
200−--
201−-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
202−seqUnliftEff
203− :: HasCallStack
204− => Env es
205− -> ((forall r. Eff es r -> IO r) -> IO a)
206− -> IO a
207−seqUnliftEff es k = seqUnliftIO k es unEff
208−
209−-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
210−concUnliftEff
211− :: HasCallStack
212− => Env es
213− -> Persistence
214− -> Limit
215− -> ((forall r. Eff es r -> IO r) -> IO a)
216− -> IO a
217−concUnliftEff es persistence limit k = concUnliftIO persistence limit k es unEff
153+withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)
218154
219155-- | Create an unlifting function with the current 'UnliftStrategy'.
220156--
@@ -222,16 +158,38 @@ concUnliftEff es persistence limit k = concUnliftIO persistence limit k es unEff
222158-- constraint for accurate stack traces in case an insufficiently powerful
223159-- 'UnliftStrategy' is used and the unlifting function fails.
224160--
225−-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
161+-- /Note:/ the strategy is reset to 'SeqUnlift' inside the continuation.
226162withEffToIO
227163 :: (HasCallStack, IOE :> es)
228164 => ((forall r. Eff es r -> IO r) -> IO a)
229165 -- ^ Continuation with the unlifting function in scope.
230166 -> Eff es a
231167withEffToIO f = unliftStrategy >>= \case
232− SeqUnlift -> unsafeEff $ \es -> seqUnliftEff es f
168+ SeqUnlift -> unsafeEff $ \es -> seqUnliftIO es f
233169 ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
234− unsafeEff $ \es -> concUnliftEff es p b f
170+ unsafeEff $ \es -> concUnliftIO es p b f
171+
172+-- | Create an unlifting function with the 'SeqUnlift' strategy.
173+seqUnliftIO
174+ :: HasCallStack
175+ => Env es
176+ -- ^ The environment.
177+ -> ((forall r. Eff es r -> IO r) -> IO a)
178+ -- ^ Continuation with the unlifting function in scope.
179+ -> IO a
180+seqUnliftIO es k = seqUnlift k es unEff
181+
182+-- | Create an unlifting function with the 'ConcUnlift' strategy.
183+concUnliftIO
184+ :: HasCallStack
185+ => Env es
186+ -- ^ The environment.
187+ -> Persistence
188+ -> Limit
189+ -> ((forall r. Eff es r -> IO r) -> IO a)
190+ -- ^ Continuation with the unlifting function in scope.
191+ -> IO a
192+concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
235193
236194----------------------------------------
237195-- Base
@@ -300,15 +258,15 @@ instance Fail :> es => MonadFail (Eff es) where
300258----------------------------------------
301259-- IO
302260
303−-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.
261+-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
304262newtype IOE :: Effect where
305263 IOE :: UnliftStrategy -> IOE m r
306264
307−-- | Run an 'Eff' operation with side effects.
265+-- | Run an 'Eff' computation with side effects.
308266--
309−-- For running pure operations see 'runPureEff'.
267+-- For running pure computations see 'runPureEff'.
310268runEff :: Eff '[IOE] a -> IO a
311−runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
269+runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv
312270
313271instance IOE :> es => MonadIO (Eff es) where
314272 liftIO = unsafeEff_
@@ -332,20 +290,20 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where
332290----------------------------------------
333291-- Primitive
334292
335−-- | An effect to perform primitive state-transformer actions.
293+-- | Provide the ability to perform primitive state-transformer actions.
336294data Prim :: Effect where
337295 Prim :: Prim m r
338296
339−-- | Run an 'Eff' operation with primitive state-transformer actions.
297+-- | Run an 'Eff' computation with primitive state-transformer actions.
340298runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
341−runPrim = evalEffect (IdE Prim)
299+runPrim = evalData (DataA Prim)
342300
343301instance Prim :> es => PrimMonad (Eff es) where
344302 type PrimState (Eff es) = RealWorld
345303 primitive = unsafeEff_ . IO
346304
347305----------------------------------------
348−-- Handler
306+-- Dynamic dispatch
349307
350308type role LocalEnv nominal nominal
351309
@@ -361,78 +319,97 @@ newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env l
361319type EffectHandler e es
362320 = forall a localEs. HasCallStack
363321 => LocalEnv localEs es
364− -- ^ Capture of the local environment for handling local 'Eff' operations when
365− -- @e@ is a higher order effect.
322+ -- ^ Capture of the local environment for handling local 'Eff' computations
323+ -- when @e@ is a higher order effect.
366324 -> e (Eff localEs) a
367325 -- ^ The effect performed in the local environment.
368326 -> Eff es a
369327
370328-- | An adapter for dynamically dispatched effects.
371329--
372−-- Represents the effect handler bundled along with its environment.
373−data Handler :: Effect -> Type where
374− Handler :: !(Env es) -> !(EffectHandler e es) -> Handler e
330+-- Represents the effect handler bundled with its environment.
331+data HandlerA :: Effect -> Type where
332+ HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e
375333
376−-- | Run the effect with the given handler.
377−runHandler :: Handler e -> Eff (e : es) a -> Eff es a
334+-- | Run a dynamically dispatched effect with the given handler.
335+runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
378336runHandler e m = unsafeEff $ \es0 -> do
379337 size0 <- sizeEnv es0
380338 E.bracket (unsafeConsEnv e relinker es0)
381339 (unsafeTailEnv size0)
382340 (\es -> unEff m es)
383341 where
384− relinker :: Relinker Handler e
385− relinker = Relinker $ \relink (Handler env handle) -> do
386− newEnv <- relink env
387− pure $ Handler newEnv handle
342+ relinker :: Relinker HandlerA e
343+ relinker = Relinker $ \relink (HandlerA handlerEs handle) -> do
344+ newHandlerEs <- relink handlerEs
345+ pure $ HandlerA newHandlerEs handle
388346
389347-- | Send an operation of the given effect to its handler for execution.
390348send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
391349send op = unsafeEff $ \es -> do
392− Handler handlerEs handle <- getEnv es
350+ HandlerA handlerEs handle <- getEnv es
393351 unEff (handle (LocalEnv es) op) handlerEs
394352
395353----------------------------------------
396−-- Helpers
354+-- Static dispatch
397355
398−runEffect :: adapter e -> Eff (e : es) a -> Eff es (a, adapter e)
399−runEffect e0 m = unsafeEff $ \es0 -> do
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
400367 size0 <- sizeEnv es0
401368 E.bracket (unsafeConsEnv e0 noRelinker es0)
402369 (unsafeTailEnv size0)
403370 (\es -> (,) <$> unEff m es <*> getEnv es)
404371
405−evalEffect :: adapter e -> Eff (e : es) a -> Eff es a
406−evalEffect e m = unsafeEff $ \es0 -> do
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
407376 size0 <- sizeEnv es0
408377 E.bracket (unsafeConsEnv e noRelinker es0)
409378 (unsafeTailEnv size0)
410379 (\es -> unEff m es)
411380
412−execEffect :: adapter e -> Eff (e : es) a -> Eff es (adapter e)
413−execEffect e0 m = unsafeEff $ \es0 -> do
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
414385 size0 <- sizeEnv es0
415386 E.bracket (unsafeConsEnv e0 noRelinker es0)
416387 (unsafeTailEnv size0)
417388 (\es -> unEff m es *> getEnv es)
418389
419−getEffect :: e :> es => Eff es (adapter e)
420−getEffect = unsafeEff $ \es -> getEnv es
390+-- | Fetch the current state of the effect.
391+getData :: e :> es => Eff es (DataA e)
392+getData = unsafeEff $ \es -> getEnv es
421393
422−putEffect :: e :> es => adapter e -> Eff es ()
423−putEffect e = unsafeEff $ \es -> putEnv es e
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
424397
425−stateEffect :: e :> es => (adapter e -> (a, adapter e)) -> Eff es a
426−stateEffect f = unsafeEff $ \es -> stateEnv es f
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
427401
428−stateEffectM :: e :> es => (adapter e -> Eff es (a, adapter e)) -> Eff es a
429−stateEffectM f = unsafeEff $ \es -> E.mask $ \release -> do
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
430406 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
431407 putEnv es e
432408 pure a
433409
434−localEffect :: e :> es => (adapter e -> adapter e) -> Eff es a -> Eff es a
435−localEffect f m = unsafeEff $ \es -> do
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
436413 E.bracket (stateEnv es $ \e -> (e, f e))
437414 (\e -> putEnv es e)
438415 (\_ -> unEff m es)
effectful-core/src/Effectful/Internal/Unlift.hs+35−78
@@ -1,4 +1,3 @@
1−{-# LANGUAGE DeriveGeneric #-}
21{-# LANGUAGE MagicHash #-}
32{-# LANGUAGE UnboxedTuples #-}
43{-# OPTIONS_HADDOCK not-home #-}
@@ -13,17 +12,13 @@ module Effectful.Internal.Unlift
1312 , Limit(..)
1413
1514 -- * Unlifting functions
16− , seqUnliftIO
17− , concUnliftIO
18− , ephemeralConcUnliftIO
19− , persistentConcUnliftIO
20−
21− -- * Unlifting errors
22− , UnliftError(..)
15+ , seqUnlift
16+ , concUnlift
17+ , ephemeralConcUnlift
18+ , persistentConcUnlift
2319 ) where
2420
2521import Control.Concurrent
26−import Control.Exception
2722import Control.Monad
2823import GHC.Conc.Sync (ThreadId(..))
2924import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)
@@ -40,8 +35,9 @@ import Effectful.Internal.Utils
4035----------------------------------------
4136-- Unlift strategies
4237
43−-- | The strategy to use when unlifting 'Eff' operations via 'withRunInIO' or
44−-- the 'Effectful.Interpreter.localUnlift' family.
38+-- | The strategy to use when unlifting 'Eff' computations via 'withRunInIO',
39+-- 'Effectful.Monad.withEffToIO' or the 'Effectful.Dispatch.Dynamic.localUnlift'
40+-- family.
4541data UnliftStrategy
4642 = SeqUnlift
4743 -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
@@ -96,26 +92,24 @@ data Limit
9692-- Unlift functions
9793
9894-- | Sequential unlift.
99−--
100−-- Exceptions thrown by this function:
101−--
102−-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
103−seqUnliftIO
95+seqUnlift
10496 :: HasCallStack
10597 => ((forall r. m r -> IO r) -> IO a)
10698 -> Env es
10799 -> (forall r. m r -> Env es -> IO r)
108100 -> IO a
109−seqUnliftIO k es unEff = do
101+seqUnlift k es unEff = do
110102 tid0 <- myThreadId
111103 k $ \m -> do
112104 tid <- myThreadId
113105 if tid `eqThreadId` tid0
114106 then unEff m es
115− else throwIO InvalidUseOfSeqUnlift
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)."
116110
117111-- | Concurrent unlift for various strategies and limits.
118−concUnliftIO
112+concUnlift
119113 :: HasCallStack
120114 => Persistence
121115 -> Limit
@@ -123,23 +117,18 @@ concUnliftIO
123117 -> Env es
124118 -> (forall r. m r -> Env es -> IO r)
125119 -> IO a
126−concUnliftIO Ephemeral (Limited uses) k =
127− ephemeralConcUnliftIO uses k
128−concUnliftIO Ephemeral Unlimited k =
129− ephemeralConcUnliftIO maxBound k
130−concUnliftIO Persistent (Limited threads) k =
131− persistentConcUnliftIO False threads k
132−concUnliftIO Persistent Unlimited k =
133− persistentConcUnliftIO True maxBound k
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
134128
135129-- | Concurrent unlift that doesn't preserve the environment between calls to
136130-- the unlifting function in threads other than its creator.
137−--
138−-- Exceptions thrown by this function:
139−--
140−-- - 'InvalidNumberOfUses' if the number of uses is less or equal zero.
141−-- - 'ExceededNumberOfUses' if the unlift function is called too often.
142−ephemeralConcUnliftIO
131+ephemeralConcUnlift
143132 :: HasCallStack
144133 => Int
145134 -- ^ Number of permitted uses of the unlift function.
@@ -147,9 +136,9 @@ ephemeralConcUnliftIO
147136 -> Env es
148137 -> (forall r. m r -> Env es -> IO r)
149138 -> IO a
150−ephemeralConcUnliftIO uses k es0 unEff = do
139+ephemeralConcUnlift uses k es0 unEff = do
151140 unless (uses > 0) $ do
152− throwIO $ InvalidNumberOfUses uses
141+ error $ "Invalid number of uses: " ++ show uses
153142 tid0 <- myThreadId
154143 -- Create a copy of the environment as a template for the other threads to
155144 -- use. This can't be done from inside the callback as the environment might
@@ -160,7 +149,10 @@ ephemeralConcUnliftIO uses k es0 unEff = do
160149 es <- myThreadId >>= \case
161150 tid | tid0 `eqThreadId` tid -> pure es0
162151 _ -> modifyMVar mvUses $ \case
163− 0 -> throwIO $ ExceededNumberOfUses uses
152+ 0 -> error
153+ $ "Number of permitted calls (" ++ show uses ++ ") to the unlifting "
154+ ++ "function in other threads was exceeded. Please increase the limit "
155+ ++ "or use the unlimited variant."
164156 1 -> pure (0, esTemplate)
165157 n -> do
166158 let newUses = n - 1
@@ -170,13 +162,7 @@ ephemeralConcUnliftIO uses k es0 unEff = do
170162
171163-- | Concurrent unlift that preserves the environment between calls to the
172164-- unlifting function within a particular thread.
173−--
174−-- Exceptions thrown by this function:
175−--
176−-- - 'InvalidNumberOfThreads' if the number of threads is less or equal zero.
177−-- - 'ExceededNumberOfThreads' if the unlift function is called by too many
178−-- threads.
179−persistentConcUnliftIO
165+persistentConcUnlift
180166 :: HasCallStack
181167 => Bool
182168 -> Int
@@ -185,9 +171,9 @@ persistentConcUnliftIO
185171 -> Env es
186172 -> (forall r. m r -> Env es -> IO r)
187173 -> IO a
188−persistentConcUnliftIO cleanUp threads k es0 unEff = do
174+persistentConcUnlift cleanUp threads k es0 unEff = do
189175 unless (threads > 0) $ do
190− throwIO $ InvalidNumberOfThreads threads
176+ error $ "Invalid number of threads: " ++ show threads
191177 tid0 <- myThreadId
192178 -- Create a copy of the environment as a template for the other threads to
193179 -- use. This can't be done from inside the callback as the environment might
@@ -205,7 +191,10 @@ persistentConcUnliftIO cleanUp threads k es0 unEff = do
205191 case mes of
206192 Just es -> pure (te, es)
207193 Nothing -> case teCapacity te of
208− 0 -> throwIO $ ExceededNumberOfThreads threads
194+ 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."
209198 1 -> do
210199 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp
211200 let newEntries = ThreadEntries
@@ -223,38 +212,6 @@ persistentConcUnliftIO cleanUp threads k es0 unEff = do
223212 newEntries `seq` pure (newEntries, es)
224213 unEff m es
225214
226−----------------------------------------
227−-- Errors
228−
229−-- | An type used for errors occuring in unlifting functions.
230−--
231−-- Use the 'displayException' method of the 'Exception' type class to get
232−-- descriptive error messages.
233−data UnliftError
234− = InvalidNumberOfThreads !Int
235− | InvalidNumberOfUses !Int
236− | InvalidUseOfSeqUnlift
237− | ExceededNumberOfThreads !Int
238− | ExceededNumberOfUses !Int
239− deriving (Eq, Generic, Show)
240−
241−instance Exception UnliftError where
242− displayException (InvalidNumberOfThreads threads) =
243− "Invalid number of threads: " ++ show threads
244− displayException (InvalidNumberOfUses uses) =
245− "Invalid number of uses: " ++ show uses
246− displayException (ExceededNumberOfThreads threads) =
247− "Number of other threads (" ++ show threads ++ ") permitted to use the " ++
248− "unlifting function was exceeded. Please increase the limit or use the " ++
249− "unlimited variant."
250− displayException (ExceededNumberOfUses uses) =
251− "Number of permitted calls (" ++ show uses ++ ") to the unlifting " ++
252− "function in other threads was exceeded. Please increase the limit or " ++
253− "use the unlimited variant."
254− displayException InvalidUseOfSeqUnlift =
255− "If you want to use the unlifting function to run Eff operations in " ++
256− "multiple threads, have a look at UnliftStrategy (ConcUnlift)."
257−
258215----------------------------------------
259216-- Data types
260217
effectful-core/src/Effectful/Monad.hs−1
@@ -18,7 +18,6 @@ module Effectful.Monad
1818 , unliftStrategy
1919 , withUnliftStrategy
2020 , withEffToIO
21− , UnliftError(..)
2221
2322 -- * Re-exports
2423 , MonadIO(..)
effectful-core/src/Effectful/Prim.hs+1
@@ -1,3 +1,4 @@
1+-- | Provider of the 'MonadPrim' instance for 'Eff'.
12module Effectful.Prim
23 ( Prim
34 , runPrim
effectful-core/src/Effectful/Reader.hs+4−4
@@ -1,4 +1,4 @@
1−-- | The 'Reader' effect.
1+-- | Support for access to a read only value of a particular type.
22module Effectful.Reader
33 ( Reader
44 , runReader
@@ -20,12 +20,12 @@ runReader
2020 :: r -- ^ An initial environment.
2121 -> Eff (Reader r : es) a
2222 -> Eff es a
23−runReader r = evalEffect (IdE (Reader r))
23+runReader r = evalData (DataA (Reader r))
2424
2525-- | Fetch the value of the environment.
2626ask :: Reader r :> es => Eff es r
2727ask = do
28− IdE (Reader r) <- getEffect
28+ DataA (Reader r) <- getData
2929 pure r
3030
3131-- | Retrieve a function of the current environment.
@@ -46,4 +46,4 @@ local
4646 => (r -> r) -- ^ The function to modify the environment.
4747 -> Eff es a
4848 -> Eff es a
49−local f = localEffect $ \(IdE (Reader r)) -> IdE (Reader (f r))
49+local f = localData $ \(DataA (Reader r)) -> DataA (Reader (f r))
effectful-core/src/Effectful/State/Dynamic.hs+1−1
@@ -27,7 +27,7 @@ import Effectful.Monad
2727import qualified Effectful.State.Local as L
2828import qualified Effectful.State.Shared as S
2929
30−-- | Provide access to a mutable state of type @s@.
30+-- | Provide access to a mutable value of type @s@.
3131data State s :: Effect where
3232 Get :: State s m s
3333 Put :: s -> State s m ()
effectful-core/src/Effectful/State/Local.hs+34−13
@@ -1,12 +1,29 @@
1−-- | The 'State' effect.
1+-- | Support for access to a mutable value of a particular type, which is:
22--
3−-- Represented as a pure value underneath, therefore:
4−--
5−-- - thread local (if you need the state to be shared between threads, have a
3+-- - thread local (if you want the value to be shared between threads, have a
64-- look at "Effectful.State.Shared"),
75--
86-- - very fast.
97--
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!"
1027module Effectful.State.Local
1128 ( State
1229 , runState
@@ -24,7 +41,7 @@ module Effectful.State.Local
2441import Effectful.Dispatch.Static
2542import Effectful.Monad
2643
27−-- | Provide access to a strict (WHNF), thread local, mutable state of type @s@.
44+-- | Provide access to a strict (WHNF), thread local, mutable value of type @s@.
2845newtype State s :: Effect where
2946 State :: s -> State s m r
3047
@@ -35,7 +52,7 @@ runState
3552 -> Eff (State s : es) a
3653 -> Eff es (a, s)
3754runState s0 m = do
38− (a, IdE (State s)) <- runEffect (IdE (State s0)) m
55+ (a, DataA (State s)) <- runData (DataA (State s0)) m
3956 pure (a, s)
4057
4158-- | Run a 'State' effect with the given initial state and return the final
@@ -44,7 +61,7 @@ evalState
4461 :: s -- ^ An initial state.
4562 -> Eff (State s : es) a
4663 -> Eff es a -- ^ A return value.
47−evalState s = evalEffect (IdE (State s))
64+evalState s = evalData (DataA (State s))
4865
4966-- | Run a 'State' effect with the given initial state and return the final
5067-- state, discarding the final value.
@@ -53,13 +70,13 @@ execState
5370 -> Eff (State s : es) a
5471 -> Eff es s
5572execState s0 m = do
56− IdE (State s) <- execEffect (IdE (State s0)) m
73+ DataA (State s) <- execData (DataA (State s0)) m
5774 pure s
5875
5976-- | Fetch the current value of the state.
6077get :: State s :> es => Eff es s
6178get = do
62− IdE (State s) <- getEffect
79+ DataA (State s) <- getData
6380 pure s
6481
6582-- | Get a function of the current state.
@@ -73,14 +90,14 @@ gets f = f <$> get
7390
7491-- | Set the current state to the given value.
7592put :: State s :> es => s -> Eff es ()
76−put s = putEffect (IdE (State s))
93+put s = putData (DataA (State s))
7794
7895-- | Apply the function to the current state and return a value.
7996state
8097 :: State s :> es
8198 => (s -> (a, s)) -- ^ The function to modify the state.
8299 -> Eff es a
83−state f = stateEffect $ \(IdE (State s0)) -> let (a, s) = f s0 in (a, IdE (State s))
100+state f = stateData $ \(DataA (State s0)) -> let (a, s) = f s0 in (a, DataA (State s))
84101
85102-- | Apply the function to the current state.
86103--
@@ -96,9 +113,9 @@ stateM
96113 :: State s :> es
97114 => (s -> Eff es (a, s)) -- ^ The function to modify the state.
98115 -> Eff es a
99−stateM f = stateEffectM $ \(IdE (State s0)) -> do
116+stateM f = stateDataM $ \(DataA (State s0)) -> do
100117 (a, s) <- f s0
101− pure (a, IdE (State s))
118+ pure (a, DataA (State s))
102119
103120-- | Apply the monadic function to the current state.
104121--
@@ -108,3 +125,7 @@ modifyM
108125 => (s -> Eff es s) -- ^ The monadic function to modify the state.
109126 -> Eff es ()
110127modifyM 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+61−12
@@ -1,11 +1,29 @@
1−-- | The 'State' effect.
1+-- | Support for access to a mutable value of a particular type, which is:
22--
3−-- Represented as an 'MVar' underneath, therefore:
3+-- - shared between multiple threads (if you want each thead to manage its own
4+-- version of the value, see "Effectful.State.Local").
45--
5−-- - shareable between multiple threads,
6+-- - slightly slower than "Effectful.State.Local".
67--
7−-- - slower than "Effectful.State.Local".
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:
811--
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!"
927module Effectful.State.Shared
1028 ( State
1129 , runState
@@ -25,54 +43,85 @@ import Control.Concurrent.MVar
2543import Effectful.Dispatch.Static
2644import Effectful.Monad
2745
28−-- | Provide access to a strict (WHNF), shareable, mutable state of type @s@.
46+-- | Provide access to a strict (WHNF), shared, mutable value of type @s@.
2947newtype State s :: Effect where
3048 State :: MVar s -> State s m r
3149
50+-- | Run a 'State' effect with the given initial state and return the final
51+-- value along with the final state.
3252runState :: s -> Eff (State s : es) a -> Eff es (a, s)
3353runState s m = do
3454 v <- unsafeEff_ $ newMVar s
35− a <- evalEffect (IdE (State v)) m
55+ a <- evalData (DataA (State v)) m
3656 (a, ) <$> unsafeEff_ (readMVar v)
3757
58+-- | Run a 'State' effect with the given initial state and return the final
59+-- value, discarding the final state.
3860evalState :: s -> Eff (State s : es) a -> Eff es a
3961evalState s m = do
4062 v <- unsafeEff_ $ newMVar s
41− evalEffect (IdE (State v)) m
63+ evalData (DataA (State v)) m
4264
65+-- | Run a 'State' effect with the given initial state and return the final
66+-- state, discarding the final value.
4367execState :: s -> Eff (State s : es) a -> Eff es s
4468execState s m = do
4569 v <- unsafeEff_ $ newMVar s
46− _ <- evalEffect (IdE (State v)) m
70+ _ <- evalData (DataA (State v)) m
4771 unsafeEff_ $ readMVar v
4872
73+-- | Fetch the current value of the state.
4974get :: State s :> es => Eff es s
5075get = unsafeEff $ \es -> do
51− IdE (State v) <- getEnv es
76+ DataA (State v) <- getEnv es
5277 readMVar v
5378
79+-- | Get a function of the current state.
80+--
81+-- @'gets' f ≡ f '<$>' 'get'@
5482gets :: State s :> es => (s -> a) -> Eff es a
5583gets f = f <$> get
5684
85+-- | Set the current state to the given value.
5786put :: State s :> es => s -> Eff es ()
5887put s = unsafeEff $ \es -> do
59− IdE (State v) <- getEnv es
88+ DataA (State v) <- getEnv es
6089 modifyMVar_ v $ \_ -> s `seq` pure s
6190
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.
6294state :: State s :> es => (s -> (a, s)) -> Eff es a
6395state f = unsafeEff $ \es -> do
64− IdE (State v) <- getEnv es
96+ DataA (State v) <- getEnv es
6597 modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)
6698
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.
67104modify :: State s :> es => (s -> s) -> Eff es ()
68105modify f = state (\s -> ((), f s))
69106
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.
70110stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
71111stateM f = unsafeEff $ \es -> do
72− IdE (State v) <- getEnv es
112+ DataA (State v) <- getEnv es
73113 modifyMVar v $ \s0 -> do
74114 (a, s) <- unEff (f s0) es
75115 s `seq` pure (s, a)
76116
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.
77122modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()
78123modifyM f = stateM (\s -> ((), ) <$> f s)
124+
125+-- $setup
126+-- >>> import Control.Exception (ErrorCall)
127+-- >>> import Control.Monad.Catch
effectful-core/src/Effectful/Writer/Local.hs+26−13
@@ -1,8 +1,6 @@
1−-- | The 'Writer' effect.
1+-- | Support for access to a write only value of a particular type, which is:
22--
3−-- Represented as a pure value underneath, therefore:
4−--
5−-- - thread local (if you need the state to be shared between threads, have a
3+-- - thread local (if you want the value to be shared between threads, have a
64-- look at "Effectful.Writer.Shared"),
75--
86-- - very fast.
@@ -26,7 +24,7 @@ module Effectful.Writer.Local
2624 , listens
2725 ) where
2826
29−import Control.Exception
27+import Control.Exception (onException, mask)
3028
3129import Effectful.Dispatch.Static
3230import Effectful.Monad
@@ -40,35 +38,46 @@ newtype Writer w :: Effect where
4038-- output.
4139runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
4240runWriter m = do
43− (a, IdE (Writer w)) <- runEffect (IdE (Writer mempty)) m
41+ (a, DataA (Writer w)) <- runData (DataA (Writer mempty)) m
4442 pure (a, w)
4543
4644-- | Run a 'Writer' effect and return the final output, discarding the final
4745-- value.
4846execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
4947execWriter m = do
50− IdE (Writer w) <- execEffect (IdE (Writer mempty)) m
48+ DataA (Writer w) <- execData (DataA (Writer mempty)) m
5149 pure w
5250
5351-- | Append the given output to the overall output of the 'Writer'.
5452tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
55−tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))
53+tell w = stateData $ \(DataA (Writer w0)) -> ((), DataA (Writer (w0 <> w)))
5654
5755-- | Execute an action and append its output to the overall output of the
5856-- 'Writer'.
5957--
60−-- /Note:/ if a runtime exception is received while the action is executed, the
61−-- partial output of the action will still be appended to the overall output of
62−-- the 'Writer'.
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!"
6372listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
6473listen m = unsafeEff $ \es -> mask $ \restore -> do
65− w0 <- stateEnv es $ \(IdE (Writer w)) -> (w, IdE (Writer mempty))
74+ w0 <- stateEnv es $ \(DataA (Writer w)) -> (w, DataA (Writer mempty))
6675 a <- restore (unEff m es) `onException` merge es w0
6776 (a, ) <$> merge es w0
6877 where
6978 merge es w0 =
7079 -- If an exception is thrown, restore w0 and keep parts of w1.
71− stateEnv es $ \(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))
80+ stateEnv es $ \(DataA (Writer w1)) -> (w1, DataA (Writer (w0 <> w1)))
7281
7382-- | Execute an action and append its output to the overall output of the
7483-- 'Writer', then return the final value along with a function of the recorded
@@ -79,3 +88,7 @@ listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
7988listens f m = do
8089 (a, w) <- listen m
8190 pure (a, f w)
91+
92+-- $setup
93+-- >>> import Control.Exception (ErrorCall)
94+-- >>> import Control.Monad.Catch
effectful-core/src/Effectful/Writer/Shared.hs+55−7
@@ -1,3 +1,20 @@
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.
118module Effectful.Writer.Shared
219 ( Writer
320 , runWriter
@@ -8,32 +25,54 @@ module Effectful.Writer.Shared
825 ) where
926
1027import Control.Concurrent.MVar
11−import Control.Exception
28+import Control.Exception (onException, uninterruptibleMask)
1229
1330import Effectful.Dispatch.Static
1431import Effectful.Monad
1532
16−-- | Provide access to a strict (WHNF), shareable, write only value of type @w@.
33+-- | Provide access to a strict (WHNF), shared, write only value of type @w@.
1734newtype Writer w :: Effect where
1835 Writer :: MVar w -> Writer w m r
1936
37+-- | Run a 'Writer' effect and return the final value along with the final
38+-- output.
2039runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
2140runWriter m = do
2241 v <- unsafeEff_ $ newMVar mempty
23− a <- evalEffect (IdE (Writer v)) m
42+ a <- evalData (DataA (Writer v)) m
2443 (a, ) <$> unsafeEff_ (readMVar v)
2544
45+-- | Run a 'Writer' effect and return the final output, discarding the final
46+-- value.
2647execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
2748execWriter m = do
2849 v <- unsafeEff_ $ newMVar mempty
29− _ <- evalEffect (IdE (Writer v)) m
50+ _ <- evalData (DataA (Writer v)) m
3051 unsafeEff_ $ readMVar v
3152
53+-- | Append the given output to the overall output of the 'Writer'.
3254tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
3355tell w1 = unsafeEff $ \es -> do
34− IdE (Writer v) <- getEnv es
56+ DataA (Writer v) <- getEnv es
3557 modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w
3658
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!"
3776listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
3877listen m = unsafeEff $ \es -> do
3978 -- The mask is uninterruptible because modifyMVar_ v0 in the merge function
@@ -42,19 +81,28 @@ listen m = unsafeEff $ \es -> do
4281 uninterruptibleMask $ \restore -> do
4382 v1 <- newMVar mempty
4483 -- Replace thread local MVar with a fresh one for isolated listening.
45− v0 <- stateEnv es $ \(IdE (Writer v)) -> (v, IdE (Writer v1))
84+ v0 <- stateEnv es $ \(DataA (Writer v)) -> (v, DataA (Writer v1))
4685 a <- restore (unEff m es) `onException` merge es v0 v1
4786 (a, ) <$> merge es v0 v1
4887 where
4988 -- Merge results accumulated in the local MVar with the mainline. If an
5089 -- exception was received while listening, merge results recorded so far.
5190 merge es v0 v1 = do
52− putEnv es $ IdE (Writer v0)
91+ putEnv es $ DataA (Writer v0)
5392 w1 <- readMVar v1
5493 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
5594 pure w1
5695
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@
57101listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
58102listens f m = do
59103 (a, w) <- listen m
60104 pure (a, f w)
105+
106+-- $setup
107+-- >>> import Control.Exception (ErrorCall)
108+-- >>> import Control.Monad.Catch
effectful/bench/Main.hs+3−3
@@ -97,11 +97,11 @@ filesize n = bgroup (show n)
9797#ifdef VERSION_eff
9898 , bench "eff" $ nfAppIO eff_calculateFileSizesDeep (take n files)
9999#endif
100−#ifdef VERSION_polysemy
101− , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)
102−#endif
103100#ifdef VERSION_mtl
104101 , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)
102+#endif
103+#ifdef VERSION_polysemy
104+ , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)
105105#endif
106106 ]
107107 ]
effectful/effectful.cabal+15−15
@@ -20,7 +20,7 @@ description: An easy to use, performant extensible effects library with seamless
2020
2121extra-source-files: CHANGELOG.md
2222
23−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1
23+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1
2424
2525bug-reports: https://github.com/arybczak/effectful/issues
2626source-repository head
@@ -40,6 +40,7 @@ common language
4040 ConstraintKinds
4141 DataKinds
4242 DeriveFunctor
43+ DeriveGeneric
4344 FlexibleContexts
4445 FlexibleInstances
4546 GADTs
@@ -60,20 +61,19 @@ common language
6061library
6162 import: language
6263
63− build-depends: base >= 4.13 && <5
64− , async
65− , directory
66− , effectful-core >= 0.1 && <0.1.1
67− , process
68− , resourcet
69− , time
70− , stm >= 2.5.0.0
71− , unliftio
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
7273
7374 hs-source-dirs: src
7475
75− exposed-modules: Effectful
76− Effectful.Concurrent
76+ exposed-modules: Effectful.Concurrent
7777 Effectful.Concurrent.Async
7878 Effectful.Concurrent.Chan
7979 Effectful.Concurrent.MVar
@@ -91,7 +91,8 @@ library
9191 other-modules: Effectful.Concurrent.Effect
9292 Effectful.FileSystem.Effect
9393
94− reexported-modules: Effectful.Dispatch.Dynamic
94+ reexported-modules: Effectful
95+ , Effectful.Dispatch.Dynamic
9596 , Effectful.Dispatch.Static
9697 , Effectful.Error
9798 , Effectful.Error.Dynamic
@@ -118,7 +119,6 @@ test-suite test
118119 , effectful-core
119120 , exceptions
120121 , lifted-base
121− , optics-core >= 0.4
122122 , tasty
123123 , tasty-hunit
124124 , unliftio
@@ -154,7 +154,7 @@ benchmark bench
154154 if impl(ghc < 9.2)
155155 build-depends: fused-effects
156156
157− if impl(ghc < 9.2)
157+ if impl(ghc < 9.3)
158158 build-depends: polysemy
159159
160160 build-depends: base
effectful/src/Effectful/Concurrent.hs+15−2
@@ -1,6 +1,19 @@
1+-- | Lifted version of "Control.Concurrent".
2+--
3+-- For functions that spawn threads, the order of preference for their usage is
4+-- recommended as follows:
5+--
6+-- 1) High level functions from "Effectful.Concurrent.Async" such as
7+-- 'Effectful.Concurrent.Async.withAsync',
8+-- 'Effectful.Concurrent.Async.concurrently' or
9+-- 'Effectful.Concurrent.Async.mapConcurrently'.
10+--
11+-- 2) Low level functions from "Effectful.Concurrent.Async" such as
12+-- 'Effectful.Concurrent.Async.async'.
13+--
14+-- 3) Low level functions from "Effectful.Concurrent" such as 'forkIO'.
115module Effectful.Concurrent
2− ( -- * Concurrent effect
3− Concurrent
16+ ( Concurrent
417 , runConcurrent
518
619 -- * Basic concurrency operations
effectful/src/Effectful/Concurrent/Async.hs+2−2
@@ -1,7 +1,7 @@
11{-# LANGUAGE UndecidableInstances #-}
2+-- | Lifted version of "Control.Concurrent.Async".
23module Effectful.Concurrent.Async
3− ( -- * Concurrent effect
4− Concurrent
4+ ( Concurrent
55 , runConcurrent
66
77 -- * Asynchronous actions
effectful/src/Effectful/Concurrent/Chan.hs+5−1
@@ -1,6 +1,10 @@
11-- | Lifted version of "Control.Concurrent.Chan".
22module Effectful.Concurrent.Chan
3− ( Chan
3+ ( Concurrent
4+ , runConcurrent
5+
6+ -- * Chan
7+ , Chan
48 , newChan
59 , writeChan
610 , readChan
effectful/src/Effectful/Concurrent/Effect.hs+65−5
@@ -6,14 +6,74 @@ module Effectful.Concurrent.Effect
66import Effectful.Dispatch.Static
77import Effectful.Monad
88
9−-- | Run 'Eff' operations asynchronously via the @async@ library.
9+-- | Provide the ability to run 'Eff' computations concurrently in multiple
10+-- threads and communicate between them.
1011--
11−-- /Note:/ thread local state changes in 'Eff' operations run asynchronously
12−-- will not affect the parent thread.
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.
1369--
14−-- /TODO:/ write about 'Concurrent' not respecting scoped operations.
1570data Concurrent :: Effect where
1671 Concurrent :: Concurrent m r
1772
73+-- | Run the 'Concurrent' effect.
1874runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a
19−runConcurrent = evalEffect (IdE Concurrent)
75+runConcurrent = evalData (DataA Concurrent)
76+
77+-- $setup
78+-- >>> import Effectful.Concurrent
79+-- >>> import Effectful.Concurrent.Async
effectful/src/Effectful/Concurrent/MVar.hs+5−1
@@ -1,6 +1,10 @@
11-- | Lifted version of "Control.Concurrent.MVar".
22module Effectful.Concurrent.MVar
3− ( MVar
3+ ( Concurrent
4+ , runConcurrent
5+
6+ -- * MVar
7+ , MVar
48 , newEmptyMVar
59 , newMVar
610 , takeMVar
effectful/src/Effectful/Concurrent/QSem.hs+6−2
@@ -1,6 +1,10 @@
1−-- | Lifted "Control.Concurrent.QSem".
1+-- | Lifted version of "Control.Concurrent.QSem".
22module Effectful.Concurrent.QSem
3− ( QSem
3+ ( Concurrent
4+ , runConcurrent
5+
6+ -- * QSem
7+ , QSem
48 , newQSem
59 , waitQSem
610 , signalQSem
effectful/src/Effectful/Concurrent/QSemN.hs+6−2
@@ -1,6 +1,10 @@
1−-- | Lifted "Control.Concurrent.QSemN".
1+-- | Lifted version of "Control.Concurrent.QSemN".
22module Effectful.Concurrent.QSemN
3− ( QSemN
3+ ( Concurrent
4+ , runConcurrent
5+
6+ -- * QSemN
7+ , QSemN
48 , newQSemN
59 , waitQSemN
610 , signalQSemN
effectful/src/Effectful/Concurrent/STM.hs+5−2
@@ -1,7 +1,10 @@
11-- | Lifted version of "Control.Concurrent.STM".
22module Effectful.Concurrent.STM
3− ( -- * Core
4− STM.STM
3+ ( Concurrent
4+ , runConcurrent
5+
6+ -- * Core
7+ , STM.STM
58 , atomically
69 , STM.retry
710 , STM.orElse
effectful/src/Effectful/Environment.hs+3−3
@@ -1,6 +1,5 @@
11module Effectful.Environment
2− ( -- * Environment effect
3− Environment
2+ ( Environment
43 , runEnvironment
54
65 -- * Querying the environment
@@ -27,8 +26,9 @@ import Effectful.Monad
2726data Environment :: Effect where
2827 Environment :: Environment m r
2928
29+-- | Run the 'Environment' effect.
3030runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a
31−runEnvironment = evalEffect (IdE Environment)
31+runEnvironment = evalData (DataA Environment)
3232
3333-- | Lifted 'E.getArgs'.
3434getArgs :: Environment :> es => Eff es [String]
effectful/src/Effectful/FileSystem.hs+89−89
@@ -1,92 +1,92 @@
11module 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
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
9090
9191import Data.Time (UTCTime)
9292import qualified System.Directory as D
@@ -100,7 +100,7 @@ data FileSystem :: Effect where
100100
101101-- | Run the 'FileSystem' effect.
102102runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a
103−runFileSystem = evalEffect (IdE FileSystem)
103+runFileSystem = evalData (DataA FileSystem)
104104
105105----------------------------------------
106106-- Actions on directories
effectful/src/Effectful/FileSystem/Effect.hs+1−1
@@ -12,4 +12,4 @@ data FileSystem :: Effect where
1212
1313-- | Run the 'FileSystem' effect.
1414runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a
15−runFileSystem = evalEffect (IdE FileSystem)
15+runFileSystem = evalData (DataA FileSystem)
effectful/src/Effectful/FileSystem/IO.hs+2
@@ -2,6 +2,8 @@
22module Effectful.FileSystem.IO
33 ( FileSystem
44 , runFileSystem
5+
6+ -- * IO
57 , IOMode (..)
68 , Handle
79 , IO.stdin
effectful/src/Effectful/Process.hs+3−4
@@ -1,8 +1,7 @@
11{-# LANGUAGE CPP #-}
2−
2+-- | Lifted version of "System.Process".
33module Effectful.Process
4− ( -- * Process effect
5− Process
4+ ( Process
65 , runProcess
76
87 -- * Running sub-processes
@@ -59,7 +58,7 @@ data Process :: Effect where
5958 Process :: Process m r
6059
6160runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a
62−runProcess = evalEffect (IdE Process)
61+runProcess = evalData (DataA Process)
6362
6463----------------------------------------
6564-- Running sub-processes
effectful/src/Effectful/Resource.hs+4−4
@@ -37,7 +37,7 @@ runResource m = unsafeEff $ \es0 -> do
3737 size0 <- sizeEnv es0
3838 istate <- R.createInternalState
3939 mask $ \restore -> do
40− es <- unsafeConsEnv (IdE (Resource istate)) noRelinker es0
40+ es <- unsafeConsEnv (DataA (Resource istate)) noRelinker es0
4141 a <- restore (unEff m es) `catch` \e -> do
4242 unsafeTailEnv size0 es
4343 RI.stateCleanupChecked (Just e) istate
@@ -52,18 +52,18 @@ runResource m = unsafeEff $ \es0 -> do
5252-- | Get the 'R.InternalState' of the current 'Resource' effect.
5353getInternalState :: Resource :> es => Eff es R.InternalState
5454getInternalState = do
55− IdE (Resource istate) <- getEffect
55+ DataA (Resource istate) <- getData
5656 pure istate
5757
5858-- | Run the 'Resource' effect with existing 'R.InternalState'.
5959--
6060-- /Note:/ the 'R.InternalState' will not be closed at the end.
6161runInternalState :: R.InternalState -> Eff (Resource : es) a -> Eff es a
62−runInternalState istate = evalEffect $ IdE (Resource istate)
62+runInternalState istate = evalData (DataA (Resource istate))
6363
6464----------------------------------------
6565-- Orphan instance
6666
6767instance (IOE :> es, Resource :> es) => R.MonadResource (Eff es) where
6868 liftResourceT (RI.ResourceT m) = unsafeEff $ \es -> do
69− getEnv es >>= \(IdE (Resource istate)) -> m istate
69+ getEnv es >>= \(DataA (Resource istate)) -> m istate
effectful/src/Effectful/Temporary.hs+1−1
@@ -19,7 +19,7 @@ data Temporary :: Effect where
1919
2020-- | Run the 'Temporary' effect.
2121runTemporary :: IOE :> es => Eff (Temporary : es) a -> Eff es a
22−runTemporary = evalEffect (IdE Temporary)
22+runTemporary = evalData (DataA Temporary)
2323
2424-- | Lifted 'T.withSystemTempFile'.
2525withSystemTempFile
effectful/src/Effectful/Timeout.hs+1−1
@@ -15,7 +15,7 @@ data Timeout :: Effect where
1515
1616-- | Run the 'Timeout' effect.
1717runTimeout :: IOE :> es => Eff (Timeout : es) a -> Eff es a
18−runTimeout = evalEffect (IdE Timeout)
18+runTimeout = evalData (DataA Timeout)
1919
2020-- | Lifted 'T.timeout'.
2121timeout
effectful/tests/EnvironmentTests.hs+11−6
@@ -9,12 +9,17 @@ import Effectful.Environment
99import qualified Utils as U
1010
1111environmentTests :: TestTree
12−environmentTests = testGroup "Environment"
13− [ testCase "set and get an environment variable" test_setAndGet
14− , testCase "unset and try to get an environment variable" test_unsetAndGet
15− , testCase "execute effects with custom arguments" test_withArgs
16− , testCase "execute effects with custom program name" test_withProg
17− ]
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
1823
1924test_setAndGet :: Assertion
2025test_setAndGet = runEff . runEnvironment $ do
effectful/tests/UnliftTests.hs+28−35
@@ -1,7 +1,6 @@
1−{-# LANGUAGE OverloadedLabels #-}
21module UnliftTests (unliftTests) where
32
4−import Optics.Core
3+import Control.Exception
54import Test.Tasty
65import Test.Tasty.HUnit
76import qualified UnliftIO.Async as A
@@ -34,43 +33,38 @@ test_resetStrategy = runEff $ do
3433
3534test_seqUnliftInNewThread :: Assertion
3635test_seqUnliftInNewThread = runEff $ do
37− assertThrowsUnliftError "InvalidUseOfSeqUnlift error"
38− (has #_InvalidUseOfSeqUnlift) $ do
39− withUnliftStrategy SeqUnlift $ do
40− withEffToIO $ \runInIO -> do
41− inThread $ runInIO $ return ()
36+ assertThrowsUnliftError "InvalidUseOfSeqUnlift error" $ do
37+ withUnliftStrategy SeqUnlift $ do
38+ withEffToIO $ \runInIO -> do
39+ inThread $ runInIO $ return ()
4240
4341test_ephemeralInvalid :: Assertion
4442test_ephemeralInvalid = runEff $ do
45− assertThrowsUnliftError "InvalidNumberOfUses error"
46− (has #_InvalidNumberOfUses) $ do
47− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do
48− withEffToIO $ \_ -> return ()
43+ assertThrowsUnliftError "InvalidNumberOfUses error" $ do
44+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do
45+ withEffToIO $ \_ -> return ()
4946
5047test_ephemeralSameThread :: Assertion
5148test_ephemeralSameThread = runEff $ do
52− assertThrowsUnliftError "ExceededNumberOfUses error"
53− (has #_ExceededNumberOfUses) $ do
54− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
55− withEffToIO $ \runInIO -> inThread $ do
56− runInIO $ return ()
57− runInIO $ return ()
49+ assertThrowsUnliftError "ExceededNumberOfUses error" $ do
50+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
51+ withEffToIO $ \runInIO -> inThread $ do
52+ runInIO $ return ()
53+ runInIO $ return ()
5854
5955test_ephemeralMultipleThreads :: Assertion
6056test_ephemeralMultipleThreads = runEff $ do
61− assertThrowsUnliftError "ExceededNumberOfUses error"
62− (has #_ExceededNumberOfUses) $ do
63− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
64− withEffToIO $ \runInIO -> do
65− inThread $ runInIO $ return ()
66− inThread $ runInIO $ return ()
57+ assertThrowsUnliftError "ExceededNumberOfUses error" $ do
58+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
59+ withEffToIO $ \runInIO -> do
60+ inThread $ runInIO $ return ()
61+ inThread $ runInIO $ return ()
6762
6863test_persistentInvalid :: Assertion
6964test_persistentInvalid = runEff $ do
70− assertThrowsUnliftError "InvalidNumberOfThreads error"
71− (has #_InvalidNumberOfThreads) $ do
72− withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do
73− withEffToIO $ \_ -> return ()
65+ assertThrowsUnliftError "InvalidNumberOfThreads error" $ do
66+ withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do
67+ withEffToIO $ \_ -> return ()
7468
7569test_persistentSameThread :: Assertion
7670test_persistentSameThread = runEff $ do
@@ -81,20 +75,19 @@ test_persistentSameThread = runEff $ do
8175
8276test_persistentMultipleThreads :: Assertion
8377test_persistentMultipleThreads = runEff $ do
84− assertThrowsUnliftError "ExceededNumberOfThreads error"
85− (has #_ExceededNumberOfThreads) $ do
86− withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
87− withEffToIO $ \runInIO -> do
88− inThread $ runInIO $ return ()
89− inThread $ runInIO $ return ()
78+ assertThrowsUnliftError "ExceededNumberOfThreads error" $ do
79+ withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
80+ withEffToIO $ \runInIO -> do
81+ inThread $ runInIO $ return ()
82+ inThread $ runInIO $ return ()
9083
9184----------------------------------------
9285-- Helpers
9386
9487assertThrowsUnliftError
9588 :: IOE :> es
96− => String -> (UnliftError -> Bool) -> Eff es a -> Eff es ()
97−assertThrowsUnliftError = U.assertThrows
89+ => String -> Eff es a -> Eff es ()
90+assertThrowsUnliftError err = U.assertThrows err (\ErrorCall{} -> True)
9891
9992inThread :: IO a -> IO a
10093inThread k = A.async k >>= A.wait