git.iko.soy/effectful
on 01bdb2a help sign in
effectful/src/Effectful/Writer.hs
63 lines 1.8 kB history raw
1{-# LANGUAGE CPP #-}
2-- | The 'Writer' as an effect.
3module Effectful.Writer
4 ( Writer
5 , runWriter
6 , execWriter
7 , writer
8 , tell
9 , listen
10 , listens
11 ) where
13import Control.Monad.Catch
15import Effectful.Internal.Effect
16import Effectful.Internal.Env
17import Effectful.Internal.Monad
19-- | Provide access to a write only value of type @w@.
20newtype Writer w :: Effect where
21 Writer :: w -> Writer w m r
23runWriter :: Monoid w => Eff (Writer w : es) a -> Eff es (a, w)
24runWriter m = do
25 (a, IdE (Writer w)) <- runEffect (IdE (Writer mempty)) m
26 pure (a, w)
28execWriter :: Monoid w => Eff (Writer w : es) a -> Eff es w
29execWriter m = do
30 IdE (Writer w) <- execEffect (IdE (Writer mempty)) m
31 pure w
33writer :: (Writer w :> es, Monoid w) => (a, w) -> Eff es a
34writer (a, w) = stateEffect $ \(IdE (Writer w0)) -> (a, IdE (Writer (w0 `mappend` w)))
36tell :: (Writer w :> es, Monoid w) => w -> Eff es ()
37tell w = stateEffect $ \(IdE (Writer w0)) -> ((), IdE (Writer (w0 `mappend` w)))
39listen
40 :: forall w es a. (Writer w :> es, Monoid w)
41 => Eff es a
42 -> Eff es (a, w)
43listen (Eff m) = unsafeEff $ \es -> mask $ \restore -> do
44#if __GLASGOW_HASKELL__ >= 900
45 error $ "'listen' temporarily doesn't compile with released GHC 9.* versions"
46 ++ " due to a GHC bug. If you want to use 'listen', please use GHC 8.*"
47#else
48 w0 <- unsafeStateEnv (\(IdE (Writer w)) -> (w, IdE (Writer mempty))) es
49 -- If an exception is thrown, restore e0 and keep parts of e1.
50 a <- restore (m es) `onException`
51 unsafeModifyEnv (\(IdE (Writer w)) -> IdE (Writer (w0 `mappend` w))) es
52 w1 <- unsafeStateEnv (\(IdE (Writer w)) -> (w, IdE (Writer (w0 `mappend` w)))) es
53 pure (a, w1)
54#endif
56listens
57 :: (Writer w :> es, Monoid w)
58 => (w -> b)
59 -> Eff es a
60 -> Eff es (a, b)
61listens f m = do
62 (a, w) <- listen m
63 pure (a, f w)