on master help sign in
11 files changed+97−91
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml−5 effectful-core/effectful-core.cabal+1−1 effectful-core/src/Effectful/Dispatch/Dynamic.hs+13−1 effectful-core/src/Effectful/Dispatch/Static.hs+9−12 effectful-core/src/Effectful/Internal/Effect.hs+1−17 effectful-core/src/Effectful/Internal/Env.hs+25−20 effectful-core/src/Effectful/Internal/Monad.hs+38−25 effectful-core/src/Effectful/Writer/Local.hs+3−3 effectful-core/src/Effectful/Writer/Shared.hs+3−3 effectful/bench/Main.hs+3−3 effectful/effectful.cabal+1−1
.github/workflows/haskell-ci.yml−5
@@ -37,11 +37,6 @@ jobs:
3737 compilerVersion: 9.2.1
3838 setup-method: ghcup
3939 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
4540 - compiler: ghc-8.10.7
4641 compilerKind: ghc
4742 compilerVersion: 8.10.7
effectful-core/effectful-core.cabal+1−1
@@ -18,7 +18,7 @@ description: An easy to use, performant extensible effects library with seamless
1818
1919extra-source-files: CHANGELOG.md
2020
21−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1
21+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1
2222
2323bug-reports: https://github.com/arybczak/effectful/issues
2424source-repository head
effectful-core/src/Effectful/Dispatch/Dynamic.hs+13−1
@@ -32,7 +32,8 @@ module Effectful.Dispatch.Dynamic
3232 ) where
3333
3434import Control.Monad.IO.Unlift
35−import GHC.Stack
35+import Data.Kind
36+import GHC.Stack (HasCallStack)
3637
3738import Effectful.Internal.Effect
3839import Effectful.Internal.Env
@@ -230,5 +231,16 @@ localLiftUnliftIO (LocalEnv les) strategy k = case strategy of
230231 SeqUnlift -> liftIO $ seqUnliftIO les $ k unsafeEff_
231232 ConcUnlift p l -> liftIO $ concUnliftIO les p l $ k unsafeEff_
232233
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+
233245-- $setup
234246-- >>> import Control.Concurrent
effectful-core/src/Effectful/Dispatch/Static.hs+9−12
@@ -2,12 +2,12 @@ module Effectful.Dispatch.Static
22 ( -- * Low level API
33 DataA(..)
44
5− -- ** Running
5+ -- ** Extending the environment
66 , runData
77 , evalData
88 , execData
99
10− -- ** Modification
10+ -- ** Data retrieval and update
1111 , getData
1212 , putData
1313 , stateData
@@ -18,6 +18,13 @@ module Effectful.Dispatch.Static
1818 , seqUnliftIO
1919 , concUnliftIO
2020
21+ -- ** Utils
22+ , unEff
23+ , unsafeEff
24+ , unsafeEff_
25+ , unsafeLiftMapIO
26+ , unsafeUnliftIO
27+
2128 -- * Primitive API
2229 , Env
2330 , Relinker(..)
@@ -39,18 +46,8 @@ module Effectful.Dispatch.Static
3946 , putEnv
4047 , stateEnv
4148 , modifyEnv
42−
43− -- * Unsafe 'Eff' operations
44− , unsafeEff
45− , unsafeEff_
46− , unsafeLiftMapIO
47− , unsafeUnliftIO
48−
49− -- * Utils
50− , unEff
5149 ) where
5250
53−import Effectful.Internal.Effect
5451import Effectful.Internal.Env
5552import Effectful.Internal.Monad
5653
effectful-core/src/Effectful/Internal/Effect.hs+1−17
@@ -8,10 +8,6 @@
88module Effectful.Internal.Effect
99 ( Effect
1010 , (:>)(..)
11− , DataA(..)
12−
13− -- * Utils
14− , SuffixOf
1511
1612 -- * Re-exports
1713 , Type
@@ -23,10 +19,6 @@ import GHC.TypeLits
2319-- | The kind of effects.
2420type Effect = (Type -> Type) -> Type -> Type
2521
26−-- | An adapter for statically dispatched effects.
27−newtype DataA :: Effect -> Type where
28− DataA :: (forall m r. e m r) -> DataA e
29−
3022-- | A constraint that requires that a particular effect @e@ is a member of the
3123-- type-level list @es@. This is used to parameterize an 'Effectful.Monad.Eff'
3224-- computation over an arbitrary list of effects, so long as @e@ is /somewhere/
@@ -36,7 +28,7 @@ newtype DataA :: Effect -> Type where
3628-- 'Integer' would likely use the following type:
3729--
3830-- @
39−-- 'Effectful.State.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
31+-- 'Effectful.State.Local.State' 'Integer' ':>' es => 'Effectful.Monad.Eff' es ()
4032-- @
4133class (e :: Effect) :> (es :: [Effect]) where
4234 -- | Get the position of @e@ in @es@.
@@ -59,11 +51,3 @@ instance {-# OVERLAPPING #-} e :> (e : es) where
5951
6052instance e :> es => e :> (x : es) where
6153 reifyIndex = 1 + reifyIndex @e @es
62−
63−-- | Require that the second list of effects is a suffix of the first one.
64−--
65−-- In other words, 'SuffixOf' @es@ @baseEs@ means "a suffix of @es@ is
66−-- @baseEs@".
67−type family SuffixOf (es :: [Effect]) (baseEs :: [Effect]) :: Constraint where
68− SuffixOf baseEs baseEs = ()
69− SuffixOf (e : es) baseEs = SuffixOf es baseEs
effectful-core/src/Effectful/Internal/Env.hs+25−20
@@ -1,3 +1,4 @@
1+{-# LANGUAGE MagicHash #-}
12{-# OPTIONS_HADDOCK not-home #-}
23-- | The environment for the 'Effectful.Internal.Monad.Eff' monad.
34--
@@ -42,7 +43,7 @@ import Control.Monad
4243import Control.Monad.Primitive
4344import Data.IORef
4445import Data.Primitive.SmallArray
45−import GHC.Exts (Any)
46+import GHC.Exts (Any, SmallMutableArray#)
4647import GHC.Stack (HasCallStack)
4748import Unsafe.Coerce
4849import qualified Data.IntMap.Strict as IM
@@ -417,43 +418,43 @@ unsafeTailEnv len (Env fork gref _) = case fork of
417418
418419-- | Extract a specific data type from the environment.
419420getEnv
420− :: forall e es adapter. e :> es
421+ :: forall e adapter es. e :> es
421422 => Env es
422423 -> IO (adapter e)
423424getEnv env = do
424− (i, es) <- getLocation (reifyIndex @e @es) env
425+ Location i es <- getLocation (reifyIndex @e @es) env
425426 fromAny <$> readSmallArray es i
426427
427428-- | Replace the data type in the environment with a new value (in place).
428429putEnv
429− :: forall e es adapter. e :> es
430+ :: forall e adapter es. e :> es
430431 => Env es
431432 -> adapter e
432433 -> IO ()
433434putEnv env e = do
434− (i, es) <- getLocation (reifyIndex @e @es) env
435+ Location i es <- getLocation (reifyIndex @e @es) env
435436 e `seq` writeSmallArray es i (toAny e)
436437
437438-- | Modify the data type in the environment (in place) and return a value.
438439stateEnv
439− :: forall e es adapter a. e :> es
440+ :: forall e adapter es a. e :> es
440441 => Env es
441442 -> (adapter e -> (a, adapter e))
442443 -> IO a
443444stateEnv env f = do
444− (i, es) <- getLocation (reifyIndex @e @es) env
445+ Location i es <- getLocation (reifyIndex @e @es) env
445446 (a, e) <- f . fromAny <$> readSmallArray es i
446447 e `seq` writeSmallArray es i (toAny e)
447448 pure a
448449
449450-- | Modify the data type in the environment (in place).
450451modifyEnv
451− :: forall e es adapter. e :> es
452+ :: forall e adapter es. e :> es
452453 => Env es
453454 -> (adapter e -> adapter e)
454455 -> IO ()
455456modifyEnv env f = do
456− (i, es) <- getLocation (reifyIndex @e @es) env
457+ Location i es <- getLocation (reifyIndex @e @es) env
457458 e <- f . fromAny <$> readSmallArray es i
458459 e `seq` writeSmallArray es i (toAny e)
459460
@@ -469,13 +470,17 @@ emptyEnvRef = do
469470 fs <- newSmallArray 0 undefinedData
470471 newIORef $ EnvRef 0 es fs
471472
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+
472477-- | Determine location of the data type in the environment.
473478getLocation
474479 :: Int
475480 -> Env es
476− -> IO (Int, SmallMutableArray RealWorld Any)
481+ -> IO Location
477482getLocation ixE (Env fork ref _) = do
478− EnvRef n es _ <- readIORef ref
483+ EnvRef n es@(SmallMutableArray es#) _ <- readIORef ref
479484 -- Optimized for the common access pattern:
480485 --
481486 -- - Most application code has no access to forks, in which case we look at
@@ -484,25 +489,25 @@ getLocation ixE (Env fork ref _) = do
484489 -- - Effect handlers will most likely access the newest fork with handler
485490 -- specific effects for reinterpretation.
486491 case fork of
487− NoFork -> pure (ix n, es)
492+ NoFork -> pure $ Location (ix n) es
488493 Forks _ baseIx lref forks -> do
489494 EnvRef ln les _ <- readIORef lref
490495 let i = ix (baseIx + ln)
491496 if i >= baseIx
492− then pure (i - baseIx, les)
493− else go es i forks
497+ then pure $ Location (i - baseIx) les
498+ else go es# i forks
494499 where
495− go :: SmallMutableArray RealWorld Any
500+ go :: SmallMutableArray# RealWorld Any
496501 -> Int
497502 -> Forks
498− -> IO (Int, SmallMutableArray RealWorld Any)
499− go es i = \case
500− NoFork -> pure (i, es)
503+ -> IO Location
504+ go es# i = \case
505+ NoFork -> pure $ Location i (SmallMutableArray es#)
501506 Forks _ baseIx lref forks -> do
502507 EnvRef _ les _ <- readIORef lref
503508 if i >= baseIx
504− then pure (i - baseIx, les)
505− else go es i forks
509+ then pure $ Location (i - baseIx) les
510+ else go es# i forks
506511
507512 ix :: Int -> Int
508513 ix n = n - ixE - 1
effectful-core/src/Effectful/Internal/Monad.hs+38−25
@@ -6,7 +6,7 @@
66-- This module is intended for internal use only, and may change without warning
77-- in subsequent releases.
88module Effectful.Internal.Monad
9− ( -- * Monad
9+ ( -- * The 'Eff' monad
1010 Eff
1111 , runPureEff
1212
@@ -22,11 +22,11 @@ module Effectful.Internal.Monad
2222 , IOE
2323 , runEff
2424
25− -- * Primitive
25+ -- * Prim
2626 , Prim
2727 , runPrim
2828
29− -- ** Unlift strategies
29+ -- * Unlift strategies
3030 , UnliftStrategy(..)
3131 , Persistence(..)
3232 , Limit(..)
@@ -34,29 +34,24 @@ module Effectful.Internal.Monad
3434 , withUnliftStrategy
3535 , withEffToIO
3636
37− --- *** Low-level helpers
37+ -- ** Low-level unlifts
3838 , seqUnliftIO
3939 , concUnliftIO
4040
4141 -- * Effects
4242
43− -- ** Handler
43+ -- ** Dynamic dispatch
4444 , EffectHandler
4545 , LocalEnv(..)
4646 , HandlerA(..)
4747 , runHandler
48−
49− -- *** Sending operations
5048 , send
5149
52− -- ** Primitive
53−
54− -- *** Running
50+ -- ** Static dispatch
51+ , DataA(..)
5552 , runData
5653 , evalData
5754 , execData
58−
59− -- *** Modification
6055 , getData
6156 , putData
6257 , stateData
@@ -92,17 +87,16 @@ type role Eff nominal representational
9287-- would have the following type:
9388--
9489-- @
95−-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.State' 'Bool'] 'Integer'
90+-- 'Eff' '['Effectful.Reader.Reader' 'String', 'Effectful.State.Local.State' 'Bool'] 'Integer'
9691-- @
9792--
9893-- Normally, a concrete list of effects is not used to parameterize 'Eff'.
9994-- Instead, the '(:>)' type class is used to express constraints on the list of
10095-- effects without coupling a computation to a concrete list of effects. For
101−-- example, the above example would more commonly be expressed with the
102−-- following type:
96+-- example, the above example would be expressed with the following type:
10397--
10498-- @
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'
106100-- @
107101--
108102-- 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)
116110-- For running computations with side effects see 'runEff'.
117111runPureEff :: Eff '[] a -> a
118112runPureEff (Eff m) =
119− -- unsafePerformIO is safe here since IOE was not on the stack, so no IO with
120− -- side effects was performed (unless someone sneakily introduced side effects
121− -- with unsafeEff, but then all bets are off).
113+ -- unsafeDupablePerformIO is safe here since IOE was not on the stack, so no
114+ -- IO with side effects was performed (unless someone sneakily introduced side
115+ -- effects with unsafeEff, but then all bets are off).
122116 --
123117 -- 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.
125119 unsafeDupablePerformIO $ m =<< emptyEnv
126120
127121----------------------------------------
@@ -164,7 +158,7 @@ withUnliftStrategy unlift = localData $ \_ -> DataA (IOE unlift)
164158-- constraint for accurate stack traces in case an insufficiently powerful
165159-- 'UnliftStrategy' is used and the unlifting function fails.
166160--
167−-- /Note:/ the strategy is reset to 'SeqUnlift' for new threads.
161+-- /Note:/ the strategy is reset to 'SeqUnlift' inside the continuation.
168162withEffToIO
169163 :: (HasCallStack, IOE :> es)
170164 => ((forall r. Eff es r -> IO r) -> IO a)
@@ -309,7 +303,7 @@ instance Prim :> es => PrimMonad (Eff es) where
309303 primitive = unsafeEff_ . IO
310304
311305----------------------------------------
312−-- Handler
306+-- Dynamic dispatch
313307
314308type role LocalEnv nominal nominal
315309
@@ -333,11 +327,11 @@ type EffectHandler e es
333327
334328-- | An adapter for dynamically dispatched effects.
335329--
336−-- Represents the effect handler bundled along with its environment.
330+-- Represents the effect handler bundled with its environment.
337331data HandlerA :: Effect -> Type where
338332 HandlerA :: !(Env es) -> !(EffectHandler e es) -> HandlerA e
339333
340−-- | Run the effect with the given handler.
334+-- | Run a dynamically dispatched effect with the given handler.
341335runHandler :: HandlerA e -> Eff (e : es) a -> Eff es a
342336runHandler e m = unsafeEff $ \es0 -> do
343337 size0 <- sizeEnv es0
@@ -357,8 +351,17 @@ send op = unsafeEff $ \es -> do
357351 unEff (handle (LocalEnv es) op) handlerEs
358352
359353----------------------------------------
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
361362
363+-- | Run a statically dispatched effect with the given initial state and return
364+-- the final value along with the final state.
362365runData :: DataA e -> Eff (e : es) a -> Eff es (a, DataA e)
363366runData e0 m = unsafeEff $ \es0 -> do
364367 size0 <- sizeEnv es0
@@ -366,6 +369,8 @@ runData e0 m = unsafeEff $ \es0 -> do
366369 (unsafeTailEnv size0)
367370 (\es -> (,) <$> unEff m es <*> getEnv es)
368371
372+-- | Run a statically dispatched effect with the given initial state and return
373+-- the final value, discarding the final state.
369374evalData :: DataA e -> Eff (e : es) a -> Eff es a
370375evalData e m = unsafeEff $ \es0 -> do
371376 size0 <- sizeEnv es0
@@ -373,6 +378,8 @@ evalData e m = unsafeEff $ \es0 -> do
373378 (unsafeTailEnv size0)
374379 (\es -> unEff m es)
375380
381+-- | Run a statically dispatched effect with the given initial state and return
382+-- the final state, discarding the final value.
376383execData :: DataA e -> Eff (e : es) a -> Eff es (DataA e)
377384execData e0 m = unsafeEff $ \es0 -> do
378385 size0 <- sizeEnv es0
@@ -380,21 +387,27 @@ execData e0 m = unsafeEff $ \es0 -> do
380387 (unsafeTailEnv size0)
381388 (\es -> unEff m es *> getEnv es)
382389
390+-- | Fetch the current state of the effect.
383391getData :: e :> es => Eff es (DataA e)
384392getData = unsafeEff $ \es -> getEnv es
385393
394+-- | Set the current state of the effect to the given value.
386395putData :: e :> es => DataA e -> Eff es ()
387396putData e = unsafeEff $ \es -> putEnv es e
388397
398+-- | Apply the function to the current state of the effect and return a value.
389399stateData :: e :> es => (DataA e -> (a, DataA e)) -> Eff es a
390400stateData f = unsafeEff $ \es -> stateEnv es f
391401
402+-- | Apply the monadic function to the current state of the effect and return a
403+-- value.
392404stateDataM :: e :> es => (DataA e -> Eff es (a, DataA e)) -> Eff es a
393405stateDataM f = unsafeEff $ \es -> E.mask $ \release -> do
394406 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
395407 putEnv es e
396408 pure a
397409
410+-- | Execute a computation with a temporarily modified state of the effect.
398411localData :: e :> es => (DataA e -> DataA e) -> Eff es a -> Eff es a
399412localData f m = unsafeEff $ \es -> do
400413 E.bracket (stateEnv es $ \e -> (e, f e))
effectful-core/src/Effectful/Writer/Local.hs+3−3
@@ -55,9 +55,9 @@ tell w = stateData $ \(DataA (Writer w0)) -> ((), DataA (Writer (w0 <> w)))
5555-- | Execute an action and append its output to the overall output of the
5656-- 'Writer'.
5757--
58−-- /Note:/ if a runtime exception is received while the action is executed, the
59−-- partial output of the action will still be appended to the overall output of
60−-- the 'Writer':
58+-- /Note:/ if an exception is received while the action is executed, the partial
59+-- output of the action will still be appended to the overall output of the
60+-- 'Writer':
6161--
6262-- >>> :{
6363-- runEff . execWriter @String $ do
effectful-core/src/Effectful/Writer/Shared.hs+3−3
@@ -59,9 +59,9 @@ tell w1 = unsafeEff $ \es -> do
5959-- | Execute an action and append its output to the overall output of the
6060-- 'Writer'.
6161--
62−-- /Note:/ if a runtime exception is received while the action is executed, the
63−-- partial output of the action will still be appended to the overall output of
64−-- the 'Writer':
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':
6565--
6666-- >>> :{
6767-- runEff . execWriter @String $ do
effectful/bench/Main.hs+3−3
@@ -97,11 +97,11 @@ filesize n = bgroup (show n)
9797#ifdef VERSION_eff
9898 , bench "eff" $ nfAppIO eff_calculateFileSizesDeep (take n files)
9999#endif
100−#ifdef VERSION_polysemy
101− , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)
102−#endif
103100#ifdef VERSION_mtl
104101 , bench "mtl" $ nfAppIO mtl_calculateFileSizesDeep (take n files)
102+#endif
103+#ifdef VERSION_polysemy
104+ , bench "polysemy" $ nfAppIO poly_calculateFileSizesDeep (take n files)
105105#endif
106106 ]
107107 ]
effectful/effectful.cabal+1−1
@@ -20,7 +20,7 @@ description: An easy to use, performant extensible effects library with seamless
2020
2121extra-source-files: CHANGELOG.md
2222
23−tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.0.1 || ==9.2.1
23+tested-with: GHC ==8.8.4 || ==8.10.7 || ==9.2.1
2424
2525bug-reports: https://github.com/arybczak/effectful/issues
2626source-repository head