git.iko.soy/effectful
on master help sign in
Remove the ability to leak unsafePerformIO via runPureEff (#43)
04aa70dAndrzej Rybczak
effectful-core/src/Effectful/Handler.hs+19−16
compare with master
unifiedsplit
@@ -24,6 +24,9 @@ module Effectful.Handler
24 , localLiftUnlift
24 , localLiftUnlift
25 , localLiftUnliftIO
25 , localLiftUnliftIO
26
26
27+ -- *** Utils
28+ , SuffixOf
29+
27 -- * Re-exports
30 -- * Re-exports
28 , HasCallStack
31 , HasCallStack
29 ) where
32 ) where
@@ -67,8 +70,8 @@ reinterpret runHandlerEs handler m = unsafeEff $ \es -> do
67-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
70-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
68-- general version see 'localUnlift'.
71-- general version see 'localUnlift'.
69localSeqUnlift
72localSeqUnlift
70− :: HasCallStack
73+ :: (HasCallStack, SuffixOf es handlerEs)
71− => LocalEnv localEs
74+ => LocalEnv localEs handlerEs
72 -- ^ Local environment.
75 -- ^ Local environment.
73 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
76 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
74 -- ^ Continuation with the unlifting function in scope.
77 -- ^ Continuation with the unlifting function in scope.
@@ -80,8 +83,8 @@ localSeqUnlift (LocalEnv les) k = unsafeEff $ \es -> do
80-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
83-- | Create a local unlifting function with the 'SeqUnlift' strategy. For the
81-- general version see 'localUnliftIO'.
84-- general version see 'localUnliftIO'.
82localSeqUnliftIO
85localSeqUnliftIO
83− :: (HasCallStack, IOE :> es)
86+ :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
84− => LocalEnv localEs
87+ => LocalEnv localEs handlerEs
85 -- ^ Local environment.
88 -- ^ Local environment.
86 -> ((forall r. Eff localEs r -> IO r) -> IO a)
89 -> ((forall r. Eff localEs r -> IO r) -> IO a)
87 -- ^ Continuation with the unlifting function in scope.
90 -- ^ Continuation with the unlifting function in scope.
@@ -90,8 +93,8 @@ localSeqUnliftIO (LocalEnv les) k = liftIO $ seqUnliftEff les k
90
93
91-- | Create a local unlifting function with the given strategy.
94-- | Create a local unlifting function with the given strategy.
92localUnlift
95localUnlift
93− :: HasCallStack
96+ :: (HasCallStack, SuffixOf es handlerEs)
94− => LocalEnv localEs
97+ => LocalEnv localEs handlerEs
95 -- ^ Local environment.
98 -- ^ Local environment.
96 -> UnliftStrategy
99 -> UnliftStrategy
97 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
100 -> ((forall r. Eff localEs r -> Eff es r) -> Eff es a)
@@ -107,8 +110,8 @@ localUnlift (LocalEnv les) strategy k = case strategy of
107
110
108-- | Create a local unlifting function with the given strategy.
111-- | Create a local unlifting function with the given strategy.
109localUnliftIO
112localUnliftIO
110− :: (HasCallStack, IOE :> es)
113+ :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
111− => LocalEnv localEs
114+ => LocalEnv localEs handlerEs
112 -- ^ Local environment.
115 -- ^ Local environment.
113 -> UnliftStrategy
116 -> UnliftStrategy
114 -> ((forall r. Eff localEs r -> IO r) -> IO a)
117 -> ((forall r. Eff localEs r -> IO r) -> IO a)
@@ -129,8 +132,8 @@ localUnliftIO (LocalEnv les) strategy k = case strategy of
129-- /Note:/ the operation must not run its argument in a separate thread,
132-- /Note:/ the operation must not run its argument in a separate thread,
130-- attempting to do so will result in a runtime error.
133-- attempting to do so will result in a runtime error.
131withLiftMap
134withLiftMap
132− :: HasCallStack
135+ :: (HasCallStack, SuffixOf es handlerEs)
133− => LocalEnv localEs
136+ => LocalEnv localEs handlerEs
134 -- ^ Local environment.
137 -- ^ Local environment.
135 -> ((forall a b. (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
138 -> ((forall a b. (Eff es a -> Eff es b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
136 -- ^ Continuation with the lifting function in scope.
139 -- ^ Continuation with the lifting function in scope.
@@ -168,8 +171,8 @@ withLiftMap !_ k = unsafeEff $ \es -> do
168-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
171-- forkIOWithUnmask $ \unmask -> unlift $ m $ liftMap unmask
169-- :}
172-- :}
170withLiftMapIO
173withLiftMapIO
171− :: (HasCallStack, IOE :> es)
174+ :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
172− => LocalEnv localEs
175+ => LocalEnv localEs handlerEs
173 -- ^ Local environment.
176 -- ^ Local environment.
174 -> ((forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
177 -> ((forall a b. (IO a -> IO b) -> Eff localEs a -> Eff localEs b) -> Eff es r)
175 -- ^ Continuation with the lifting function in scope.
178 -- ^ Continuation with the lifting function in scope.
@@ -190,8 +193,8 @@ withLiftMapIO !_ k = k $ \mapIO m -> unsafeEff $ \es -> do
190-- /Note:/ depending on the operation you're lifting 'localUnlift' along with
193-- /Note:/ depending on the operation you're lifting 'localUnlift' along with
191-- 'withLiftMap' might be enough and is more efficient.
194-- 'withLiftMap' might be enough and is more efficient.
192localLiftUnlift
195localLiftUnlift
193− :: HasCallStack
196+ :: (HasCallStack, SuffixOf es handlerEs)
194− => LocalEnv localEs
197+ => LocalEnv localEs handlerEs
195 -- ^ Local environment.
198 -- ^ Local environment.
196 -> UnliftStrategy
199 -> UnliftStrategy
197 -> ((forall r. Eff es r -> Eff localEs r) -> (forall r. Eff localEs r -> Eff es r) -> Eff es a)
200 -> ((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
216-- /Note:/ depending on the operation you're lifting 'localUnliftIO' along with
219-- /Note:/ depending on the operation you're lifting 'localUnliftIO' along with
217-- 'withLiftMapIO' might be enough and is more efficient.
220-- 'withLiftMapIO' might be enough and is more efficient.
218localLiftUnliftIO
221localLiftUnliftIO
219− :: (HasCallStack, IOE :> es)
222+ :: (HasCallStack, SuffixOf es handlerEs, IOE :> es)
220− => LocalEnv localEs
223+ => LocalEnv localEs handlerEs
221 -- ^ Local environment.
224 -- ^ Local environment.
222 -> UnliftStrategy
225 -> UnliftStrategy
223 -> ((forall r. IO r -> Eff localEs r) -> (forall r. Eff localEs r -> IO r) -> IO a)
226 -> ((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
10 , (:>)(..)
10 , (:>)(..)
11 , IdE(..)
11 , IdE(..)
12
12
13+ -- * Utils
14+ , SuffixOf
15+
13 -- * Re-exports
16 -- * Re-exports
14 , Type
17 , Type
15 ) where
18 ) where
@@ -56,3 +59,11 @@ instance {-# OVERLAPPING #-} e :> (e : es) where
56
59
57instance e :> es => e :> (x : es) where
60instance e :> es => e :> (x : es) where
58 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/Monad.hs+5−2
@@ -398,12 +398,15 @@ withEffToIO f = unliftStrategy >>= \case
398-- | Opaque representation of the 'Eff' environment at the point of calling the
398-- | Opaque representation of the 'Eff' environment at the point of calling the
399-- 'send' function, i.e. right before the control is passed to the effect
399-- 'send' function, i.e. right before the control is passed to the effect
400-- handler.
400-- handler.
401+--
402+-- The second type variable represents effects of a handler and is needed for
403+-- technical reasons to guarantee soundness.
401−newtype LocalEnv es = LocalEnv (Env es)
404+newtype LocalEnv (localEs :: [Effect]) (handlerEs :: [Effect]) = LocalEnv (Env localEs)
402
405
403-- | Type signature of the effect handler.
406-- | Type signature of the effect handler.
404type EffectHandler e es
407type EffectHandler e es
405 = forall a localEs. HasCallStack
408 = forall a localEs. HasCallStack
406− => LocalEnv localEs
409+ => LocalEnv localEs es
407 -- ^ Capture of the local environment for handling local 'Eff' operations when
410 -- ^ Capture of the local environment for handling local 'Eff' operations when
408 -- @e@ is a higher order effect.
411 -- @e@ is a higher order effect.
409 -> e (Eff localEs) a
412 -> e (Eff localEs) a
effectful-core/src/Effectful/State/Dynamic.hs+2−2
@@ -48,7 +48,7 @@ execLocalState s0 = reinterpret (L.execState s0) localState
48
48
49localState
49localState
50 :: L.State s :> es
50 :: L.State s :> es
51− => LocalEnv localEs
51+ => LocalEnv localEs es
52 -> State s (Eff localEs) a
52 -> State s (Eff localEs) a
53 -> Eff es a
53 -> Eff es a
54localState env = \case
54localState env = \case
@@ -71,7 +71,7 @@ execSharedState s0 = reinterpret (S.execState s0) sharedState
71
71
72sharedState
72sharedState
73 :: S.State s :> es
73 :: S.State s :> es
74− => LocalEnv localEs
74+ => LocalEnv localEs es
75 -> State s (Eff localEs) a
75 -> State s (Eff localEs) a
76 -> Eff es a
76 -> Eff es a
77sharedState env = \case
77sharedState env = \case
effectful-core/src/Effectful/Writer/Dynamic.hs+2−2
@@ -35,7 +35,7 @@ execLocalWriter = reinterpret L.execWriter localWriter
35
35
36localWriter
36localWriter
37 :: (L.Writer w :> es, Monoid w)
37 :: (L.Writer w :> es, Monoid w)
38− => LocalEnv localEs
38+ => LocalEnv localEs es
39 -> Writer w (Eff localEs) a
39 -> Writer w (Eff localEs) a
40 -> Eff es a
40 -> Eff es a
41localWriter env = \case
41localWriter env = \case
@@ -53,7 +53,7 @@ execSharedWriter = reinterpret S.execWriter sharedWriter
53
53
54sharedWriter
54sharedWriter
55 :: (S.Writer w :> es, Monoid w)
55 :: (S.Writer w :> es, Monoid w)
56− => LocalEnv localEs
56+ => LocalEnv localEs es
57 -> Writer w (Eff localEs) a
57 -> Writer w (Eff localEs) a
58 -> Eff es a
58 -> Eff es a
59sharedWriter env = \case
59sharedWriter env = \case