git.iko.soy/effectful
on b42e0dc help sign in
effectful/src/Effectful/Writer.hs
57 lines 1.6 kB history raw
1-- | The 'Writer' as an effect.
2module Effectful.Writer
3 ( Writer
4 , runWriter
5 , execWriter
6 , writer
7 , tell
8 , listen
9 , listens
10 ) where
12import Control.Monad.Catch
14import Effectful.Internal.Effect
15import Effectful.Internal.Env
16import Effectful.Internal.Monad
18-- | Provide access to a write only value of type @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
32writer :: (Writer w :> es, Monoid w) => (a, w) -> Eff es a
33writer (a, w) = stateEffect $ \(IdE (Writer w0)) -> (a, IdE (Writer (w0 <> w)))
35tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
36tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 <> w)))
38listen
39 :: forall w es a. (Writer w :> es, Monoid w)
40 => Eff es a
41 -> Eff es (a, w)
42listen (Eff m) = unsafeEff $ \es -> mask $ \restore -> do
43 w0 <- unsafeStateEnv (\(IdE (Writer w)) -> (w, IdE (Writer mempty))) es
44 -- If an exception is thrown, restore e0 and keep parts of e1.
45 a <- restore (m es) `onException`
46 unsafeModifyEnv (\(IdE (Writer w)) -> IdE (Writer (w0 <> w))) es
47 w1 <- unsafeStateEnv (\(IdE (Writer w)) -> (w, IdE (Writer (w0 <> w)))) es
48 pure (a, w1)
50listens
51 :: (Writer w :> es, Monoid w)
52 => (w -> b)
53 -> Eff es a
54 -> Eff es (a, b)
55listens f m = do
56 (a, w) <- listen m
57 pure (a, f w)