git.iko.soy/effectful
on master help sign in
Remove the ability to leak unsafePerformIO via runPureEff (#43)

Fixes #42.

commit04aa70d8a5aa56fb016469c05be3981c67ad37b1 authorAndrzej Rybczak <arybczak@users.noreply.github.com> dateWed 13 Oct 2021, 17:50 (5 years ago) parent5084f03
5 files changed+39−22
compare with master
unifiedsplit
effectful-core/src/Effectful/Handler.hs+19−16 effectful-core/src/Effectful/Internal/Effect.hs+11 effectful-core/src/Effectful/Internal/Monad.hs+5−2 effectful-core/src/Effectful/State/Dynamic.hs+2−2 effectful-core/src/Effectful/Writer/Dynamic.hs+2−2
effectful-core/src/Effectful/Handler.hs+19−16
@@ -24,6 +24,9 @@ module Effectful.Handler
2424 , localLiftUnlift
2525 , localLiftUnliftIO
2626
27+ -- *** Utils
28+ , SuffixOf
29+
2730 -- * Re-exports
2831 , HasCallStack
2932 ) where
@@ -67,8 +70,8 @@ reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
6770-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
6871-- general version see 'localUnlift'.
6972localSeqUnlift
70− :: HasCallStack
71− => LocalEnv localEs
73+ :: (HasCallStack, SuffixOf es handlerEs)
74+ => LocalEnv localEs handlerEs
7275 -- ^ Local environment.
7376 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
7477 -- ^ Continuation with the unlifting function in scope.
@@ -80,8 +83,8 @@ localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
8083-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
8184-- general version see 'localUnliftIO'.
8285localSeqUnliftIO
83− :: (HasCallStack, IOE :> es)
84− => LocalEnv localEs
86+ :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
87+ => LocalEnv localEs handlerEs
8588 -- ^ Local environment.
8689 -> ((forall r. Eff localEs r -> IO r) -> IO a)
8790 -- ^ Continuation with the unlifting function in scope.
@@ -90,8 +93,8 @@ localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftEff les k
9093
9194-- | Create a local unlifting function with the given strategy.
9295localUnlift
93− :: HasCallStack
94− => LocalEnv localEs
96+ :: (HasCallStack, SuffixOf es handlerEs)
97+ => LocalEnv localEs handlerEs
9598 -- ^ Local environment.
9699 -> UnliftStrategy
97100 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
@@ -107,8 +110,8 @@ localUnlift (LocalEnv les) strategy k = case strategy of
107110
108111-- | Create a local unlifting function with the given strategy.
109112localUnliftIO
110− :: (HasCallStack, IOE :> es)
111− => LocalEnv localEs
113+ :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
114+ => LocalEnv localEs handlerEs
112115 -- ^ Local environment.
113116 -> UnliftStrategy
114117 -> ((forall r. Eff localEs r -> IO r) -> IO a)
@@ -129,8 +132,8 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of
129132-- /Note:/ the operation must not run its argument in a separate thread,
130133-- attempting to do so will result in a runtime error.
131134withLiftMap
132− :: HasCallStack
133− => LocalEnv localEs
135+ :: (HasCallStack, SuffixOf es handlerEs)
136+ => LocalEnv localEs handlerEs
134137 -- ^ Local environment.
135138 -> ((forall a b. (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
136139 -- ^ Continuation with the lifting function in scope.
@@ -168,8 +171,8 @@ withLiftMap !_ k = unsafeEff $ \es -> do
168171-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
169172-- :}
170173withLiftMapIO
171− :: (HasCallStack, IOE :> es)
172− => LocalEnv localEs
174+ :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
175+ => LocalEnv localEs handlerEs
173176 -- ^ Local environment.
174177 -> ((forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
175178 -- ^ Continuation with the lifting function in scope.
@@ -190,8 +193,8 @@ withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do
190193-- /Note:/ depending on the operation you're lifting 'localUnlift' along with
191194-- 'withLiftMap' might be enough and is more efficient.
192195localLiftUnlift
193− :: HasCallStack
194− => LocalEnv localEs
196+ :: (HasCallStack, SuffixOf es handlerEs)
197+ => LocalEnv localEs handlerEs
195198 -- ^ Local environment.
196199 -> UnliftStrategy
197200 -> ((forall r. Eff es r -> Eff localEs r) -> (forall r. Eff localEs r -> Eff es r) -> Eff es a)
@@ -216,8 +219,8 @@ localLiftUnlift (LocalEnv les) strategy k = case strategy of
216219-- /Note:/ depending on the operation you're lifting 'localUnliftIO' along with
217220-- 'withLiftMapIO' might be enough and is more efficient.
218221localLiftUnliftIO
219− :: (HasCallStack, IOE :> es)
220− => LocalEnv localEs
222+ :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
223+ => LocalEnv localEs handlerEs
221224 -- ^ Local environment.
222225 -> UnliftStrategy
223226 -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)
effectful-core/src/Effectful/Internal/Effect.hs+11
@@ -10,6 +10,9 @@ module Effectful.Internal.Effect
1010 , (:>)(..)
1111 , IdE(..)
1212
13+ -- * Utils
14+ , SuffixOf
15+
1316 -- * Re-exports
1417 , Type
1518 ) where
@@ -56,3 +59,11 @@ instance {-# OVERLAPPING #-} e :> (e : es) where
5659
5760instance e :> es => e :> (x : es) where
5861 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/Monad.hs+5−2
@@ -398,12 +398,15 @@ withEffToIO f = unliftStrategy >>= \case
398398-- | Opaque representation of the 'Eff' environment at the point of calling the
399399-- 'send' function, i.e. right before the control is passed to the effect
400400-- handler.
401−newtype LocalEnv es = LocalEnv (Env es)
401+--
402+-- The second type variable represents effects of a handler and is needed for
403+-- technical reasons to guarantee soundness.
404+newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env localEs)
402405
403406-- | Type signature of the effect handler.
404407type EffectHandler e es
405408 = forall a localEs. HasCallStack
406− => LocalEnv localEs
409+ => LocalEnv localEs es
407410 -- ^ Capture of the local environment for handling local 'Eff' operations when
408411 -- @e@ is a higher order effect.
409412 -> e (Eff localEs) a
effectful-core/src/Effectful/State/Dynamic.hs+2−2
@@ -48,7 +48,7 @@ execLocalState s0 = reinterpret (L.execState s0) localState
4848
4949localState
5050 :: L.State s :> es
51− => LocalEnv localEs
51+ => LocalEnv localEs es
5252 -> State s (Eff localEs) a
5353 -> Eff es a
5454localState env = \case
@@ -71,7 +71,7 @@ execSharedState s0 = reinterpret (S.execState s0) sharedState
7171
7272sharedState
7373 :: S.State s :> es
74− => LocalEnv localEs
74+ => LocalEnv localEs es
7575 -> State s (Eff localEs) a
7676 -> Eff es a
7777sharedState env = \case
effectful-core/src/Effectful/Writer/Dynamic.hs+2−2
@@ -35,7 +35,7 @@ execLocalWriter = reinterpret L.execWriter localWriter
3535
3636localWriter
3737 :: (L.Writer w :> es, Monoid w)
38− => LocalEnv localEs
38+ => LocalEnv localEs es
3939 -> Writer w (Eff localEs) a
4040 -> Eff es a
4141localWriter env = \case
@@ -53,7 +53,7 @@ execSharedWriter = reinterpret S.execWriter sharedWriter
5353
5454sharedWriter
5555 :: (S.Writer w :> es, Monoid w)
56− => LocalEnv localEs
56+ => LocalEnv localEs es
5757 -> Writer w (Eff localEs) a
5858 -> Eff es a
5959sharedWriter env = \case