Slightly smaller stateStaticRepM

This commit is contained in:
Andrzej Rybczak 2022-08-08 23:20:27 +02:00
parent 870660445d
commit 34a3e57420
4 changed files with 10 additions and 12 deletions

View File

@ -292,11 +292,11 @@ putEnv env e = do
stateEnv stateEnv
:: forall e es a. e :> es :: forall e es a. e :> es
=> Env es -- ^ The environment. => Env es -- ^ The environment.
-> (EffectRep (DispatchOf e) e -> (a, EffectRep (DispatchOf e) e)) -> (EffectRep (DispatchOf e) e -> IO (a, EffectRep (DispatchOf e) e))
-> IO a -> IO a
stateEnv env f = do stateEnv env f = do
(i, es) <- getLocation @e env (i, es) <- getLocation @e env
(a, e) <- f . fromAny <$> readSmallArray es i (a, e) <- f . fromAny =<< readSmallArray es i
e `seq` writeSmallArray es i (toAny e) e `seq` writeSmallArray es i (toAny e)
pure a pure a
@ -304,11 +304,11 @@ stateEnv env f = do
modifyEnv modifyEnv
:: forall e es. e :> es :: forall e es. e :> es
=> Env es -- ^ The environment. => Env es -- ^ The environment.
-> (EffectRep (DispatchOf e) e -> EffectRep (DispatchOf e) e) -> (EffectRep (DispatchOf e) e -> IO (EffectRep (DispatchOf e) e))
-> IO () -> IO ()
modifyEnv env f = do modifyEnv env f = do
(i, es) <- getLocation @e env (i, es) <- getLocation @e env
e <- f . fromAny <$> readSmallArray es i e <- f . fromAny =<< readSmallArray es i
e `seq` writeSmallArray es i (toAny e) e `seq` writeSmallArray es i (toAny e)
-- | Determine location of the effect in the environment. -- | Determine location of the effect in the environment.

View File

@ -474,7 +474,7 @@ stateStaticRep
=> (StaticRep e -> (a, StaticRep e)) => (StaticRep e -> (a, StaticRep e))
-- ^ The function to modify the representation. -- ^ The function to modify the representation.
-> Eff es a -> Eff es a
stateStaticRep f = unsafeEff $ \es -> stateEnv es f stateStaticRep f = unsafeEff $ \es -> stateEnv es (pure . f)
-- | Apply the monadic function to the current representation of the effect and -- | Apply the monadic function to the current representation of the effect and
-- return a value. -- return a value.
@ -484,9 +484,7 @@ stateStaticRepM
-- ^ The function to modify the representation. -- ^ The function to modify the representation.
-> Eff es a -> Eff es a
stateStaticRepM f = unsafeEff $ \es -> E.mask $ \unmask -> do stateStaticRepM f = unsafeEff $ \es -> E.mask $ \unmask -> do
(a, s) <- (\s0 -> unmask $ unEff (f s0) es) =<< getEnv es stateEnv es $ unmask . (`unEff` es) . f
putEnv es s
pure a
-- | Execute a computation with a temporarily modified representation of the -- | Execute a computation with a temporarily modified representation of the
-- effect. -- effect.
@ -497,6 +495,6 @@ localStaticRep
-> Eff es a -> Eff es a
-> Eff es a -> Eff es a
localStaticRep f m = unsafeEff $ \es -> do localStaticRep f m = unsafeEff $ \es -> do
E.bracket (stateEnv es $ \s -> (s, f s)) E.bracket (stateEnv es $ \s -> pure (s, f s))
(\s -> putEnv es s) (\s -> putEnv es s)
(\_ -> unEff m es) (\_ -> unEff m es)

View File

@ -77,13 +77,13 @@ tell w = stateStaticRep $ \(Writer w0) -> ((), Writer (w0 <> w))
-- "Hi there!" -- "Hi there!"
listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w) listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
listen m = unsafeEff $ \es -> mask $ \unmask -> do listen m = unsafeEff $ \es -> mask $ \unmask -> do
w0 <- stateEnv es $ \(Writer w) -> (w, Writer mempty) w0 <- stateEnv es $ \(Writer w) -> pure (w, Writer mempty)
a <- unmask (unEff m es) `onException` merge es w0 a <- unmask (unEff m es) `onException` merge es w0
(a, ) <$> merge es w0 (a, ) <$> merge es w0
where where
merge es w0 = merge es w0 =
-- If an exception is thrown, restore w0 and keep parts of w1. -- If an exception is thrown, restore w0 and keep parts of w1.
stateEnv es $ \(Writer w1) -> (w1, Writer (w0 <> w1)) stateEnv es $ \(Writer w1) -> pure (w1, Writer (w0 <> w1))
-- | Execute an action and append its output to the overall output of the -- | Execute an action and append its output to the overall output of the
-- 'Writer', then return the final value along with a function of the recorded -- 'Writer', then return the final value along with a function of the recorded

View File

@ -87,7 +87,7 @@ listen m = unsafeEff $ \es -> do
uninterruptibleMask $ \unmask -> do uninterruptibleMask $ \unmask -> do
v1 <- newMVar mempty v1 <- newMVar mempty
-- Replace thread local MVar with a fresh one for isolated listening. -- Replace thread local MVar with a fresh one for isolated listening.
v0 <- stateEnv es $ \(Writer v) -> (v, Writer v1) v0 <- stateEnv es $ \(Writer v) -> pure (v, Writer v1)
a <- unmask (unEff m es) `onException` merge es v0 v1 a <- unmask (unEff m es) `onException` merge es v0 v1
(a, ) <$> merge es v0 v1 (a, ) <$> merge es v0 v1
where where