git.iko.soy/effectful
on b702e62 help sign in
0d02839
swap
0 ahead, 28 behind
.github/workflows/haskell-ci.yml+8−3
since splitsnapshots
unifiedsplit
@@ -37,6 +37,11 @@ jobs:
37 compilerVersion: 9.2.1
37 compilerVersion: 9.2.1
38 setup-method: ghcup
38 setup-method: ghcup
39 allow-failure: false
39 allow-failure: false
40+ - compiler: ghc-9.0.1
41+ compilerKind: ghc
42+ compilerVersion: 9.0.1
43+ setup-method: hvr-ppa
44+ allow-failure: false
40 - compiler: ghc-8.10.7
45 - compiler: ghc-8.10.7
41 compilerKind: ghc
46 compilerKind: ghc
42 compilerVersion: 8.10.7
47 compilerVersion: 8.10.7
@@ -223,11 +228,11 @@ jobs:
223 - name: doctest
228 - name: doctest
224 run: |
229 run: |
225 cd ${PKGDIR_effectful} || false
230 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
231+ doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src
227 cd ${PKGDIR_effectful_core} || false
232 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
233+ doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators src
229 cd ${PKGDIR_effectful_core} || false
234 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
235+ doctest -XBangPatterns -XConstraintKinds -XDataKinds -XDeriveFunctor -XFlexibleContexts -XFlexibleInstances -XGADTs -XGeneralizedNewtypeDeriving -XLambdaCase -XMultiParamTypeClasses -XNoStarIsType -XRankNTypes -XRecordWildCards -XRoleAnnotations -XScopedTypeVariables -XStandaloneDeriving -XTupleSections -XTypeApplications -XTypeFamilies -XTypeOperators utils
231 - name: cabal check
236 - name: cabal check
232 run: |
237 run: |
233 cd ${PKGDIR_effectful} || false
238 cd ${PKGDIR_effectful} || false
README.md+2−2
@@ -20,8 +20,8 @@ Main features:
20
20
212. Easy to use API (no boilerplate code and dealing with arcane types).
212. Easy to use API (no boilerplate code and dealing with arcane types).
22
22
23−3. Correct semantics in presence of runtime exceptions (no more lost state
23+3. Correct semantics in presence of runtime exceptions (no more lost or
24− modifications).
24+ discarded state).
25
25
264. Seamless integration with the existing ecosystem (`exceptions`,
264. Seamless integration with the existing ecosystem (`exceptions`,
27 `monad-control`, `unliftio-core`, `resourcet` etc.).
27 `monad-control`, `unliftio-core`, `resourcet` etc.).
doctest.sh+1−2
@@ -17,7 +17,6 @@ run_doctest() {
17 -XConstraintKinds \
17 -XConstraintKinds \
18 -XDataKinds \
18 -XDataKinds \
19 -XDeriveFunctor \
19 -XDeriveFunctor \
20− -XDeriveGeneric \
21 -XFlexibleContexts \
20 -XFlexibleContexts \
22 -XFlexibleInstances \
21 -XFlexibleInstances \
23 -XGADTs \
22 -XGADTs \
@@ -37,5 +36,5 @@ run_doctest() {
37 popd
36 popd
38}
37}
39
38
40−run_doctest effectful-core src
41run_doctest effectful src
39run_doctest effectful src
40+run_doctest effectful-core src
effectful-core/effectful-core.cabal+10−13
@@ -18,7 +18,7 @@ description: An easy to use, performant extensible effects library with seamless
18
18
19extra-source-files: CHANGELOG.md
19extra-source-files: CHANGELOG.md
20
20
21−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1
21+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1
22
22
23bug-reports: https://github.com/arybczak/effectful/issues
23bug-reports: https://github.com/arybczak/effectful/issues
24source-repository head
24source-repository head
@@ -34,7 +34,6 @@ common language
34 ConstraintKinds
34 ConstraintKinds
35 DataKinds
35 DataKinds
36 DeriveFunctor
36 DeriveFunctor
37− DeriveGeneric
38 FlexibleContexts
37 FlexibleContexts
39 FlexibleInstances
38 FlexibleInstances
40 GADTs
39 GADTs
@@ -67,20 +66,18 @@ library
67
66
68 ghc-options: -O2
67 ghc-options: -O2
69
68
70− build-depends: effectful-internal-utils
69+ build-depends: base >= 4.13 && <5
71−
72− build-depends: base >= 4.13 && < 5
73− , containers >= 0.6
70+ , containers
71+ , effectful-internal-utils
74− , exceptions >= 0.10.4
72+ , exceptions
75− , monad-control >= 1.0.3
73+ , monad-control
76− , primitive >= 0.7.3.0
74+ , primitive
77− , transformers-base >= 0.4.6
75+ , transformers-base
78− , unliftio-core >= 0.2.0.1
76+ , unliftio-core
79
77
80 hs-source-dirs: src
78 hs-source-dirs: src
81
79
82− exposed-modules: Effectful
80+ exposed-modules: Effectful.Dispatch.Dynamic
83− Effectful.Dispatch.Dynamic
84 Effectful.Dispatch.Static
81 Effectful.Dispatch.Static
85 Effectful.Error
82 Effectful.Error
86 Effectful.Error.Dynamic
83 Effectful.Error.Dynamic
effectful-core/src/Effectful/Dispatch/Dynamic.hs+15−27
@@ -7,7 +7,7 @@ module Effectful.Dispatch.Dynamic
7 , interpret
7 , interpret
8 , reinterpret
8 , reinterpret
9
9
10− -- ** Handling local 'Eff' computations
10+ -- ** Handling local 'Eff' operations
11 , LocalEnv
11 , LocalEnv
12
12
13 -- *** Unlifts
13 -- *** Unlifts
@@ -32,8 +32,7 @@ module Effectful.Dispatch.Dynamic
32 ) where
32 ) where
33
33
34import Control.Monad.IO.Unlift
34import Control.Monad.IO.Unlift
35−import Data.Kind
35+import GHC.Stack
36−import GHC.Stack (HasCallStack)
37
36
38import Effectful.Internal.Effect
37import Effectful.Internal.Effect
39import Effectful.Internal.Env
38import Effectful.Internal.Env
@@ -50,7 +49,7 @@ interpret
50 -> Eff es a
49 -> Eff es a
51interpret handler m = unsafeEff $ \es -> do
50interpret handler m = unsafeEff $ \es -> do
52 les <- forkEnv es
51 les <- forkEnv es
53− (`unEff` es) $ runHandler (HandlerA les handler) m
52+ (`unEff` es) $ runHandler (Handler les handler) m
54
53
55-- | Interpret an effect using other effects.
54-- | Interpret an effect using other effects.
56reinterpret
55reinterpret
@@ -63,7 +62,7 @@ reinterpret
63reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
62reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
64 les0 <- forkEnv es
63 les0 <- forkEnv es
65 (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do
64 (`unEff` les0) . runHandlerEs . unsafeEff $ \les -> do
66− (`unEff` es) $ runHandler (HandlerA les handler) m
65+ (`unEff` es) $ runHandler (Handler les handler) m
67
66
68----------------------------------------
67----------------------------------------
69-- Unlifts
68-- Unlifts
@@ -122,7 +121,7 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of
122 SeqUnlift -> liftIO $ seqUnliftIO les k
121 SeqUnlift -> liftIO $ seqUnliftIO les k
123 ConcUnlift p l -> liftIO $ concUnliftIO les p l k
122 ConcUnlift p l -> liftIO $ concUnliftIO les p l k
124
123
125−-- | Utility for lifting 'Eff' computations of type
124+-- | Utility for lifting 'Eff' operations of type
126--
125--
127-- @'Eff' es a -> 'Eff' es b@
126-- @'Eff' es a -> 'Eff' es b@
128--
127--
@@ -130,7 +129,7 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of
130--
129--
131-- @'Eff' localEs a -> 'Eff' localEs b@
130-- @'Eff' localEs a -> 'Eff' localEs b@
132--
131--
133−-- /Note:/ the computation must not run its argument in a separate thread,
132+-- /Note:/ the operation must not run its argument in a separate thread,
134-- attempting to do so will result in a runtime error.
133-- attempting to do so will result in a runtime error.
135withLiftMap
134withLiftMap
136 :: (HasCallStack, SuffixOf es handlerEs)
135 :: (HasCallStack, SuffixOf es handlerEs)
@@ -146,7 +145,7 @@ withLiftMap !_ k = unsafeEff $ \es -> do
146 seqUnliftIO localEs $ \unlift -> do
145 seqUnliftIO localEs $ \unlift -> do
147 (`unEff` es) . mapEff . unsafeEff_ $ unlift m
146 (`unEff` es) . mapEff . unsafeEff_ $ unlift m
148
147
149−-- | Utility for lifting 'IO' computations of type
148+-- | Utility for lifting 'IO' operations of type
150--
149--
151-- @'IO' a -> 'IO' b@
150-- @'IO' a -> 'IO' b@
152--
151--
@@ -154,11 +153,11 @@ withLiftMap !_ k = unsafeEff $ \es -> do
154--
153--
155-- @'Eff' localEs a -> 'Eff' localEs b@
154-- @'Eff' localEs a -> 'Eff' localEs b@
156--
155--
157−-- /Note:/ the computation must not run its argument in a separate thread,
156+-- /Note:/ the operation must not run its argument in a separate thread,
158-- attempting to do so will result in a runtime error.
157-- attempting to do so will result in a runtime error.
159--
158--
160-- Useful e.g. for lifting the unmasking function in
159-- Useful e.g. for lifting the unmasking function in
161−-- 'Control.Exception.mask'-like computations:
160+-- 'Control.Exception.mask'-like operations:
162--
161--
163-- >>> :{
162-- >>> :{
164-- data Fork :: Effect where
163-- data Fork :: Effect where
@@ -188,10 +187,10 @@ withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do
188
187
189-- | Create a local lifting and unlifting function with the given strategy.
188-- | Create a local lifting and unlifting function with the given strategy.
190--
189--
191−-- Useful for lifting complicated 'Eff' computations where the monadic action
190+-- Useful for lifting complicated 'Eff' operations where the monadic action
192-- shows in both positive (as a result) and negative (as an argument) position.
191-- shows in both positive (as a result) and negative (as an argument) position.
193--
192--
194−-- /Note:/ depending on the computation you're lifting 'localUnlift' along with
193+-- /Note:/ depending on the operation you're lifting 'localUnlift' along with
195-- 'withLiftMap' might be enough and is more efficient.
194-- 'withLiftMap' might be enough and is more efficient.
196localLiftUnlift
195localLiftUnlift
197 :: (HasCallStack, SuffixOf es handlerEs)
196 :: (HasCallStack, SuffixOf es handlerEs)
@@ -214,11 +213,11 @@ localLiftUnlift (LocalEnv les) strategy k = case strategy of
214-- | Create a local unlifting function with the given strategy along with an
213-- | Create a local unlifting function with the given strategy along with an
215-- unrestricted lifting function.
214-- unrestricted lifting function.
216--
215--
217−-- Useful for lifting complicated 'IO' computations where the monadic action
216+-- Useful for lifting complicated 'IO' operations where the monadic action shows
218−-- shows in both positive (as a result) and negative (as an argument) position.
217+-- in both positive (as a result) and negative (as an argument) position.
219--
218--
220−-- /Note:/ depending on the computation you're lifting 'localUnliftIO' along
219+-- /Note:/ depending on the operation you're lifting 'localUnliftIO' along with
221−-- with 'withLiftMapIO' might be enough and is more efficient.
220+-- 'withLiftMapIO' might be enough and is more efficient.
222localLiftUnliftIO
221localLiftUnliftIO
223 :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
222 :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
224 => LocalEnv localEs handlerEs
223 => LocalEnv localEs handlerEs
@@ -231,16 +230,5 @@ localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
231 SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_
230 SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_
232 ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
231 ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
233
232
234−----------------------------------------
235−-- Utils
236−
237−-- | Require that the second list of effects is a suffix of the first one.
238−--
239−-- In other words, 'SuffixOf' @es@ @baseEs@ means "a suffix of @es@ is
240−-- @baseEs@".
241−type family SuffixOf (es :: [Effect]) (baseEs :: [Effect]) :: Constraint where
242− SuffixOf baseEs baseEs = ()
243− SuffixOf (e : es) baseEs = SuffixOf es baseEs
244−
245-- $setup
233-- $setup
246-- >>> import Control.Concurrent
234-- >>> import Control.Concurrent
effectful-core/src/Effectful/Dispatch/Static.hs+33−29
@@ -1,29 +1,18 @@
1module Effectful.Dispatch.Static
1module Effectful.Dispatch.Static
2 ( -- * Low level API
2 ( -- * Low level API
3− DataA(..)
3+ IdE(..)
4
4
5− -- ** Extending the environment
5+ -- ** Running
6− , runData
6+ , runEffect
7− , evalData
7+ , evalEffect
8− , execData
8+ , execEffect
9
9
10− -- ** Data retrieval and update
10+ -- ** Modification
11− , getData
11+ , getEffect
12− , putData
12+ , putEffect
13− , stateData
13+ , stateEffect
14− , stateDataM
14+ , stateEffectM
15− , localData
15+ , localEffect
16−
17− -- ** Unlifts
18− , seqUnliftIO
19− , concUnliftIO
20−
21− -- ** Utils
22− , unEff
23− , unsafeEff
24− , unsafeEff_
25− , unsafeLiftMapIO
26− , unsafeUnliftIO
27
16
28 -- * Primitive API
17 -- * Primitive API
29 , Env
18 , Env
@@ -46,12 +35,24 @@ module Effectful.Dispatch.Static
46 , putEnv
35 , putEnv
47 , stateEnv
36 , stateEnv
48 , modifyEnv
37 , modifyEnv
38+
39+ -- * Unsafe 'Eff' operations
40+ , unsafeEff
41+ , unsafeEff_
42+ , unsafeLiftMapIO
43+ , unsafeUnliftIO
44+
45+ -- * Utils
46+ , unEff
49 ) where
47 ) where
50
48
49+import GHC.Stack (HasCallStack)
50+
51+import Effectful.Internal.Effect
51import Effectful.Internal.Env
52import Effectful.Internal.Env
52import Effectful.Internal.Monad
53import Effectful.Internal.Monad
53
54
54−-- | Utility for lifting 'IO' computations of type
55+-- | Utility for lifting 'IO' operations of type
55--
56--
56-- @'IO' a -> 'IO' b@
57-- @'IO' a -> 'IO' b@
57--
58--
@@ -62,10 +63,10 @@ import Effectful.Internal.Monad
62-- This function is __unsafe__ because:
63-- This function is __unsafe__ because:
63--
64--
64-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
65-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
65−-- computations.
66+-- operations.
66--
67--
67−-- - The 'IO' computation must not run its argument in a separate thread, but
68+-- - The 'IO' operation must not run its argument in a separate thread, but it's
68−-- it's not checked anywhere.
69+-- not checked anywhere.
69unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
70unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
70unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
71unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
71
72
@@ -74,9 +75,12 @@ unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
74-- This function is __unsafe__ because:
75-- This function is __unsafe__ because:
75--
76--
76-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
77-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
77−-- computations.
78+-- operations.
78--
79--
79−-- - Unlifted 'Eff' computations must not be run in a thread distinct from the
80+-- - Unlifted 'Eff' operations must not be run in a thread distinct from the
80-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
81-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
82+unsafeUnliftIO
83+ :: HasCallStack
81−unsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
84+ => ((forall r. Eff es r -> IO r) -> IO a)
85+ -> Eff es a
82unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)
86unsafeUnliftIO 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.
1+{- | Support for checked exceptions.
2−--
2+
3+The 'Error' effect provided by this module is a suitable replacement for the
4+'Control.Monad.Except.ExceptT' monad transformer found in the @mtl@ library. It
3−-- The 'Error' effect is __not__ a general mechanism for handling regular
5+is __not__ intended to be a general mechanism for catching errors, that's what
4−-- exceptions, that's what functions from the @exceptions@ library are for (see
5−-- "Control.Monad.Catch" for more information).
6+functions from the "Control.Monad.Catch" module are for.
6−--
7+
7−-- In particular, regular exceptions of type @e@ are distinct from errors of
8+For example, if you want to catch an unchecked exception like
8−-- type @e@ and will __not__ be caught by functions from this module:
9−--
10−-- >>> import qualified Control.Monad.Catch as E
11−-- >>> let boom = error "BOOM!"
12−-- >>> runEff . runError @ErrorCall $ boom `catchError` \_ (_::ErrorCall) -> pure "caught"
13−-- *** Exception: BOOM!
14−-- ...
15−--
16−-- If you want to catch regular exceptions, you should use
17−-- 'Control.Monad.Catch.catch' (or a similar function):
9+'Control.Exception.ErrorCall' you could use 'Control.Monad.Catch.catch':
18−--
10+
19−-- >>> runEff $ boom `E.catch` \(_::ErrorCall) -> pure "caught"
20−-- "caught"
21−--
22−-- On the other hand, functions for safe finalization and management of
23−-- resources such as 'Control.Monad.Catch.finally' and
24−-- 'Control.Monad.Catch.bracket' work as expected:
11+>>> import qualified Control.Monad.Catch as E
25−--
12+>>> :{
26−-- >>> let msg = liftIO . putStrLn
13+ let boom :: Eff es String
27−-- >>> :{
14+ boom = error "BOOM!"
28−-- runEff . fmap (either (Left . snd) Right) . runError @String $ do
15+ in
29−-- E.bracket_ (msg "Beginning.")
16+ runEff $ boom `E.catch` \(e :: ErrorCall) -> pure "caught some error"
30−-- (msg "Cleaning up.")
31−-- (msg "Computing." >> throwError "oops" >> msg "More.")
32−-- :}
17+:}
33−-- Beginning.
18+"caught some error"
34−-- Computing.
19+
35−-- Cleaning up.
20+-}
36−-- Left "oops"
37−--
38−-- /Note:/ unlike the 'Control.Monad.Trans.Except.ExceptT' monad transformer
39−-- from the @transformers@ library, the order in which you handle the 'Error'
40−-- effect with regard to other stateful effects does not matter. Consider the
41−-- following:
42−--
43−-- >>> import qualified Control.Monad.State.Strict as T
44−-- >>> import qualified Control.Monad.Except as T
45−--
46−-- >>> let m1 = (T.modify (++ " there!") >> T.throwError "oops") `T.catchError` \_ -> pure ()
47−--
48−-- >>> (`T.runStateT` "Hi") . T.runExceptT $ m1
49−-- (Right (),"Hi there!")
50−--
51−-- >>> T.runExceptT . (`T.runStateT` "Hi") $ m1
52−-- Right ((),"Hi")
53−--
54−-- Here, whether state modifications within the @catchError@ block are lost or
55−-- not depends on the shape of the monad transformer stack, which is surprising
56−-- and can be a source of subtle bugs. On the other hand:
57−--
58−-- >>> import Effectful.State.Local
59−--
60−-- >>> let m2 = (modify (++ " there!") >> throwError "oops") `catchError` \_ (_::String) -> pure ()
61−--
62−-- >>> runEff . runState "Hi" . runError @String $ m2
63−-- (Right (),"Hi there!")
64−--
65−-- >>> runEff . runError @String . runState "Hi" $ m2
66−-- Right ((),"Hi there!")
67−--
68−-- Here, no matter the order of effects, state modifications within the
69−-- @catchError@ block always persist, giving predictable behavior.
70module Effectful.Error
21module Effectful.Error
71 ( Error
22 ( Error
72 , runError
23 , runError
73 , throwError
24 , throwError
74 , catchError
25 , catchError
75− , handleError
76 , tryError
26 , tryError
77
27
78 -- * Re-exports
28 -- * Re-exports
@@ -90,11 +40,9 @@ import GHC.Stack
90import Effectful.Dispatch.Static
40import Effectful.Dispatch.Static
91import Effectful.Monad
41import Effectful.Monad
92
42
93−-- | Provide the ability to handle errors of type @e@.
94newtype Error e :: Effect where
43newtype Error e :: Effect where
95 Error :: ErrorId -> Error e m r
44 Error :: ErrorId -> Error e m r
96
45
97−-- | Handle errors of type @e@.
98runError
46runError
99 :: forall e es a. Typeable e
47 :: forall e es a. Typeable e
100 => Eff (Error e : es) a
48 => Eff (Error e : es) a
@@ -102,7 +50,7 @@ runError
102runError m = unsafeEff $ \es0 -> mask $ \release -> do
50runError m = unsafeEff $ \es0 -> mask $ \release -> do
103 eid <- newErrorId
51 eid <- newErrorId
104 size0 <- sizeEnv es0
52 size0 <- sizeEnv es0
105− es <- unsafeConsEnv (DataA (Error @e eid)) noRelinker es0
53+ es <- unsafeConsEnv (IdE (Error @e eid)) noRelinker es0
106 r <- tryErrorIO release eid es `onException` unsafeTailEnv size0 es
54 r <- tryErrorIO release eid es `onException` unsafeTailEnv size0 es
107 unsafeTailEnv size0 es
55 unsafeTailEnv size0 es
108 pure r
56 pure r
@@ -112,48 +60,29 @@ runError m = unsafeEff $ \es0 -> mask $ \release -> do
112 Left ex -> tryHandler ex eid (\cs e -> Left (cs, e))
60 Left ex -> tryHandler ex eid (\cs e -> Left (cs, e))
113 $ throwIO ex
61 $ throwIO ex
114
62
115−-- | Throw an error of type @e@.
116throwError
63throwError
117 :: forall e es a. (HasCallStack, Typeable e, Error e :> es)
64 :: forall e es a. (HasCallStack, Typeable e, Error e :> es)
118 => e
65 => e
119− -- ^ The error.
120 -> Eff es a
66 -> Eff es a
121throwError e = unsafeEff $ \es -> do
67throwError e = unsafeEff $ \es -> do
122− DataA (Error eid) <- getEnv @(Error e) es
68+ IdE (Error eid) <- getEnv @(Error e) es
123 throwIO $ ErrorEx eid callStack e
69 throwIO $ ErrorEx eid callStack e
124
70
125−-- | Handle an error of type @e@.
126catchError
71catchError
127 :: forall e es a. (Typeable e, Error e :> es)
72 :: forall e es a. (Typeable e, Error e :> es)
128 => Eff es a
73 => Eff es a
129− -- ^ The inner computation.
130 -> (CallStack -> e -> Eff es a)
74 -> (CallStack -> e -> Eff es a)
131− -- ^ A handler for errors in the inner computation.
132 -> Eff es a
75 -> Eff es a
133catchError m handler = unsafeEff $ \es -> do
76catchError m handler = unsafeEff $ \es -> do
134− DataA (Error eid) <- getEnv @(Error e) es
77+ IdE (Error eid) <- getEnv @(Error e) es
135 size <- sizeEnv es
78 size <- sizeEnv es
136 catchErrorIO eid (unEff m es) $ \cs e -> do
79 catchErrorIO eid (unEff m es) $ \cs e -> do
137 checkSizeEnv size es
80 checkSizeEnv size es
138 unEff (handler cs e) es
81 unEff (handler cs e) es
139
82
140−-- | The same as @'flip' 'catchError'@, which is useful in situations where the
141−-- code for the handler is shorter.
142−handleError
143− :: forall e es a. (Typeable e, Error e :> es)
144− => (CallStack -> e -> Eff es a)
145− -- ^ A handler for errors in the inner computation.
146− -> Eff es a
147− -- ^ The inner computation.
148− -> Eff es a
149−handleError = flip catchError
150−
151−-- | Similar to 'catchError', but returns an 'Either' result which is a 'Right'
152−-- if no error was thrown and a 'Left' otherwise.
153tryError
83tryError
154 :: forall e es a. (Typeable e, Error e :> es)
84 :: forall e es a. (Typeable e, Error e :> es)
155 => Eff es a
85 => Eff es a
156− -- ^ The inner computation.
157 -> Eff es (Either (CallStack, e) a)
86 -> Eff es (Either (CallStack, e) a)
158tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)
87tryError m = (Right <$> m) `catchError` \es e -> pure $ Left (es, e)
159
88
effectful-core/src/Effectful/Fail.hs−1
@@ -1,4 +1,3 @@
1−-- | Provider of the 'MonadFail' instance for 'Eff'.
2module Effectful.Fail
1module Effectful.Fail
3 ( Fail(..)
2 ( Fail(..)
4 , runFail
3 , runFail
effectful-core/src/Effectful/Internal/Effect.hs+23−7
@@ -8,6 +8,10 @@
8module Effectful.Internal.Effect
8module Effectful.Internal.Effect
9 ( Effect
9 ( Effect
10 , (:>)(..)
10 , (:>)(..)
11+ , IdE(..)
12+
13+ -- * Utils
14+ , SuffixOf
11
15
12 -- * Re-exports
16 -- * Re-exports
13 , Type
17 , Type
@@ -19,16 +23,20 @@ import GHC.TypeLits
19-- | The kind of effects.
23-- | The kind of effects.
20type Effect = (Type -> Type) -> Type -> Type
24type Effect = (Type -> Type) -> Type -> Type
21
25
26+-- | An adapter for statically dispatched effects.
27+newtype IdE :: Effect -> Type where
28+ IdE :: (forall m r. e m r) -> IdE e
29+
22−-- | A constraint that requires that a particular effect @e@ is a member of the
30+-- | A constraint that requires that a particular effect, @e@, is a member of
23−-- type-level list @es@. This is used to parameterize an 'Effectful.Monad.Eff'
31+-- the type-level list @es@. This is used to parameterize an
24−-- computation over an arbitrary list of effects, so long as @e@ is /somewhere/
32+-- 'Effectful.Monad.Eff' operation over an arbitrary list of effects, so long as
25−-- in the list.
33+-- @e@ is /somewhere/ in the list.
26--
34--
27−-- For example, a computation that only needs access to a mutable value of type
35+-- For example, an operation that only needs access to a cell of mutable state
28−-- 'Integer' would likely use the following type:
36+-- containing an 'Integer' would likely use the following type:
29--
37--
30-- @
38-- @
31−-- 'Effectful.State.Local.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
39+-- 'Effectful.State.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
32-- @
40-- @
33class (e :: Effect) :> (es :: [Effect]) where
41class (e :: Effect) :> (es :: [Effect]) where
34 -- | Get the position of @e@ in @es@.
42 -- | Get the position of @e@ in @es@.
@@ -51,3 +59,11 @@ instance {-# OVERLAPPING #-} e :> (e : es) where
51
59
52instance e :> es => e :> (x : es) where
60instance e :> es => e :> (x : es) where
53 reifyIndex = 1 + reifyIndex @e @es
61 reifyIndex = 1 + reifyIndex @e @es
62+
63+-- | Require that the second list of effects is a suffix of the first one.
64+--
65+-- In other words, 'SuffixOf' @es@ @baseEs@ means "a suffix of @es@ is
66+-- @baseEs@".
67+type family SuffixOf (es :: [Effect]) (baseEs :: [Effect]) :: Constraint where
68+ SuffixOf baseEs baseEs = ()
69+ SuffixOf (e : es) baseEs = SuffixOf es baseEs
effectful-core/src/Effectful/Internal/Env.hs+32−51
@@ -1,38 +1,25 @@
1−{-# LANGUAGE MagicHash #-}
2{-# OPTIONS_HADDOCK not-home #-}
1{-# OPTIONS_HADDOCK not-home #-}
3-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.
2-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.
4--
3--
5-- This module is intended for internal use only, and may change without warning
4-- This module is intended for internal use only, and may change without warning
6-- in subsequent releases.
5-- in subsequent releases.
7module Effectful.Internal.Env
6module Effectful.Internal.Env
8− ( -- * The environment
9− Env(..)
7+ ( Env
10− , Forks(..)
11− , EnvRef(..)
12−
13− -- ** ForkId
14− , ForkId(..)
15− , ForkIdGen(..)
16− , newForkIdGen
17− , cloneForkIdGen
18− , newForkId
19−
20− -- ** Relinker
21 , Relinker(..)
8 , Relinker(..)
22 , noRelinker
9 , noRelinker
23
10
24− -- * Operations
11+ -- * Operations
25 , emptyEnv
12 , emptyEnv
26 , cloneEnv
13 , cloneEnv
27 , forkEnv
14 , forkEnv
28 , sizeEnv
15 , sizeEnv
29 , checkSizeEnv
16 , checkSizeEnv
30
17
31− -- ** Extending and shrinking
18+ -- ** Extending and shrinking
32 , unsafeConsEnv
19 , unsafeConsEnv
33 , unsafeTailEnv
20 , unsafeTailEnv
34
21
35− -- ** Data retrieval and update
22+ -- ** Data retrieval and update
36 , getEnv
23 , getEnv
37 , putEnv
24 , putEnv
38 , stateEnv
25 , stateEnv
@@ -43,7 +30,7 @@ import Control.Monad
43import Control.Monad.Primitive
30import Control.Monad.Primitive
44import Data.IORef
31import Data.IORef
45import Data.Primitive.SmallArray
32import Data.Primitive.SmallArray
46−import GHC.Exts (Any, SmallMutableArray#)
33+import GHC.Exts (Any)
47import GHC.Stack (HasCallStack)
34import GHC.Stack (HasCallStack)
48import Unsafe.Coerce
35import Unsafe.Coerce
49import qualified Data.IntMap.Strict as IM
36import qualified Data.IntMap.Strict as IM
@@ -81,17 +68,17 @@ type role Env nominal
81-- @
68-- @
82--
69--
83-- The point of execution is currently at (*), i.e. the mainline. Moreover,
70-- The point of execution is currently at (*), i.e. the mainline. Moreover,
84−-- currently (brackets represent forks):
71+-- currently:
85--
72--
86-- - Mainline sees @[e00, e01, e05, e07]@.
73-- - Mainline sees @[e00, e01, e05, e07]@.
87--
74--
88−-- - @e01@ is an interpreted effect, its handler sees @[e00][e02, e03]@.
75+-- - @e01@ is an interpreted effect, its handler sees @[e00, e02, e03]@.
89--
76--
90−-- - @e03@ is an interpreted effect, its handler sees @[e00][e02][e04]@.
77+-- - @e03@ is an interpreted effect, its handler sees @[e00, e02, e04]@.
91--
78--
92−-- - @e05@ is an interpreted effect, its handler sees @[e00, e01][e06]@.
79+-- - @e05@ is an interpreted effect, its handler sees @[e00, e01, e06]@.
93--
80--
94−-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05][e08,
81+-- - @e07@ is an interpreted effect, its handler sees @[e00, e01, e05, e08,
95-- e09]@.
82-- e09]@.
96--
83--
97-- If an operation from @e01@ is invoked, the environment in the middle of
84-- If an operation from @e01@ is invoked, the environment in the middle of
@@ -114,11 +101,11 @@ type role Env nominal
114-- introduced @e12@), so its local environment was temporarily extended with
101-- introduced @e12@), so its local environment was temporarily extended with
115-- it. Moreover, currently:
102-- it. Moreover, currently:
116--
103--
117−-- - Handler of @e01@ sees @[e00][e02, e03, e10]@.
104+-- - Handler of @e01@ sees @[e00, e02, e03, e10]@.
118--
105--
119−-- - Handler of @e10@ sees @[e00][e02, e03][e11]@.
106+-- - Handler of @e10@ sees @[e00, e02, e03, e11]@.
120--
107--
121−-- - Handler of @e11@ sees @[e00][e02, e03][e12]@.
108+-- - Handler of @e11@ sees @[e00, e02, e03, e12]@.
122--
109--
123data Env (es :: [Effect]) = Env
110data Env (es :: [Effect]) = Env
124 { _forks :: !Forks
111 { _forks :: !Forks
@@ -129,7 +116,6 @@ data Env (es :: [Effect]) = Env
129-- | Local forks of the environment.
116-- | Local forks of the environment.
130data Forks = Forks !ForkId !Int !(IORef EnvRef) Forks | NoFork
117data Forks = Forks !ForkId !Int !(IORef EnvRef) Forks | NoFork
131
118
132−-- | Data held in the environment.
133data EnvRef = EnvRef
119data EnvRef = EnvRef
134 { _size :: !Int
120 { _size :: !Int
135 , _data :: !(SmallMutableArray RealWorld Any)
121 , _data :: !(SmallMutableArray RealWorld Any)
@@ -139,7 +125,6 @@ data EnvRef = EnvRef
139----------------------------------------
125----------------------------------------
140-- ForkId
126-- ForkId
141
127
142−-- | Internal id of the fork.
143newtype ForkId = ForkId { unForkId :: Int }
128newtype ForkId = ForkId { unForkId :: Int }
144
129
145-- | 'ForkId' generation.
130-- | 'ForkId' generation.
@@ -418,43 +403,43 @@ unsafeTailEnv len (Env fork gref _) = case fork of
418
403
419-- | Extract a specific data type from the environment.
404-- | Extract a specific data type from the environment.
420getEnv
405getEnv
421− :: forall e adapter es. e :> es
406+ :: forall e es adapter. e :> es
422 => Env es
407 => Env es
423 -> IO (adapter e)
408 -> IO (adapter e)
424getEnv env = do
409getEnv env = do
425− Location i es <- getLocation (reifyIndex @e @es) env
410+ (i, es) <- getLocation (reifyIndex @e @es) env
426 fromAny <$> readSmallArray es i
411 fromAny <$> readSmallArray es i
427
412
428-- | Replace the data type in the environment with a new value (in place).
413-- | Replace the data type in the environment with a new value (in place).
429putEnv
414putEnv
430− :: forall e adapter es. e :> es
415+ :: forall e es adapter. e :> es
431 => Env es
416 => Env es
432 -> adapter e
417 -> adapter e
433 -> IO ()
418 -> IO ()
434putEnv env e = do
419putEnv env e = do
435− Location i es <- getLocation (reifyIndex @e @es) env
420+ (i, es) <- getLocation (reifyIndex @e @es) env
436 e `seq` writeSmallArray es i (toAny e)
421 e `seq` writeSmallArray es i (toAny e)
437
422
438-- | Modify the data type in the environment (in place) and return a value.
423-- | Modify the data type in the environment (in place) and return a value.
439stateEnv
424stateEnv
440− :: forall e adapter es a. e :> es
425+ :: forall e es adapter a. e :> es
441 => Env es
426 => Env es
442 -> (adapter e -> (a, adapter e))
427 -> (adapter e -> (a, adapter e))
443 -> IO a
428 -> IO a
444stateEnv env f = do
429stateEnv env f = do
445− Location i es <- getLocation (reifyIndex @e @es) env
430+ (i, es) <- getLocation (reifyIndex @e @es) env
446 (a, e) <- f . fromAny <$> readSmallArray es i
431 (a, e) <- f . fromAny <$> readSmallArray es i
447 e `seq` writeSmallArray es i (toAny e)
432 e `seq` writeSmallArray es i (toAny e)
448 pure a
433 pure a
449
434
450-- | Modify the data type in the environment (in place).
435-- | Modify the data type in the environment (in place).
451modifyEnv
436modifyEnv
452− :: forall e adapter es. e :> es
437+ :: forall e es adapter. e :> es
453 => Env es
438 => Env es
454 -> (adapter e -> adapter e)
439 -> (adapter e -> adapter e)
455 -> IO ()
440 -> IO ()
456modifyEnv env f = do
441modifyEnv env f = do
457− Location i es <- getLocation (reifyIndex @e @es) env
442+ (i, es) <- getLocation (reifyIndex @e @es) env
458 e <- f . fromAny <$> readSmallArray es i
443 e <- f . fromAny <$> readSmallArray es i
459 e `seq` writeSmallArray es i (toAny e)
444 e `seq` writeSmallArray es i (toAny e)
460
445
@@ -470,17 +455,13 @@ emptyEnvRef = do
470 fs <- newSmallArray 0 undefinedData
455 fs <- newSmallArray 0 undefinedData
471 newIORef $ EnvRef 0 es fs
456 newIORef $ EnvRef 0 es fs
472
457
473−-- | Location with unboxed fields to make GHC generate Core without unnecessary
474−-- reboxing around the local 'go' function from 'getLocation'.
475−data Location = Location !Int !(SmallMutableArray RealWorld Any)
476−
477-- | Determine location of the data type in the environment.
458-- | Determine location of the data type in the environment.
478getLocation
459getLocation
479 :: Int
460 :: Int
480 -> Env es
461 -> Env es
481− -> IO Location
462+ -> IO (Int, SmallMutableArray RealWorld Any)
482getLocation ixE (Env fork ref _) = do
463getLocation ixE (Env fork ref _) = do
483− EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref
464+ EnvRef n es _ <- readIORef ref
484 -- Optimized for the common access pattern:
465 -- Optimized for the common access pattern:
485 --
466 --
486 -- - Most application code has no access to forks, in which case we look at
467 -- - Most application code has no access to forks, in which case we look at
@@ -489,25 +470,25 @@ getLocation ixE (Env fork ref _) = do
489 -- - Effect handlers will most likely access the newest fork with handler
470 -- - Effect handlers will most likely access the newest fork with handler
490 -- specific effects for reinterpretation.
471 -- specific effects for reinterpretation.
491 case fork of
472 case fork of
492− NoFork -> pure $ Location (ix n) es
473+ NoFork -> pure (ix n, es)
493 Forks _ baseIx lref forks -> do
474 Forks _ baseIx lref forks -> do
494 EnvRef ln les _ <- readIORef lref
475 EnvRef ln les _ <- readIORef lref
495 let i = ix (baseIx + ln)
476 let i = ix (baseIx + ln)
496 if i >= baseIx
477 if i >= baseIx
497− then pure $ Location (i - baseIx) les
478+ then pure (i - baseIx, les)
498− else go es# i forks
479+ else go es i forks
499 where
480 where
500− go :: SmallMutableArray# RealWorld Any
481+ go :: SmallMutableArray RealWorld Any
501 -> Int
482 -> Int
502 -> Forks
483 -> Forks
503− -> IO Location
484+ -> IO (Int, SmallMutableArray RealWorld Any)
504− go es# i = \case
485+ go es i = \case
505− NoFork -> pure $ Location i (SmallMutableArray es#)
486+ NoFork -> pure (i, es)
506 Forks _ baseIx lref forks -> do
487 Forks _ baseIx lref forks -> do
507 EnvRef _ les _ <- readIORef lref
488 EnvRef _ les _ <- readIORef lref
508 if i >= baseIx
489 if i >= baseIx
509− then pure $ Location (i - baseIx) les
490+ then pure (i - baseIx, les)
510− else go es# i forks
491+ else go es i forks
511
492
512 ix :: Int -> Int
493 ix :: Int -> Int
513 ix n = n - ixE - 1
494 ix n = n - ixE - 1
effectful-core/src/Effectful/Internal/Monad.hs+87−99
@@ -6,7 +6,7 @@
6-- This module is intended for internal use only, and may change without warning
6-- This module is intended for internal use only, and may change without warning
7-- in subsequent releases.
7-- in subsequent releases.
8module Effectful.Internal.Monad
8module Effectful.Internal.Monad
9− ( -- * The 'Eff' monad
9+ ( -- * Monad
10 Eff
10 Eff
11 , runPureEff
11 , runPureEff
12
12
@@ -22,41 +22,47 @@ module Effectful.Internal.Monad
22 , IOE
22 , IOE
23 , runEff
23 , runEff
24
24
25− -- * Prim
25+ -- * Primitive
26 , Prim
26 , Prim
27 , runPrim
27 , runPrim
28
28
29− -- * Unlift strategies
29+ -- ** Unlift strategies
30 , UnliftStrategy(..)
30 , UnliftStrategy(..)
31 , Persistence(..)
31 , Persistence(..)
32 , Limit(..)
32 , Limit(..)
33 , unliftStrategy
33 , unliftStrategy
34 , withUnliftStrategy
34 , withUnliftStrategy
35 , withEffToIO
35 , withEffToIO
36+ , UnliftError(..)
36
37
37− -- ** Low-level unlifts
38+ --- *** Low-level helpers
38 , seqUnliftIO
39 , seqUnliftIO
39 , concUnliftIO
40 , concUnliftIO
40
41
41 -- * Effects
42 -- * Effects
42
43
43− -- ** Dynamic dispatch
44+ -- ** Handler
44 , EffectHandler
45 , EffectHandler
45 , LocalEnv(..)
46 , LocalEnv(..)
46− , HandlerA(..)
47+ , Handler(..)
47 , runHandler
48 , runHandler
49+
50+ -- *** Sending operations
48 , send
51 , send
49
52
50− -- ** Static dispatch
53+ -- ** Primitive
51− , DataA(..)
54+
52− , runData
55+ -- *** Running
53− , evalData
56+ , runEffect
54− , execData
57+ , evalEffect
55− , getData
58+ , execEffect
56− , putData
59+
57− , stateData
60+ -- *** Modification
58− , stateDataM
61+ , getEffect
59− , localData
62+ , putEffect
63+ , stateEffect
64+ , stateEffectM
65+ , localEffect
60 ) where
66 ) where
61
67
62import Control.Applicative (liftA2)
68import Control.Applicative (liftA2)
@@ -79,43 +85,44 @@ import Effectful.Internal.Unlift
79
85
80type role Eff nominal representational
86type role Eff nominal representational
81
87
82−-- | The 'Eff' monad provides the implementation of a computation that performs
88+-- | The 'Eff' monad provides the implementation of an operation that performs
83-- an arbitrary set of effects. In @'Eff' es a@, @es@ is a type-level list that
89-- 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
90+-- contains all the effects that the operation may perform. For example, an
85−-- computation that produces an 'Integer' by consuming a 'String' from the
91+-- operation that produces an 'Integer' by consuming a 'String' from the global
86−-- global environment and acting upon a single mutable value of type 'Bool'
92+-- environment and acting upon a single mutable cell containing a 'Bool' would
87−-- would have the following type:
93+-- have the following type:
88--
94--
89-- @
95-- @
90−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
96+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
91-- @
97-- @
92--
98--
93-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
99-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
94-- Instead, the '(:>)' type class is used to express constraints on the list of
100-- 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
101+-- effects without coupling an operation to a concrete list of effects. For
96−-- example, the above example would be expressed with the following type:
102+-- example, the above example would more commonly be expressed with the
103+-- following type:
97--
104--
98-- @
105-- @
99−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
106+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
100-- @
107-- @
101--
108--
102−-- This abstraction allows the computation to be used in functions that may
109+-- This abstraction allows the operation to be used in functions that may
103-- perform other effects, and it also allows the effects to be handled in any
110-- perform other effects, and it also allows the effects to be handled in any
104-- order.
111-- order.
105newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
112newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
106 deriving (Monoid, Semigroup)
113 deriving (Monoid, Semigroup)
107
114
108−-- | Run a pure 'Eff' computation.
115+-- | Run a pure 'Eff' operation.
109--
116--
110−-- For running computations with side effects see 'runEff'.
117+-- For running operations with side effects see 'runEff'.
111runPureEff :: Eff '[] a -> a
118runPureEff :: Eff '[] a -> a
112runPureEff (Eff m) =
119runPureEff (Eff m) =
113− -- unsafeDupablePerformIO is safe here since IOE was not on the stack, so no
120+ -- unsafePerformIO is safe here since IOE was not on the stack, so no IO with
114− -- IO with side effects was performed (unless someone sneakily introduced side
121+ -- side effects was performed (unless someone sneakily introduced side effects
115− -- effects with unsafeEff, but then all bets are off).
122+ -- with unsafeEff, but then all bets are off).
116 --
123 --
117 -- Moreover, internals don't allocate any resources that require explicit
124 -- Moreover, internals don't allocate any resources that require explicit
118− -- cleanup actions to run.
125+ -- cleanup actions to run, so the "Dupable" part should also be just fine.
119 unsafeDupablePerformIO $ m =<< emptyEnv
126 unsafeDupablePerformIO $ m =<< emptyEnv
120
127
121----------------------------------------
128----------------------------------------
@@ -128,14 +135,14 @@ unEff (Eff m) = m
128-- | Access the underlying 'IO' monad along with the environment.
135-- | Access the underlying 'IO' monad along with the environment.
129--
136--
130-- This function is __unsafe__ because it can be used to introduce arbitrary
137-- This function is __unsafe__ because it can be used to introduce arbitrary
131−-- 'IO' actions into pure 'Eff' computations.
138+-- 'IO' actions into pure 'Eff' operations.
132unsafeEff :: (Env es -> IO a) -> Eff es a
139unsafeEff :: (Env es -> IO a) -> Eff es a
133unsafeEff m = Eff (oneShot m)
140unsafeEff m = Eff (oneShot m)
134
141
135-- | Access the underlying 'IO' monad.
142-- | Access the underlying 'IO' monad.
136--
143--
137-- This function is __unsafe__ because it can be used to introduce arbitrary
144-- This function is __unsafe__ because it can be used to introduce arbitrary
138−-- 'IO' actions into pure 'Eff' computations.
145+-- 'IO' actions into pure 'Eff' operations.
139unsafeEff_ :: IO a -> Eff es a
146unsafeEff_ :: IO a -> Eff es a
140unsafeEff_ m = unsafeEff $ \_ -> m
147unsafeEff_ m = unsafeEff $ \_ -> m
141
148
@@ -145,12 +152,12 @@ unsafeEff_ m = unsafeEff $ \_ -> m
145-- | Get the current 'UnliftStrategy'.
152-- | Get the current 'UnliftStrategy'.
146unliftStrategy :: IOE :> es => Eff es UnliftStrategy
153unliftStrategy :: IOE :> es => Eff es UnliftStrategy
147unliftStrategy = do
154unliftStrategy = do
148− DataA (IOE unlift) <- getData
155+ IdE (IOE unlift) <- getEffect
149 pure unlift
156 pure unlift
150
157
151-- | Locally override the 'UnliftStrategy' with the given value.
158-- | Locally override the 'UnliftStrategy' with the given value.
152withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
159withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
153−withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)
160+withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
154
161
155-- | Create an unlifting function with the current 'UnliftStrategy'.
162-- | Create an unlifting function with the current 'UnliftStrategy'.
156--
163--
@@ -158,7 +165,7 @@ withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)
158-- constraint for accurate stack traces in case an insufficiently powerful
165-- constraint for accurate stack traces in case an insufficiently powerful
159-- 'UnliftStrategy' is used and the unlifting function fails.
166-- 'UnliftStrategy' is used and the unlifting function fails.
160--
167--
161−-- /Note:/ the strategy is reset to 'SeqUnlift' inside the continuation.
168+-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
162withEffToIO
169withEffToIO
163 :: (HasCallStack, IOE :> es)
170 :: (HasCallStack, IOE :> es)
164 => ((forall r. Eff es r -> IO r) -> IO a)
171 => ((forall r. Eff es r -> IO r) -> IO a)
@@ -169,25 +176,25 @@ withEffToIO f = unliftStrategy >>= \case
169 ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
176 ConcUnlift p b -> withUnliftStrategy SeqUnlift $ do
170 unsafeEff $ \es -> concUnliftIO es p b f
177 unsafeEff $ \es -> concUnliftIO es p b f
171
178
172−-- | Create an unlifting function with the 'SeqUnlift' strategy.
179+-- | Lower 'Eff' operations into 'IO' ('SeqUnlift').
180+--
181+-- Exceptions thrown by this function:
182+--
183+-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
173seqUnliftIO
184seqUnliftIO
174 :: HasCallStack
185 :: HasCallStack
175 => Env es
186 => Env es
176− -- ^ The environment.
177 -> ((forall r. Eff es r -> IO r) -> IO a)
187 -> ((forall r. Eff es r -> IO r) -> IO a)
178− -- ^ Continuation with the unlifting function in scope.
179 -> IO a
188 -> IO a
180seqUnliftIO es k = seqUnlift k es unEff
189seqUnliftIO es k = seqUnlift k es unEff
181
190
182−-- | Create an unlifting function with the 'ConcUnlift' strategy.
191+-- | Lower 'Eff' operations into 'IO' ('ConcUnlift').
183concUnliftIO
192concUnliftIO
184 :: HasCallStack
193 :: HasCallStack
185 => Env es
194 => Env es
186− -- ^ The environment.
187 -> Persistence
195 -> Persistence
188 -> Limit
196 -> Limit
189 -> ((forall r. Eff es r -> IO r) -> IO a)
197 -> ((forall r. Eff es r -> IO r) -> IO a)
190− -- ^ Continuation with the unlifting function in scope.
191 -> IO a
198 -> IO a
192concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
199concUnliftIO es persistence limit k = concUnlift persistence limit k es unEff
193
200
@@ -258,15 +265,15 @@ instance Fail :> es => MonadFail (Eff es) where
258----------------------------------------
265----------------------------------------
259-- IO
266-- IO
260
267
261−-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
268+-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.
262newtype IOE :: Effect where
269newtype IOE :: Effect where
263 IOE :: UnliftStrategy -> IOE m r
270 IOE :: UnliftStrategy -> IOE m r
264
271
265−-- | Run an 'Eff' computation with side effects.
272+-- | Run an 'Eff' operation with side effects.
266--
273--
267−-- For running pure computations see 'runPureEff'.
274+-- For running pure operations see 'runPureEff'.
268runEff :: Eff '[IOE] a -> IO a
275runEff :: Eff '[IOE] a -> IO a
269−runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv
276+runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
270
277
271instance IOE :> es => MonadIO (Eff es) where
278instance IOE :> es => MonadIO (Eff es) where
272 liftIO = unsafeEff_
279 liftIO = unsafeEff_
@@ -290,20 +297,20 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where
290----------------------------------------
297----------------------------------------
291-- Primitive
298-- Primitive
292
299
293−-- | Provide the ability to perform primitive state-transformer actions.
300+-- | An effect to perform primitive state-transformer actions.
294data Prim :: Effect where
301data Prim :: Effect where
295 Prim :: Prim m r
302 Prim :: Prim m r
296
303
297−-- | Run an 'Eff' computation with primitive state-transformer actions.
304+-- | Run an 'Eff' operation with primitive state-transformer actions.
298runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
305runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
299−runPrim = evalData (DataA Prim)
306+runPrim = evalEffect (IdE Prim)
300
307
301instance Prim :> es => PrimMonad (Eff es) where
308instance Prim :> es => PrimMonad (Eff es) where
302 type PrimState (Eff es) = RealWorld
309 type PrimState (Eff es) = RealWorld
303 primitive = unsafeEff_ . IO
310 primitive = unsafeEff_ . IO
304
311
305----------------------------------------
312----------------------------------------
306−-- Dynamic dispatch
313+-- Handler
307
314
308type role LocalEnv nominal nominal
315type role LocalEnv nominal nominal
309
316
@@ -319,97 +326,78 @@ newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env l
319type EffectHandler e es
326type EffectHandler e es
320 = forall a localEs. HasCallStack
327 = forall a localEs. HasCallStack
321 => LocalEnv localEs es
328 => LocalEnv localEs es
322− -- ^ Capture of the local environment for handling local 'Eff' computations
329+ -- ^ Capture of the local environment for handling local 'Eff' operations when
323− -- when @e@ is a higher order effect.
330+ -- @e@ is a higher order effect.
324 -> e (Eff localEs) a
331 -> e (Eff localEs) a
325 -- ^ The effect performed in the local environment.
332 -- ^ The effect performed in the local environment.
326 -> Eff es a
333 -> Eff es a
327
334
328-- | An adapter for dynamically dispatched effects.
335-- | An adapter for dynamically dispatched effects.
329--
336--
330−-- Represents the effect handler bundled with its environment.
337+-- Represents the effect handler bundled along with its environment.
331−data HandlerA :: Effect -> Type where
338+data Handler :: Effect -> Type where
332− HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e
339+ Handler :: !(Env es) -> !(EffectHandler e es) -> Handler e
333
340
334−-- | Run a dynamically dispatched effect with the given handler.
341+-- | Run the effect with the given handler.
335−runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
342+runHandler :: Handler e -> Eff (e : es) a -> Eff es a
336runHandler e m = unsafeEff $ \es0 -> do
343runHandler e m = unsafeEff $ \es0 -> do
337 size0 <- sizeEnv es0
344 size0 <- sizeEnv es0
338 E.bracket (unsafeConsEnv e relinker es0)
345 E.bracket (unsafeConsEnv e relinker es0)
339 (unsafeTailEnv size0)
346 (unsafeTailEnv size0)
340 (\es -> unEff m es)
347 (\es -> unEff m es)
341 where
348 where
342− relinker :: Relinker HandlerA e
349+ relinker :: Relinker Handler e
343− relinker = Relinker $ \relink (HandlerA handlerEs handle) -> do
350+ relinker = Relinker $ \relink (Handler env handle) -> do
344− newHandlerEs <- relink handlerEs
351+ newEnv <- relink env
345− pure $ HandlerA newHandlerEs handle
352+ pure $ Handler newEnv handle
346
353
347-- | Send an operation of the given effect to its handler for execution.
354-- | Send an operation of the given effect to its handler for execution.
348send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
355send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
349send op = unsafeEff $ \es -> do
356send op = unsafeEff $ \es -> do
350− HandlerA handlerEs handle <- getEnv es
357+ Handler handlerEs handle <- getEnv es
351 unEff (handle (LocalEnv es) op) handlerEs
358 unEff (handle (LocalEnv es) op) handlerEs
352
359
353----------------------------------------
360----------------------------------------
354−-- Static dispatch
361+-- Helpers
355
362
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)
363+runEffect :: adapter e -> Eff (e : es) a -> Eff es (a, adapter e)
366−runData e0 m = unsafeEff $ \es0 -> do
364+runEffect e0 m = unsafeEff $ \es0 -> do
367 size0 <- sizeEnv es0
365 size0 <- sizeEnv es0
368 E.bracket (unsafeConsEnv e0 noRelinker es0)
366 E.bracket (unsafeConsEnv e0 noRelinker es0)
369 (unsafeTailEnv size0)
367 (unsafeTailEnv size0)
370 (\es -> (,) <$> unEff m es <*> getEnv es)
368 (\es -> (,) <$> unEff m es <*> getEnv es)
371
369
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
370+evalEffect :: adapter e -> Eff (e : es) a -> Eff es a
375−evalData e m = unsafeEff $ \es0 -> do
371+evalEffect e m = unsafeEff $ \es0 -> do
376 size0 <- sizeEnv es0
372 size0 <- sizeEnv es0
377 E.bracket (unsafeConsEnv e noRelinker es0)
373 E.bracket (unsafeConsEnv e noRelinker es0)
378 (unsafeTailEnv size0)
374 (unsafeTailEnv size0)
379 (\es -> unEff m es)
375 (\es -> unEff m es)
380
376
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)
377+execEffect :: adapter e -> Eff (e : es) a -> Eff es (adapter e)
384−execData e0 m = unsafeEff $ \es0 -> do
378+execEffect e0 m = unsafeEff $ \es0 -> do
385 size0 <- sizeEnv es0
379 size0 <- sizeEnv es0
386 E.bracket (unsafeConsEnv e0 noRelinker es0)
380 E.bracket (unsafeConsEnv e0 noRelinker es0)
387 (unsafeTailEnv size0)
381 (unsafeTailEnv size0)
388 (\es -> unEff m es *> getEnv es)
382 (\es -> unEff m es *> getEnv es)
389
383
390−-- | Fetch the current state of the effect.
384+getEffect :: e :> es => Eff es (adapter e)
391−getData :: e :> es => Eff es (DataA e)
392−getData = unsafeEff $ \es -> getEnv es
385+getEffect = unsafeEff $ \es -> getEnv es
393
386
394−-- | Set the current state of the effect to the given value.
387+putEffect :: e :> es => adapter e -> Eff es ()
395−putData :: e :> es => DataA e -> Eff es ()
396−putData e = unsafeEff $ \es -> putEnv es e
388+putEffect e = unsafeEff $ \es -> putEnv es e
397
389
398−-- | Apply the function to the current state of the effect and return a value.
390+stateEffect :: e :> es => (adapter e -> (a, adapter e)) -> Eff es a
399−stateData :: e :> es => (DataA e -> (a, DataA e)) -> Eff es a
400−stateData f = unsafeEff $ \es -> stateEnv es f
391+stateEffect f = unsafeEff $ \es -> stateEnv es f
401
392
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
393+stateEffectM :: e :> es => (adapter e -> Eff es (a, adapter e)) -> Eff es a
405−stateDataM f = unsafeEff $ \es -> E.mask $ \release -> do
394+stateEffectM f = unsafeEff $ \es -> E.mask $ \release -> do
406 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
395 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
407 putEnv es e
396 putEnv es e
408 pure a
397 pure a
409
398
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
399+localEffect :: e :> es => (adapter e -> adapter e) -> Eff es a -> Eff es a
412−localData f m = unsafeEff $ \es -> do
400+localEffect f m = unsafeEff $ \es -> do
413 E.bracket (stateEnv es $ \e -> (e, f e))
401 E.bracket (stateEnv es $ \e -> (e, f e))
414 (\e -> putEnv es e)
402 (\e -> putEnv es e)
415 (\_ -> unEff m es)
403 (\_ -> unEff m es)
effectful-core/src/Effectful/Internal/Unlift.hs+59−16
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE MagicHash #-}
2{-# LANGUAGE MagicHash #-}
2{-# LANGUAGE UnboxedTuples #-}
3{-# LANGUAGE UnboxedTuples #-}
3{-# OPTIONS_HADDOCK not-home #-}
4{-# OPTIONS_HADDOCK not-home #-}
@@ -16,9 +17,13 @@ module Effectful.Internal.Unlift
16 , concUnlift
17 , concUnlift
17 , ephemeralConcUnlift
18 , ephemeralConcUnlift
18 , persistentConcUnlift
19 , persistentConcUnlift
20+
21+ -- * Unlifting errors
22+ , UnliftError(..)
19 ) where
23 ) where
20
24
21import Control.Concurrent
25import Control.Concurrent
26+import Control.Exception
22import Control.Monad
27import Control.Monad
23import GHC.Conc.Sync (ThreadId(..))
28import GHC.Conc.Sync (ThreadId(..))
24import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)
29import GHC.Exts (mkWeak#, mkWeakNoFinalizer#)
@@ -35,9 +40,8 @@ import Effectful.Internal.Utils
35----------------------------------------
40----------------------------------------
36-- Unlift strategies
41-- Unlift strategies
37
42
38−-- | The strategy to use when unlifting 'Eff' computations via 'withRunInIO',
43+-- | The strategy to use when unlifting 'Eff' operations via 'withRunInIO' or
39−-- 'Effectful.Monad.withEffToIO' or the 'Effectful.Dispatch.Dynamic.localUnlift'
44+-- the 'Effectful.Interpreter.localUnlift' family.
40−-- family.
41data UnliftStrategy
45data UnliftStrategy
42 = SeqUnlift
46 = SeqUnlift
43 -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
47 -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
@@ -92,6 +96,10 @@ data Limit
92-- Unlift functions
96-- Unlift functions
93
97
94-- | Sequential unlift.
98-- | Sequential unlift.
99+--
100+-- Exceptions thrown by this function:
101+--
102+-- - 'InvalidUseOfSeqUnlift' if the unlift function is used in another thread.
95seqUnlift
103seqUnlift
96 :: HasCallStack
104 :: HasCallStack
97 => ((forall r. m r -> IO r) -> IO a)
105 => ((forall r. m r -> IO r) -> IO a)
@@ -104,9 +112,7 @@ seqUnlift k es unEff = do
104 tid <- myThreadId
112 tid <- myThreadId
105 if tid `eqThreadId` tid0
113 if tid `eqThreadId` tid0
106 then unEff m es
114 then unEff m es
107− else error
115+ else throwIO InvalidUseOfSeqUnlift
108− $ "If you want to use the unlifting function to run Eff computations "
109− ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
110
116
111-- | Concurrent unlift for various strategies and limits.
117-- | Concurrent unlift for various strategies and limits.
112concUnlift
118concUnlift
@@ -128,6 +134,11 @@ concUnlift Persistent Unlimited k =
128
134
129-- | Concurrent unlift that doesn't preserve the environment between calls to
135-- | Concurrent unlift that doesn't preserve the environment between calls to
130-- the unlifting function in threads other than its creator.
136-- the unlifting function in threads other than its creator.
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.
131ephemeralConcUnlift
142ephemeralConcUnlift
132 :: HasCallStack
143 :: HasCallStack
133 => Int
144 => Int
@@ -138,7 +149,7 @@ ephemeralConcUnlift
138 -> IO a
149 -> IO a
139ephemeralConcUnlift uses k es0 unEff = do
150ephemeralConcUnlift uses k es0 unEff = do
140 unless (uses > 0) $ do
151 unless (uses > 0) $ do
141− error $ "Invalid number of uses: " ++ show uses
152+ throwIO $ InvalidNumberOfUses uses
142 tid0 <- myThreadId
153 tid0 <- myThreadId
143 -- Create a copy of the environment as a template for the other threads to
154 -- Create a copy of the environment as a template for the other threads to
144 -- use. This can't be done from inside the callback as the environment might
155 -- use. This can't be done from inside the callback as the environment might
@@ -149,10 +160,7 @@ ephemeralConcUnlift uses k es0 unEff = do
149 es <- myThreadId >>= \case
160 es <- myThreadId >>= \case
150 tid | tid0 `eqThreadId` tid -> pure es0
161 tid | tid0 `eqThreadId` tid -> pure es0
151 _ -> modifyMVar mvUses $ \case
162 _ -> modifyMVar mvUses $ \case
152− 0 -> error
163+ 0 -> throwIO $ ExceededNumberOfUses uses
153− $ "Number of permitted calls (" ++ show uses ++ ") to the unlifting "
154− ++ "function in other threads was exceeded. Please increase the limit "
155− ++ "or use the unlimited variant."
156 1 -> pure (0, esTemplate)
164 1 -> pure (0, esTemplate)
157 n -> do
165 n -> do
158 let newUses = n - 1
166 let newUses = n - 1
@@ -162,6 +170,12 @@ ephemeralConcUnlift uses k es0 unEff = do
162
170
163-- | Concurrent unlift that preserves the environment between calls to the
171-- | Concurrent unlift that preserves the environment between calls to the
164-- unlifting function within a particular thread.
172-- unlifting function within a particular thread.
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.
165persistentConcUnlift
179persistentConcUnlift
166 :: HasCallStack
180 :: HasCallStack
167 => Bool
181 => Bool
@@ -173,7 +187,7 @@ persistentConcUnlift
173 -> IO a
187 -> IO a
174persistentConcUnlift cleanUp threads k es0 unEff = do
188persistentConcUnlift cleanUp threads k es0 unEff = do
175 unless (threads > 0) $ do
189 unless (threads > 0) $ do
176− error $ "Invalid number of threads: " ++ show threads
190+ throwIO $ InvalidNumberOfThreads threads
177 tid0 <- myThreadId
191 tid0 <- myThreadId
178 -- Create a copy of the environment as a template for the other threads to
192 -- Create a copy of the environment as a template for the other threads to
179 -- use. This can't be done from inside the callback as the environment might
193 -- use. This can't be done from inside the callback as the environment might
@@ -191,10 +205,7 @@ persistentConcUnlift cleanUp threads k es0 unEff = do
191 case mes of
205 case mes of
192 Just es -> pure (te, es)
206 Just es -> pure (te, es)
193 Nothing -> case teCapacity te of
207 Nothing -> case teCapacity te of
194− 0 -> error
208+ 0 -> throwIO $ ExceededNumberOfThreads threads
195− $ "Number of other threads (" ++ show threads ++ ") permitted to "
196− ++ "use the unlifting function was exceeded. Please increase the "
197− ++ "limit or use the unlimited variant."
198 1 -> do
209 1 -> do
199 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp
210 wkTidEs <- mkWeakThreadIdEnv tid esTemplate wkTid i mvEntries cleanUp
200 let newEntries = ThreadEntries
211 let newEntries = ThreadEntries
@@ -212,6 +223,38 @@ persistentConcUnlift cleanUp threads k es0 unEff = do
212 newEntries `seq` pure (newEntries, es)
223 newEntries `seq` pure (newEntries, es)
213 unEff m es
224 unEff m es
214
225
226+----------------------------------------
227+-- Errors
228+
229+-- | An type used for errors occuring in unlifting functions.
230+--
231+-- Use the 'displayException' method of the 'Exception' type class to get
232+-- descriptive error messages.
233+data UnliftError
234+ = InvalidNumberOfThreads !Int
235+ | InvalidNumberOfUses !Int
236+ | InvalidUseOfSeqUnlift
237+ | ExceededNumberOfThreads !Int
238+ | ExceededNumberOfUses !Int
239+ deriving (Eq, Generic, Show)
240+
241+instance Exception UnliftError where
242+ displayException (InvalidNumberOfThreads threads) =
243+ "Invalid number of threads: " ++ show threads
244+ displayException (InvalidNumberOfUses uses) =
245+ "Invalid number of uses: " ++ show uses
246+ displayException (ExceededNumberOfThreads threads) =
247+ "Number of other threads (" ++ show threads ++ ") permitted to use the " ++
248+ "unlifting function was exceeded. Please increase the limit or use the " ++
249+ "unlimited variant."
250+ displayException (ExceededNumberOfUses uses) =
251+ "Number of permitted calls (" ++ show uses ++ ") to the unlifting " ++
252+ "function in other threads was exceeded. Please increase the limit or " ++
253+ "use the unlimited variant."
254+ displayException InvalidUseOfSeqUnlift =
255+ "If you want to use the unlifting function to run Eff operations in " ++
256+ "multiple threads, have a look at UnliftStrategy (ConcUnlift)."
257+
215----------------------------------------
258----------------------------------------
216-- Data types
259-- Data types
217
260
effectful-core/src/Effectful/Monad.hs+1
@@ -18,6 +18,7 @@ module Effectful.Monad
18 , unliftStrategy
18 , unliftStrategy
19 , withUnliftStrategy
19 , withUnliftStrategy
20 , withEffToIO
20 , withEffToIO
21+ , UnliftError(..)
21
22
22 -- * Re-exports
23 -- * Re-exports
23 , MonadIO(..)
24 , MonadIO(..)
effectful-core/src/Effectful/Prim.hs−1
@@ -1,4 +1,3 @@
1−-- | Provider of the 'MonadPrim' instance for 'Eff'.
2module Effectful.Prim
1module Effectful.Prim
3 ( Prim
2 ( Prim
4 , runPrim
3 , runPrim
effectful-core/src/Effectful/Reader.hs+4−4
@@ -1,4 +1,4 @@
1−-- | Support for access to a read only value of a particular type.
1+-- | The 'Reader' effect.
2module Effectful.Reader
2module Effectful.Reader
3 ( Reader
3 ( Reader
4 , runReader
4 , runReader
@@ -20,12 +20,12 @@ runReader
20 :: r -- ^ An initial environment.
20 :: r -- ^ An initial environment.
21 -> Eff (Reader r : es) a
21 -> Eff (Reader r : es) a
22 -> Eff es a
22 -> Eff es a
23−runReader r = evalData (DataA (Reader r))
23+runReader r = evalEffect (IdE (Reader r))
24
24
25-- | Fetch the value of the environment.
25-- | Fetch the value of the environment.
26ask :: Reader r :> es => Eff es r
26ask :: Reader r :> es => Eff es r
27ask = do
27ask = do
28− DataA (Reader r) <- getData
28+ IdE (Reader r) <- getEffect
29 pure r
29 pure r
30
30
31-- | Retrieve a function of the current environment.
31-- | Retrieve a function of the current environment.
@@ -46,4 +46,4 @@ local
46 => (r -> r) -- ^ The function to modify the environment.
46 => (r -> r) -- ^ The function to modify the environment.
47 -> Eff es a
47 -> Eff es a
48 -> Eff es a
48 -> Eff es a
49−local f = localData $ \(DataA (Reader r)) -> DataA (Reader (f r))
49+local f = localEffect $ \(IdE (Reader r)) -> IdE (Reader (f r))
effectful-core/src/Effectful/State/Dynamic.hs+1−1
@@ -27,7 +27,7 @@ import Effectful.Monad
27import qualified Effectful.State.Local as L
27import qualified Effectful.State.Local as L
28import qualified Effectful.State.Shared as S
28import qualified Effectful.State.Shared as S
29
29
30−-- | Provide access to a mutable value of type @s@.
30+-- | Provide access to a mutable state of type @s@.
31data State s :: Effect where
31data State s :: Effect where
32 Get :: State s m s
32 Get :: State s m s
33 Put :: s -> State s m ()
33 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.
2--
2--
3+-- Represented as a pure value underneath, therefore:
4+--
3−-- - thread local (if you want the value to be shared between threads, have a
5+-- - thread local (if you need the state to be shared between threads, have a
4-- look at "Effectful.State.Shared"),
6-- look at "Effectful.State.Shared"),
5--
7--
6-- - very fast.
8-- - very fast.
7--
9--
8−-- /Note:/ unlike the 'Control.Monad.Trans.State.StateT' monad transformer from
9−-- the @transformers@ library, the 'State' effect doesn't lose state
10−-- modifications when an exception is received:
11−--
12−-- >>> import qualified Control.Monad.Trans.State.Strict as S
13−--
14−-- >>> :{
15−-- (`S.execStateT` "Hi") . handle (\(_::ErrorCall) -> pure ()) $ do
16−-- S.modify (++ " there!")
17−-- error "oops"
18−-- :}
19−-- "Hi"
20−--
21−-- >>> :{
22−-- runEff . execState "Hi" . handle (\(_::ErrorCall) -> pure ()) $ do
23−-- modify (++ " there!")
24−-- error "oops"
25−-- :}
26−-- "Hi there!"
27module Effectful.State.Local
10module Effectful.State.Local
28 ( State
11 ( State
29 , runState
12 , runState
@@ -41,7 +24,7 @@ module Effectful.State.Local
41import Effectful.Dispatch.Static
24import Effectful.Dispatch.Static
42import Effectful.Monad
25import Effectful.Monad
43
26
44−-- | Provide access to a strict (WHNF), thread local, mutable value of type @s@.
27+-- | Provide access to a strict (WHNF), thread local, mutable state of type @s@.
45newtype State s :: Effect where
28newtype State s :: Effect where
46 State :: s -> State s m r
29 State :: s -> State s m r
47
30
@@ -52,7 +35,7 @@ runState
52 -> Eff (State s : es) a
35 -> Eff (State s : es) a
53 -> Eff es (a, s)
36 -> Eff es (a, s)
54runState s0 m = do
37runState s0 m = do
55− (a, DataA (State s)) <- runData (DataA (State s0)) m
38+ (a, IdE (State s)) <- runEffect (IdE (State s0)) m
56 pure (a, s)
39 pure (a, s)
57
40
58-- | Run a 'State' effect with the given initial state and return the final
41-- | Run a 'State' effect with the given initial state and return the final
@@ -61,7 +44,7 @@ evalState
61 :: s -- ^ An initial state.
44 :: s -- ^ An initial state.
62 -> Eff (State s : es) a
45 -> Eff (State s : es) a
63 -> Eff es a -- ^ A return value.
46 -> Eff es a -- ^ A return value.
64−evalState s = evalData (DataA (State s))
47+evalState s = evalEffect (IdE (State s))
65
48
66-- | Run a 'State' effect with the given initial state and return the final
49-- | Run a 'State' effect with the given initial state and return the final
67-- state, discarding the final value.
50-- state, discarding the final value.
@@ -70,13 +53,13 @@ execState
70 -> Eff (State s : es) a
53 -> Eff (State s : es) a
71 -> Eff es s
54 -> Eff es s
72execState s0 m = do
55execState s0 m = do
73− DataA (State s) <- execData (DataA (State s0)) m
56+ IdE (State s) <- execEffect (IdE (State s0)) m
74 pure s
57 pure s
75
58
76-- | Fetch the current value of the state.
59-- | Fetch the current value of the state.
77get :: State s :> es => Eff es s
60get :: State s :> es => Eff es s
78get = do
61get = do
79− DataA (State s) <- getData
62+ IdE (State s) <- getEffect
80 pure s
63 pure s
81
64
82-- | Get a function of the current state.
65-- | Get a function of the current state.
@@ -90,14 +73,14 @@ gets f = f <$> get
90
73
91-- | Set the current state to the given value.
74-- | Set the current state to the given value.
92put :: State s :> es => s -> Eff es ()
75put :: State s :> es => s -> Eff es ()
93−put s = putData (DataA (State s))
76+put s = putEffect (IdE (State s))
94
77
95-- | Apply the function to the current state and return a value.
78-- | Apply the function to the current state and return a value.
96state
79state
97 :: State s :> es
80 :: State s :> es
98 => (s -> (a, s)) -- ^ The function to modify the state.
81 => (s -> (a, s)) -- ^ The function to modify the state.
99 -> Eff es a
82 -> Eff es a
100−state f = stateData $ \(DataA (State s0)) -> let (a, s) = f s0 in (a, DataA (State s))
83+state f = stateEffect $ \(IdE (State s0)) -> let (a, s) = f s0 in (a, IdE (State s))
101
84
102-- | Apply the function to the current state.
85-- | Apply the function to the current state.
103--
86--
@@ -113,9 +96,9 @@ stateM
113 :: State s :> es
96 :: State s :> es
114 => (s -> Eff es (a, s)) -- ^ The function to modify the state.
97 => (s -> Eff es (a, s)) -- ^ The function to modify the state.
115 -> Eff es a
98 -> Eff es a
116−stateM f = stateDataM $ \(DataA (State s0)) -> do
99+stateM f = stateEffectM $ \(IdE (State s0)) -> do
117 (a, s) <- f s0
100 (a, s) <- f s0
118− pure (a, DataA (State s))
101+ pure (a, IdE (State s))
119
102
120-- | Apply the monadic function to the current state.
103-- | Apply the monadic function to the current state.
121--
104--
@@ -125,7 +108,3 @@ modifyM
125 => (s -> Eff es s) -- ^ The monadic function to modify the state.
108 => (s -> Eff es s) -- ^ The monadic function to modify the state.
126 -> Eff es ()
109 -> Eff es ()
127modifyM f = stateM (\s -> ((), ) <$> f s)
110modifyM f = stateM (\s -> ((), ) <$> f s)
128−
129−-- $setup
130−-- >>> import Control.Exception (ErrorCall)
131−-- >>> import Control.Monad.Catch
effectful-core/src/Effectful/State/Shared.hs+12−61
@@ -1,29 +1,11 @@
1−-- | Support for access to a mutable value of a particular type, which is:
1+-- | The 'State' effect.
2--
2--
3−-- - shared between multiple threads (if you want each thead to manage its own
3+-- Represented as an 'MVar' underneath, therefore:
4−-- version of the value, see "Effectful.State.Local").
5--
4--
6−-- - slightly slower than "Effectful.State.Local".
5+-- - shareable between multiple threads,
7--
6--
8−-- /Note:/ unlike the 'Control.Monad.Trans.State.StateT' monad transformer from
7+-- - slower than "Effectful.State.Local".
9−-- the @transformers@ library, the 'State' effect doesn't lose state
10−-- modifications when an exception is received:
11--
8--
12−-- >>> import qualified Control.Monad.Trans.State.Strict as S
13−--
14−-- >>> :{
15−-- (`S.execStateT` "Hi") . handle (\(_::ErrorCall) -> pure ()) $ do
16−-- S.modify (++ " there!")
17−-- error "oops"
18−-- :}
19−-- "Hi"
20−--
21−-- >>> :{
22−-- runEff . execState "Hi" . handle (\(_::ErrorCall) -> pure ()) $ do
23−-- modify (++ " there!")
24−-- error "oops"
25−-- :}
26−-- "Hi there!"
27module Effectful.State.Shared
9module Effectful.State.Shared
28 ( State
10 ( State
29 , runState
11 , runState
@@ -43,85 +25,54 @@ import Control.Concurrent.MVar
43import Effectful.Dispatch.Static
25import Effectful.Dispatch.Static
44import Effectful.Monad
26import Effectful.Monad
45
27
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@.
47newtype State s :: Effect where
29newtype State s :: Effect where
48 State :: MVar s -> State s m r
30 State :: MVar s -> State s m r
49
31
50−-- | Run a 'State' effect with the given initial state and return the final
51−-- value along with the final state.
52runState :: s -> Eff (State s : es) a -> Eff es (a, s)
32runState :: s -> Eff (State s : es) a -> Eff es (a, s)
53runState s m = do
33runState s m = do
54 v <- unsafeEff_ $ newMVar s
34 v <- unsafeEff_ $ newMVar s
55− a <- evalData (DataA (State v)) m
35+ a <- evalEffect (IdE (State v)) m
56 (a, ) <$> unsafeEff_ (readMVar v)
36 (a, ) <$> unsafeEff_ (readMVar v)
57
37
58−-- | Run a 'State' effect with the given initial state and return the final
59−-- value, discarding the final state.
60evalState :: s -> Eff (State s : es) a -> Eff es a
38evalState :: s -> Eff (State s : es) a -> Eff es a
61evalState s m = do
39evalState s m = do
62 v <- unsafeEff_ $ newMVar s
40 v <- unsafeEff_ $ newMVar s
63− evalData (DataA (State v)) m
41+ evalEffect (IdE (State v)) m
64
42
65−-- | Run a 'State' effect with the given initial state and return the final
66−-- state, discarding the final value.
67execState :: s -> Eff (State s : es) a -> Eff es s
43execState :: s -> Eff (State s : es) a -> Eff es s
68execState s m = do
44execState s m = do
69 v <- unsafeEff_ $ newMVar s
45 v <- unsafeEff_ $ newMVar s
70− _ <- evalData (DataA (State v)) m
46+ _ <- evalEffect (IdE (State v)) m
71 unsafeEff_ $ readMVar v
47 unsafeEff_ $ readMVar v
72
48
73−-- | Fetch the current value of the state.
74get :: State s :> es => Eff es s
49get :: State s :> es => Eff es s
75get = unsafeEff $ \es -> do
50get = unsafeEff $ \es -> do
76− DataA (State v) <- getEnv es
51+ IdE (State v) <- getEnv es
77 readMVar v
52 readMVar v
78
53
79−-- | Get a function of the current state.
80−--
81−-- @'gets' f ≡ f '<$>' 'get'@
82gets :: State s :> es => (s -> a) -> Eff es a
54gets :: State s :> es => (s -> a) -> Eff es a
83gets f = f <$> get
55gets f = f <$> get
84
56
85−-- | Set the current state to the given value.
86put :: State s :> es => s -> Eff es ()
57put :: State s :> es => s -> Eff es ()
87put s = unsafeEff $ \es -> do
58put s = unsafeEff $ \es -> do
88− DataA (State v) <- getEnv es
59+ IdE (State v) <- getEnv es
89 modifyMVar_ v $ \_ -> s `seq` pure s
60 modifyMVar_ v $ \_ -> s `seq` pure s
90
61
91−-- | Apply the function to the current state and return a value.
92−--
93−-- /Note:/ this function gets an exclusive access to the state for its duration.
94state :: State s :> es => (s -> (a, s)) -> Eff es a
62state :: State s :> es => (s -> (a, s)) -> Eff es a
95state f = unsafeEff $ \es -> do
63state f = unsafeEff $ \es -> do
96− DataA (State v) <- getEnv es
64+ IdE (State v) <- getEnv es
97 modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)
65 modifyMVar v $ \s0 -> let (a, s) = f s0 in s `seq` pure (s, a)
98
66
99−-- | Apply the function to the current state.
100−--
101−-- @'modify' f ≡ 'state' (\\s -> ((), f s))@
102−--
103−-- /Note:/ this function gets an exclusive access to the state for its duration.
104modify :: State s :> es => (s -> s) -> Eff es ()
67modify :: State s :> es => (s -> s) -> Eff es ()
105modify f = state (\s -> ((), f s))
68modify f = state (\s -> ((), f s))
106
69
107−-- | Apply the monadic function to the current state and return a value.
108−--
109−-- /Note:/ this function gets an exclusive access to the state for its duration.
110stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
70stateM :: State s :> es => (s -> Eff es (a, s)) -> Eff es a
111stateM f = unsafeEff $ \es -> do
71stateM f = unsafeEff $ \es -> do
112− DataA (State v) <- getEnv es
72+ IdE (State v) <- getEnv es
113 modifyMVar v $ \s0 -> do
73 modifyMVar v $ \s0 -> do
114 (a, s) <- unEff (f s0) es
74 (a, s) <- unEff (f s0) es
115 s `seq` pure (s, a)
75 s `seq` pure (s, a)
116
76
117−-- | Apply the monadic function to the current state.
118−--
119−-- @'modifyM' f ≡ 'stateM' (\\s -> ((), ) '<$>' f s)@
120−--
121−-- /Note:/ this function gets an exclusive access to the state for its duration.
122modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()
77modifyM :: State s :> es => (s -> Eff es s) -> Eff es ()
123modifyM f = stateM (\s -> ((), ) <$> f s)
78modifyM 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.
2--
2--
3+-- Represented as a pure value underneath, therefore:
4+--
3−-- - thread local (if you want the value to be shared between threads, have a
5+-- - thread local (if you need the state to be shared between threads, have a
4-- look at "Effectful.Writer.Shared"),
6-- look at "Effectful.Writer.Shared"),
5--
7--
6-- - very fast.
8-- - very fast.
@@ -24,7 +26,7 @@ module Effectful.Writer.Local
24 , listens
26 , listens
25 ) where
27 ) where
26
28
27−import Control.Exception (onException, mask)
29+import Control.Exception
28
30
29import Effectful.Dispatch.Static
31import Effectful.Dispatch.Static
30import Effectful.Monad
32import Effectful.Monad
@@ -38,46 +40,35 @@ newtype Writer w :: Effect where
38-- output.
40-- output.
39runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
41runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
40runWriter m = do
42runWriter m = do
41− (a, DataA (Writer w)) <- runData (DataA (Writer mempty)) m
43+ (a, IdE (Writer w)) <- runEffect (IdE (Writer mempty)) m
42 pure (a, w)
44 pure (a, w)
43
45
44-- | Run a 'Writer' effect and return the final output, discarding the final
46-- | Run a 'Writer' effect and return the final output, discarding the final
45-- value.
47-- value.
46execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
48execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
47execWriter m = do
49execWriter m = do
48− DataA (Writer w) <- execData (DataA (Writer mempty)) m
50+ IdE (Writer w) <- execEffect (IdE (Writer mempty)) m
49 pure w
51 pure w
50
52
51-- | Append the given output to the overall output of the 'Writer'.
53-- | Append the given output to the overall output of the 'Writer'.
52tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
54tell :: (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)))
54
56
55-- | Execute an action and append its output to the overall output of the
57-- | Execute an action and append its output to the overall output of the
56-- 'Writer'.
58-- 'Writer'.
57--
59--
58−-- /Note:/ if an exception is received while the action is executed, the partial
60+-- /Note:/ if a runtime exception is received while the action is executed, the
59−-- output of the action will still be appended to the overall output of the
61+-- partial output of the action will still be appended to the overall output of
60−-- 'Writer':
62+-- the 'Writer'.
61−--
62−-- >>> :{
63−-- runEff . execWriter @String $ do
64−-- tell "Hi"
65−-- handle (\(_::ErrorCall) -> pure ((), "")) $ do
66−-- tell " there"
67−-- listen $ do
68−-- tell "!"
69−-- error "oops"
70−-- :}
71−-- "Hi there!"
72listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
63listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
73listen m = unsafeEff $ \es -> mask $ \restore -> do
64listen 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))
75 a <- restore (unEff m es) `onException` merge es w0
66 a <- restore (unEff m es) `onException` merge es w0
76 (a, ) <$> merge es w0
67 (a, ) <$> merge es w0
77 where
68 where
78 merge es w0 =
69 merge es w0 =
79 -- If an exception is thrown, restore w0 and keep parts of w1.
70 -- 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)))
81
72
82-- | Execute an action and append its output to the overall output of the
73-- | Execute an action and append its output to the overall output of the
83-- 'Writer', then return the final value along with a function of the recorded
74-- '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)
88listens f m = do
79listens f m = do
89 (a, w) <- listen m
80 (a, w) <- listen m
90 pure (a, f w)
81 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.
18module Effectful.Writer.Shared
1module Effectful.Writer.Shared
19 ( Writer
2 ( Writer
20 , runWriter
3 , runWriter
@@ -25,54 +8,32 @@ module Effectful.Writer.Shared
25 ) where
8 ) where
26
9
27import Control.Concurrent.MVar
10import Control.Concurrent.MVar
28−import Control.Exception (onException, uninterruptibleMask)
11+import Control.Exception
29
12
30import Effectful.Dispatch.Static
13import Effectful.Dispatch.Static
31import Effectful.Monad
14import Effectful.Monad
32
15
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@.
34newtype Writer w :: Effect where
17newtype Writer w :: Effect where
35 Writer :: MVar w -> Writer w m r
18 Writer :: MVar w -> Writer w m r
36
19
37−-- | Run a 'Writer' effect and return the final value along with the final
38−-- output.
39runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
20runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
40runWriter m = do
21runWriter m = do
41 v <- unsafeEff_ $ newMVar mempty
22 v <- unsafeEff_ $ newMVar mempty
42− a <- evalData (DataA (Writer v)) m
23+ a <- evalEffect (IdE (Writer v)) m
43 (a, ) <$> unsafeEff_ (readMVar v)
24 (a, ) <$> unsafeEff_ (readMVar v)
44
25
45−-- | Run a 'Writer' effect and return the final output, discarding the final
46−-- value.
47execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
26execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
48execWriter m = do
27execWriter m = do
49 v <- unsafeEff_ $ newMVar mempty
28 v <- unsafeEff_ $ newMVar mempty
50− _ <- evalData (DataA (Writer v)) m
29+ _ <- evalEffect (IdE (Writer v)) m
51 unsafeEff_ $ readMVar v
30 unsafeEff_ $ readMVar v
52
31
53−-- | Append the given output to the overall output of the 'Writer'.
54tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
32tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
55tell w1 = unsafeEff $ \es -> do
33tell w1 = unsafeEff $ \es -> do
56− DataA (Writer v) <- getEnv es
34+ IdE (Writer v) <- getEnv es
57 modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w
35 modifyMVar_ v $ \w0 -> let w = w0 <> w1 in w `seq` pure w
58
36
59−-- | Execute an action and append its output to the overall output of the
60−-- 'Writer'.
61−--
62−-- /Note:/ if an exception is received while the action is executed, the partial
63−-- output of the action will still be appended to the overall output of the
64−-- 'Writer':
65−--
66−-- >>> :{
67−-- runEff . execWriter @String $ do
68−-- tell "Hi"
69−-- handle (\(_::ErrorCall) -> pure ((), "")) $ do
70−-- tell " there"
71−-- listen $ do
72−-- tell "!"
73−-- error "oops"
74−-- :}
75−-- "Hi there!"
76listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
37listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
77listen m = unsafeEff $ \es -> do
38listen m = unsafeEff $ \es -> do
78 -- The mask is uninterruptible because modifyMVar_ v0 in the merge function
39 -- The mask is uninterruptible because modifyMVar_ v0 in the merge function
@@ -81,28 +42,19 @@ listen m = unsafeEff $ \es -> do
81 uninterruptibleMask $ \restore -> do
42 uninterruptibleMask $ \restore -> do
82 v1 <- newMVar mempty
43 v1 <- newMVar mempty
83 -- Replace thread local MVar with a fresh one for isolated listening.
44 -- 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))
85 a <- restore (unEff m es) `onException` merge es v0 v1
46 a <- restore (unEff m es) `onException` merge es v0 v1
86 (a, ) <$> merge es v0 v1
47 (a, ) <$> merge es v0 v1
87 where
48 where
88 -- Merge results accumulated in the local MVar with the mainline. If an
49 -- Merge results accumulated in the local MVar with the mainline. If an
89 -- exception was received while listening, merge results recorded so far.
50 -- exception was received while listening, merge results recorded so far.
90 merge es v0 v1 = do
51 merge es v0 v1 = do
91− putEnv es $ DataA (Writer v0)
52+ putEnv es $ IdE (Writer v0)
92 w1 <- readMVar v1
53 w1 <- readMVar v1
93 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
54 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
94 pure w1
55 pure w1
95
56
96−-- | Execute an action and append its output to the overall output of the
97−-- 'Writer', then return the final value along with a function of the recorded
98−-- output.
99−--
100−-- @'listens' f m ≡ 'Data.Bifunctor.second' f '<$>' 'listen' m@
101listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
57listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
102listens f m = do
58listens f m = do
103 (a, w) <- listen m
59 (a, w) <- listen m
104 pure (a, f w)
60 pure (a, f w)
105−
106−-- $setup
107−-- >>> import Control.Exception (ErrorCall)
108−-- >>> import Control.Monad.Catch
effectful/bench/Main.hs+3−3
@@ -97,11 +97,11 @@ filesize n = bgroup (show n)
97#ifdef VERSION_eff
97#ifdef VERSION_eff
98 , bench "eff" $ nfAppIO eff_calculateFileSizesDeep (take n files)
98 , bench "eff" $ nfAppIO eff_calculateFileSizesDeep (take n files)
99#endif
99#endif
100−#ifdef VERSION_mtl
101− , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)
102−#endif
103#ifdef VERSION_polysemy
100#ifdef VERSION_polysemy
104 , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)
101 , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)
102+#endif
103+#ifdef VERSION_mtl
104+ , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)
105#endif
105#endif
106 ]
106 ]
107 ]
107 ]
effectful/effectful.cabal+15−15
@@ -20,7 +20,7 @@ description: An easy to use, performant extensible effects library with seamless
20
20
21extra-source-files: CHANGELOG.md
21extra-source-files: CHANGELOG.md
22
22
23−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1
23+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1
24
24
25bug-reports: https://github.com/arybczak/effectful/issues
25bug-reports: https://github.com/arybczak/effectful/issues
26source-repository head
26source-repository head
@@ -40,7 +40,6 @@ common language
40 ConstraintKinds
40 ConstraintKinds
41 DataKinds
41 DataKinds
42 DeriveFunctor
42 DeriveFunctor
43− DeriveGeneric
44 FlexibleContexts
43 FlexibleContexts
45 FlexibleInstances
44 FlexibleInstances
46 GADTs
45 GADTs
@@ -61,19 +60,20 @@ common language
61library
60library
62 import: language
61 import: language
63
62
64− build-depends: base >= 4.13 && < 5
63+ build-depends: base >= 4.13 && <5
65− , async >= 2.2.2
64+ , async
66− , directory >= 1.3.2
65+ , directory
67− , effectful-core >= 0.1 && < 0.1.1
66+ , effectful-core >= 0.1 && <0.1.1
68− , process >= 1.6.9
67+ , process
69− , resourcet >= 1.2.4.3
68+ , resourcet
70− , time >= 1.9.2
69+ , time
71− , stm >= 2.5.0.0
70+ , stm >= 2.5.0.0
72− , unliftio >= 0.2.20
71+ , unliftio
73
72
74 hs-source-dirs: src
73 hs-source-dirs: src
75
74
76− exposed-modules: Effectful.Concurrent
75+ exposed-modules: Effectful
76+ Effectful.Concurrent
77 Effectful.Concurrent.Async
77 Effectful.Concurrent.Async
78 Effectful.Concurrent.Chan
78 Effectful.Concurrent.Chan
79 Effectful.Concurrent.MVar
79 Effectful.Concurrent.MVar
@@ -91,8 +91,7 @@ library
91 other-modules: Effectful.Concurrent.Effect
91 other-modules: Effectful.Concurrent.Effect
92 Effectful.FileSystem.Effect
92 Effectful.FileSystem.Effect
93
93
94− reexported-modules: Effectful
94+ reexported-modules: Effectful.Dispatch.Dynamic
95− , Effectful.Dispatch.Dynamic
96 , Effectful.Dispatch.Static
95 , Effectful.Dispatch.Static
97 , Effectful.Error
96 , Effectful.Error
98 , Effectful.Error.Dynamic
97 , Effectful.Error.Dynamic
@@ -119,6 +118,7 @@ test-suite test
119 , effectful-core
118 , effectful-core
120 , exceptions
119 , exceptions
121 , lifted-base
120 , lifted-base
121+ , optics-core >= 0.4
122 , tasty
122 , tasty
123 , tasty-hunit
123 , tasty-hunit
124 , unliftio
124 , unliftio
@@ -154,7 +154,7 @@ benchmark bench
154 if impl(ghc < 9.2)
154 if impl(ghc < 9.2)
155 build-depends: fused-effects
155 build-depends: fused-effects
156
156
157− if impl(ghc < 9.3)
157+ if impl(ghc < 9.2)
158 build-depends: polysemy
158 build-depends: polysemy
159
159
160 build-depends: base
160 build-depends: base
effectful-core/src/Effectful.hs → effectful/src/Effectful.hsrenamed+4−3
@@ -8,10 +8,10 @@ module Effectful
8
8
9 -- * Running the 'Eff' monad
9 -- * Running the 'Eff' monad
10
10
11− -- ** Pure computations
11+ -- ** Pure operations
12 , runPureEff
12 , runPureEff
13
13
14− -- ** Computations with side effects
14+ -- ** Operations with side effects
15 , IOE
15 , IOE
16 , runEff
16 , runEff
17
17
@@ -22,6 +22,7 @@ module Effectful
22 , unliftStrategy
22 , unliftStrategy
23 , withUnliftStrategy
23 , withUnliftStrategy
24 , withEffToIO
24 , withEffToIO
25+ , UnliftError(..)
25
26
26 -- * 'Effect' handlers
27 -- * 'Effect' handlers
27
28
@@ -32,7 +33,7 @@ module Effectful
32 , interpret
33 , interpret
33 , reinterpret
34 , reinterpret
34
35
35− -- ** Handling local 'Eff' computations
36+ -- ** Handling local 'Eff' operations
36 , LocalEnv
37 , LocalEnv
37
38
38 -- *** Unlifts
39 -- *** Unlifts
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'.
15module Effectful.Concurrent
1module Effectful.Concurrent
2+ ( -- * Concurrent effect
16− ( Concurrent
3+ Concurrent
17 , runConcurrent
4 , runConcurrent
18
5
19 -- * Basic concurrency operations
6 -- * Basic concurrency operations
effectful/src/Effectful/Concurrent/Async.hs+2−2
@@ -1,7 +1,7 @@
1{-# LANGUAGE UndecidableInstances #-}
1{-# LANGUAGE UndecidableInstances #-}
2−-- | Lifted version of "Control.Concurrent.Async".
3module Effectful.Concurrent.Async
2module Effectful.Concurrent.Async
3+ ( -- * Concurrent effect
4− ( Concurrent
4+ Concurrent
5 , runConcurrent
5 , runConcurrent
6
6
7 -- * Asynchronous actions
7 -- * Asynchronous actions
effectful/src/Effectful/Concurrent/Chan.hs+1−5
@@ -1,10 +1,6 @@
1-- | Lifted version of "Control.Concurrent.Chan".
1-- | Lifted version of "Control.Concurrent.Chan".
2module Effectful.Concurrent.Chan
2module Effectful.Concurrent.Chan
3− ( Concurrent
4− , runConcurrent
5−
6− -- * Chan
7− , Chan
3+ ( Chan
8 , newChan
4 , newChan
9 , writeChan
5 , writeChan
10 , readChan
6 , readChan
effectful/src/Effectful/Concurrent/Effect.hs+5−65
@@ -6,74 +6,14 @@ module Effectful.Concurrent.Effect
6import Effectful.Dispatch.Static
6import Effectful.Dispatch.Static
7import Effectful.Monad
7import Effectful.Monad
8
8
9−-- | Provide the ability to run 'Eff' computations concurrently in multiple
9+-- | Run 'Eff' operations asynchronously via the @async@ library.
10−-- threads and communicate between them.
11--
10--
12−-- /Warning:/ unless you stick to high level functions from the
11+-- /Note:/ thread local state changes in 'Eff' operations run asynchronously
13−-- 'Effectful.Concurrent.Async.withAsync' family, the 'Concurrent' effect makes
12+-- will not affect the parent thread.
14−-- it possible to escape the scope of any scoped effect operation. Consider the
15−-- following:
16−--
17−-- >>> import qualified Effectful.Reader as R
18−-- >>> let printAsk msg = liftIO . putStrLn . (msg ++) . (": " ++) =<< R.ask
19−-- >>> :{
20−-- runEff . R.runReader "GLOBAL" . runConcurrent $ do
21−-- a <- R.local (const "LOCAL") $ do
22−-- a <- async $ do
23−-- printAsk "child (first)"
24−-- threadDelay 20000
25−-- printAsk "child (second)"
26−-- threadDelay 10000
27−-- printAsk "parent (inside)"
28−-- pure a
29−-- printAsk "parent (outside)"
30−-- wait a
31−-- :}
32−-- child (first): LOCAL
33−-- parent (inside): LOCAL
34−-- parent (outside): GLOBAL
35−-- child (second): LOCAL
36−--
37−-- Note that the asynchronous computation doesn't respect the scope of
38−-- 'Effectful.Reader.local', i.e. the child thread still behaves like it's
39−-- inside the 'Effectful.Reader.local' block, even though the parent thread
40−-- already got out of it.
41−--
42−-- This is because the value provided by the 'Effectful.Reader.Reader' effect is
43−-- thread local, i.e. each thread manages its own version of it. For the
44−-- 'Effectful.Reader.Reader' it is the only reasonable behavior, it wouldn't be
45−-- very useful if its "read only" value was affected by calls to
46−-- 'Effectful.Reader.local' from its parent or child threads.
47−--
48−-- However, the cut isn't so clear if it comes to effects that provide access to
49−-- a mutable state. That's why primitive @State@ and @Writer@ effects come in
50−-- two flavors, local and shared:
51−--
52−-- >>> import qualified Effectful.State.Local as SL
53−-- >>> :{
54−-- runEff . SL.execState "Hi" . runConcurrent $ do
55−-- replicateConcurrently_ 3 $ SL.modify (++ "!")
56−-- :}
57−-- "Hi"
58−--
59−-- >>> import qualified Effectful.State.Shared as SS
60−-- >>> :{
61−-- runEff . SS.execState "Hi" . runConcurrent $ do
62−-- replicateConcurrently_ 3 $ SS.modify (++ "!")
63−-- :}
64−-- "Hi!!!"
65−--
66−-- In the first example state modification made concurrently are not reflected
67−-- in the parent thread because the value is thread local, but in the second
68−-- example they are, because the value is shared.
69--
13--
14+-- /TODO:/ write about 'Concurrent' not respecting scoped operations.
70data Concurrent :: Effect where
15data Concurrent :: Effect where
71 Concurrent :: Concurrent m r
16 Concurrent :: Concurrent m r
72
17
73−-- | Run the 'Concurrent' effect.
74runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a
18runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a
75−runConcurrent = evalData (DataA Concurrent)
19+runConcurrent = evalEffect (IdE Concurrent)
76−
77−-- $setup
78−-- >>> import Effectful.Concurrent
79−-- >>> import Effectful.Concurrent.Async
effectful/src/Effectful/Concurrent/MVar.hs+1−5
@@ -1,10 +1,6 @@
1-- | Lifted version of "Control.Concurrent.MVar".
1-- | Lifted version of "Control.Concurrent.MVar".
2module Effectful.Concurrent.MVar
2module Effectful.Concurrent.MVar
3− ( Concurrent
4− , runConcurrent
5−
6− -- * MVar
7− , MVar
3+ ( MVar
8 , newEmptyMVar
4 , newEmptyMVar
9 , newMVar
5 , newMVar
10 , takeMVar
6 , takeMVar
effectful/src/Effectful/Concurrent/QSem.hs+2−6
@@ -1,10 +1,6 @@
1−-- | Lifted version of "Control.Concurrent.QSem".
1+-- | Lifted "Control.Concurrent.QSem".
2module Effectful.Concurrent.QSem
2module Effectful.Concurrent.QSem
3− ( Concurrent
4− , runConcurrent
5−
6− -- * QSem
7− , QSem
3+ ( QSem
8 , newQSem
4 , newQSem
9 , waitQSem
5 , waitQSem
10 , signalQSem
6 , signalQSem
effectful/src/Effectful/Concurrent/QSemN.hs+2−6
@@ -1,10 +1,6 @@
1−-- | Lifted version of "Control.Concurrent.QSemN".
1+-- | Lifted "Control.Concurrent.QSemN".
2module Effectful.Concurrent.QSemN
2module Effectful.Concurrent.QSemN
3− ( Concurrent
4− , runConcurrent
5−
6− -- * QSemN
7− , QSemN
3+ ( QSemN
8 , newQSemN
4 , newQSemN
9 , waitQSemN
5 , waitQSemN
10 , signalQSemN
6 , signalQSemN
effectful/src/Effectful/Concurrent/STM.hs+2−5
@@ -1,10 +1,7 @@
1-- | Lifted version of "Control.Concurrent.STM".
1-- | Lifted version of "Control.Concurrent.STM".
2module Effectful.Concurrent.STM
2module Effectful.Concurrent.STM
3− ( Concurrent
4− , runConcurrent
5−
6− -- * Core
3+ ( -- * Core
7− , STM.STM
4+ STM.STM
8 , atomically
5 , atomically
9 , STM.retry
6 , STM.retry
10 , STM.orElse
7 , STM.orElse
effectful/src/Effectful/Environment.hs+3−3
@@ -1,5 +1,6 @@
1module Effectful.Environment
1module Effectful.Environment
2+ ( -- * Environment effect
2− ( Environment
3+ Environment
3 , runEnvironment
4 , runEnvironment
4
5
5 -- * Querying the environment
6 -- * Querying the environment
@@ -26,9 +27,8 @@ import Effectful.Monad
26data Environment :: Effect where
27data Environment :: Effect where
27 Environment :: Environment m r
28 Environment :: Environment m r
28
29
29−-- | Run the 'Environment' effect.
30runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a
30runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a
31−runEnvironment = evalData (DataA Environment)
31+runEnvironment = evalEffect (IdE Environment)
32
32
33-- | Lifted 'E.getArgs'.
33-- | Lifted 'E.getArgs'.
34getArgs :: Environment :> es => Eff es [String]
34getArgs :: Environment :> es => Eff es [String]
effectful/src/Effectful/FileSystem.hs+89−89
@@ -1,92 +1,92 @@
1module Effectful.FileSystem
1module Effectful.FileSystem
2− ( FileSystem
2+ ( FileSystem
3− , runFileSystem
3+ , runFileSystem
4−
4+
5− -- * Actions on directories
5+ -- * Actions on directories
6− , createDirectory
6+ , createDirectory
7− , createDirectoryIfMissing
7+ , createDirectoryIfMissing
8− , removeDirectory
8+ , removeDirectory
9− , removeDirectoryRecursive
9+ , removeDirectoryRecursive
10− , removePathForcibly
10+ , removePathForcibly
11− , renameDirectory
11+ , renameDirectory
12− , listDirectory
12+ , listDirectory
13− , getDirectoryContents
13+ , getDirectoryContents
14−
14+
15− -- ** Current working directory
15+ -- ** Current working directory
16− , getCurrentDirectory
16+ , getCurrentDirectory
17− , setCurrentDirectory
17+ , setCurrentDirectory
18− , withCurrentDirectory
18+ , withCurrentDirectory
19−
19+
20− -- * Pre-defined directories
20+ -- * Pre-defined directories
21− , getHomeDirectory
21+ , getHomeDirectory
22− , getXdgDirectory
22+ , getXdgDirectory
23− , getXdgDirectoryList
23+ , getXdgDirectoryList
24− , getAppUserDataDirectory
24+ , getAppUserDataDirectory
25− , getUserDocumentsDirectory
25+ , getUserDocumentsDirectory
26− , getTemporaryDirectory
26+ , getTemporaryDirectory
27−
27+
28− -- * Actions on files
28+ -- * Actions on files
29− , removeFile
29+ , removeFile
30− , renameFile
30+ , renameFile
31− , renamePath
31+ , renamePath
32− , copyFile
32+ , copyFile
33− , copyFileWithMetadata
33+ , copyFileWithMetadata
34− , getFileSize
34+ , getFileSize
35− , canonicalizePath
35+ , canonicalizePath
36− , makeAbsolute
36+ , makeAbsolute
37− , makeRelativeToCurrentDirectory
37+ , makeRelativeToCurrentDirectory
38−
38+
39− -- * Existence tests
39+ -- * Existence tests
40− , doesPathExist
40+ , doesPathExist
41− , doesFileExist
41+ , doesFileExist
42− , doesDirectoryExist
42+ , doesDirectoryExist
43− , findExecutable
43+ , findExecutable
44− , findExecutables
44+ , findExecutables
45− , findExecutablesInDirectories
45+ , findExecutablesInDirectories
46− , findFile
46+ , findFile
47− , findFiles
47+ , findFiles
48− , findFileWith
48+ , findFileWith
49− , findFilesWith
49+ , findFilesWith
50−
50+
51− -- * Symbolic links
51+ -- * Symbolic links
52− , createFileLink
52+ , createFileLink
53− , createDirectoryLink
53+ , createDirectoryLink
54− , removeDirectoryLink
54+ , removeDirectoryLink
55− , pathIsSymbolicLink
55+ , pathIsSymbolicLink
56− , getSymbolicLinkTarget
56+ , getSymbolicLinkTarget
57−
57+
58− -- * Permissions
58+ -- * Permissions
59− , getPermissions
59+ , getPermissions
60− , setPermissions
60+ , setPermissions
61− , copyPermissions
61+ , copyPermissions
62−
62+
63− -- * Timestamps
63+ -- * Timestamps
64− , getAccessTime
64+ , getAccessTime
65− , getModificationTime
65+ , getModificationTime
66− , setAccessTime
66+ , setAccessTime
67− , setModificationTime
67+ , setModificationTime
68−
68+
69− -- * Re-exports
69+ -- * Re-exports
70−
70+
71− -- ** Pre-defined directories
71+ -- ** Pre-defined directories
72− , D.XdgDirectory(..)
72+ , D.XdgDirectory(..)
73− , D.XdgDirectoryList(..)
73+ , D.XdgDirectoryList(..)
74−
74+
75− -- ** Existence tests
75+ -- ** Existence tests
76− , D.exeExtension
76+ , D.exeExtension
77−
77+
78− -- ** Permissions
78+ -- ** Permissions
79− , D.Permissions
79+ , D.Permissions
80− , D.emptyPermissions
80+ , D.emptyPermissions
81− , D.readable
81+ , D.readable
82− , D.writable
82+ , D.writable
83− , D.executable
83+ , D.executable
84− , D.searchable
84+ , D.searchable
85− , D.setOwnerReadable
85+ , D.setOwnerReadable
86− , D.setOwnerWritable
86+ , D.setOwnerWritable
87− , D.setOwnerExecutable
87+ , D.setOwnerExecutable
88− , D.setOwnerSearchable
88+ , D.setOwnerSearchable
89− ) where
89+ ) where
90
90
91import Data.Time (UTCTime)
91import Data.Time (UTCTime)
92import qualified System.Directory as D
92import qualified System.Directory as D
@@ -100,7 +100,7 @@ data FileSystem :: Effect where
100
100
101-- | Run the 'FileSystem' effect.
101-- | Run the 'FileSystem' effect.
102runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a
102runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a
103−runFileSystem = evalData (DataA FileSystem)
103+runFileSystem = evalEffect (IdE FileSystem)
104
104
105----------------------------------------
105----------------------------------------
106-- Actions on directories
106-- Actions on directories
effectful/src/Effectful/FileSystem/Effect.hs+1−1
@@ -12,4 +12,4 @@ data FileSystem :: Effect where
12
12
13-- | Run the 'FileSystem' effect.
13-- | Run the 'FileSystem' effect.
14runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a
14runFileSystem :: 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 @@
2module Effectful.FileSystem.IO
2module Effectful.FileSystem.IO
3 ( FileSystem
3 ( FileSystem
4 , runFileSystem
4 , runFileSystem
5−
6− -- * IO
7 , IOMode (..)
5 , IOMode (..)
8 , Handle
6 , Handle
9 , IO.stdin
7 , IO.stdin
effectful/src/Effectful/Process.hs+4−3
@@ -1,7 +1,8 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−-- | Lifted version of "System.Process".
2+
3module Effectful.Process
3module Effectful.Process
4+ ( -- * Process effect
4− ( Process
5+ Process
5 , runProcess
6 , runProcess
6
7
7 -- * Running sub-processes
8 -- * Running sub-processes
@@ -58,7 +59,7 @@ data Process :: Effect where
58 Process :: Process m r
59 Process :: Process m r
59
60
60runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a
61runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a
61−runProcess = evalData (DataA Process)
62+runProcess = evalEffect (IdE Process)
62
63
63----------------------------------------
64----------------------------------------
64-- Running sub-processes
65-- Running sub-processes
effectful/src/Effectful/Resource.hs+4−4
@@ -37,7 +37,7 @@ runResource m = unsafeEff $ \es0 -> do
37 size0 <- sizeEnv es0
37 size0 <- sizeEnv es0
38 istate <- R.createInternalState
38 istate <- R.createInternalState
39 mask $ \restore -> do
39 mask $ \restore -> do
40− es <- unsafeConsEnv (DataA (Resource istate)) noRelinker es0
40+ es <- unsafeConsEnv (IdE (Resource istate)) noRelinker es0
41 a <- restore (unEff m es) `catch` \e -> do
41 a <- restore (unEff m es) `catch` \e -> do
42 unsafeTailEnv size0 es
42 unsafeTailEnv size0 es
43 RI.stateCleanupChecked (Just e) istate
43 RI.stateCleanupChecked (Just e) istate
@@ -52,18 +52,18 @@ runResource m = unsafeEff $ \es0 -> do
52-- | Get the 'R.InternalState' of the current 'Resource' effect.
52-- | Get the 'R.InternalState' of the current 'Resource' effect.
53getInternalState :: Resource :> es => Eff es R.InternalState
53getInternalState :: Resource :> es => Eff es R.InternalState
54getInternalState = do
54getInternalState = do
55− DataA (Resource istate) <- getData
55+ IdE (Resource istate) <- getEffect
56 pure istate
56 pure istate
57
57
58-- | Run the 'Resource' effect with existing 'R.InternalState'.
58-- | Run the 'Resource' effect with existing 'R.InternalState'.
59--
59--
60-- /Note:/ the 'R.InternalState' will not be closed at the end.
60-- /Note:/ the 'R.InternalState' will not be closed at the end.
61runInternalState :: R.InternalState -> Eff (Resource : es) a -> Eff es a
61runInternalState :: R.InternalState -> Eff (Resource : es) a -> Eff es a
62−runInternalState istate = evalData (DataA (Resource istate))
62+runInternalState istate = evalEffect $ IdE (Resource istate)
63
63
64----------------------------------------
64----------------------------------------
65-- Orphan instance
65-- Orphan instance
66
66
67instance (IOE :> es, Resource :> es) => R.MonadResource (Eff es) where
67instance (IOE :> es, Resource :> es) => R.MonadResource (Eff es) where
68 liftResourceT (RI.ResourceT m) = unsafeEff $ \es -> do
68 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
19
19
20-- | Run the 'Temporary' effect.
20-- | Run the 'Temporary' effect.
21runTemporary :: IOE :> es => Eff (Temporary : es) a -> Eff es a
21runTemporary :: IOE :> es => Eff (Temporary : es) a -> Eff es a
22−runTemporary = evalData (DataA Temporary)
22+runTemporary = evalEffect (IdE Temporary)
23
23
24-- | Lifted 'T.withSystemTempFile'.
24-- | Lifted 'T.withSystemTempFile'.
25withSystemTempFile
25withSystemTempFile
effectful/src/Effectful/Timeout.hs+1−1
@@ -15,7 +15,7 @@ data Timeout :: Effect where
15
15
16-- | Run the 'Timeout' effect.
16-- | Run the 'Timeout' effect.
17runTimeout :: IOE :> es => Eff (Timeout : es) a -> Eff es a
17runTimeout :: IOE :> es => Eff (Timeout : es) a -> Eff es a
18−runTimeout = evalData (DataA Timeout)
18+runTimeout = evalEffect (IdE Timeout)
19
19
20-- | Lifted 'T.timeout'.
20-- | Lifted 'T.timeout'.
21timeout
21timeout
effectful/tests/EnvironmentTests.hs+6−11
@@ -9,17 +9,12 @@ import Effectful.Environment
9import qualified Utils as U
9import qualified Utils as U
10
10
11environmentTests :: TestTree
11environmentTests :: TestTree
12−environmentTests = testCaseSteps "Environment" $ \step -> do
12+environmentTests = testGroup "Environment"
13− -- These tests need to be run sequentially because of
14− -- https://github.com/arybczak/effectful/issues/39.
15− step "set and get an environment variable"
13+ [ testCase "set and get an environment variable" test_setAndGet
16− test_setAndGet
17− step "unset and try to get an environment variable"
14+ , testCase "unset and try to get an environment variable" test_unsetAndGet
18− test_unsetAndGet
19− step "execute effects with custom arguments"
15+ , testCase "execute effects with custom arguments" test_withArgs
20− test_withArgs
21− step "execute effects with custom program name"
16+ , testCase "execute effects with custom program name" test_withProg
22− test_withProg
17+ ]
23
18
24test_setAndGet :: Assertion
19test_setAndGet :: Assertion
25test_setAndGet = runEff . runEnvironment $ do
20test_setAndGet = runEff . runEnvironment $ do
effectful/tests/UnliftTests.hs+35−28
@@ -1,6 +1,7 @@
1+{-# LANGUAGE OverloadedLabels #-}
1module UnliftTests (unliftTests) where
2module UnliftTests (unliftTests) where
2
3
3−import Control.Exception
4+import Optics.Core
4import Test.Tasty
5import Test.Tasty
5import Test.Tasty.HUnit
6import Test.Tasty.HUnit
6import qualified UnliftIO.Async as A
7import qualified UnliftIO.Async as A
@@ -33,38 +34,43 @@ test_resetStrategy = runEff $ do
33
34
34test_seqUnliftInNewThread :: Assertion
35test_seqUnliftInNewThread :: Assertion
35test_seqUnliftInNewThread = runEff $ do
36test_seqUnliftInNewThread = runEff $ do
36− assertThrowsUnliftError "InvalidUseOfSeqUnlift error" $ do
37+ assertThrowsUnliftError "InvalidUseOfSeqUnlift error"
38+ (has #_InvalidUseOfSeqUnlift) $ do
37− withUnliftStrategy SeqUnlift $ do
39+ withUnliftStrategy SeqUnlift $ do
38− withEffToIO $ \runInIO -> do
40+ withEffToIO $ \runInIO -> do
39− inThread $ runInIO $ return ()
41+ inThread $ runInIO $ return ()
40
42
41test_ephemeralInvalid :: Assertion
43test_ephemeralInvalid :: Assertion
42test_ephemeralInvalid = runEff $ do
44test_ephemeralInvalid = runEff $ do
43− assertThrowsUnliftError "InvalidNumberOfUses error" $ do
45+ assertThrowsUnliftError "InvalidNumberOfUses error"
46+ (has #_InvalidNumberOfUses) $ do
44− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do
47+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 0) $ do
45− withEffToIO $ \_ -> return ()
48+ withEffToIO $ \_ -> return ()
46
49
47test_ephemeralSameThread :: Assertion
50test_ephemeralSameThread :: Assertion
48test_ephemeralSameThread = runEff $ do
51test_ephemeralSameThread = runEff $ do
49− assertThrowsUnliftError "ExceededNumberOfUses error" $ do
52+ assertThrowsUnliftError "ExceededNumberOfUses error"
53+ (has #_ExceededNumberOfUses) $ do
50− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
54+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
51− withEffToIO $ \runInIO -> inThread $ do
55+ withEffToIO $ \runInIO -> inThread $ do
52− runInIO $ return ()
56+ runInIO $ return ()
53− runInIO $ return ()
57+ runInIO $ return ()
54
58
55test_ephemeralMultipleThreads :: Assertion
59test_ephemeralMultipleThreads :: Assertion
56test_ephemeralMultipleThreads = runEff $ do
60test_ephemeralMultipleThreads = runEff $ do
57− assertThrowsUnliftError "ExceededNumberOfUses error" $ do
61+ assertThrowsUnliftError "ExceededNumberOfUses error"
62+ (has #_ExceededNumberOfUses) $ do
58− withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
63+ withUnliftStrategy (ConcUnlift Ephemeral $ Limited 1) $ do
59− withEffToIO $ \runInIO -> do
64+ withEffToIO $ \runInIO -> do
60− inThread $ runInIO $ return ()
65+ inThread $ runInIO $ return ()
61− inThread $ runInIO $ return ()
66+ inThread $ runInIO $ return ()
62
67
63test_persistentInvalid :: Assertion
68test_persistentInvalid :: Assertion
64test_persistentInvalid = runEff $ do
69test_persistentInvalid = runEff $ do
65− assertThrowsUnliftError "InvalidNumberOfThreads error" $ do
70+ assertThrowsUnliftError "InvalidNumberOfThreads error"
71+ (has #_InvalidNumberOfThreads) $ do
66− withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do
72+ withUnliftStrategy (ConcUnlift Persistent $ Limited 0) $ do
67− withEffToIO $ \_ -> return ()
73+ withEffToIO $ \_ -> return ()
68
74
69test_persistentSameThread :: Assertion
75test_persistentSameThread :: Assertion
70test_persistentSameThread = runEff $ do
76test_persistentSameThread = runEff $ do
@@ -75,19 +81,20 @@ test_persistentSameThread = runEff $ do
75
81
76test_persistentMultipleThreads :: Assertion
82test_persistentMultipleThreads :: Assertion
77test_persistentMultipleThreads = runEff $ do
83test_persistentMultipleThreads = runEff $ do
78− assertThrowsUnliftError "ExceededNumberOfThreads error" $ do
84+ assertThrowsUnliftError "ExceededNumberOfThreads error"
85+ (has #_ExceededNumberOfThreads) $ do
79− withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
86+ withUnliftStrategy (ConcUnlift Persistent $ Limited 1) $ do
80− withEffToIO $ \runInIO -> do
87+ withEffToIO $ \runInIO -> do
81− inThread $ runInIO $ return ()
88+ inThread $ runInIO $ return ()
82− inThread $ runInIO $ return ()
89+ inThread $ runInIO $ return ()
83
90
84----------------------------------------
91----------------------------------------
85-- Helpers
92-- Helpers
86
93
87assertThrowsUnliftError
94assertThrowsUnliftError
88 :: IOE :> es
95 :: IOE :> es
89− => String -> Eff es a -> Eff es ()
96+ => String -> (UnliftError -> Bool) -> Eff es a -> Eff es ()
90−assertThrowsUnliftError err = U.assertThrows err (\ErrorCall{} -> True)
97+assertThrowsUnliftError = U.assertThrows
91
98
92inThread :: IO a -> IO a
99inThread :: IO a -> IO a
93inThread k = A.async k >>= A.wait
100inThread k = A.async k >>= A.wait