git.iko.soy/effectful
on d728875 help sign in
effectful/src/Effectful/Writer.hs
48 lines 1.4 kB history raw
1-- | The 'Writer' effect.
2module Effectful.Writer
3 ( Writer
4 , runWriter
5 , execWriter
6 , tell
7 , listen
8 , listens
9 ) where
11import Control.Monad.Catch
13import Effectful.Internal.Effect
14import Effectful.Internal.Env
15import Effectful.Internal.Monad
17-- | Provide access to a strict (WHNF), thread local, write only value of type
18-- @w@.
19newtype Writer w :: Effect where
20 Writer :: w -> Writer w m r
22runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
23runWriter m = do
24 (a, IdE (Writer w)) <- runEffect (IdE (Writer mempty)) m
25 pure (a, w)
27execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
28execWriter m = do
29 IdE (Writer w) <- execEffect (IdE (Writer mempty)) m
30 pure w
32tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
33tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))
35listen :: (Writer w :> es, Monoid w) => Eff es a -> Eff es (a, w)
36listen m = unsafeEff $ \es -> mask $ \restore -> do
37 w0 <- unsafeStateEnv (\(IdE (Writer w)) -> (w, IdE (Writer mempty))) es
38 a <- restore (unEff m es) `onException` merge es w0
39 (a, ) <$> merge es w0
40 where
41 merge es w0 =
42 -- If an exception is thrown, restore w0 and keep parts of w1.
43 unsafeStateEnv (\(IdE (Writer w1)) -> (w1, IdE (Writer (w0 <> w1)))) es
45listens :: (Writer w :> es, Monoid w) => (w -> b) -> Eff es a -> Eff es (a, b)
46listens f m = do
47 (a, w) <- listen m
48 pure (a, f w)