on master help sign in
Adjust order of arguments in Env functions and remove readerEffectM
commit5cb1e35a8974502844934f662c886de626226789 authorAndrzej Rybczak <andrzej@rybczak.net> dateMon 26 Jul 2021, 15:08 (5 years ago) parentf0bf1e4
4 files changed+30−30
effectful-core/src/Effectful/Internal/Env.hs+10−9 effectful-core/src/Effectful/Internal/Monad.hs+16−17 effectful-core/src/Effectful/Writer/Local.hs+2−2 effectful-core/src/Effectful/Writer/Shared.hs+2−2
effectful-core/src/Effectful/Internal/Env.hs+10−9
@@ -405,19 +405,20 @@ unsafeTailEnv len (Env fork gref gen) = case fork of
405405-- | Replace the data type in the environment with a new value (in place).
406406unsafePutEnv
407407 :: forall e es handler. e :> es
408− => handler e
409− -> Env es -> IO ()
410−unsafePutEnv e env = do
408+ => Env es
409+ -> handler e
410+ -> IO ()
411+unsafePutEnv env e = do
411412 (i, es) <- getLocation @e env
412413 e `seq` writeSmallArray es i (toAny e)
413414
414415-- | Modify the data type in the environment (in place).
415416unsafeModifyEnv
416417 :: forall e es handler. e :> es
417− => (handler e -> handler e)
418− -> Env es
418+ => Env es
419+ -> (handler e -> handler e)
419420 -> IO ()
420−unsafeModifyEnv f env = do
421+unsafeModifyEnv env f = do
421422 (i, es) <- getLocation @e env
422423 e <- f . fromAny <$> readSmallArray es i
423424 e `seq` writeSmallArray es i (toAny e)
@@ -425,10 +426,10 @@ unsafeModifyEnv f env = do
425426-- | Modify the data type in the environment (in place) and return a value.
426427unsafeStateEnv
427428 :: forall e es handler a. e :> es
428− => (handler e -> (a, handler e))
429− -> Env es
429+ => Env es
430+ -> (handler e -> (a, handler e))
430431 -> IO a
431−unsafeStateEnv f env = do
432+unsafeStateEnv env f = do
432433 (i, es) <- getLocation @e env
433434 (a, e) <- f . fromAny <$> readSmallArray es i
434435 e `seq` writeSmallArray es i (toAny e)
effectful-core/src/Effectful/Internal/Monad.hs+16−17
@@ -51,9 +51,8 @@ module Effectful.Internal.Monad
5151 , getEffect
5252 , putEffect
5353 , stateEffect
54− , localEffect
55− , readerEffectM
5654 , stateEffectM
55+ , localEffect
5756 ) where
5857
5958import Control.Applicative (liftA2)
@@ -256,8 +255,9 @@ runFail m = unsafeEff $ \es0 -> mask $ \release -> do
256255 pure r
257256
258257instance Fail :> es => MonadFail (Eff es) where
259− fail msg = readerEffectM $ \(IdE (Fail tag)) -> unsafeEff_ $ do
260− throwIO $ FailEx tag msg
258+ fail msg = do
259+ IdE (Fail tag) <- getEffect
260+ unsafeEff_ . throwIO $ FailEx tag msg
261261
262262--------------------
263263
@@ -379,7 +379,9 @@ data Limit
379379
380380-- | Get the current 'UnliftStrategy'.
381381unliftStrategy :: IOE :> es => Eff es UnliftStrategy
382−unliftStrategy = readerEffectM $ \(IdE (IOE unlift)) -> pure unlift
382+unliftStrategy = do
383+ IdE (IOE unlift) <- getEffect
384+ pure unlift
383385
384386-- | Locally override the 'UnliftStrategy' with a given value.
385387--
@@ -430,22 +432,19 @@ getEffect :: e :> es => Eff es (handler e)
430432getEffect = unsafeEff $ \es -> getEnv es
431433
432434putEffect :: e :> es => handler e -> Eff es ()
433−putEffect e = unsafeEff $ \es -> unsafePutEnv e es
435+putEffect e = unsafeEff $ \es -> unsafePutEnv es e
434436
435437stateEffect :: e :> es => (handler e -> (a, handler e)) -> Eff es a
436−stateEffect f = unsafeEff $ \es -> unsafeStateEnv f es
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
438+stateEffect f = unsafeEff $ \es -> unsafeStateEnv es f
446439
447440stateEffectM :: e :> es => (handler e -> Eff es (a, handler e)) -> Eff es a
448441stateEffectM f = unsafeEff $ \es -> mask $ \release -> do
449442 (a, e) <- (\e -> release $ unEff (f e) es) =<< getEnv es
450− unsafePutEnv e es
443+ unsafePutEnv es e
451444 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)))
3434
3535listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
3636listen 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))
3838 a <- restore (unEff m es) `onException` merge es w0
3939 (a, ) <$> merge es w0
4040 where
4141 merge es w0 =
4242 -- 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)))
4444
4545listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
4646listens f m = do
effectful-core/src/Effectful/Writer/Shared.hs+2−2
@@ -43,14 +43,14 @@ listen m = unsafeEff $ \es -> do
4343 uninterruptibleMask $ \restore -> do
4444 v1 <- newMVar mempty
4545 -- 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))
4747 a <- restore (unEff m es) `onException` merge es v0 v1
4848 (a, ) <$> merge es v0 v1
4949 where
5050 -- Merge results accumulated in the local MVar with the mainline. If an
5151 -- exception was received while listening, merge results recorded so far.
5252 merge es v0 v1 = do
53− unsafePutEnv (IdE (Writer v0)) es
53+ unsafePutEnv es $ IdE (Writer v0)
5454 w1 <- readMVar v1
5555 modifyMVar_ v0 $ \w0 -> let w = w0 <> w1 in w `seq` pure w
5656 pure w1