on master help sign in
Shuffle things around
3b965edAndrzej Rybczak
effectful-core/src/Effectful/Dispatch/Dynamic.hs+13−1
@@ -32,7 +32,8 @@ module Effectful.Dispatch.Dynamic
32 ) where
32 ) where
33
33
34import Control.Monad.IO.Unlift
34import Control.Monad.IO.Unlift
35−import GHC.Stack
35+import Data.Kind
36+import GHC.Stack (HasCallStack)
36
37
37import Effectful.Internal.Effect
38import Effectful.Internal.Effect
38import Effectful.Internal.Env
39import Effectful.Internal.Env
@@ -230,5 +231,16 @@ localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
230 SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_
231 SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_
231 ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
232 ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
232
233
234+----------------------------------------
235+-- Utils
236+
237+-- | Require that the second list of effects is a suffix of the first one.
238+--
239+-- In other words, 'SuffixOf' @es@ @baseEs@ means "a suffix of @es@ is
240+-- @baseEs@".
241+type family SuffixOf (es :: [Effect]) (baseEs :: [Effect]) :: Constraint where
242+ SuffixOf baseEs baseEs = ()
243+ SuffixOf (e : es) baseEs = SuffixOf es baseEs
244+
233-- $setup
245-- $setup
234-- >>> import Control.Concurrent
246-- >>> import Control.Concurrent
effectful-core/src/Effectful/Dispatch/Static.hs+9−12
@@ -2,12 +2,12 @@ module Effectful.Dispatch.Static
2 ( -- * Low level API
2 ( -- * Low level API
3 DataA(..)
3 DataA(..)
4
4
5− -- ** Running
5+ -- ** Extending the environment
6 , runData
6 , runData
7 , evalData
7 , evalData
8 , execData
8 , execData
9
9
10− -- ** Modification
10+ -- ** Data retrieval and update
11 , getData
11 , getData
12 , putData
12 , putData
13 , stateData
13 , stateData
@@ -18,6 +18,13 @@ module Effectful.Dispatch.Static
18 , seqUnliftIO
18 , seqUnliftIO
19 , concUnliftIO
19 , concUnliftIO
20
20
21+ -- ** Utils
22+ , unEff
23+ , unsafeEff
24+ , unsafeEff_
25+ , unsafeLiftMapIO
26+ , unsafeUnliftIO
27+
21 -- * Primitive API
28 -- * Primitive API
22 , Env
29 , Env
23 , Relinker(..)
30 , Relinker(..)
@@ -39,18 +46,8 @@ module Effectful.Dispatch.Static
39 , putEnv
46 , putEnv
40 , stateEnv
47 , stateEnv
41 , modifyEnv
48 , modifyEnv
42−
43− -- * Unsafe 'Eff' operations
44− , unsafeEff
45− , unsafeEff_
46− , unsafeLiftMapIO
47− , unsafeUnliftIO
48−
49− -- * Utils
50− , unEff
51 ) where
49 ) where
52
50
53−import Effectful.Internal.Effect
54import Effectful.Internal.Env
51import Effectful.Internal.Env
55import Effectful.Internal.Monad
52import Effectful.Internal.Monad
56
53
effectful-core/src/Effectful/Internal/Effect.hs+1−17
@@ -8,10 +8,6 @@
8module Effectful.Internal.Effect
8module Effectful.Internal.Effect
9 ( Effect
9 ( Effect
10 , (:>)(..)
10 , (:>)(..)
11− , DataA(..)
12−
13− -- * Utils
14− , SuffixOf
15
11
16 -- * Re-exports
12 -- * Re-exports
17 , Type
13 , Type
@@ -23,10 +19,6 @@ import GHC.TypeLits
23-- | The kind of effects.
19-- | The kind of effects.
24type Effect = (Type -> Type) -> Type -> Type
20type Effect = (Type -> Type) -> Type -> Type
25
21
26−-- | An adapter for statically dispatched effects.
27−newtype DataA :: Effect -> Type where
28− DataA :: (forall m r. e m r) -> DataA e
29−
30-- | A constraint that requires that a particular effect @e@ is a member of the
22-- | A constraint that requires that a particular effect @e@ is a member of the
31-- type-level list @es@. This is used to parameterize an 'Effectful.Monad.Eff'
23-- type-level list @es@. This is used to parameterize an 'Effectful.Monad.Eff'
32-- computation over an arbitrary list of effects, so long as @e@ is /somewhere/
24-- computation over an arbitrary list of effects, so long as @e@ is /somewhere/
@@ -36,7 +28,7 @@ newtype DataA :: Effect -> Type where
36-- 'Integer' would likely use the following type:
28-- 'Integer' would likely use the following type:
37--
29--
38-- @
30-- @
39−-- 'Effectful.State.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
31+-- 'Effectful.State.Local.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
40-- @
32-- @
41class (e :: Effect) :> (es :: [Effect]) where
33class (e :: Effect) :> (es :: [Effect]) where
42 -- | Get the position of @e@ in @es@.
34 -- | Get the position of @e@ in @es@.
@@ -59,11 +51,3 @@ instance {-# OVERLAPPING #-} e :> (e : es) where
59
51
60instance e :> es => e :> (x : es) where
52instance e :> es => e :> (x : es) where
61 reifyIndex = 1 + reifyIndex @e @es
53 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+4−4
@@ -417,7 +417,7 @@ unsafeTailEnv len (Env fork gref _) = case fork of
417
417
418-- | Extract a specific data type from the environment.
418-- | Extract a specific data type from the environment.
419getEnv
419getEnv
420− :: forall e es adapter. e :> es
420+ :: forall e adapter es. e :> es
421 => Env es
421 => Env es
422 -> IO (adapter e)
422 -> IO (adapter e)
423getEnv env = do
423getEnv env = do
@@ -426,7 +426,7 @@ getEnv env = do
426
426
427-- | 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).
428putEnv
428putEnv
429− :: forall e es adapter. e :> es
429+ :: forall e adapter es. e :> es
430 => Env es
430 => Env es
431 -> adapter e
431 -> adapter e
432 -> IO ()
432 -> IO ()
@@ -436,7 +436,7 @@ putEnv env e = do
436
436
437-- | 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.
438stateEnv
438stateEnv
439− :: forall e es adapter a. e :> es
439+ :: forall e adapter es a. e :> es
440 => Env es
440 => Env es
441 -> (adapter e -> (a, adapter e))
441 -> (adapter e -> (a, adapter e))
442 -> IO a
442 -> IO a
@@ -448,7 +448,7 @@ stateEnv env f = do
448
448
449-- | Modify the data type in the environment (in place).
449-- | Modify the data type in the environment (in place).
450modifyEnv
450modifyEnv
451− :: forall e es adapter. e :> es
451+ :: forall e adapter es. e :> es
452 => Env es
452 => Env es
453 -> (adapter e -> adapter e)
453 -> (adapter e -> adapter e)
454 -> IO ()
454 -> IO ()
effectful-core/src/Effectful/Internal/Monad.hs+38−25
@@ -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− ( -- * Monad
9+ ( -- * The 'Eff' 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− -- * Primitive
25+ -- * Prim
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,24 @@ module Effectful.Internal.Monad
34 , withUnliftStrategy
34 , withUnliftStrategy
35 , withEffToIO
35 , withEffToIO
36
36
37− --- *** Low-level helpers
37+ -- ** Low-level unlifts
38 , seqUnliftIO
38 , seqUnliftIO
39 , concUnliftIO
39 , concUnliftIO
40
40
41 -- * Effects
41 -- * Effects
42
42
43− -- ** Handler
43+ -- ** Dynamic dispatch
44 , EffectHandler
44 , EffectHandler
45 , LocalEnv(..)
45 , LocalEnv(..)
46 , HandlerA(..)
46 , HandlerA(..)
47 , runHandler
47 , runHandler
48−
49− -- *** Sending operations
50 , send
48 , send
51
49
52− -- ** Primitive
50+ -- ** Static dispatch
53−
51+ , DataA(..)
54− -- *** Running
55 , runData
52 , runData
56 , evalData
53 , evalData
57 , execData
54 , execData
58−
59− -- *** Modification
60 , getData
55 , getData
61 , putData
56 , putData
62 , stateData
57 , stateData
@@ -92,17 +87,16 @@ type role Eff nominal representational
92-- would have the following type:
87-- would have the following type:
93--
88--
94-- @
89-- @
95−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
90+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
96-- @
91-- @
97--
92--
98-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
93-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
99-- Instead, the '(:>)' type class is used to express constraints on the list of
94-- Instead, the '(:>)' type class is used to express constraints on the list of
100-- effects without coupling a computation to a concrete list of effects. For
95-- effects without coupling a computation to a concrete list of effects. For
101−-- example, the above example would more commonly be expressed with the
96+-- example, the above example would be expressed with the following type:
102−-- following type:
103--
97--
104-- @
98-- @
105−-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
99+-- ('Effectful.Reader.Reader' 'String' ':>' es, 'Effectful.State.Local.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
106-- @
100-- @
107--
101--
108-- This abstraction allows the computation to be used in functions that may
102-- This abstraction allows the computation to be used in functions that may
@@ -116,12 +110,12 @@ newtype Eff (es :: [Effect]) a = Eff (Env es -> IO a)
116-- For running computations with side effects see 'runEff'.
110-- For running computations with side effects see 'runEff'.
117runPureEff :: Eff '[] a -> a
111runPureEff :: Eff '[] a -> a
118runPureEff (Eff m) =
112runPureEff (Eff m) =
119− -- unsafePerformIO is safe here since IOE was not on the stack, so no IO with
113+ -- unsafeDupablePerformIO is safe here since IOE was not on the stack, so no
120− -- side effects was performed (unless someone sneakily introduced side effects
114+ -- IO with side effects was performed (unless someone sneakily introduced side
121− -- with unsafeEff, but then all bets are off).
115+ -- effects with unsafeEff, but then all bets are off).
122 --
116 --
123 -- Moreover, internals don't allocate any resources that require explicit
117 -- Moreover, internals don't allocate any resources that require explicit
124− -- cleanup actions to run, so the "Dupable" part should also be just fine.
118+ -- cleanup actions to run.
125 unsafeDupablePerformIO $ m =<< emptyEnv
119 unsafeDupablePerformIO $ m =<< emptyEnv
126
120
127----------------------------------------
121----------------------------------------
@@ -164,7 +158,7 @@ withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)
164-- constraint for accurate stack traces in case an insufficiently powerful
158-- constraint for accurate stack traces in case an insufficiently powerful
165-- 'UnliftStrategy' is used and the unlifting function fails.
159-- 'UnliftStrategy' is used and the unlifting function fails.
166--
160--
167−-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
161+-- /Note:/ the strategy is reset to 'SeqUnlift' inside the continuation.
168withEffToIO
162withEffToIO
169 :: (HasCallStack, IOE :> es)
163 :: (HasCallStack, IOE :> es)
170 => ((forall r. Eff es r -> IO r) -> IO a)
164 => ((forall r. Eff es r -> IO r) -> IO a)
@@ -309,7 +303,7 @@ instance Prim :> es => PrimMonad (Eff es) where
309 primitive = unsafeEff_ . IO
303 primitive = unsafeEff_ . IO
310
304
311----------------------------------------
305----------------------------------------
312−-- Handler
306+-- Dynamic dispatch
313
307
314type role LocalEnv nominal nominal
308type role LocalEnv nominal nominal
315
309
@@ -333,11 +327,11 @@ type EffectHandler e es
333
327
334-- | An adapter for dynamically dispatched effects.
328-- | An adapter for dynamically dispatched effects.
335--
329--
336−-- Represents the effect handler bundled along with its environment.
330+-- Represents the effect handler bundled with its environment.
337data HandlerA :: Effect -> Type where
331data HandlerA :: Effect -> Type where
338 HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e
332 HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e
339
333
340−-- | Run the effect with the given handler.
334+-- | Run a dynamically dispatched effect with the given handler.
341runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
335runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
342runHandler e m = unsafeEff $ \es0 -> do
336runHandler e m = unsafeEff $ \es0 -> do
343 size0 <- sizeEnv es0
337 size0 <- sizeEnv es0
@@ -357,8 +351,17 @@ send op = unsafeEff $ \es -> do
357 unEff (handle (LocalEnv es) op) handlerEs
351 unEff (handle (LocalEnv es) op) handlerEs
358
352
359----------------------------------------
353----------------------------------------
360−-- Helpers
354+-- Static dispatch
355+
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
361
362
363+-- | Run a statically dispatched effect with the given initial state and return
364+-- the final value along with the final state.
362runData :: DataA e -> Eff (e : es) a -> Eff es (a, DataA e)
365runData :: DataA e -> Eff (e : es) a -> Eff es (a, DataA e)
363runData e0 m = unsafeEff $ \es0 -> do
366runData e0 m = unsafeEff $ \es0 -> do
364 size0 <- sizeEnv es0
367 size0 <- sizeEnv es0
@@ -366,6 +369,8 @@ runData e0 m = unsafeEff $ \es0 -> do
366 (unsafeTailEnv size0)
369 (unsafeTailEnv size0)
367 (\es -> (,) <$> unEff m es <*> getEnv es)
370 (\es -> (,) <$> unEff m es <*> getEnv es)
368
371
372+-- | Run a statically dispatched effect with the given initial state and return
373+-- the final value, discarding the final state.
369evalData :: DataA e -> Eff (e : es) a -> Eff es a
374evalData :: DataA e -> Eff (e : es) a -> Eff es a
370evalData e m = unsafeEff $ \es0 -> do
375evalData e m = unsafeEff $ \es0 -> do
371 size0 <- sizeEnv es0
376 size0 <- sizeEnv es0
@@ -373,6 +378,8 @@ evalData e m = unsafeEff $ \es0 -> do
373 (unsafeTailEnv size0)
378 (unsafeTailEnv size0)
374 (\es -> unEff m es)
379 (\es -> unEff m es)
375
380
381+-- | Run a statically dispatched effect with the given initial state and return
382+-- the final state, discarding the final value.
376execData :: DataA e -> Eff (e : es) a -> Eff es (DataA e)
383execData :: DataA e -> Eff (e : es) a -> Eff es (DataA e)
377execData e0 m = unsafeEff $ \es0 -> do
384execData e0 m = unsafeEff $ \es0 -> do
378 size0 <- sizeEnv es0
385 size0 <- sizeEnv es0
@@ -380,21 +387,27 @@ execData e0 m = unsafeEff $ \es0 -> do
380 (unsafeTailEnv size0)
387 (unsafeTailEnv size0)
381 (\es -> unEff m es *> getEnv es)
388 (\es -> unEff m es *> getEnv es)
382
389
390+-- | Fetch the current state of the effect.
383getData :: e :> es => Eff es (DataA e)
391getData :: e :> es => Eff es (DataA e)
384getData = unsafeEff $ \es -> getEnv es
392getData = unsafeEff $ \es -> getEnv es
385
393
394+-- | Set the current state of the effect to the given value.
386putData :: e :> es => DataA e -> Eff es ()
395putData :: e :> es => DataA e -> Eff es ()
387putData e = unsafeEff $ \es -> putEnv es e
396putData e = unsafeEff $ \es -> putEnv es e
388
397
398+-- | Apply the function to the current state of the effect and return a value.
389stateData :: e :> es => (DataA e -> (a, DataA e)) -> Eff es a
399stateData :: e :> es => (DataA e -> (a, DataA e)) -> Eff es a
390stateData f = unsafeEff $ \es -> stateEnv es f
400stateData f = unsafeEff $ \es -> stateEnv es f
391
401
402+-- | Apply the monadic function to the current state of the effect and return a
403+-- value.
392stateDataM :: e :> es => (DataA e -> Eff es (a, DataA e)) -> Eff es a
404stateDataM :: e :> es => (DataA e -> Eff es (a, DataA e)) -> Eff es a
393stateDataM f = unsafeEff $ \es -> E.mask $ \release -> do
405stateDataM f = unsafeEff $ \es -> E.mask $ \release -> do
394 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
406 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
395 putEnv es e
407 putEnv es e
396 pure a
408 pure a
397
409
410+-- | Execute a computation with a temporarily modified state of the effect.
398localData :: e :> es => (DataA e -> DataA e) -> Eff es a -> Eff es a
411localData :: e :> es => (DataA e -> DataA e) -> Eff es a -> Eff es a
399localData f m = unsafeEff $ \es -> do
412localData f m = unsafeEff $ \es -> do
400 E.bracket (stateEnv es $ \e -> (e, f e))
413 E.bracket (stateEnv es $ \e -> (e, f e))