git.iko.soy/effectful
on master help sign in
Adjust order of arguments in Env functions and remove readerEffectM
5cb1e35Andrzej Rybczak
effectful-core/src/Effectful/Internal/Env.hs+10−9
compare with master
unifiedsplit
@@ -405,19 +405,20 @@ unsafeTailEnv len (Env fork gref gen) = case fork of
405-- | Replace the data type in the environment with a new value (in place).
405-- | Replace the data type in the environment with a new value (in place).
406unsafePutEnv
406unsafePutEnv
407 :: forall e es handler. e :> es
407 :: forall e es handler. e :> es
408− => handler e
409− -> Env es -> IO ()
408+ => Env es
409+ -> handler e
410+ -> IO ()
410−unsafePutEnv e env = do
411+unsafePutEnv env e = do
411 (i, es) <- getLocation @e env
412 (i, es) <- getLocation @e env
412 e `seq` writeSmallArray es i (toAny e)
413 e `seq` writeSmallArray es i (toAny e)
413
414
414-- | Modify the data type in the environment (in place).
415-- | Modify the data type in the environment (in place).
415unsafeModifyEnv
416unsafeModifyEnv
416 :: forall e es handler. e :> es
417 :: forall e es handler. e :> es
418+ => Env es
417− => (handler e -> handler e)
419+ -> (handler e -> handler e)
418− -> Env es
419 -> IO ()
420 -> IO ()
420−unsafeModifyEnv f env = do
421+unsafeModifyEnv env f = do
421 (i, es) <- getLocation @e env
422 (i, es) <- getLocation @e env
422 e <- f . fromAny <$> readSmallArray es i
423 e <- f . fromAny <$> readSmallArray es i
423 e `seq` writeSmallArray es i (toAny e)
424 e `seq` writeSmallArray es i (toAny e)
@@ -425,10 +426,10 @@ unsafeModifyEnv f env = do
425-- | Modify the data type in the environment (in place) and return a value.
426-- | Modify the data type in the environment (in place) and return a value.
426unsafeStateEnv
427unsafeStateEnv
427 :: forall e es handler a. e :> es
428 :: forall e es handler a. e :> es
429+ => Env es
428− => (handler e -> (a, handler e))
430+ -> (handler e -> (a, handler e))
429− -> Env es
430 -> IO a
431 -> IO a
431−unsafeStateEnv f env = do
432+unsafeStateEnv env f = do
432 (i, es) <- getLocation @e env
433 (i, es) <- getLocation @e env
433 (a, e) <- f . fromAny <$> readSmallArray es i
434 (a, e) <- f . fromAny <$> readSmallArray es i
434 e `seq` writeSmallArray es i (toAny e)
435 e `seq` writeSmallArray es i (toAny e)
effectful-core/src/Effectful/Internal/Monad.hs+16−17
@@ -51,9 +51,8 @@ module Effectful.Internal.Monad
51 , getEffect
51 , getEffect
52 , putEffect
52 , putEffect
53 , stateEffect
53 , stateEffect
54− , localEffect
55− , readerEffectM
56 , stateEffectM
54 , stateEffectM
55+ , localEffect
57 ) where
56 ) where
58
57
59import Control.Applicative (liftA2)
58import Control.Applicative (liftA2)
@@ -256,8 +255,9 @@ runFail m = unsafeEff $ \es0 -> mask $ \release -> do
256 pure r
255 pure r
257
256
258instance Fail :> es => MonadFail (Eff es) where
257instance Fail :> es => MonadFail (Eff es) where
259− fail msg = readerEffectM $ \(IdE (Fail tag)) -> unsafeEff_ $ do
258+ fail msg = do
259+ IdE (Fail tag) <- getEffect
260− throwIO $ FailEx tag msg
260+ unsafeEff_ . throwIO $ FailEx tag msg
261
261
262--------------------
262--------------------
263
263
@@ -379,7 +379,9 @@ data Limit
379
379
380-- | Get the current 'UnliftStrategy'.
380-- | Get the current 'UnliftStrategy'.
381unliftStrategy :: IOE :> es => Eff es UnliftStrategy
381unliftStrategy :: IOE :> es => Eff es UnliftStrategy
382−unliftStrategy = readerEffectM $ \(IdE (IOE unlift)) -> pure unlift
382+unliftStrategy = do
383+ IdE (IOE unlift) <- getEffect
384+ pure unlift
383
385
384-- | Locally override the 'UnliftStrategy' with a given value.
386-- | Locally override the 'UnliftStrategy' with a given value.
385--
387--
@@ -430,22 +432,19 @@ getEffect :: e :> es => Eff es (handler e)
430getEffect = unsafeEff $ \es -> getEnv es
432getEffect = unsafeEff $ \es -> getEnv es
431
433
432putEffect :: e :> es => handler e -> Eff es ()
434putEffect :: e :> es => handler e -> Eff es ()
433−putEffect e = unsafeEff $ \es -> unsafePutEnv e es
435+putEffect e = unsafeEff $ \es -> unsafePutEnv es e
434
436
435stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a
437stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a
436−stateEffect f = unsafeEff $ \es -> unsafeStateEnv f es
438+stateEffect f = unsafeEff $ \es -> unsafeStateEnv es f
437−
438−localEffect :: e :> es => (handler e -> handler e) -> Eff es a -> Eff es a
439−localEffect f m = unsafeEff $ \es -> do
440− bracket (unsafeStateEnv (\e -> (e, f e)) es)
441− (\e -> unsafePutEnv e es)
442− (\_ -> unEff m es)
443−
444−readerEffectM :: e :> es => (handler e -> Eff es a) -> Eff es a
445−readerEffectM f = unsafeEff $ \es -> getEnv es >>= \e -> unEff (f e) es
446
439
447stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a
440stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a
448stateEffectM f = unsafeEff $ \es -> mask $ \release -> do
441stateEffectM f = unsafeEff $ \es -> mask $ \release -> do
449 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
442 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
450− unsafePutEnv e es
443+ unsafePutEnv es e
451 pure a
444 pure a
445+
446+localEffect :: e :> es => (handler e -> handler e) -> Eff es a -> Eff es a
447+localEffect f m = unsafeEff $ \es -> do
448+ bracket (unsafeStateEnv es $ \e -> (e, f e))
449+ (\e -> unsafePutEnv es e)
450+ (\_ -> unEff m es)
effectful-core/src/Effectful/Writer/Local.hs+2−2
@@ -34,13 +34,13 @@ tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))
34
34
35listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
35listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
36listen m = unsafeEff $ \es -> mask $ \restore -> do
36listen m = unsafeEff $ \es -> mask $ \restore -> do
37− w0 <- unsafeStateEnv (\(IdE (Writer w)) -> (w, IdE (Writer mempty))) es
37+ w0 <- unsafeStateEnv es $ \(IdE (Writer w)) -> (w, IdE (Writer mempty))
38 a <- restore (unEff m es) `onException` merge es w0
38 a <- restore (unEff m es) `onException` merge es w0
39 (a, ) <$> merge es w0
39 (a, ) <$> merge es w0
40 where
40 where
41 merge es w0 =
41 merge es w0 =
42 -- If an exception is thrown, restore w0 and keep parts of w1.
42 -- If an exception is thrown, restore w0 and keep parts of w1.
43− unsafeStateEnv (\(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))) es
43+ unsafeStateEnv es $ \(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))
44
44
45listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
45listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
46listens f m = do
46listens f m = do
effectful-core/src/Effectful/Writer/Shared.hs+2−2
@@ -43,14 +43,14 @@ listen m = unsafeEff $ \es -> do
43 uninterruptibleMask $ \restore -> do
43 uninterruptibleMask $ \restore -> do
44 v1 <- newMVar mempty
44 v1 <- newMVar mempty
45 -- Replace thread local MVar with a fresh one for isolated listening.
45 -- Replace thread local MVar with a fresh one for isolated listening.
46− v0 <- unsafeStateEnv (\(IdE (Writer v)) -> (v, IdE (Writer v1))) es
46+ v0 <- unsafeStateEnv es $ \(IdE (Writer v)) -> (v, IdE (Writer v1))
47 a <- restore (unEff m es) `onException` merge es v0 v1
47 a <- restore (unEff m es) `onException` merge es v0 v1
48 (a, ) <$> merge es v0 v1
48 (a, ) <$> merge es v0 v1
49 where
49 where
50 -- Merge results accumulated in the local MVar with the mainline. If an
50 -- Merge results accumulated in the local MVar with the mainline. If an
51 -- exception was received while listening, merge results recorded so far.
51 -- exception was received while listening, merge results recorded so far.
52 merge es v0 v1 = do
52 merge es v0 v1 = do
53− unsafePutEnv (IdE (Writer v0)) es
53+ unsafePutEnv es $ IdE (Writer v0)
54 w1 <- readMVar v1
54 w1 <- readMVar v1
55 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
55 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
56 pure w1
56 pure w1