on 1fdb00a help sign in
.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+2−3
@@ -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
@@ -70,7 +69,7 @@ library
70 build-depends: effectful-internal-utils
69 build-depends: effectful-internal-utils
71
70
72 build-depends: base >= 4.13 && < 5
71 build-depends: base >= 4.13 && < 5
73− , containers >= 0.6
72+ , containers >= 0.6.5.1
74 , exceptions >= 0.10.4
73 , exceptions >= 0.10.4
75 , monad-control >= 1.0.3
74 , monad-control >= 1.0.3
76 , primitive >= 0.7.3.0
75 , primitive >= 0.7.3.0
effectful-core/src/Effectful.hs+3−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
@@ -32,7 +32,7 @@ module Effectful
32 , interpret
32 , interpret
33 , reinterpret
33 , reinterpret
34
34
35− -- ** Handling local 'Eff' computations
35+ -- ** Handling local 'Eff' operations
36 , LocalEnv
36 , LocalEnv
37
37
38 -- *** Unlifts
38 -- *** Unlifts
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−25
@@ -1,30 +1,23 @@
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
16
17 -- ** Unlifts
17 -- ** Unlifts
18 , seqUnliftIO
18 , seqUnliftIO
19 , concUnliftIO
19 , concUnliftIO
20
20
21− -- ** Utils
22− , unEff
23− , unsafeEff
24− , unsafeEff_
25− , unsafeLiftMapIO
26− , unsafeUnliftIO
27−
28 -- * Primitive API
21 -- * Primitive API
29 , Env
22 , Env
30 , Relinker(..)
23 , Relinker(..)
@@ -46,12 +39,24 @@ module Effectful.Dispatch.Static
46 , putEnv
39 , putEnv
47 , stateEnv
40 , stateEnv
48 , modifyEnv
41 , modifyEnv
42+
43+ -- * Unsafe 'Eff' operations
44+ , unsafeEff
45+ , unsafeEff_
46+ , unsafeLiftMapIO
47+ , unsafeUnliftIO
48+
49+ -- * Utils
50+ , unEff
49 ) where
51 ) where
50
52
53+import GHC.Stack (HasCallStack)
54+
55+import Effectful.Internal.Effect
51import Effectful.Internal.Env
56import Effectful.Internal.Env
52import Effectful.Internal.Monad
57import Effectful.Internal.Monad
53
58
54−-- | Utility for lifting 'IO' computations of type
59+-- | Utility for lifting 'IO' operations of type
55--
60--
56-- @'IO' a -> 'IO' b@
61-- @'IO' a -> 'IO' b@
57--
62--
@@ -62,10 +67,10 @@ import Effectful.Internal.Monad
62-- This function is __unsafe__ because:
67-- This function is __unsafe__ because:
63--
68--
64-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
69-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
65−-- computations.
70+-- operations.
66--
71--
67−-- - The 'IO' computation must not run its argument in a separate thread, but
72+-- - The 'IO' operation must not run its argument in a separate thread, but it's
68−-- it's not checked anywhere.
73+-- not checked anywhere.
69unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
74unsafeLiftMapIO :: (IO a -> IO b) -> Eff es a -> Eff es b
70unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
75unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
71
76
@@ -74,9 +79,12 @@ unsafeLiftMapIO f m = unsafeEff $ \es -> f (unEff m es)
74-- This function is __unsafe__ because:
79-- This function is __unsafe__ because:
75--
80--
76-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
81-- - It can be used to introduce arbitrary 'IO' actions into pure 'Eff'
77−-- computations.
82+-- operations.
78--
83--
79−-- - Unlifted 'Eff' computations must not be run in a thread distinct from the
84+-- - Unlifted 'Eff' operations must not be run in a thread distinct from the
80-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
85-- caller of 'unsafeUnliftIO', but it's not checked anywhere.
86+unsafeUnliftIO
87+ :: HasCallStack
81−unsafeUnliftIO :: ((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
88+ => ((forall r. Eff es r -> IO r) -> IO a)
89+ -> Eff es a
82unsafeUnliftIO k = unsafeEff $ \es -> k (`unEff` es)
90unsafeUnliftIO 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+20−25
@@ -1,4 +1,3 @@
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--
@@ -43,7 +42,7 @@ import Control.Monad
43import Control.Monad.Primitive
42import Control.Monad.Primitive
44import Data.IORef
43import Data.IORef
45import Data.Primitive.SmallArray
44import Data.Primitive.SmallArray
46−import GHC.Exts (Any, SmallMutableArray#)
45+import GHC.Exts (Any)
47import GHC.Stack (HasCallStack)
46import GHC.Stack (HasCallStack)
48import Unsafe.Coerce
47import Unsafe.Coerce
49import qualified Data.IntMap.Strict as IM
48import qualified Data.IntMap.Strict as IM
@@ -418,43 +417,43 @@ unsafeTailEnv len (Env fork gref _) = case fork of
418
417
419-- | Extract a specific data type from the environment.
418-- | Extract a specific data type from the environment.
420getEnv
419getEnv
421− :: forall e adapter es. e :> es
420+ :: forall e es adapter. e :> es
422 => Env es
421 => Env es
423 -> IO (adapter e)
422 -> IO (adapter e)
424getEnv env = do
423getEnv env = do
425− Location i es <- getLocation (reifyIndex @e @es) env
424+ (i, es) <- getLocation (reifyIndex @e @es) env
426 fromAny <$> readSmallArray es i
425 fromAny <$> readSmallArray es i
427
426
428-- | Replace the data type in the environment with a new value (in place).
427-- | Replace the data type in the environment with a new value (in place).
429putEnv
428putEnv
430− :: forall e adapter es. e :> es
429+ :: forall e es adapter. e :> es
431 => Env es
430 => Env es
432 -> adapter e
431 -> adapter e
433 -> IO ()
432 -> IO ()
434putEnv env e = do
433putEnv env e = do
435− Location i es <- getLocation (reifyIndex @e @es) env
434+ (i, es) <- getLocation (reifyIndex @e @es) env
436 e `seq` writeSmallArray es i (toAny e)
435 e `seq` writeSmallArray es i (toAny e)
437
436
438-- | Modify the data type in the environment (in place) and return a value.
437-- | Modify the data type in the environment (in place) and return a value.
439stateEnv
438stateEnv
440− :: forall e adapter es a. e :> es
439+ :: forall e es adapter a. e :> es
441 => Env es
440 => Env es
442 -> (adapter e -> (a, adapter e))
441 -> (adapter e -> (a, adapter e))
443 -> IO a
442 -> IO a
444stateEnv env f = do
443stateEnv env f = do
445− Location i es <- getLocation (reifyIndex @e @es) env
444+ (i, es) <- getLocation (reifyIndex @e @es) env
446 (a, e) <- f . fromAny <$> readSmallArray es i
445 (a, e) <- f . fromAny <$> readSmallArray es i
447 e `seq` writeSmallArray es i (toAny e)
446 e `seq` writeSmallArray es i (toAny e)
448 pure a
447 pure a
449
448
450-- | Modify the data type in the environment (in place).
449-- | Modify the data type in the environment (in place).
451modifyEnv
450modifyEnv
452− :: forall e adapter es. e :> es
451+ :: forall e es adapter. e :> es
453 => Env es
452 => Env es
454 -> (adapter e -> adapter e)
453 -> (adapter e -> adapter e)
455 -> IO ()
454 -> IO ()
456modifyEnv env f = do
455modifyEnv env f = do
457− Location i es <- getLocation (reifyIndex @e @es) env
456+ (i, es) <- getLocation (reifyIndex @e @es) env
458 e <- f . fromAny <$> readSmallArray es i
457 e <- f . fromAny <$> readSmallArray es i
459 e `seq` writeSmallArray es i (toAny e)
458 e `seq` writeSmallArray es i (toAny e)
460
459
@@ -470,17 +469,13 @@ emptyEnvRef = do
470 fs <- newSmallArray 0 undefinedData
469 fs <- newSmallArray 0 undefinedData
471 newIORef $ EnvRef 0 es fs
470 newIORef $ EnvRef 0 es fs
472
471
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.
472-- | Determine location of the data type in the environment.
478getLocation
473getLocation
479 :: Int
474 :: Int
480 -> Env es
475 -> Env es
481− -> IO Location
476+ -> IO (Int, SmallMutableArray RealWorld Any)
482getLocation ixE (Env fork ref _) = do
477getLocation ixE (Env fork ref _) = do
483− EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref
478+ EnvRef n es _ <- readIORef ref
484 -- Optimized for the common access pattern:
479 -- Optimized for the common access pattern:
485 --
480 --
486 -- - Most application code has no access to forks, in which case we look at
481 -- - Most application code has no access to forks, in which case we look at
@@ -489,25 +484,25 @@ getLocation ixE (Env fork ref _) = do
489 -- - Effect handlers will most likely access the newest fork with handler
484 -- - Effect handlers will most likely access the newest fork with handler
490 -- specific effects for reinterpretation.
485 -- specific effects for reinterpretation.
491 case fork of
486 case fork of
492− NoFork -> pure $ Location (ix n) es
487+ NoFork -> pure (ix n, es)
493 Forks _ baseIx lref forks -> do
488 Forks _ baseIx lref forks -> do
494 EnvRef ln les _ <- readIORef lref
489 EnvRef ln les _ <- readIORef lref
495 let i = ix (baseIx + ln)
490 let i = ix (baseIx + ln)
496 if i >= baseIx
491 if i >= baseIx
497− then pure $ Location (i - baseIx) les
492+ then pure (i - baseIx, les)
498− else go es# i forks
493+ else go es i forks
499 where
494 where
500− go :: SmallMutableArray# RealWorld Any
495+ go :: SmallMutableArray RealWorld Any
501 -> Int
496 -> Int
502 -> Forks
497 -> Forks
503− -> IO Location
498+ -> IO (Int, SmallMutableArray RealWorld Any)
504− go es# i = \case
499+ go es i = \case
505− NoFork -> pure $ Location i (SmallMutableArray es#)
500+ NoFork -> pure (i, es)
506 Forks _ baseIx lref forks -> do
501 Forks _ baseIx lref forks -> do
507 EnvRef _ les _ <- readIORef lref
502 EnvRef _ les _ <- readIORef lref
508 if i >= baseIx
503 if i >= baseIx
509− then pure $ Location (i - baseIx) les
504+ then pure (i - baseIx, les)
510− else go es# i forks
505+ else go es i forks
511
506
512 ix :: Int -> Int
507 ix :: Int -> Int
513 ix n = n - ixE - 1
508 ix n = n - ixE - 1
effectful-core/src/Effectful/Internal/Monad.hs+80−93
@@ -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,11 +22,11 @@ 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(..)
@@ -34,29 +34,34 @@ module Effectful.Internal.Monad
34 , withUnliftStrategy
34 , withUnliftStrategy
35 , withEffToIO
35 , withEffToIO
36
36
37− -- ** Low-level unlifts
37+ --- *** Low-level helpers
38 , seqUnliftIO
38 , seqUnliftIO
39 , concUnliftIO
39 , concUnliftIO
40
40
41 -- * Effects
41 -- * Effects
42
42
43− -- ** Dynamic dispatch
43+ -- ** Handler
44 , EffectHandler
44 , EffectHandler
45 , LocalEnv(..)
45 , LocalEnv(..)
46− , HandlerA(..)
46+ , Handler(..)
47 , runHandler
47 , runHandler
48+
49+ -- *** Sending operations
48 , send
50 , send
49
51
50− -- ** Static dispatch
52+ -- ** Primitive
51− , DataA(..)
53+
52− , runData
54+ -- *** Running
53− , evalData
55+ , runEffect
54− , execData
56+ , evalEffect
55− , getData
57+ , execEffect
56− , putData
58+
57− , stateData
59+ -- *** Modification
58− , stateDataM
60+ , getEffect
59− , localData
61+ , putEffect
62+ , stateEffect
63+ , stateEffectM
64+ , localEffect
60 ) where
65 ) where
61
66
62import Control.Applicative (liftA2)
67import Control.Applicative (liftA2)
@@ -79,43 +84,44 @@ import Effectful.Internal.Unlift
79
84
80type role Eff nominal representational
85type role Eff nominal representational
81
86
82−-- | The 'Eff' monad provides the implementation of a computation that performs
87+-- | 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
88-- 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
89+-- contains all the effects that the operation may perform. For example, an
85−-- computation that produces an 'Integer' by consuming a 'String' from the
90+-- 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'
91+-- environment and acting upon a single mutable cell containing a 'Bool' would
87−-- would have the following type:
92+-- have the following type:
88--
93--
89-- @
94-- @
90−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
95+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
91-- @
96-- @
92--
97--
93-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
98-- 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
99-- 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
100+-- effects without coupling an operation to a concrete list of effects. For
96−-- example, the above example would be expressed with the following type:
101+-- example, the above example would more commonly be expressed with the
102+-- following type:
97--
103--
98-- @
104-- @
99−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
105+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
100-- @
106-- @
101--
107--
102−-- This abstraction allows the computation to be used in functions that may
108+-- 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
109-- perform other effects, and it also allows the effects to be handled in any
104-- order.
110-- order.
105newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
111newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
106 deriving (Monoid, Semigroup)
112 deriving (Monoid, Semigroup)
107
113
108−-- | Run a pure 'Eff' computation.
114+-- | Run a pure 'Eff' operation.
109--
115--
110−-- For running computations with side effects see 'runEff'.
116+-- For running operations with side effects see 'runEff'.
111runPureEff :: Eff '[] a -> a
117runPureEff :: Eff '[] a -> a
112runPureEff (Eff m) =
118runPureEff (Eff m) =
113− -- unsafeDupablePerformIO is safe here since IOE was not on the stack, so no
119+ -- 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
120+ -- side effects was performed (unless someone sneakily introduced side effects
115− -- effects with unsafeEff, but then all bets are off).
121+ -- with unsafeEff, but then all bets are off).
116 --
122 --
117 -- Moreover, internals don't allocate any resources that require explicit
123 -- Moreover, internals don't allocate any resources that require explicit
118− -- cleanup actions to run.
124+ -- cleanup actions to run, so the "Dupable" part should also be just fine.
119 unsafeDupablePerformIO $ m =<< emptyEnv
125 unsafeDupablePerformIO $ m =<< emptyEnv
120
126
121----------------------------------------
127----------------------------------------
@@ -128,14 +134,14 @@ unEff (Eff m) = m
128-- | Access the underlying 'IO' monad along with the environment.
134-- | Access the underlying 'IO' monad along with the environment.
129--
135--
130-- This function is __unsafe__ because it can be used to introduce arbitrary
136-- This function is __unsafe__ because it can be used to introduce arbitrary
131−-- 'IO' actions into pure 'Eff' computations.
137+-- 'IO' actions into pure 'Eff' operations.
132unsafeEff :: (Env es -> IO a) -> Eff es a
138unsafeEff :: (Env es -> IO a) -> Eff es a
133unsafeEff m = Eff (oneShot m)
139unsafeEff m = Eff (oneShot m)
134
140
135-- | Access the underlying 'IO' monad.
141-- | Access the underlying 'IO' monad.
136--
142--
137-- This function is __unsafe__ because it can be used to introduce arbitrary
143-- This function is __unsafe__ because it can be used to introduce arbitrary
138−-- 'IO' actions into pure 'Eff' computations.
144+-- 'IO' actions into pure 'Eff' operations.
139unsafeEff_ :: IO a -> Eff es a
145unsafeEff_ :: IO a -> Eff es a
140unsafeEff_ m = unsafeEff $ \_ -> m
146unsafeEff_ m = unsafeEff $ \_ -> m
141
147
@@ -145,12 +151,12 @@ unsafeEff_ m = unsafeEff $ \_ -> m
145-- | Get the current 'UnliftStrategy'.
151-- | Get the current 'UnliftStrategy'.
146unliftStrategy :: IOE :> es => Eff es UnliftStrategy
152unliftStrategy :: IOE :> es => Eff es UnliftStrategy
147unliftStrategy = do
153unliftStrategy = do
148− DataA (IOE unlift) <- getData
154+ IdE (IOE unlift) <- getEffect
149 pure unlift
155 pure unlift
150
156
151-- | Locally override the 'UnliftStrategy' with the given value.
157-- | Locally override the 'UnliftStrategy' with the given value.
152withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
158withUnliftStrategy :: IOE :> es => UnliftStrategy -> Eff es a -> Eff es a
153−withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)
159+withUnliftStrategy unlift = localEffect $ \_ -> IdE (IOE unlift)
154
160
155-- | Create an unlifting function with the current 'UnliftStrategy'.
161-- | Create an unlifting function with the current 'UnliftStrategy'.
156--
162--
@@ -158,7 +164,7 @@ withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)
158-- constraint for accurate stack traces in case an insufficiently powerful
164-- constraint for accurate stack traces in case an insufficiently powerful
159-- 'UnliftStrategy' is used and the unlifting function fails.
165-- 'UnliftStrategy' is used and the unlifting function fails.
160--
166--
161−-- /Note:/ the strategy is reset to 'SeqUnlift' inside the continuation.
167+-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
162withEffToIO
168withEffToIO
163 :: (HasCallStack, IOE :> es)
169 :: (HasCallStack, IOE :> es)
164 => ((forall r. Eff es r -> IO r) -> IO a)
170 => ((forall r. Eff es r -> IO r) -> IO a)
@@ -258,15 +264,15 @@ instance Fail :> es => MonadFail (Eff es) where
258----------------------------------------
264----------------------------------------
259-- IO
265-- IO
260
266
261−-- | Run arbitrary 'IO' computations via 'MonadIO' or 'MonadUnliftIO'.
267+-- | Run arbitrary 'IO' operations via 'MonadIO' or 'MonadUnliftIO'.
262newtype IOE :: Effect where
268newtype IOE :: Effect where
263 IOE :: UnliftStrategy -> IOE m r
269 IOE :: UnliftStrategy -> IOE m r
264
270
265−-- | Run an 'Eff' computation with side effects.
271+-- | Run an 'Eff' operation with side effects.
266--
272--
267−-- For running pure computations see 'runPureEff'.
273+-- For running pure operations see 'runPureEff'.
268runEff :: Eff '[IOE] a -> IO a
274runEff :: Eff '[IOE] a -> IO a
269−runEff m = unEff (evalData (DataA (IOE SeqUnlift)) m) =<< emptyEnv
275+runEff m = unEff (evalEffect (IdE (IOE SeqUnlift)) m) =<< emptyEnv
270
276
271instance IOE :> es => MonadIO (Eff es) where
277instance IOE :> es => MonadIO (Eff es) where
272 liftIO = unsafeEff_
278 liftIO = unsafeEff_
@@ -290,20 +296,20 @@ instance IOE :> es => MonadBaseControl IO (Eff es) where
290----------------------------------------
296----------------------------------------
291-- Primitive
297-- Primitive
292
298
293−-- | Provide the ability to perform primitive state-transformer actions.
299+-- | An effect to perform primitive state-transformer actions.
294data Prim :: Effect where
300data Prim :: Effect where
295 Prim :: Prim m r
301 Prim :: Prim m r
296
302
297−-- | Run an 'Eff' computation with primitive state-transformer actions.
303+-- | Run an 'Eff' operation with primitive state-transformer actions.
298runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
304runPrim :: IOE :> es => Eff (Prim : es) a -> Eff es a
299−runPrim = evalData (DataA Prim)
305+runPrim = evalEffect (IdE Prim)
300
306
301instance Prim :> es => PrimMonad (Eff es) where
307instance Prim :> es => PrimMonad (Eff es) where
302 type PrimState (Eff es) = RealWorld
308 type PrimState (Eff es) = RealWorld
303 primitive = unsafeEff_ . IO
309 primitive = unsafeEff_ . IO
304
310
305----------------------------------------
311----------------------------------------
306−-- Dynamic dispatch
312+-- Handler
307
313
308type role LocalEnv nominal nominal
314type role LocalEnv nominal nominal
309
315
@@ -319,97 +325,78 @@ newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env l
319type EffectHandler e es
325type EffectHandler e es
320 = forall a localEs. HasCallStack
326 = forall a localEs. HasCallStack
321 => LocalEnv localEs es
327 => LocalEnv localEs es
322− -- ^ Capture of the local environment for handling local 'Eff' computations
328+ -- ^ Capture of the local environment for handling local 'Eff' operations when
323− -- when @e@ is a higher order effect.
329+ -- @e@ is a higher order effect.
324 -> e (Eff localEs) a
330 -> e (Eff localEs) a
325 -- ^ The effect performed in the local environment.
331 -- ^ The effect performed in the local environment.
326 -> Eff es a
332 -> Eff es a
327
333
328-- | An adapter for dynamically dispatched effects.
334-- | An adapter for dynamically dispatched effects.
329--
335--
330−-- Represents the effect handler bundled with its environment.
336+-- Represents the effect handler bundled along with its environment.
331−data HandlerA :: Effect -> Type where
337+data Handler :: Effect -> Type where
332− HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e
338+ Handler :: !(Env es) -> !(EffectHandler e es) -> Handler e
333
339
334−-- | Run a dynamically dispatched effect with the given handler.
340+-- | Run the effect with the given handler.
335−runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
341+runHandler :: Handler e -> Eff (e : es) a -> Eff es a
336runHandler e m = unsafeEff $ \es0 -> do
342runHandler e m = unsafeEff $ \es0 -> do
337 size0 <- sizeEnv es0
343 size0 <- sizeEnv es0
338 E.bracket (unsafeConsEnv e relinker es0)
344 E.bracket (unsafeConsEnv e relinker es0)
339 (unsafeTailEnv size0)
345 (unsafeTailEnv size0)
340 (\es -> unEff m es)
346 (\es -> unEff m es)
341 where
347 where
342− relinker :: Relinker HandlerA e
348+ relinker :: Relinker Handler e
343− relinker = Relinker $ \relink (HandlerA handlerEs handle) -> do
349+ relinker = Relinker $ \relink (Handler env handle) -> do
344− newHandlerEs <- relink handlerEs
350+ newEnv <- relink env
345− pure $ HandlerA newHandlerEs handle
351+ pure $ Handler newEnv handle
346
352
347-- | Send an operation of the given effect to its handler for execution.
353-- | Send an operation of the given effect to its handler for execution.
348send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
354send :: (HasCallStack, e :> es) => e (Eff es) a -> Eff es a
349send op = unsafeEff $ \es -> do
355send op = unsafeEff $ \es -> do
350− HandlerA handlerEs handle <- getEnv es
356+ Handler handlerEs handle <- getEnv es
351 unEff (handle (LocalEnv es) op) handlerEs
357 unEff (handle (LocalEnv es) op) handlerEs
352
358
353----------------------------------------
359----------------------------------------
354−-- Static dispatch
360+-- Helpers
355
361
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)
362+runEffect :: adapter e -> Eff (e : es) a -> Eff es (a, adapter e)
366−runData e0 m = unsafeEff $ \es0 -> do
363+runEffect e0 m = unsafeEff $ \es0 -> do
367 size0 <- sizeEnv es0
364 size0 <- sizeEnv es0
368 E.bracket (unsafeConsEnv e0 noRelinker es0)
365 E.bracket (unsafeConsEnv e0 noRelinker es0)
369 (unsafeTailEnv size0)
366 (unsafeTailEnv size0)
370 (\es -> (,) <$> unEff m es <*> getEnv es)
367 (\es -> (,) <$> unEff m es <*> getEnv es)
371
368
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
369+evalEffect :: adapter e -> Eff (e : es) a -> Eff es a
375−evalData e m = unsafeEff $ \es0 -> do
370+evalEffect e m = unsafeEff $ \es0 -> do
376 size0 <- sizeEnv es0
371 size0 <- sizeEnv es0
377 E.bracket (unsafeConsEnv e noRelinker es0)
372 E.bracket (unsafeConsEnv e noRelinker es0)
378 (unsafeTailEnv size0)
373 (unsafeTailEnv size0)
379 (\es -> unEff m es)
374 (\es -> unEff m es)
380
375
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)
376+execEffect :: adapter e -> Eff (e : es) a -> Eff es (adapter e)
384−execData e0 m = unsafeEff $ \es0 -> do
377+execEffect e0 m = unsafeEff $ \es0 -> do
385 size0 <- sizeEnv es0
378 size0 <- sizeEnv es0
386 E.bracket (unsafeConsEnv e0 noRelinker es0)
379 E.bracket (unsafeConsEnv e0 noRelinker es0)
387 (unsafeTailEnv size0)
380 (unsafeTailEnv size0)
388 (\es -> unEff m es *> getEnv es)
381 (\es -> unEff m es *> getEnv es)
389
382
390−-- | Fetch the current state of the effect.
383+getEffect :: e :> es => Eff es (adapter e)
391−getData :: e :> es => Eff es (DataA e)
392−getData = unsafeEff $ \es -> getEnv es
384+getEffect = unsafeEff $ \es -> getEnv es
393
385
394−-- | Set the current state of the effect to the given value.
386+putEffect :: e :> es => adapter e -> Eff es ()
395−putData :: e :> es => DataA e -> Eff es ()
396−putData e = unsafeEff $ \es -> putEnv es e
387+putEffect e = unsafeEff $ \es -> putEnv es e
397
388
398−-- | Apply the function to the current state of the effect and return a value.
389+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
390+stateEffect f = unsafeEff $ \es -> stateEnv es f
401
391
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
392+stateEffectM :: e :> es => (adapter e -> Eff es (a, adapter e)) -> Eff es a
405−stateDataM f = unsafeEff $ \es -> E.mask $ \release -> do
393+stateEffectM f = unsafeEff $ \es -> E.mask $ \release -> do
406 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
394 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
407 putEnv es e
395 putEnv es e
408 pure a
396 pure a
409
397
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
398+localEffect :: e :> es => (adapter e -> adapter e) -> Eff es a -> Eff es a
412−localData f m = unsafeEff $ \es -> do
399+localEffect f m = unsafeEff $ \es -> do
413 E.bracket (stateEnv es $ \e -> (e, f e))
400 E.bracket (stateEnv es $ \e -> (e, f e))
414 (\e -> putEnv es e)
401 (\e -> putEnv es e)
415 (\_ -> unEff m es)
402 (\_ -> unEff m es)
effectful-core/src/Effectful/Internal/Unlift.hs+4−4
@@ -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 #-}
@@ -35,9 +36,8 @@ import Effectful.Internal.Utils
35----------------------------------------
36----------------------------------------
36-- Unlift strategies
37-- Unlift strategies
37
38
38−-- | The strategy to use when unlifting 'Eff' computations via 'withRunInIO',
39+-- | The strategy to use when unlifting 'Eff' operations via 'withRunInIO' or
39−-- 'Effectful.Monad.withEffToIO' or the 'Effectful.Dispatch.Dynamic.localUnlift'
40+-- the 'Effectful.Interpreter.localUnlift' family.
40−-- family.
41data UnliftStrategy
41data UnliftStrategy
42 = SeqUnlift
42 = SeqUnlift
43 -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
43 -- ^ The fastest strategy and a default setting for 'IOE'. An attempt to call
@@ -105,7 +105,7 @@ seqUnlift k es unEff = do
105 if tid `eqThreadId` tid0
105 if tid `eqThreadId` tid0
106 then unEff m es
106 then unEff m es
107 else error
107 else error
108− $ "If you want to use the unlifting function to run Eff computations "
108+ $ "If you want to use the unlifting function to run Eff operations "
109 ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
109 ++ "in multiple threads, have a look at UnliftStrategy (ConcUnlift)."
110
110
111-- | Concurrent unlift for various strategies and limits.
111-- | Concurrent unlift for various strategies and limits.
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+5−6
@@ -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
@@ -63,12 +62,12 @@ library
63
62
64 build-depends: base >= 4.13 && < 5
63 build-depends: base >= 4.13 && < 5
65 , async >= 2.2.2
64 , async >= 2.2.2
66− , directory >= 1.3.2
65+ , directory >= 1.3.7.0
67 , effectful-core >= 0.1 && < 0.1.1
66 , effectful-core >= 0.1 && < 0.1.1
68− , process >= 1.6.9
67+ , process >= 1.6.12
69 , resourcet >= 1.2.4.3
68 , resourcet >= 1.2.4.3
70 , time >= 1.9.2
69 , time >= 1.9.2
71− , stm >= 2.5.0.0
70+ , stm >= 2.5.0.2
72 , unliftio >= 0.2.20
71 , unliftio >= 0.2.20
73
72
74 hs-source-dirs: src
73 hs-source-dirs: src
@@ -154,7 +153,7 @@ benchmark bench
154 if impl(ghc < 9.2)
153 if impl(ghc < 9.2)
155 build-depends: fused-effects
154 build-depends: fused-effects
156
155
157− if impl(ghc < 9.3)
156+ if impl(ghc < 9.2)
158 build-depends: polysemy
157 build-depends: polysemy
159
158
160 build-depends: base
159 build-depends: base
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+ ( -- * The 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+ ( -- * The effect
4− ( Concurrent
4+ Concurrent
5 , runConcurrent
5 , runConcurrent
6
6
7 -- * Asynchronous actions
7 -- * Asynchronous actions
effectful/src/Effectful/Concurrent/Chan.hs+2−1
@@ -1,6 +1,7 @@
1-- | Lifted version of "Control.Concurrent.Chan".
1-- | Lifted version of "Control.Concurrent.Chan".
2module Effectful.Concurrent.Chan
2module Effectful.Concurrent.Chan
3+ ( -- * The effect
3− ( Concurrent
4+ Concurrent
4 , runConcurrent
5 , runConcurrent
5
6
6 -- * Chan
7 -- * Chan
effectful/src/Effectful/Concurrent/Effect.hs+5−64
@@ -6,74 +6,15 @@ 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.
18-- | Run the 'Concurrent' effect.
74runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a
19runConcurrent :: IOE :> es => Eff (Concurrent : es) a -> Eff es a
75−runConcurrent = evalData (DataA Concurrent)
20+runConcurrent = evalEffect (IdE Concurrent)
76−
77−-- $setup
78−-- >>> import Effectful.Concurrent
79−-- >>> import Effectful.Concurrent.Async
effectful/src/Effectful/Concurrent/MVar.hs+2−1
@@ -1,6 +1,7 @@
1-- | Lifted version of "Control.Concurrent.MVar".
1-- | Lifted version of "Control.Concurrent.MVar".
2module Effectful.Concurrent.MVar
2module Effectful.Concurrent.MVar
3+ ( -- * The effect
3− ( Concurrent
4+ Concurrent
4 , runConcurrent
5 , runConcurrent
5
6
6 -- * MVar
7 -- * MVar
effectful/src/Effectful/Concurrent/QSem.hs+3−2
@@ -1,6 +1,7 @@
1−-- | Lifted version of "Control.Concurrent.QSem".
1+-- | Lifted "Control.Concurrent.QSem".
2module Effectful.Concurrent.QSem
2module Effectful.Concurrent.QSem
3+ ( -- * The effect
3− ( Concurrent
4+ Concurrent
4 , runConcurrent
5 , runConcurrent
5
6
6 -- * QSem
7 -- * QSem
effectful/src/Effectful/Concurrent/QSemN.hs+3−2
@@ -1,6 +1,7 @@
1−-- | Lifted version of "Control.Concurrent.QSemN".
1+-- | Lifted "Control.Concurrent.QSemN".
2module Effectful.Concurrent.QSemN
2module Effectful.Concurrent.QSemN
3+ ( -- * The effect
3− ( Concurrent
4+ Concurrent
4 , runConcurrent
5 , runConcurrent
5
6
6 -- * QSemN
7 -- * QSemN
effectful/src/Effectful/Concurrent/STM.hs+2−1
@@ -1,6 +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+ ( -- * The effect
3− ( Concurrent
4+ Concurrent
4 , runConcurrent
5 , runConcurrent
5
6
6 -- * Core
7 -- * Core
effectful/src/Effectful/Environment.hs+3−2
@@ -1,5 +1,6 @@
1module Effectful.Environment
1module Effectful.Environment
2+ ( -- * The effect
2− ( Environment
3+ Environment
3 , runEnvironment
4 , runEnvironment
4
5
5 -- * Querying the environment
6 -- * Querying the environment
@@ -28,7 +29,7 @@ data Environment :: Effect where
28
29
29-- | Run the 'Environment' effect.
30-- | Run the 'Environment' effect.
30runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a
31runEnvironment :: IOE :> es => Eff (Environment : es) a -> Eff es a
31−runEnvironment = evalData (DataA Environment)
32+runEnvironment = evalEffect (IdE Environment)
32
33
33-- | Lifted 'E.getArgs'.
34-- | Lifted 'E.getArgs'.
34getArgs :: Environment :> es => Eff es [String]
35getArgs :: Environment :> es => Eff es [String]
effectful/src/Effectful/FileSystem.hs+90−89
@@ -1,92 +1,93 @@
1module Effectful.FileSystem
1module Effectful.FileSystem
2+ ( -- * The effect
2− ( FileSystem
3+ FileSystem
3− , runFileSystem
4+ , runFileSystem
4−
5+
5− -- * Actions on directories
6+ -- * Actions on directories
6− , createDirectory
7+ , createDirectory
7− , createDirectoryIfMissing
8+ , createDirectoryIfMissing
8− , removeDirectory
9+ , removeDirectory
9− , removeDirectoryRecursive
10+ , removeDirectoryRecursive
10− , removePathForcibly
11+ , removePathForcibly
11− , renameDirectory
12+ , renameDirectory
12− , listDirectory
13+ , listDirectory
13− , getDirectoryContents
14+ , getDirectoryContents
14−
15+
15− -- ** Current working directory
16+ -- ** Current working directory
16− , getCurrentDirectory
17+ , getCurrentDirectory
17− , setCurrentDirectory
18+ , setCurrentDirectory
18− , withCurrentDirectory
19+ , withCurrentDirectory
19−
20+
20− -- * Pre-defined directories
21+ -- * Pre-defined directories
21− , getHomeDirectory
22+ , getHomeDirectory
22− , getXdgDirectory
23+ , getXdgDirectory
23− , getXdgDirectoryList
24+ , getXdgDirectoryList
24− , getAppUserDataDirectory
25+ , getAppUserDataDirectory
25− , getUserDocumentsDirectory
26+ , getUserDocumentsDirectory
26− , getTemporaryDirectory
27+ , getTemporaryDirectory
27−
28+
28− -- * Actions on files
29+ -- * Actions on files
29− , removeFile
30+ , removeFile
30− , renameFile
31+ , renameFile
31− , renamePath
32+ , renamePath
32− , copyFile
33+ , copyFile
33− , copyFileWithMetadata
34+ , copyFileWithMetadata
34− , getFileSize
35+ , getFileSize
35− , canonicalizePath
36+ , canonicalizePath
36− , makeAbsolute
37+ , makeAbsolute
37− , makeRelativeToCurrentDirectory
38+ , makeRelativeToCurrentDirectory
38−
39+
39− -- * Existence tests
40+ -- * Existence tests
40− , doesPathExist
41+ , doesPathExist
41− , doesFileExist
42+ , doesFileExist
42− , doesDirectoryExist
43+ , doesDirectoryExist
43− , findExecutable
44+ , findExecutable
44− , findExecutables
45+ , findExecutables
45− , findExecutablesInDirectories
46+ , findExecutablesInDirectories
46− , findFile
47+ , findFile
47− , findFiles
48+ , findFiles
48− , findFileWith
49+ , findFileWith
49− , findFilesWith
50+ , findFilesWith
50−
51+
51− -- * Symbolic links
52+ -- * Symbolic links
52− , createFileLink
53+ , createFileLink
53− , createDirectoryLink
54+ , createDirectoryLink
54− , removeDirectoryLink
55+ , removeDirectoryLink
55− , pathIsSymbolicLink
56+ , pathIsSymbolicLink
56− , getSymbolicLinkTarget
57+ , getSymbolicLinkTarget
57−
58+
58− -- * Permissions
59+ -- * Permissions
59− , getPermissions
60+ , getPermissions
60− , setPermissions
61+ , setPermissions
61− , copyPermissions
62+ , copyPermissions
62−
63+
63− -- * Timestamps
64+ -- * Timestamps
64− , getAccessTime
65+ , getAccessTime
65− , getModificationTime
66+ , getModificationTime
66− , setAccessTime
67+ , setAccessTime
67− , setModificationTime
68+ , setModificationTime
68−
69+
69− -- * Re-exports
70+ -- * Re-exports
70−
71+
71− -- ** Pre-defined directories
72+ -- ** Pre-defined directories
72− , D.XdgDirectory(..)
73+ , D.XdgDirectory(..)
73− , D.XdgDirectoryList(..)
74+ , D.XdgDirectoryList(..)
74−
75+
75− -- ** Existence tests
76+ -- ** Existence tests
76− , D.exeExtension
77+ , D.exeExtension
77−
78+
78− -- ** Permissions
79+ -- ** Permissions
79− , D.Permissions
80+ , D.Permissions
80− , D.emptyPermissions
81+ , D.emptyPermissions
81− , D.readable
82+ , D.readable
82− , D.writable
83+ , D.writable
83− , D.executable
84+ , D.executable
84− , D.searchable
85+ , D.searchable
85− , D.setOwnerReadable
86+ , D.setOwnerReadable
86− , D.setOwnerWritable
87+ , D.setOwnerWritable
87− , D.setOwnerExecutable
88+ , D.setOwnerExecutable
88− , D.setOwnerSearchable
89+ , D.setOwnerSearchable
89− ) where
90+ ) where
90
91
91import Data.Time (UTCTime)
92import Data.Time (UTCTime)
92import qualified System.Directory as D
93import qualified System.Directory as D
@@ -100,7 +101,7 @@ data FileSystem :: Effect where
100
101
101-- | Run the 'FileSystem' effect.
102-- | Run the 'FileSystem' effect.
102runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a
103runFileSystem :: IOE :> es => Eff (FileSystem : es) a -> Eff es a
103−runFileSystem = evalData (DataA FileSystem)
104+runFileSystem = evalEffect (IdE FileSystem)
104
105
105----------------------------------------
106----------------------------------------
106-- Actions on directories
107-- 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−1
@@ -1,6 +1,7 @@
1-- | Lifted version of "System.IO".
1-- | Lifted version of "System.IO".
2module Effectful.FileSystem.IO
2module Effectful.FileSystem.IO
3+ ( -- * The effect
3− ( FileSystem
4+ FileSystem
4 , runFileSystem
5 , runFileSystem
5
6
6 -- * IO
7 -- * IO
effectful/src/Effectful/Process.hs+3−7
@@ -1,7 +1,7 @@
1−{-# LANGUAGE CPP #-}
2-- | Lifted version of "System.Process".
1-- | Lifted version of "System.Process".
3module Effectful.Process
2module Effectful.Process
3+ ( -- * The effect
4− ( Process
4+ Process
5 , runProcess
5 , runProcess
6
6
7 -- * Running sub-processes
7 -- * Running sub-processes
@@ -30,9 +30,7 @@ module Effectful.Process
30 , P.showCommandForUser
30 , P.showCommandForUser
31 , P.Pid
31 , P.Pid
32 , getPid
32 , getPid
33−#if MIN_VERSION_process(1,6,12)
34 , getCurrentPid
33 , getCurrentPid
35−#endif
36
34
37 -- * Process completion
35 -- * Process completion
38 , waitForProcess
36 , waitForProcess
@@ -58,7 +56,7 @@ data Process :: Effect where
58 Process :: Process m r
56 Process :: Process m r
59
57
60runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a
58runProcess :: IOE :> es => Eff (Process : es) a -> Eff es a
61−runProcess = evalData (DataA Process)
59+runProcess = evalEffect (IdE Process)
62
60
63----------------------------------------
61----------------------------------------
64-- Running sub-processes
62-- Running sub-processes
@@ -145,11 +143,9 @@ cleanupProcess = unsafeEff_ . P.cleanupProcess
145getPid :: Process :> es => P.ProcessHandle -> Eff es (Maybe P.Pid)
143getPid :: Process :> es => P.ProcessHandle -> Eff es (Maybe P.Pid)
146getPid = unsafeEff_ . P.getPid
144getPid = unsafeEff_ . P.getPid
147
145
148−#if MIN_VERSION_process(1,6,12)
149-- | Lifted 'P.getCurrentPid'.
146-- | Lifted 'P.getCurrentPid'.
150getCurrentPid :: Process :> es => Eff es P.Pid
147getCurrentPid :: Process :> es => Eff es P.Pid
151getCurrentPid = unsafeEff_ P.getCurrentPid
148getCurrentPid = unsafeEff_ P.getCurrentPid
152−#endif
153
149
154----------------------------------------
150----------------------------------------
155-- Process completion
151-- Process completion
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/UnliftTests.hs+1
@@ -1,3 +1,4 @@
1+{-# LANGUAGE OverloadedLabels #-}
1module UnliftTests (unliftTests) where
2module UnliftTests (unliftTests) where
2
3
3import Control.Exception
4import Control.Exception