1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE
ExplicitForAll
, GADTs
, RebindableSyntax #-}
module T5908
( Writer
, runWriter
, execWriter
, WriterT
, runWriterT
, execWriterT
, tell
) where
import Control.Category (Category (id), (>>>))
import Prelude hiding (Monad (..), id)
import qualified Prelude
newtype Identity a = Identity { runIdentity :: a }
class Monad m where
(>>=) :: forall e ex x a b . m e ex a -> (a -> m ex x b) -> m e x b
(>>) :: forall e ex x a b . m e ex a -> m ex x b -> m e x b
return :: a -> m ex ex a
{-# INLINE (>>) #-}
m >> k = m >>= \ _ -> k
type Writer w = WriterT w Identity
runWriter :: Writer w e x a -> (a, w e x)
runWriter = runIdentity . runWriterT
execWriter :: Writer w e x a -> w e x
execWriter m = snd (runWriter m)
newtype WriterT w m e x a = WriterT { runWriterT :: m (a, w e x) }
execWriterT :: Prelude.Monad m => WriterT w m e x a -> m (w e x)
execWriterT m = do
~(_, w) <- runWriterT m
return w
where
(>>=) = (Prelude.>>=)
return = Prelude.return
instance (Category w, Prelude.Monad m) => Monad (WriterT w m) where
return a = WriterT $ return (a, id)
where
return = Prelude.return
m >>= k = WriterT $ do
~(a, w) <- runWriterT m
~(b, w') <- runWriterT (k a)
return (b, w >>> w')
where
(>>=) = (Prelude.>>=)
return = Prelude.return
tell :: (Category w, Prelude.Monad m) => w e x -> WriterT w m e x ()
tell w = WriterT $ return ((), w)
where
return = Prelude.return
|
