on f685d65 help sign in
42 files changed+617−893
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml+18−19 README.md+2−2 cabal.haskell-ci+3−1 doctest.sh+1−2 effectful-core/effectful-core.cabal+10−13 effectful-core/src/Effectful/Dispatch/Dynamic.hs+29−41 effectful-core/src/Effectful/Dispatch/Static.hs+21−52 effectful-core/src/Effectful/Error.hs+23−94 effectful-core/src/Effectful/Fail.hs−1 effectful-core/src/Effectful/Internal/Effect.hs+23−7 effectful-core/src/Effectful/Internal/Env.hs+32−51 effectful-core/src/Effectful/Internal/Monad.hs+143−120 effectful-core/src/Effectful/Internal/Unlift.hs+78−35 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+13−34 effectful-core/src/Effectful/State/Shared.hs+12−61 effectful-core/src/Effectful/Writer/Local.hs+13−26 effectful-core/src/Effectful/Writer/Shared.hs+7−55 effectful/bench/Main.hs+3−3 effectful/effectful.cabal+15−15 effectful-core/src/Effectful.hs → effectful/src/Effectful.hs+4−3 effectful/src/Effectful/Concurrent.hs+2−15 effectful/src/Effectful/Concurrent/Async.hs+2−2 effectful/src/Effectful/Concurrent/Chan.hs+1−5 effectful/src/Effectful/Concurrent/Effect.hs+5−65 effectful/src/Effectful/Concurrent/MVar.hs+1−5 effectful/src/Effectful/Concurrent/QSem.hs+2−6 effectful/src/Effectful/Concurrent/QSemN.hs+2−6 effectful/src/Effectful/Concurrent/STM.hs+2−5 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+4−3 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+6−11 effectful/tests/UnliftTests.hs+35−28
.github/workflows/haskell-ci.yml+18−19
@@ -8,9 +8,9 @@
88#
99# For more information, see https://github.com/haskell-CI/haskell-ci
1010#
11−# version: 0.13.20211116
11+# version: 0.13.20211030
1212#
13−# REGENDATA ("0.13.20211116",["github","--config=cabal.haskell-ci","cabal.project"])
13+# REGENDATA ("0.13.20211030",["github","--config=cabal.haskell-ci","cabal.project"])
1414#
1515name: Haskell-CI
1616on:
@@ -24,8 +24,6 @@ jobs:
2424 linux:
2525 name: Haskell-CI - Linux - ${{ matrix.compiler }}
2626 runs-on: ubuntu-18.04
27− timeout-minutes:
28− 60
2927 container:
3028 image: buildpack-deps:bionic
3129 continue-on-error: ${{ matrix.allow-failure }}
@@ -37,6 +35,11 @@ jobs:
3735 compilerVersion: 9.2.1
3836 setup-method: ghcup
3937 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
4043 - compiler: ghc-8.10.7
4144 compilerKind: ghc
4245 compilerVersion: 8.10.7
@@ -126,10 +129,6 @@ jobs:
126129 repository hackage.haskell.org
127130 url: http://hackage.haskell.org/
128131 EOF
129− cat >> $CABAL_CONFIG <<EOF
130− program-default-options
131− ghc-options: $GHCJOBS +RTS -M3G -RTS
132− EOF
133132 cat $CABAL_CONFIG
134133 - name: versions
135134 run: |
@@ -142,7 +141,7 @@ jobs:
142141 - name: cache (tools)
143142 uses: actions/cache@v2
144143 with:
145− key: ${{ runner.os }}-${{ matrix.compiler }}-tools-16fe7d6d
144+ key: ${{ runner.os }}-${{ matrix.compiler }}-tools-b692a344
146145 path: ~/.haskell-ci-tools
147146 - name: install cabal-plan
148147 run: |
@@ -155,8 +154,8 @@ jobs:
155154 cabal-plan --version
156155 - name: install doctest
157156 run: |
158− $CABAL --store-dir=$HOME/.haskell-ci-tools/store v2-install $ARG_COMPILER --ignore-project -j2 doctest --constraint='doctest ^>=0.20'
159− doctest --version
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
160159 - name: checkout
161160 uses: actions/checkout@v2
162161 with:
@@ -164,8 +163,8 @@ jobs:
164163 - name: initial cabal.project for sdist
165164 run: |
166165 touch cabal.project
167− echo "packages: $GITHUB_WORKSPACE/source/effectful" >> cabal.project
168− echo "packages: $GITHUB_WORKSPACE/source/effectful-core" >> cabal.project
166+ echo "packages: $GITHUB_WORKSPACE/source/./effectful" >> cabal.project
167+ echo "packages: $GITHUB_WORKSPACE/source/./effectful-core" >> cabal.project
169168 cat cabal.project
170169 - name: sdist
171170 run: |
@@ -222,12 +221,12 @@ jobs:
222221 $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
223222 - name: doctest
224223 run: |
225− cd ${PKGDIR_effectful} || false
226− doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src
227− cd ${PKGDIR_effectful_core} || false
228− doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src
229− cd ${PKGDIR_effectful_core} || false
230− doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XDeriveGeneric -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators utils
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
231230 - name: cabal check
232231 run: |
233232 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 state
24− modifications).
23+3. Correct semantics in presence of runtime exceptions (no more lost or
24+ discarded state).
2525
26264. Seamless integration with the existing ecosystem (`exceptions`,
2727 `monad-control`, `unliftio-core`, `resourcet` etc.).
cabal.haskell-ci+3−1
@@ -1,9 +1,11 @@
11branches: master
22
3−doctest: <9.3
3+doctest: <9.2
44tests: True
55benchmarks: True
66
7+ghcup-jobs: ==8.10.7 || >=9.2
8+
79raw-project
810 package effectful
911 flags: +benchmark-foreign-libraries
doctest.sh+1−2
@@ -17,7 +17,6 @@ run_doctest() {
1717 -XConstraintKinds \
1818 -XDataKinds \
1919 -XDeriveFunctor \
20− -XDeriveGeneric \
2120 -XFlexibleContexts \
2221 -XFlexibleInstances \
2322 -XGADTs \
@@ -37,5 +36,5 @@ run_doctest() {
3736 popd
3837}
3938
40−run_doctest effectful-core src
4139run_doctest effectful src
40+run_doctest effectful-core src
effectful-core/effectful-core.cabal+10−13
@@ -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.2.1
21+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1
2222
2323bug-reports: https://github.com/arybczak/effectful/issues
2424source-repository head
@@ -34,7 +34,6 @@ common language
3434 ConstraintKinds
3535 DataKinds
3636 DeriveFunctor
37− DeriveGeneric
3837 FlexibleContexts
3938 FlexibleInstances
4039 GADTs
@@ -67,20 +66,18 @@ library
6766
6867 ghc-options: -O2
6968
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
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
7977
8078 hs-source-dirs: src
8179
82− exposed-modules: Effectful
83− Effectful.Dispatch.Dynamic
80+ exposed-modules: Effectful.Dispatch.Dynamic
8481 Effectful.Dispatch.Static
8582 Effectful.Error
8683 Effectful.Error.Dynamic
effectful-core/src/Effectful/Dispatch/Dynamic.hs+29−41
@@ -7,7 +7,7 @@ module Effectful.Dispatch.Dynamic
77 , interpret
88 , reinterpret
99
10− -- ** Handling local 'Eff' computations
10+ -- ** Handling local 'Eff' operations
1111 , LocalEnv
1212
1313 -- *** Unlifts
@@ -32,8 +32,7 @@ module Effectful.Dispatch.Dynamic
3232 ) where
3333
3434import Control.Monad.IO.Unlift
35−import Data.Kind
36−import GHC.Stack (HasCallStack)
35+import GHC.Stack
3736
3837import Effectful.Internal.Effect
3938import Effectful.Internal.Env
@@ -50,7 +49,7 @@ interpret
5049 -> Eff es a
5150interpret handler m = unsafeEff $ \es -> do
5251 les <- forkEnv es
53− (`unEff` es) $ runHandler (HandlerA les handler) m
52+ (`unEff` es) $ runHandler (Handler les handler) m
5453
5554-- | Interpret an effect using other effects.
5655reinterpret
@@ -63,7 +62,7 @@ reinterpret
6362reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
6463 les0 <- forkEnv es
6564 (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do
66− (`unEff` es) $ runHandler (HandlerA les handler) m
65+ (`unEff` es) $ runHandler (Handler les handler) m
6766
6867----------------------------------------
6968-- Unlifts
@@ -78,7 +77,7 @@ localSeqUnlift
7877 -- ^ Continuation with the unlifting function in scope.
7978 -> Eff es a
8079localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
81− seqUnliftIO les $ \unlift -> do
80+ seqUnliftEff les $ \unlift -> do
8281 (`unEff` es) $ k $ unsafeEff_ . unlift
8382
8483-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
@@ -90,7 +89,7 @@ localSeqUnliftIO
9089 -> ((forall r. Eff localEs r -> IO r) -> IO a)
9190 -- ^ Continuation with the unlifting function in scope.
9291 -> Eff es a
93−localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftIO les k
92+localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftEff les k
9493
9594-- | Create a local unlifting function with the given strategy.
9695localUnlift
@@ -103,10 +102,10 @@ localUnlift
103102 -> Eff es a
104103localUnlift (LocalEnv les) strategy k = case strategy of
105104 SeqUnlift -> unsafeEff $ \es -> do
106− seqUnliftIO les $ \unlift -> do
105+ seqUnliftEff les $ \unlift -> do
107106 (`unEff` es) $ k $ unsafeEff_ . unlift
108107 ConcUnlift p l -> unsafeEff $ \es -> do
109− concUnliftIO les p l $ \unlift -> do
108+ concUnliftEff les p l $ \unlift -> do
110109 (`unEff` es) $ k $ unsafeEff_ . unlift
111110
112111-- | Create a local unlifting function with the given strategy.
@@ -119,10 +118,10 @@ localUnliftIO
119118 -- ^ Continuation with the unlifting function in scope.
120119 -> Eff es a
121120localUnliftIO (LocalEnv les) strategy k = case strategy of
122− SeqUnlift -> liftIO $ seqUnliftIO les k
123− ConcUnlift p l -> liftIO $ concUnliftIO les p l k
121+ SeqUnlift -> liftIO $ seqUnliftEff les k
122+ ConcUnlift p l -> liftIO $ concUnliftEff les p l k
124123
125−-- | Utility for lifting 'Eff' computations of type
124+-- | Utility for lifting 'Eff' operations of type
126125--
127126-- @'Eff' es a -> 'Eff' es b@
128127--
@@ -130,7 +129,7 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of
130129--
131130-- @'Eff' localEs a -> 'Eff' localEs b@
132131--
133−-- /Note:/ the computation must not run its argument in a separate thread,
132+-- /Note:/ the operation must not run its argument in a separate thread,
134133-- attempting to do so will result in a runtime error.
135134withLiftMap
136135 :: (HasCallStack, SuffixOf es handlerEs)
@@ -143,10 +142,10 @@ withLiftMap !_ k = unsafeEff $ \es -> do
143142 -- The LocalEnv parameter is not used, but we need it to constraint the
144143 -- localEs type variable. It's also strict so that callers don't cheat.
145144 (`unEff` es) $ k $ \mapEff m -> unsafeEff $ \localEs -> do
146− seqUnliftIO localEs $ \unlift -> do
145+ seqUnliftEff localEs $ \unlift -> do
147146 (`unEff` es) . mapEff . unsafeEff_ $ unlift m
148147
149−-- | Utility for lifting 'IO' computations of type
148+-- | Utility for lifting 'IO' operations of type
150149--
151150-- @'IO' a -> 'IO' b@
152151--
@@ -154,11 +153,11 @@ withLiftMap !_ k = unsafeEff $ \es -> do
154153--
155154-- @'Eff' localEs a -> 'Eff' localEs b@
156155--
157−-- /Note:/ the computation must not run its argument in a separate thread,
156+-- /Note:/ the operation must not run its argument in a separate thread,
158157-- attempting to do so will result in a runtime error.
159158--
160159-- Useful e.g. for lifting the unmasking function in
161−-- 'Control.Exception.mask'-like computations:
160+-- 'Control.Exception.mask'-like operations:
162161--
163162-- >>> :{
164163-- data Fork :: Effect where
@@ -181,17 +180,17 @@ withLiftMapIO
181180withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do
182181 -- The LocalEnv parameter is not used, but we need it to constraint the
183182 -- localEs type variable. It's also strict so that callers don't cheat.
184− seqUnliftIO es $ \unlift -> mapIO $ unlift m
183+ seqUnliftEff es $ \unlift -> mapIO $ unlift m
185184
186185----------------------------------------
187186-- Bidirectional lifts
188187
189188-- | Create a local lifting and unlifting function with the given strategy.
190189--
191−-- Useful for lifting complicated 'Eff' computations where the monadic action
190+-- Useful for lifting complicated 'Eff' operations where the monadic action
192191-- shows in both positive (as a result) and negative (as an argument) position.
193192--
194−-- /Note:/ depending on the computation you're lifting 'localUnlift' along with
193+-- /Note:/ depending on the operation you're lifting 'localUnlift' along with
195194-- 'withLiftMap' might be enough and is more efficient.
196195localLiftUnlift
197196 :: (HasCallStack, SuffixOf es handlerEs)
@@ -203,22 +202,22 @@ localLiftUnlift
203202 -> Eff es a
204203localLiftUnlift (LocalEnv les) strategy k = case strategy of
205204 SeqUnlift -> unsafeEff $ \es -> do
206− seqUnliftIO es $ \unliftEs -> do
207− seqUnliftIO les $ \unliftLocalEs -> do
205+ seqUnliftEff es $ \unliftEs -> do
206+ seqUnliftEff les $ \unliftLocalEs -> do
208207 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
209208 ConcUnlift p l -> unsafeEff $ \es -> do
210− concUnliftIO es p l $ \unliftEs -> do
211− concUnliftIO les p l $ \unliftLocalEs -> do
209+ concUnliftEff es p l $ \unliftEs -> do
210+ concUnliftEff les p l $ \unliftLocalEs -> do
212211 (`unEff` es) $ k (unsafeEff_ . unliftEs) (unsafeEff_ . unliftLocalEs)
213212
214213-- | Create a local unlifting function with the given strategy along with an
215214-- unrestricted lifting function.
216215--
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.
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.
219218--
220−-- /Note:/ depending on the computation you're lifting 'localUnliftIO' along
221−-- with 'withLiftMapIO' might be enough and is more efficient.
219+-- /Note:/ depending on the operation you're lifting 'localUnliftIO' along with
220+-- 'withLiftMapIO' might be enough and is more efficient.
222221localLiftUnliftIO
223222 :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
224223 => LocalEnv localEs handlerEs
@@ -228,19 +227,8 @@ localLiftUnliftIO
228227 -- ^ Continuation with the lifting and unlifting function in scope.
229228 -> Eff es a
230229localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
231− SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_
232− ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
233−
234−----------------------------------------
235−-- Utils
236−
237−-- | Require that the second list of effects is a suffix of the first one.
238−--
239−-- In other words, 'SuffixOf' @es@ @baseEs@ means "a suffix of @es@ is
240−-- @baseEs@".
241−type family SuffixOf (es :: [Effect]) (baseEs :: [Effect]) :: Constraint where
242− SuffixOf baseEs baseEs = ()
243− SuffixOf (e : es) baseEs = SuffixOf es baseEs
230+ SeqUnlift -> liftIO $ seqUnliftEff les $ k unsafeEff_
231+ ConcUnlift p l -> liftIO $ concUnliftEff les p l $ k unsafeEff_
244232
245233-- $setup
246234-- >>> import Control.Concurrent
effectful-core/src/Effectful/Dispatch/Static.hs+21−52
@@ -1,29 +1,18 @@
11module Effectful.Dispatch.Static
22 ( -- * Low level API
3− DataA(..)
3+ IdE(..)
44
5− -- ** Extending the environment
6− , runData
7− , evalData
8− , execData
5+ -- ** Running
6+ , runEffect
7+ , evalEffect
8+ , execEffect
99
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
10+ -- ** Modification
11+ , getEffect
12+ , putEffect
13+ , stateEffect
14+ , stateEffectM
15+ , localEffect
2716
2817 -- * Primitive API
2918 , Env
@@ -46,37 +35,17 @@ module Effectful.Dispatch.Static
4635 , putEnv
4736 , stateEnv
4837 , modifyEnv
38+
39+ -- * Unsafe 'Eff' operations
40+ , unsafeEff
41+ , unsafeEff_
42+ , unsafeLiftMapIO
43+ , unsafeUnliftIO
44+
45+ -- * Utils
46+ , unEff
4947 ) where
5048
49+import Effectful.Internal.Effect
5150import Effectful.Internal.Env
5251import 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+23−94
@@ -1,78 +1,28 @@
1−-- | Support for handling errors of a particular type, i.e. checked exceptions.
2−--
3−-- The 'Error' effect is __not__ a general mechanism for handling regular
4−-- exceptions, that's what functions from the @exceptions@ library are for (see
5−-- "Control.Monad.Catch" for more information).
6−--
7−-- In particular, regular exceptions of type @e@ are distinct from errors of
8−-- type @e@ and will __not__ be caught by functions from this module:
9−--
10−-- >>> import qualified Control.Monad.Catch as E
11−-- >>> let boom = error "BOOM!"
12−-- >>> runEff . runError @ErrorCall $ boom `catchError` \_ (_::ErrorCall) -> pure "caught"
13−-- *** Exception: BOOM!
14−-- ...
15−--
16−-- If you want to catch regular exceptions, you should use
17−-- 'Control.Monad.Catch.catch' (or a similar function):
18−--
19−-- >>> runEff $ boom `E.catch` \(_::ErrorCall) -> pure "caught"
20−-- "caught"
21−--
22−-- On the other hand, functions for safe finalization and management of
23−-- resources such as 'Control.Monad.Catch.finally' and
24−-- 'Control.Monad.Catch.bracket' work as expected:
25−--
26−-- >>> let msg = liftIO . putStrLn
27−-- >>> :{
28−-- runEff . fmap (either (Left . snd) Right) . runError @String $ do
29−-- E.bracket_ (msg "Beginning.")
30−-- (msg "Cleaning up.")
31−-- (msg "Computing." >> throwError "oops" >> msg "More.")
32−-- :}
33−-- Beginning.
34−-- Computing.
35−-- Cleaning up.
36−-- Left "oops"
37−--
38−-- /Note:/ unlike the 'Control.Monad.Trans.Except.ExceptT' monad transformer
39−-- from the @transformers@ library, the order in which you handle the 'Error'
40−-- effect with regard to other stateful effects does not matter. Consider the
41−-- following:
42−--
43−-- >>> import qualified Control.Monad.State.Strict as T
44−-- >>> import qualified Control.Monad.Except as T
45−--
46−-- >>> let m1 = (T.modify (++ " there!") >> T.throwError "oops") `T.catchError` \_ -> pure ()
47−--
48−-- >>> (`T.runStateT` "Hi") . T.runExceptT $ m1
49−-- (Right (),"Hi there!")
50−--
51−-- >>> T.runExceptT . (`T.runStateT` "Hi") $ m1
52−-- Right ((),"Hi")
53−--
54−-- Here, whether state modifications within the @catchError@ block are lost or
55−-- not depends on the shape of the monad transformer stack, which is surprising
56−-- and can be a source of subtle bugs. On the other hand:
57−--
58−-- >>> import Effectful.State.Local
59−--
60−-- >>> let m2 = (modify (++ " there!") >> throwError "oops") `catchError` \_ (_::String) -> pure ()
61−--
62−-- >>> runEff . runState "Hi" . runError @String $ m2
63−-- (Right (),"Hi there!")
64−--
65−-- >>> runEff . runError @String . runState "Hi" $ m2
66−-- Right ((),"Hi there!")
67−--
68−-- Here, no matter the order of effects, state modifications within the
69−-- @catchError@ block always persist, giving predictable behavior.
1+{- | Support for checked exceptions.
2+
3+The 'Error' effect provided by this module is a suitable replacement for the
4+'Control.Monad.Except.ExceptT' monad transformer found in the @mtl@ library. It
5+is __not__ intended to be a general mechanism for catching errors, that's what
6+functions from the "Control.Monad.Catch" module are for.
7+
8+For example, if you want to catch an unchecked exception like
9+'Control.Exception.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+-}
7021module Effectful.Error
7122 ( Error
7223 , runError
7324 , throwError
7425 , catchError
75− , handleError
7626 , tryError
7727
7828 -- * Re-exports
@@ -90,11 +40,9 @@ import GHC.Stack
9040import Effectful.Dispatch.Static
9141import Effectful.Monad
9242
93−-- | Provide the ability to handle errors of type @e@.
9443newtype Error e :: Effect where
9544 Error :: ErrorId -> Error e m r
9645
97−-- | Handle errors of type @e@.
9846runError
9947 :: forall e es a. Typeable e
10048 => Eff (Error e : es) a
@@ -102,7 +50,7 @@ runError
10250runError m = unsafeEff $ \es0 -> mask $ \release -> do
10351 eid <- newErrorId
10452 size0 <- sizeEnv es0
105− es <- unsafeConsEnv (DataA (Error @e eid)) noRelinker es0
53+ es <- unsafeConsEnv (IdE (Error @e eid)) noRelinker es0
10654 r <- tryErrorIO release eid es `onException` unsafeTailEnv size0 es
10755 unsafeTailEnv size0 es
10856 pure r
@@ -112,48 +60,29 @@ runError m = unsafeEff $ \es0 -> mask $ \release -> do
11260 Left ex -> tryHandler ex eid (\cs e -> Left (cs, e))
11361 $ throwIO ex
11462
115−-- | Throw an error of type @e@.
11663throwError
11764 :: forall e es a. (HasCallStack, Typeable e, Error e :> es)
11865 => e
119− -- ^ The error.
12066 -> Eff es a
12167throwError e = unsafeEff $ \es -> do
122− DataA (Error eid) <- getEnv @(Error e) es
68+ IdE (Error eid) <- getEnv @(Error e) es
12369 throwIO $ ErrorEx eid callStack e
12470
125−-- | Handle an error of type @e@.
12671catchError
12772 :: forall e es a. (Typeable e, Error e :> es)
12873 => Eff es a
129− -- ^ The inner computation.
13074 -> (CallStack -> e -> Eff es a)
131− -- ^ A handler for errors in the inner computation.
13275 -> Eff es a
13376catchError m handler = unsafeEff $ \es -> do
134− DataA (Error eid) <- getEnv @(Error e) es
77+ IdE (Error eid) <- getEnv @(Error e) es
13578 size <- sizeEnv es
13679 catchErrorIO eid (unEff m es) $ \cs e -> do
13780 checkSizeEnv size es
13881 unEff (handler cs e) es
13982
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.
15383tryError
15484 :: forall e es a. (Typeable e, Error e :> es)
15585 => Eff es a
156− -- ^ The inner computation.
15786 -> Eff es (Either (CallStack, e) a)
15887tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)
15988
effectful-core/src/Effectful/Fail.hs−1
@@ -1,4 +1,3 @@
1−-- | Provider of the 'MonadFail' instance for 'Eff'.
21module Effectful.Fail
32 ( Fail(..)
43 , runFail
effectful-core/src/Effectful/Internal/Effect.hs+23−7
@@ -8,6 +8,10 @@
88module Effectful.Internal.Effect
99 ( Effect
1010 , (:>)(..)
11+ , IdE(..)
12+
13+ -- * Utils
14+ , SuffixOf
1115
1216 -- * Re-exports
1317 , Type
@@ -19,16 +23,20 @@ import GHC.TypeLits
1923-- | The kind of effects.
2024type Effect = (Type -> Type) -> Type -> Type
2125
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.
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.
2634--
27−-- For example, a computation that only needs access to a mutable value of type
28−-- 'Integer' would likely use the following type:
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:
2937--
3038-- @
31−-- 'Effectful.State.Local.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
39+-- 'Effectful.State.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
3240-- @
3341class (e :: Effect) :> (es :: [Effect]) where
3442 -- | Get the position of @e@ in @es@.
@@ -51,3 +59,11 @@ instance {-# OVERLAPPING #-} e :> (e : es) where
5159
5260instance e :> es => e :> (x : es) where
5361 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+32−51
@@ -1,38 +1,25 @@
1−{-# LANGUAGE MagicHash #-}
21{-# OPTIONS_HADDOCK not-home #-}
32-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.
43--
54-- This module is intended for internal use only, and may change without warning
65-- in subsequent releases.
76module Effectful.Internal.Env
8− ( -- * The environment
9− Env(..)
10− , Forks(..)
11− , EnvRef(..)
12−
13− -- ** ForkId
14− , ForkId(..)
15− , ForkIdGen(..)
16− , newForkIdGen
17− , cloneForkIdGen
18− , newForkId
19−
20− -- ** Relinker
7+ ( Env
218 , Relinker(..)
229 , noRelinker
2310
24− -- * Operations
11+ -- * Operations
2512 , emptyEnv
2613 , cloneEnv
2714 , forkEnv
2815 , sizeEnv
2916 , checkSizeEnv
3017
31− -- ** Extending and shrinking
18+ -- ** Extending and shrinking
3219 , unsafeConsEnv
3320 , unsafeTailEnv
3421
35− -- ** Data retrieval and update
22+ -- ** Data retrieval and update
3623 , getEnv
3724 , putEnv
3825 , stateEnv
@@ -43,7 +30,7 @@ import Control.Monad
4330import Control.Monad.Primitive
4431import Data.IORef
4532import Data.Primitive.SmallArray
46−import GHC.Exts (Any, SmallMutableArray#)
33+import GHC.Exts (Any)
4734import GHC.Stack (HasCallStack)
4835import Unsafe.Coerce
4936import qualified Data.IntMap.Strict as IM
@@ -81,17 +68,17 @@ type role Env nominal
8168-- @
8269--
8370-- The point of execution is currently at (*), i.e. the mainline. Moreover,
84−-- currently (brackets represent forks):
71+-- currently:
8572--
8673-- - Mainline sees @[e00, e01, e05, e07]@.
8774--
88−-- - @e01@ is an interpreted effect, its handler sees @[e00][e02, e03]@.
75+-- - @e01@ is an interpreted effect, its handler sees @[e00, e02, e03]@.
8976--
90−-- - @e03@ is an interpreted effect, its handler sees @[e00][e02][e04]@.
77+-- - @e03@ is an interpreted effect, its handler sees @[e00, e02, e04]@.
9178--
92−-- - @e05@ is an interpreted effect, its handler sees @[e00, e01][e06]@.
79+-- - @e05@ is an interpreted effect, its handler sees @[e00, e01, e06]@.
9380--
94−-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05][e08,
81+-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05, e08,
9582-- e09]@.
9683--
9784-- If an operation from @e01@ is invoked, the environment in the middle of
@@ -114,11 +101,11 @@ type role Env nominal
114101-- introduced @e12@), so its local environment was temporarily extended with
115102-- it. Moreover, currently:
116103--
117−-- - Handler of @e01@ sees @[e00][e02, e03, e10]@.
104+-- - Handler of @e01@ sees @[e00, e02, e03, e10]@.
118105--
119−-- - Handler of @e10@ sees @[e00][e02, e03][e11]@.
106+-- - Handler of @e10@ sees @[e00, e02, e03, e11]@.
120107--
121−-- - Handler of @e11@ sees @[e00][e02, e03][e12]@.
108+-- - Handler of @e11@ sees @[e00, e02, e03, e12]@.
122109--
123110data Env (es :: [Effect]) = Env
124111 { _forks :: !Forks
@@ -129,7 +116,6 @@ data Env (es :: [Effect]) = Env
129116-- | Local forks of the environment.
130117data Forks = Forks !ForkId !Int !(IORef EnvRef) Forks | NoFork
131118
132−-- | Data held in the environment.
133119data EnvRef = EnvRef
134120 { _size :: !Int
135121 , _data :: !(SmallMutableArray RealWorld Any)
@@ -139,7 +125,6 @@ data EnvRef = EnvRef
139125----------------------------------------
140126-- ForkId
141127
142−-- | Internal id of the fork.
143128newtype ForkId = ForkId { unForkId :: Int }
144129
145130-- | 'ForkId' generation.
@@ -418,43 +403,43 @@ unsafeTailEnv len (Env fork gref _) = case fork of
418403
419404-- | Extract a specific data type from the environment.
420405getEnv
421− :: forall e adapter es. e :> es
406+ :: forall e es adapter. e :> es
422407 => Env es
423408 -> IO (adapter e)
424409getEnv env = do
425− Location i es <- getLocation (reifyIndex @e @es) env
410+ (i, es) <- getLocation (reifyIndex @e @es) env
426411 fromAny <$> readSmallArray es i
427412
428413-- | Replace the data type in the environment with a new value (in place).
429414putEnv
430− :: forall e adapter es. e :> es
415+ :: forall e es adapter. e :> es
431416 => Env es
432417 -> adapter e
433418 -> IO ()
434419putEnv env e = do
435− Location i es <- getLocation (reifyIndex @e @es) env
420+ (i, es) <- getLocation (reifyIndex @e @es) env
436421 e `seq` writeSmallArray es i (toAny e)
437422
438423-- | Modify the data type in the environment (in place) and return a value.
439424stateEnv
440− :: forall e adapter es a. e :> es
425+ :: forall e es adapter a. e :> es
441426 => Env es
442427 -> (adapter e -> (a, adapter e))
443428 -> IO a
444429stateEnv env f = do
445− Location i es <- getLocation (reifyIndex @e @es) env
430+ (i, es) <- getLocation (reifyIndex @e @es) env
446431 (a, e) <- f . fromAny <$> readSmallArray es i
447432 e `seq` writeSmallArray es i (toAny e)
448433 pure a
449434
450435-- | Modify the data type in the environment (in place).
451436modifyEnv
452− :: forall e adapter es. e :> es
437+ :: forall e es adapter. e :> es
453438 => Env es
454439 -> (adapter e -> adapter e)
455440 -> IO ()
456441modifyEnv env f = do
457− Location i es <- getLocation (reifyIndex @e @es) env
442+ (i, es) <- getLocation (reifyIndex @e @es) env
458443 e <- f . fromAny <$> readSmallArray es i
459444 e `seq` writeSmallArray es i (toAny e)
460445
@@ -470,17 +455,13 @@ emptyEnvRef = do
470455 fs <- newSmallArray 0 undefinedData
471456 newIORef $ EnvRef 0 es fs
472457
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−
477458-- | Determine location of the data type in the environment.
478459getLocation
479460 :: Int
480461 -> Env es
481− -> IO Location
462+ -> IO (Int, SmallMutableArray RealWorld Any)
482463getLocation ixE (Env fork ref _) = do
483− EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref
464+ EnvRef n es _ <- readIORef ref
484465 -- Optimized for the common access pattern:
485466 --
486467 -- - Most application code has no access to forks, in which case we look at
@@ -489,25 +470,25 @@ getLocation ixE (Env fork ref _) = do
489470 -- - Effect handlers will most likely access the newest fork with handler
490471 -- specific effects for reinterpretation.
491472 case fork of
492− NoFork -> pure $ Location (ix n) es
473+ NoFork -> pure (ix n, es)
493474 Forks _ baseIx lref forks -> do
494475 EnvRef ln les _ <- readIORef lref
495476 let i = ix (baseIx + ln)
496477 if i >= baseIx
497− then pure $ Location (i - baseIx) les
498− else go es# i forks
478+ then pure (i - baseIx, les)
479+ else go es i forks
499480 where
500− go :: SmallMutableArray# RealWorld Any
481+ go :: SmallMutableArray RealWorld Any
501482 -> Int
502483 -> Forks
503− -> IO Location
504− go es# i = \case
505− NoFork -> pure $ Location i (SmallMutableArray es#)
484+ -> IO (Int, SmallMutableArray RealWorld Any)
485+ go es i = \case
486+ NoFork -> pure (i, es)
506487 Forks _ baseIx lref forks -> do
507488 EnvRef _ les _ <- readIORef lref
508489 if i >= baseIx
509− then pure $ Location (i - baseIx) les
510− else go es# i forks
490+ then pure (i - baseIx, les)
491+ else go es i forks
511492
512493 ix :: Int -> Int
513494 ix n = n - ixE - 1
effectful-core/src/Effectful/Internal/Monad.hs+143−120
@@ -6,7 +6,7 @@
66-- This module is intended for internal use only, and may change without warning
77-- in subsequent releases.
88module Effectful.Internal.Monad
9− ( -- * The 'Eff' monad
9+ ( -- * Monad
1010 Eff
1111 , runPureEff
1212
@@ -22,41 +22,49 @@ module Effectful.Internal.Monad
2222 , IOE
2323 , runEff
2424
25− -- * Prim
25+ -- * Primitive
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(..)
3637
37− -- ** Low-level unlifts
38− , seqUnliftIO
39− , concUnliftIO
38+ --- *** Low-level helpers
39+ , unsafeLiftMapIO
40+ , unsafeUnliftIO
41+ , seqUnliftEff
42+ , concUnliftEff
4043
4144 -- * Effects
4245
43− -- ** Dynamic dispatch
46+ -- ** Handler
4447 , EffectHandler
4548 , LocalEnv(..)
46− , HandlerA(..)
49+ , Handler(..)
4750 , runHandler
51+
52+ -- *** Sending operations
4853 , send
4954
50− -- ** Static dispatch
51− , DataA(..)
52− , runData
53− , evalData
54− , execData
55− , getData
56− , putData
57− , stateData
58− , stateDataM
59− , localData
55+ -- ** Primitive
56+
57+ -- *** Running
58+ , runEffect
59+ , evalEffect
60+ , execEffect
61+
62+ -- *** Modification
63+ , getEffect
64+ , putEffect
65+ , stateEffect
66+ , stateEffectM
67+ , localEffect
6068 ) where
6169
6270import Control.Applicative (liftA2)
@@ -79,43 +87,44 @@ import Effectful.Internal.Unlift
7987
8088type role Eff nominal representational
8189
82−-- | The 'Eff' monad provides the implementation of a computation that performs
90+-- | The 'Eff' monad provides the implementation of an operation that performs
8391-- an arbitrary set of effects. In @'Eff' es a@, @es@ is a type-level list that
84−-- contains all the effects that the computation may perform. For example, a
85−-- computation that produces an 'Integer' by consuming a 'String' from the
86−-- global environment and acting upon a single mutable value of type 'Bool'
87−-- would have the following type:
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:
8896--
8997-- @
90−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
98+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
9199-- @
92100--
93101-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
94102-- Instead, the '(:>)' type class is used to express constraints on the list of
95−-- effects without coupling a computation to a concrete list of effects. For
96−-- example, the above example would be expressed with the following type:
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:
97106--
98107-- @
99−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
108+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
100109-- @
101110--
102−-- This abstraction allows the computation to be used in functions that may
111+-- This abstraction allows the operation to be used in functions that may
103112-- perform other effects, and it also allows the effects to be handled in any
104113-- order.
105114newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
106115 deriving (Monoid, Semigroup)
107116
108−-- | Run a pure 'Eff' computation.
117+-- | Run a pure 'Eff' operation.
109118--
110−-- For running computations with side effects see 'runEff'.
119+-- For running operations with side effects see 'runEff'.
111120runPureEff :: Eff '[] a -> a
112121runPureEff (Eff m) =
113− -- unsafeDupablePerformIO is safe here since IOE was not on the stack, so no
114− -- IO with side effects was performed (unless someone sneakily introduced side
115− -- effects with unsafeEff, but then all bets are off).
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).
116125 --
117126 -- Moreover, internals don't allocate any resources that require explicit
118− -- cleanup actions to run.
127+ -- cleanup actions to run, so the "Dupable" part should also be just fine.
119128 unsafeDupablePerformIO $ m =<< emptyEnv
120129
121130----------------------------------------
@@ -128,68 +137,101 @@ unEff (Eff m) = m
128137-- | Access the underlying 'IO' monad along with the environment.
129138--
130139-- This function is __unsafe__ because it can be used to introduce arbitrary
131−-- 'IO' actions into pure 'Eff' computations.
140+-- 'IO' actions into pure 'Eff' operations.
132141unsafeEff :: (Env es -> IO a) -> Eff es a
133142unsafeEff m = Eff (oneShot m)
134143
135144-- | Access the underlying 'IO' monad.
136145--
137146-- This function is __unsafe__ because it can be used to introduce arbitrary
138−-- 'IO' actions into pure 'Eff' computations.
147+-- 'IO' actions into pure 'Eff' operations.
139148unsafeEff_ :: IO a -> Eff es a
140149unsafeEff_ m = unsafeEff $ \_ -> m
141150
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+
142184----------------------------------------
143−-- Unlifting IO
185+-- Unlifting Eff
144186
145187-- | Get the current 'UnliftStrategy'.
146188unliftStrategy :: IOE :> es => Eff es UnliftStrategy
147189unliftStrategy = do
148− DataA (IOE unlift) <- getData
190+ IdE (IOE unlift) <- getEffect
149191 pure unlift
150192
151193-- | Locally override the 'UnliftStrategy' with the given value.
152194withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
153−withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)
195+withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
154196
155−-- | Create an unlifting function with the current 'UnliftStrategy'.
197+-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
156198--
157−-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
158−-- constraint for accurate stack traces in case an insufficiently powerful
159−-- 'UnliftStrategy' is used and the unlifting function fails.
199+-- Exceptions thrown by this function:
160200--
161−-- /Note:/ the strategy is reset to 'SeqUnlift' inside the continuation.
162−withEffToIO
163− :: (HasCallStack, IOE :> es)
164− => ((forall r. Eff es r -> IO r) -> IO a)
165− -- ^ Continuation with the unlifting function in scope.
166− -> Eff es a
167−withEffToIO f = unliftStrategy >>= \case
168− SeqUnlift -> unsafeEff $ \es -> seqUnliftIO es f
169− ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
170− unsafeEff $ \es -> concUnliftIO es p b f
171−
172−-- | Create an unlifting function with the 'SeqUnlift' strategy.
173−seqUnliftIO
201+-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
202+seqUnliftEff
174203 :: HasCallStack
175204 => Env es
176− -- ^ The environment.
177205 -> ((forall r. Eff es r -> IO r) -> IO a)
178− -- ^ Continuation with the unlifting function in scope.
179206 -> IO a
180−seqUnliftIO es k = seqUnlift k es unEff
207+seqUnliftEff es k = seqUnliftIO k es unEff
181208
182−-- | Create an unlifting function with the 'ConcUnlift' strategy.
183−concUnliftIO
209+-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
210+concUnliftEff
184211 :: HasCallStack
185212 => Env es
186− -- ^ The environment.
187213 -> Persistence
188214 -> Limit
189215 -> ((forall r. Eff es r -> IO r) -> IO a)
190− -- ^ Continuation with the unlifting function in scope.
191216 -> IO a
192−concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
217+concUnliftEff es persistence limit k = concUnliftIO persistence limit k es unEff
218+
219+-- | Create an unlifting function with the current 'UnliftStrategy'.
220+--
221+-- This function is equivalent to 'withRunInIO', but has a 'HasCallStack'
222+-- constraint for accurate stack traces in case an insufficiently powerful
223+-- 'UnliftStrategy' is used and the unlifting function fails.
224+--
225+-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
226+withEffToIO
227+ :: (HasCallStack, IOE :> es)
228+ => ((forall r. Eff es r -> IO r) -> IO a)
229+ -- ^ Continuation with the unlifting function in scope.
230+ -> Eff es a
231+withEffToIO f = unliftStrategy >>= \case
232+ SeqUnlift -> unsafeEff $ \es -> seqUnliftEff es f
233+ ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
234+ unsafeEff $ \es -> concUnliftEff es p b f
193235
194236----------------------------------------
195237-- Base
@@ -258,15 +300,15 @@ instance Fail :> es => MonadFail (Eff es) where
258300----------------------------------------
259301-- IO
260302
261−-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
303+-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.
262304newtype IOE :: Effect where
263305 IOE :: UnliftStrategy -> IOE m r
264306
265−-- | Run an 'Eff' computation with side effects.
307+-- | Run an 'Eff' operation with side effects.
266308--
267−-- For running pure computations see 'runPureEff'.
309+-- For running pure operations see 'runPureEff'.
268310runEff :: Eff '[IOE] a -> IO a
269−runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv
311+runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
270312
271313instance IOE :> es => MonadIO (Eff es) where
272314 liftIO = unsafeEff_
@@ -290,20 +332,20 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where
290332----------------------------------------
291333-- Primitive
292334
293−-- | Provide the ability to perform primitive state-transformer actions.
335+-- | An effect to perform primitive state-transformer actions.
294336data Prim :: Effect where
295337 Prim :: Prim m r
296338
297−-- | Run an 'Eff' computation with primitive state-transformer actions.
339+-- | Run an 'Eff' operation with primitive state-transformer actions.
298340runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
299−runPrim = evalData (DataA Prim)
341+runPrim = evalEffect (IdE Prim)
300342
301343instance Prim :> es => PrimMonad (Eff es) where
302344 type PrimState (Eff es) = RealWorld
303345 primitive = unsafeEff_ . IO
304346
305347----------------------------------------
306−-- Dynamic dispatch
348+-- Handler
307349
308350type role LocalEnv nominal nominal
309351
@@ -319,97 +361,78 @@ newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env l
319361type EffectHandler e es
320362 = forall a localEs. HasCallStack
321363 => LocalEnv localEs es
322− -- ^ Capture of the local environment for handling local 'Eff' computations
323− -- when @e@ is a higher order effect.
364+ -- ^ Capture of the local environment for handling local 'Eff' operations when
365+ -- @e@ is a higher order effect.
324366 -> e (Eff localEs) a
325367 -- ^ The effect performed in the local environment.
326368 -> Eff es a
327369
328370-- | An adapter for dynamically dispatched effects.
329371--
330−-- Represents the effect handler bundled with its environment.
331−data HandlerA :: Effect -> Type where
332− HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e
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
333375
334−-- | Run a dynamically dispatched effect with the given handler.
335−runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
376+-- | Run the effect with the given handler.
377+runHandler :: Handler e -> Eff (e : es) a -> Eff es a
336378runHandler e m = unsafeEff $ \es0 -> do
337379 size0 <- sizeEnv es0
338380 E.bracket (unsafeConsEnv e relinker es0)
339381 (unsafeTailEnv size0)
340382 (\es -> unEff m es)
341383 where
342− relinker :: Relinker HandlerA e
343− relinker = Relinker $ \relink (HandlerA handlerEs handle) -> do
344− newHandlerEs <- relink handlerEs
345− pure $ HandlerA newHandlerEs handle
384+ relinker :: Relinker Handler e
385+ relinker = Relinker $ \relink (Handler env handle) -> do
386+ newEnv <- relink env
387+ pure $ Handler newEnv handle
346388
347389-- | Send an operation of the given effect to its handler for execution.
348390send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
349391send op = unsafeEff $ \es -> do
350− HandlerA handlerEs handle <- getEnv es
392+ Handler handlerEs handle <- getEnv es
351393 unEff (handle (LocalEnv es) op) handlerEs
352394
353395----------------------------------------
354−-- Static dispatch
396+-- Helpers
355397
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
398+runEffect :: adapter e -> Eff (e : es) a -> Eff es (a, adapter e)
399+runEffect e0 m = unsafeEff $ \es0 -> do
367400 size0 <- sizeEnv es0
368401 E.bracket (unsafeConsEnv e0 noRelinker es0)
369402 (unsafeTailEnv size0)
370403 (\es -> (,) <$> unEff m es <*> getEnv es)
371404
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
405+evalEffect :: adapter e -> Eff (e : es) a -> Eff es a
406+evalEffect e m = unsafeEff $ \es0 -> do
376407 size0 <- sizeEnv es0
377408 E.bracket (unsafeConsEnv e noRelinker es0)
378409 (unsafeTailEnv size0)
379410 (\es -> unEff m es)
380411
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
412+execEffect :: adapter e -> Eff (e : es) a -> Eff es (adapter e)
413+execEffect e0 m = unsafeEff $ \es0 -> do
385414 size0 <- sizeEnv es0
386415 E.bracket (unsafeConsEnv e0 noRelinker es0)
387416 (unsafeTailEnv size0)
388417 (\es -> unEff m es *> getEnv es)
389418
390−-- | Fetch the current state of the effect.
391−getData :: e :> es => Eff es (DataA e)
392−getData = unsafeEff $ \es -> getEnv es
419+getEffect :: e :> es => Eff es (adapter e)
420+getEffect = unsafeEff $ \es -> getEnv es
393421
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
422+putEffect :: e :> es => adapter e -> Eff es ()
423+putEffect e = unsafeEff $ \es -> putEnv es e
397424
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
425+stateEffect :: e :> es => (adapter e -> (a, adapter e)) -> Eff es a
426+stateEffect f = unsafeEff $ \es -> stateEnv es f
401427
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
428+stateEffectM :: e :> es => (adapter e -> Eff es (a, adapter e)) -> Eff es a
429+stateEffectM f = unsafeEff $ \es -> E.mask $ \release -> do
406430 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
407431 putEnv es e
408432 pure a
409433
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
434+localEffect :: e :> es => (adapter e -> adapter e) -> Eff es a -> Eff es a
435+localEffect f m = unsafeEff $ \es -> do
413436 E.bracket (stateEnv es $ \e -> (e, f e))
414437 (\e -> putEnv es e)
415438 (\_ -> unEff m es)
effectful-core/src/Effectful/Internal/Unlift.hs+78−35
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DeriveGeneric #-}
12{-# LANGUAGE MagicHash #-}
23{-# LANGUAGE UnboxedTuples #-}
34{-# OPTIONS_HADDOCK not-home #-}
@@ -12,13 +13,17 @@ module Effectful.Internal.Unlift
1213 , Limit(..)
1314
1415 -- * Unlifting functions
15− , seqUnlift
16− , concUnlift
17− , ephemeralConcUnlift
18− , persistentConcUnlift
16+ , seqUnliftIO
17+ , concUnliftIO
18+ , ephemeralConcUnliftIO
19+ , persistentConcUnliftIO
20+
21+ -- * Unlifting errors
22+ , UnliftError(..)
1923 ) where
2024
2125import Control.Concurrent
26+import Control.Exception
2227import Control.Monad
2328import GHC.Conc.Sync (ThreadId(..))
2429import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)
@@ -35,9 +40,8 @@ import Effectful.Internal.Utils
3540----------------------------------------
3641-- Unlift strategies
3742
38−-- | The strategy to use when unlifting 'Eff' computations via 'withRunInIO',
39−-- 'Effectful.Monad.withEffToIO' or the 'Effectful.Dispatch.Dynamic.localUnlift'
40−-- family.
43+-- | The strategy to use when unlifting 'Eff' operations via 'withRunInIO' or
44+-- the 'Effectful.Interpreter.localUnlift' family.
4145data UnliftStrategy
4246 = SeqUnlift
4347 -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
@@ -92,24 +96,26 @@ data Limit
9296-- Unlift functions
9397
9498-- | Sequential unlift.
95−seqUnlift
99+--
100+-- Exceptions thrown by this function:
101+--
102+-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
103+seqUnliftIO
96104 :: HasCallStack
97105 => ((forall r. m r -> IO r) -> IO a)
98106 -> Env es
99107 -> (forall r. m r -> Env es -> IO r)
100108 -> IO a
101−seqUnlift k es unEff = do
109+seqUnliftIO k es unEff = do
102110 tid0 <- myThreadId
103111 k $ \m -> do
104112 tid <- myThreadId
105113 if tid `eqThreadId` tid0
106114 then unEff m es
107− else error
108− $ "If you want to use the unlifting function to run Eff computations "
109− ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
115+ else throwIO InvalidUseOfSeqUnlift
110116
111117-- | Concurrent unlift for various strategies and limits.
112−concUnlift
118+concUnliftIO
113119 :: HasCallStack
114120 => Persistence
115121 -> Limit
@@ -117,18 +123,23 @@ concUnlift
117123 -> Env es
118124 -> (forall r. m r -> Env es -> IO r)
119125 -> IO a
120−concUnlift Ephemeral (Limited uses) k =
121− ephemeralConcUnlift uses k
122−concUnlift Ephemeral Unlimited k =
123− ephemeralConcUnlift maxBound k
124−concUnlift Persistent (Limited threads) k =
125− persistentConcUnlift False threads k
126−concUnlift Persistent Unlimited k =
127− persistentConcUnlift True maxBound k
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
128134
129135-- | Concurrent unlift that doesn't preserve the environment between calls to
130136-- the unlifting function in threads other than its creator.
131−ephemeralConcUnlift
137+--
138+-- Exceptions thrown by this function:
139+--
140+-- - 'InvalidNumberOfUses' if the number of uses is less or equal zero.
141+-- - 'ExceededNumberOfUses' if the unlift function is called too often.
142+ephemeralConcUnliftIO
132143 :: HasCallStack
133144 => Int
134145 -- ^ Number of permitted uses of the unlift function.
@@ -136,9 +147,9 @@ ephemeralConcUnlift
136147 -> Env es
137148 -> (forall r. m r -> Env es -> IO r)
138149 -> IO a
139−ephemeralConcUnlift uses k es0 unEff = do
150+ephemeralConcUnliftIO uses k es0 unEff = do
140151 unless (uses > 0) $ do
141− error $ "Invalid number of uses: " ++ show uses
152+ throwIO $ InvalidNumberOfUses uses
142153 tid0 <- myThreadId
143154 -- Create a copy of the environment as a template for the other threads to
144155 -- use. This can't be done from inside the callback as the environment might
@@ -149,10 +160,7 @@ ephemeralConcUnlift uses k es0 unEff = do
149160 es <- myThreadId >>= \case
150161 tid | tid0 `eqThreadId` tid -> pure es0
151162 _ -> modifyMVar mvUses $ \case
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."
163+ 0 -> throwIO $ ExceededNumberOfUses uses
156164 1 -> pure (0, esTemplate)
157165 n -> do
158166 let newUses = n - 1
@@ -162,7 +170,13 @@ ephemeralConcUnlift uses k es0 unEff = do
162170
163171-- | Concurrent unlift that preserves the environment between calls to the
164172-- unlifting function within a particular thread.
165−persistentConcUnlift
173+--
174+-- Exceptions thrown by this function:
175+--
176+-- - 'InvalidNumberOfThreads' if the number of threads is less or equal zero.
177+-- - 'ExceededNumberOfThreads' if the unlift function is called by too many
178+-- threads.
179+persistentConcUnliftIO
166180 :: HasCallStack
167181 => Bool
168182 -> Int
@@ -171,9 +185,9 @@ persistentConcUnlift
171185 -> Env es
172186 -> (forall r. m r -> Env es -> IO r)
173187 -> IO a
174−persistentConcUnlift cleanUp threads k es0 unEff = do
188+persistentConcUnliftIO cleanUp threads k es0 unEff = do
175189 unless (threads > 0) $ do
176− error $ "Invalid number of threads: " ++ show threads
190+ throwIO $ InvalidNumberOfThreads threads
177191 tid0 <- myThreadId
178192 -- Create a copy of the environment as a template for the other threads to
179193 -- use. This can't be done from inside the callback as the environment might
@@ -191,10 +205,7 @@ persistentConcUnlift cleanUp threads k es0 unEff = do
191205 case mes of
192206 Just es -> pure (te, es)
193207 Nothing -> case teCapacity te of
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."
208+ 0 -> throwIO $ ExceededNumberOfThreads threads
198209 1 -> do
199210 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp
200211 let newEntries = ThreadEntries
@@ -212,6 +223,38 @@ persistentConcUnlift cleanUp threads k es0 unEff = do
212223 newEntries `seq` pure (newEntries, es)
213224 unEff m es
214225
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+
215258----------------------------------------
216259-- Data types
217260
effectful-core/src/Effectful/Monad.hs+1
@@ -18,6 +18,7 @@ module Effectful.Monad
1818 , unliftStrategy
1919 , withUnliftStrategy
2020 , withEffToIO
21+ , UnliftError(..)
2122
2223 -- * Re-exports
2324 , MonadIO(..)
effectful-core/src/Effectful/Prim.hs−1
@@ -1,4 +1,3 @@
1−-- | Provider of the 'MonadPrim' instance for 'Eff'.
21module Effectful.Prim
32 ( Prim
43 , runPrim
effectful-core/src/Effectful/Reader.hs+4−4
@@ -1,4 +1,4 @@
1−-- | Support for access to a read only value of a particular type.
1+-- | The 'Reader' effect.
22module Effectful.Reader
33 ( Reader
44 , runReader
@@ -20,12 +20,12 @@ runReader
2020 :: r -- ^ An initial environment.
2121 -> Eff (Reader r : es) a
2222 -> Eff es a
23−runReader r = evalData (DataA (Reader r))
23+runReader r = evalEffect (IdE (Reader r))
2424
2525-- | Fetch the value of the environment.
2626ask :: Reader r :> es => Eff es r
2727ask = do
28− DataA (Reader r) <- getData
28+ IdE (Reader r) <- getEffect
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 = localData $ \(DataA (Reader r)) -> DataA (Reader (f r))
49+local f = localEffect $ \(IdE (Reader r)) -> IdE (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 value of type @s@.
30+-- | Provide access to a mutable state 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+13−34
@@ -1,29 +1,12 @@
1−-- | Support for access to a mutable value of a particular type, which is:
1+-- | The 'State' effect.
22--
3−-- - thread local (if you want the value to be shared between threads, have a
3+-- Represented as a pure value underneath, therefore:
4+--
5+-- - thread local (if you need the state to be shared between threads, have a
46-- look at "Effectful.State.Shared"),
57--
68-- - very fast.
79--
8−-- /Note:/ unlike the 'Control.Monad.Trans.State.StateT' monad transformer from
9−-- the @transformers@ library, the 'State' effect doesn't lose state
10−-- modifications when an exception is received:
11−--
12−-- >>> import qualified Control.Monad.Trans.State.Strict as S
13−--
14−-- >>> :{
15−-- (`S.execStateT` "Hi") . handle (\(_::ErrorCall) -> pure ()) $ do
16−-- S.modify (++ " there!")
17−-- error "oops"
18−-- :}
19−-- "Hi"
20−--
21−-- >>> :{
22−-- runEff . execState "Hi" . handle (\(_::ErrorCall) -> pure ()) $ do
23−-- modify (++ " there!")
24−-- error "oops"
25−-- :}
26−-- "Hi there!"
2710module Effectful.State.Local
2811 ( State
2912 , runState
@@ -41,7 +24,7 @@ module Effectful.State.Local
4124import Effectful.Dispatch.Static
4225import Effectful.Monad
4326
44−-- | Provide access to a strict (WHNF), thread local, mutable value of type @s@.
27+-- | Provide access to a strict (WHNF), thread local, mutable state of type @s@.
4528newtype State s :: Effect where
4629 State :: s -> State s m r
4730
@@ -52,7 +35,7 @@ runState
5235 -> Eff (State s : es) a
5336 -> Eff es (a, s)
5437runState s0 m = do
55− (a, DataA (State s)) <- runData (DataA (State s0)) m
38+ (a, IdE (State s)) <- runEffect (IdE (State s0)) m
5639 pure (a, s)
5740
5841-- | Run a 'State' effect with the given initial state and return the final
@@ -61,7 +44,7 @@ evalState
6144 :: s -- ^ An initial state.
6245 -> Eff (State s : es) a
6346 -> Eff es a -- ^ A return value.
64−evalState s = evalData (DataA (State s))
47+evalState s = evalEffect (IdE (State s))
6548
6649-- | Run a 'State' effect with the given initial state and return the final
6750-- state, discarding the final value.
@@ -70,13 +53,13 @@ execState
7053 -> Eff (State s : es) a
7154 -> Eff es s
7255execState s0 m = do
73− DataA (State s) <- execData (DataA (State s0)) m
56+ IdE (State s) <- execEffect (IdE (State s0)) m
7457 pure s
7558
7659-- | Fetch the current value of the state.
7760get :: State s :> es => Eff es s
7861get = do
79− DataA (State s) <- getData
62+ IdE (State s) <- getEffect
8063 pure s
8164
8265-- | Get a function of the current state.
@@ -90,14 +73,14 @@ gets f = f <$> get
9073
9174-- | Set the current state to the given value.
9275put :: State s :> es => s -> Eff es ()
93−put s = putData (DataA (State s))
76+put s = putEffect (IdE (State s))
9477
9578-- | Apply the function to the current state and return a value.
9679state
9780 :: State s :> es
9881 => (s -> (a, s)) -- ^ The function to modify the state.
9982 -> Eff es a
100−state f = stateData $ \(DataA (State s0)) -> let (a, s) = f s0 in (a, DataA (State s))
83+state f = stateEffect $ \(IdE (State s0)) -> let (a, s) = f s0 in (a, IdE (State s))
10184
10285-- | Apply the function to the current state.
10386--
@@ -113,9 +96,9 @@ stateM
11396 :: State s :> es
11497 => (s -> Eff es (a, s)) -- ^ The function to modify the state.
11598 -> Eff es a
116−stateM f = stateDataM $ \(DataA (State s0)) -> do
99+stateM f = stateEffectM $ \(IdE (State s0)) -> do
117100 (a, s) <- f s0
118− pure (a, DataA (State s))
101+ pure (a, IdE (State s))
119102
120103-- | Apply the monadic function to the current state.
121104--
@@ -125,7 +108,3 @@ modifyM
125108 => (s -> Eff es s) -- ^ The monadic function to modify the state.
126109 -> Eff es ()
127110modifyM 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+12−61
@@ -1,29 +1,11 @@
1−-- | Support for access to a mutable value of a particular type, which is:
1+-- | The 'State' effect.
22--
3−-- - shared between multiple threads (if you want each thead to manage its own
4−-- version of the value, see "Effectful.State.Local").
3+-- Represented as an 'MVar' underneath, therefore:
54--
6−-- - slightly slower than "Effectful.State.Local".
5+-- - shareable between multiple threads,
76--
8−-- /Note:/ unlike the 'Control.Monad.Trans.State.StateT' monad transformer from
9−-- the @transformers@ library, the 'State' effect doesn't lose state
10−-- modifications when an exception is received:
7+-- - slower than "Effectful.State.Local".
118--
12−-- >>> import qualified Control.Monad.Trans.State.Strict as S
13−--
14−-- >>> :{
15−-- (`S.execStateT` "Hi") . handle (\(_::ErrorCall) -> pure ()) $ do
16−-- S.modify (++ " there!")
17−-- error "oops"
18−-- :}
19−-- "Hi"
20−--
21−-- >>> :{
22−-- runEff . execState "Hi" . handle (\(_::ErrorCall) -> pure ()) $ do
23−-- modify (++ " there!")
24−-- error "oops"
25−-- :}
26−-- "Hi there!"
279module Effectful.State.Shared
2810 ( State
2911 , runState
@@ -43,85 +25,54 @@ import Control.Concurrent.MVar
4325import Effectful.Dispatch.Static
4426import Effectful.Monad
4527
46−-- | Provide access to a strict (WHNF), shared, mutable value of type @s@.
28+-- | Provide access to a strict (WHNF), shareable, mutable state of type @s@.
4729newtype State s :: Effect where
4830 State :: MVar s -> State s m r
4931
50−-- | Run a 'State' effect with the given initial state and return the final
51−-- value along with the final state.
5232runState :: s -> Eff (State s : es) a -> Eff es (a, s)
5333runState s m = do
5434 v <- unsafeEff_ $ newMVar s
55− a <- evalData (DataA (State v)) m
35+ a <- evalEffect (IdE (State v)) m
5636 (a, ) <$> unsafeEff_ (readMVar v)
5737
58−-- | Run a 'State' effect with the given initial state and return the final
59−-- value, discarding the final state.
6038evalState :: s -> Eff (State s : es) a -> Eff es a
6139evalState s m = do
6240 v <- unsafeEff_ $ newMVar s
63− evalData (DataA (State v)) m
41+ evalEffect (IdE (State v)) m
6442
65−-- | Run a 'State' effect with the given initial state and return the final
66−-- state, discarding the final value.
6743execState :: s -> Eff (State s : es) a -> Eff es s
6844execState s m = do
6945 v <- unsafeEff_ $ newMVar s
70− _ <- evalData (DataA (State v)) m
46+ _ <- evalEffect (IdE (State v)) m
7147 unsafeEff_ $ readMVar v
7248
73−-- | Fetch the current value of the state.
7449get :: State s :> es => Eff es s
7550get = unsafeEff $ \es -> do
76− DataA (State v) <- getEnv es
51+ IdE (State v) <- getEnv es
7752 readMVar v
7853
79−-- | Get a function of the current state.
80−--
81−-- @'gets' f ≡ f '<$>' 'get'@
8254gets :: State s :> es => (s -> a) -> Eff es a
8355gets f = f <$> get
8456
85−-- | Set the current state to the given value.
8657put :: State s :> es => s -> Eff es ()
8758put s = unsafeEff $ \es -> do
88− DataA (State v) <- getEnv es
59+ IdE (State v) <- getEnv es
8960 modifyMVar_ v $ \_ -> s `seq` pure s
9061
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.
9462state :: State s :> es => (s -> (a, s)) -> Eff es a
9563state f = unsafeEff $ \es -> do
96− DataA (State v) <- getEnv es
64+ IdE (State v) <- getEnv es
9765 modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)
9866
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.
10467modify :: State s :> es => (s -> s) -> Eff es ()
10568modify f = state (\s -> ((), f s))
10669
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.
11070stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
11171stateM f = unsafeEff $ \es -> do
112− DataA (State v) <- getEnv es
72+ IdE (State v) <- getEnv es
11373 modifyMVar v $ \s0 -> do
11474 (a, s) <- unEff (f s0) es
11575 s `seq` pure (s, a)
11676
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.
12277modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()
12378modifyM 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+13−26
@@ -1,6 +1,8 @@
1−-- | Support for access to a write only value of a particular type, which is:
1+-- | The 'Writer' effect.
22--
3−-- - thread local (if you want the value to be shared between threads, have a
3+-- Represented as a pure value underneath, therefore:
4+--
5+-- - thread local (if you need the state to be shared between threads, have a
46-- look at "Effectful.Writer.Shared"),
57--
68-- - very fast.
@@ -24,7 +26,7 @@ module Effectful.Writer.Local
2426 , listens
2527 ) where
2628
27−import Control.Exception (onException, mask)
29+import Control.Exception
2830
2931import Effectful.Dispatch.Static
3032import Effectful.Monad
@@ -38,46 +40,35 @@ newtype Writer w :: Effect where
3840-- output.
3941runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
4042runWriter m = do
41− (a, DataA (Writer w)) <- runData (DataA (Writer mempty)) m
43+ (a, IdE (Writer w)) <- runEffect (IdE (Writer mempty)) m
4244 pure (a, w)
4345
4446-- | Run a 'Writer' effect and return the final output, discarding the final
4547-- value.
4648execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
4749execWriter m = do
48− DataA (Writer w) <- execData (DataA (Writer mempty)) m
50+ IdE (Writer w) <- execEffect (IdE (Writer mempty)) m
4951 pure w
5052
5153-- | Append the given output to the overall output of the 'Writer'.
5254tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
53−tell w = stateData $ \(DataA (Writer w0)) -> ((), DataA (Writer (w0 <> w)))
55+tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))
5456
5557-- | Execute an action and append its output to the overall output of the
5658-- 'Writer'.
5759--
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!"
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'.
7263listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
7364listen m = unsafeEff $ \es -> mask $ \restore -> do
74− w0 <- stateEnv es $ \(DataA (Writer w)) -> (w, DataA (Writer mempty))
65+ w0 <- stateEnv es $ \(IdE (Writer w)) -> (w, IdE (Writer mempty))
7566 a <- restore (unEff m es) `onException` merge es w0
7667 (a, ) <$> merge es w0
7768 where
7869 merge es w0 =
7970 -- If an exception is thrown, restore w0 and keep parts of w1.
80− stateEnv es $ \(DataA (Writer w1)) -> (w1, DataA (Writer (w0 <> w1)))
71+ stateEnv es $ \(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))
8172
8273-- | Execute an action and append its output to the overall output of the
8374-- 'Writer', then return the final value along with a function of the recorded
@@ -88,7 +79,3 @@ listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
8879listens f m = do
8980 (a, w) <- listen m
9081 pure (a, f w)
91−
92−-- $setup
93−-- >>> import Control.Exception (ErrorCall)
94−-- >>> import Control.Monad.Catch
effectful-core/src/Effectful/Writer/Shared.hs+7−55
@@ -1,20 +1,3 @@
1−-- | Support for access to a write only value of a particular type, which is:
2−--
3−-- - shared between multiple threads (if you want each thead to manage its own
4−-- version of the value, see "Effectful.Writer.Local").
5−--
6−-- - slightly slower than "Effectful.Writer.Local".
7−--
8−-- /Warning:/ 'Writer'\'s state will be accumulated via __left-associated__ uses
9−-- of '<>', which makes it unsuitable for use with types for which such pattern
10−-- is inefficient. __This applies, in particular, to the standard list type__,
11−-- which makes the 'Writer' effect pretty niche.
12−--
13−-- /Note:/ while the 'Control.Monad.Trans.Writer.Strict.Writer' from the
14−-- @transformers@ package includes additional operations
15−-- 'Control.Monad.Trans.Writer.Strict.pass' and
16−-- 'Control.Monad.Trans.Writer.Strict.censor', they don't cooperate with runtime
17−-- exceptions very well, so they're deliberately omitted here.
181module Effectful.Writer.Shared
192 ( Writer
203 , runWriter
@@ -25,54 +8,32 @@ module Effectful.Writer.Shared
258 ) where
269
2710import Control.Concurrent.MVar
28−import Control.Exception (onException, uninterruptibleMask)
11+import Control.Exception
2912
3013import Effectful.Dispatch.Static
3114import Effectful.Monad
3215
33−-- | Provide access to a strict (WHNF), shared, write only value of type @w@.
16+-- | Provide access to a strict (WHNF), shareable, write only value of type @w@.
3417newtype Writer w :: Effect where
3518 Writer :: MVar w -> Writer w m r
3619
37−-- | Run a 'Writer' effect and return the final value along with the final
38−-- output.
3920runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
4021runWriter m = do
4122 v <- unsafeEff_ $ newMVar mempty
42− a <- evalData (DataA (Writer v)) m
23+ a <- evalEffect (IdE (Writer v)) m
4324 (a, ) <$> unsafeEff_ (readMVar v)
4425
45−-- | Run a 'Writer' effect and return the final output, discarding the final
46−-- value.
4726execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
4827execWriter m = do
4928 v <- unsafeEff_ $ newMVar mempty
50− _ <- evalData (DataA (Writer v)) m
29+ _ <- evalEffect (IdE (Writer v)) m
5130 unsafeEff_ $ readMVar v
5231
53−-- | Append the given output to the overall output of the 'Writer'.
5432tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
5533tell w1 = unsafeEff $ \es -> do
56− DataA (Writer v) <- getEnv es
34+ IdE (Writer v) <- getEnv es
5735 modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w
5836
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!"
7637listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
7738listen m = unsafeEff $ \es -> do
7839 -- The mask is uninterruptible because modifyMVar_ v0 in the merge function
@@ -81,28 +42,19 @@ listen m = unsafeEff $ \es -> do
8142 uninterruptibleMask $ \restore -> do
8243 v1 <- newMVar mempty
8344 -- Replace thread local MVar with a fresh one for isolated listening.
84− v0 <- stateEnv es $ \(DataA (Writer v)) -> (v, DataA (Writer v1))
45+ v0 <- stateEnv es $ \(IdE (Writer v)) -> (v, IdE (Writer v1))
8546 a <- restore (unEff m es) `onException` merge es v0 v1
8647 (a, ) <$> merge es v0 v1
8748 where
8849 -- Merge results accumulated in the local MVar with the mainline. If an
8950 -- exception was received while listening, merge results recorded so far.
9051 merge es v0 v1 = do
91− putEnv es $ DataA (Writer v0)
52+ putEnv es $ IdE (Writer v0)
9253 w1 <- readMVar v1
9354 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
9455 pure w1
9556
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@
10157listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
10258listens f m = do
10359 (a, w) <- listen m
10460 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_mtl
101− , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)
102−#endif
103100#ifdef VERSION_polysemy
104101 , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)
102+#endif
103+#ifdef VERSION_mtl
104+ , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)
105105#endif
106106 ]
107107 ]
effectful/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.2.1
23+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1
2424
2525bug-reports: https://github.com/arybczak/effectful/issues
2626source-repository head
@@ -40,7 +40,6 @@ common language
4040 ConstraintKinds
4141 DataKinds
4242 DeriveFunctor
43− DeriveGeneric
4443 FlexibleContexts
4544 FlexibleInstances
4645 GADTs
@@ -61,19 +60,20 @@ common language
6160library
6261 import: language
6362
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
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
7372
7473 hs-source-dirs: src
7574
76− exposed-modules: Effectful.Concurrent
75+ exposed-modules: Effectful
76+ Effectful.Concurrent
7777 Effectful.Concurrent.Async
7878 Effectful.Concurrent.Chan
7979 Effectful.Concurrent.MVar
@@ -91,8 +91,7 @@ library
9191 other-modules: Effectful.Concurrent.Effect
9292 Effectful.FileSystem.Effect
9393
94− reexported-modules: Effectful
95− , Effectful.Dispatch.Dynamic
94+ reexported-modules: Effectful.Dispatch.Dynamic
9695 , Effectful.Dispatch.Static
9796 , Effectful.Error
9897 , Effectful.Error.Dynamic
@@ -119,6 +118,7 @@ test-suite test
119118 , effectful-core
120119 , exceptions
121120 , 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.3)
157+ if impl(ghc < 9.2)
158158 build-depends: polysemy
159159
160160 build-depends: base
effectful-core/src/Effectful.hs → effectful/src/Effectful.hsrenamed+4−3
@@ -8,10 +8,10 @@ module Effectful
88
99 -- * Running the 'Eff' monad
1010
11− -- ** Pure computations
11+ -- ** Pure operations
1212 , runPureEff
1313
14− -- ** Computations with side effects
14+ -- ** Operations with side effects
1515 , IOE
1616 , runEff
1717
@@ -22,6 +22,7 @@ module Effectful
2222 , unliftStrategy
2323 , withUnliftStrategy
2424 , withEffToIO
25+ , UnliftError(..)
2526
2627 -- * 'Effect' handlers
2728
@@ -32,7 +33,7 @@ module Effectful
3233 , interpret
3334 , reinterpret
3435
35− -- ** Handling local 'Eff' computations
36+ -- ** Handling local 'Eff' operations
3637 , LocalEnv
3738
3839 -- *** Unlifts
effectful/src/Effectful/Concurrent.hs+2−15
@@ -1,19 +1,6 @@
1−-- | Lifted version of "Control.Concurrent".
2−--
3−-- For functions that spawn threads, the order of preference for their usage is
4−-- recommended as follows:
5−--
6−-- 1) High level functions from "Effectful.Concurrent.Async" such as
7−-- 'Effectful.Concurrent.Async.withAsync',
8−-- 'Effectful.Concurrent.Async.concurrently' or
9−-- 'Effectful.Concurrent.Async.mapConcurrently'.
10−--
11−-- 2) Low level functions from "Effectful.Concurrent.Async" such as
12−-- 'Effectful.Concurrent.Async.async'.
13−--
14−-- 3) Low level functions from "Effectful.Concurrent" such as 'forkIO'.
151module Effectful.Concurrent
16− ( Concurrent
2+ ( -- * Concurrent effect
3+ Concurrent
174 , runConcurrent
185
196 -- * 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".
32module Effectful.Concurrent.Async
4− ( Concurrent
3+ ( -- * Concurrent effect
4+ Concurrent
55 , runConcurrent
66
77 -- * Asynchronous actions
effectful/src/Effectful/Concurrent/Chan.hs+1−5
@@ -1,10 +1,6 @@
11-- | Lifted version of "Control.Concurrent.Chan".
22module Effectful.Concurrent.Chan
3− ( Concurrent
4− , runConcurrent
5−
6− -- * Chan
7− , Chan
3+ ( Chan
84 , newChan
95 , writeChan
106 , readChan
effectful/src/Effectful/Concurrent/Effect.hs+5−65
@@ -6,74 +6,14 @@ module Effectful.Concurrent.Effect
66import Effectful.Dispatch.Static
77import Effectful.Monad
88
9−-- | Provide the ability to run 'Eff' computations concurrently in multiple
10−-- threads and communicate between them.
9+-- | Run 'Eff' operations asynchronously via the @async@ library.
1110--
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.
11+-- /Note:/ thread local state changes in 'Eff' operations run asynchronously
12+-- will not affect the parent thread.
6913--
14+-- /TODO:/ write about 'Concurrent' not respecting scoped operations.
7015data Concurrent :: Effect where
7116 Concurrent :: Concurrent m r
7217
73−-- | Run the 'Concurrent' effect.
7418runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a
75−runConcurrent = evalData (DataA Concurrent)
76−
77−-- $setup
78−-- >>> import Effectful.Concurrent
79−-- >>> import Effectful.Concurrent.Async
19+runConcurrent = evalEffect (IdE Concurrent)
effectful/src/Effectful/Concurrent/MVar.hs+1−5
@@ -1,10 +1,6 @@
11-- | Lifted version of "Control.Concurrent.MVar".
22module Effectful.Concurrent.MVar
3− ( Concurrent
4− , runConcurrent
5−
6− -- * MVar
7− , MVar
3+ ( MVar
84 , newEmptyMVar
95 , newMVar
106 , takeMVar
effectful/src/Effectful/Concurrent/QSem.hs+2−6
@@ -1,10 +1,6 @@
1−-- | Lifted version of "Control.Concurrent.QSem".
1+-- | Lifted "Control.Concurrent.QSem".
22module Effectful.Concurrent.QSem
3− ( Concurrent
4− , runConcurrent
5−
6− -- * QSem
7− , QSem
3+ ( QSem
84 , newQSem
95 , waitQSem
106 , signalQSem
effectful/src/Effectful/Concurrent/QSemN.hs+2−6
@@ -1,10 +1,6 @@
1−-- | Lifted version of "Control.Concurrent.QSemN".
1+-- | Lifted "Control.Concurrent.QSemN".
22module Effectful.Concurrent.QSemN
3− ( Concurrent
4− , runConcurrent
5−
6− -- * QSemN
7− , QSemN
3+ ( QSemN
84 , newQSemN
95 , waitQSemN
106 , signalQSemN
effectful/src/Effectful/Concurrent/STM.hs+2−5
@@ -1,10 +1,7 @@
11-- | Lifted version of "Control.Concurrent.STM".
22module Effectful.Concurrent.STM
3− ( Concurrent
4− , runConcurrent
5−
6− -- * Core
7− , STM.STM
3+ ( -- * Core
4+ STM.STM
85 , atomically
96 , STM.retry
107 , STM.orElse
effectful/src/Effectful/Environment.hs+3−3
@@ -1,5 +1,6 @@
11module Effectful.Environment
2− ( Environment
2+ ( -- * Environment effect
3+ Environment
34 , runEnvironment
45
56 -- * Querying the environment
@@ -26,9 +27,8 @@ import Effectful.Monad
2627data Environment :: Effect where
2728 Environment :: Environment m r
2829
29−-- | Run the 'Environment' effect.
3030runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a
31−runEnvironment = evalData (DataA Environment)
31+runEnvironment = evalEffect (IdE 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 = evalData (DataA FileSystem)
103+runFileSystem = evalEffect (IdE 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 = evalData (DataA FileSystem)
15+runFileSystem = evalEffect (IdE FileSystem)
effectful/src/Effectful/FileSystem/IO.hs−2
@@ -2,8 +2,6 @@
22module Effectful.FileSystem.IO
33 ( FileSystem
44 , runFileSystem
5−
6− -- * IO
75 , IOMode (..)
86 , Handle
97 , IO.stdin
effectful/src/Effectful/Process.hs+4−3
@@ -1,7 +1,8 @@
11{-# LANGUAGE CPP #-}
2−-- | Lifted version of "System.Process".
2+
33module Effectful.Process
4− ( Process
4+ ( -- * Process effect
5+ Process
56 , runProcess
67
78 -- * Running sub-processes
@@ -58,7 +59,7 @@ data Process :: Effect where
5859 Process :: Process m r
5960
6061runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a
61−runProcess = evalData (DataA Process)
62+runProcess = evalEffect (IdE Process)
6263
6364----------------------------------------
6465-- Running sub-processes
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 (DataA (Resource istate)) noRelinker es0
40+ es <- unsafeConsEnv (IdE (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− DataA (Resource istate) <- getData
55+ IdE (Resource istate) <- getEffect
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 = evalData (DataA (Resource istate))
62+runInternalState istate = evalEffect $ IdE (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 >>= \(DataA (Resource istate)) -> m istate
69+ getEnv es >>= \(IdE (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 = evalData (DataA Temporary)
22+runTemporary = evalEffect (IdE 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 = evalData (DataA Timeout)
18+runTimeout = evalEffect (IdE Timeout)
1919
2020-- | Lifted 'T.timeout'.
2121timeout
effectful/tests/EnvironmentTests.hs+6−11
@@ -9,17 +9,12 @@ import Effectful.Environment
99import qualified Utils as U
1010
1111environmentTests :: TestTree
12−environmentTests = testCaseSteps "Environment" $ \step -> do
13− -- These tests need to be run sequentially because of
14− -- https://github.com/arybczak/effectful/issues/39.
15− step "set and get an environment variable"
16− test_setAndGet
17− step "unset and try to get an environment variable"
18− test_unsetAndGet
19− step "execute effects with custom arguments"
20− test_withArgs
21− step "execute effects with custom program name"
22− test_withProg
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+ ]
2318
2419test_setAndGet :: Assertion
2520test_setAndGet = runEff . runEnvironment $ do
effectful/tests/UnliftTests.hs+35−28
@@ -1,6 +1,7 @@
1+{-# LANGUAGE OverloadedLabels #-}
12module UnliftTests (unliftTests) where
23
3−import Control.Exception
4+import Optics.Core
45import Test.Tasty
56import Test.Tasty.HUnit
67import qualified UnliftIO.Async as A
@@ -33,38 +34,43 @@ test_resetStrategy = runEff $ do
3334
3435test_seqUnliftInNewThread :: Assertion
3536test_seqUnliftInNewThread = runEff $ do
36− assertThrowsUnliftError "InvalidUseOfSeqUnlift error" $ do
37− withUnliftStrategy SeqUnlift $ do
38− withEffToIO $ \runInIO -> do
39− inThread $ runInIO $ return ()
37+ assertThrowsUnliftError "InvalidUseOfSeqUnlift error"
38+ (has #_InvalidUseOfSeqUnlift) $ do
39+ withUnliftStrategy SeqUnlift $ do
40+ withEffToIO $ \runInIO -> do
41+ inThread $ runInIO $ return ()
4042
4143test_ephemeralInvalid :: Assertion
4244test_ephemeralInvalid = runEff $ do
43− assertThrowsUnliftError "InvalidNumberOfUses error" $ do
44− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do
45− withEffToIO $ \_ -> return ()
45+ assertThrowsUnliftError "InvalidNumberOfUses error"
46+ (has #_InvalidNumberOfUses) $ do
47+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do
48+ withEffToIO $ \_ -> return ()
4649
4750test_ephemeralSameThread :: Assertion
4851test_ephemeralSameThread = runEff $ do
49− assertThrowsUnliftError "ExceededNumberOfUses error" $ do
50− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
51− withEffToIO $ \runInIO -> inThread $ do
52− runInIO $ return ()
53− runInIO $ return ()
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 ()
5458
5559test_ephemeralMultipleThreads :: Assertion
5660test_ephemeralMultipleThreads = runEff $ do
57− assertThrowsUnliftError "ExceededNumberOfUses error" $ do
58− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
59− withEffToIO $ \runInIO -> do
60− inThread $ runInIO $ return ()
61− inThread $ runInIO $ return ()
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 ()
6267
6368test_persistentInvalid :: Assertion
6469test_persistentInvalid = runEff $ do
65− assertThrowsUnliftError "InvalidNumberOfThreads error" $ do
66− withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do
67− withEffToIO $ \_ -> return ()
70+ assertThrowsUnliftError "InvalidNumberOfThreads error"
71+ (has #_InvalidNumberOfThreads) $ do
72+ withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do
73+ withEffToIO $ \_ -> return ()
6874
6975test_persistentSameThread :: Assertion
7076test_persistentSameThread = runEff $ do
@@ -75,19 +81,20 @@ test_persistentSameThread = runEff $ do
7581
7682test_persistentMultipleThreads :: Assertion
7783test_persistentMultipleThreads = runEff $ do
78− assertThrowsUnliftError "ExceededNumberOfThreads error" $ do
79− withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
80− withEffToIO $ \runInIO -> do
81− inThread $ runInIO $ return ()
82− inThread $ runInIO $ return ()
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 ()
8390
8491----------------------------------------
8592-- Helpers
8693
8794assertThrowsUnliftError
8895 :: IOE :> es
89− => String -> Eff es a -> Eff es ()
90−assertThrowsUnliftError err = U.assertThrows err (\ErrorCall{} -> True)
96+ => String -> (UnliftError -> Bool) -> Eff es a -> Eff es ()
97+assertThrowsUnliftError = U.assertThrows
9198
9299inThread :: IO a -> IO a
93100inThread k = A.async k >>= A.wait