@@ -0,0 +1,156 @@
1+{-# LANGUAGE MultiParamTypeClasses #-}
2+{-# LANGUAGE TypeFamilies #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE UndecidableInstances #-}
6+{-# LANGUAGE DataKinds #-}
7+{-# LANGUAGE ConstraintKinds #-}
8+{-# LANGUAGE TypeOperators #-}
9+{-# LANGUAGE FunctionalDependencies #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE RankNTypes #-}
12+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
13+module Control.Monad.Ether.Writer
14+ (
15+ -- * MonadWriter class
16+ MonadWriter(..)
17+ , listens
18+ , censor
19+ -- * The Writer monad
20+ , Writer
21+ , runWriter
22+ , execWriter
23+ -- * The WriterT monad transformer
24+ , WriterT
25+ , writerT
26+ , runWriterT
27+ , execWriterT
28+ , mapWriterT
29+ ) where
30+
31+import Data.Proxy (Proxy(Proxy))
32+import Control.Monad.Trans (lift)
33+
34+import Control.Monad.Trans.Ether.Writer hiding (writer, tell, listen, pass)
35+import qualified Control.Monad.Trans.Ether.Reader as R
36+import qualified Control.Monad.Trans.Ether.State as S
37+import qualified Control.Monad.Trans.Ether.Except as E
38+import qualified Control.Monad.Trans.Ether.Writer as W
39+import qualified Control.Ether.Util as Util
40+
41+-- for mtl instances
42+import qualified Control.Monad.Trans.Except as Trans.E
43+import qualified Control.Monad.Trans.Identity as Trans.I
44+import qualified Control.Monad.Trans.Maybe as Trans.M
45+import qualified Control.Monad.Trans.Reader as Trans.R
46+import qualified Control.Monad.Trans.State.Lazy as Trans.S.Lazy
47+import qualified Control.Monad.Trans.State.Strict as Trans.S.Strict
48+import qualified Control.Monad.Trans.Writer.Lazy as Trans.W.Lazy
49+
50+class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where
51+
52+ {-# MINIMAL (writer | tell), listen, pass #-}
53+
54+ -- | Embed a simple writer action.
55+ writer :: proxy tag -> (a, w) -> m a
56+ writer t ~(a, w) = do
57+ tell t w
58+ return a
59+
60+ -- | Append a value to the accumulator within the monad.
61+ tell :: proxy tag -> w -> m ()
62+ tell t w = writer t ((),w)
63+
64+ -- | Execute an action and add its accumulator
65+ -- to the value of the computation.
66+ listen :: proxy tag -> m a -> m (a, w)
67+
68+ -- | Execute an action which returns a value and a function,
69+ -- and return the value, applying the function to the accumulator.
70+ pass :: proxy tag -> m (a, w -> w) -> m a
71+
72+listens :: MonadWriter tag w m => proxy tag -> (w -> b) -> m a -> m (a, b)
73+listens t f m = do
74+ ~(a, w) <- listen t m
75+ return (a, f w)
76+
77+censor :: MonadWriter tag w m => proxy tag -> (w -> w) -> m a -> m a
78+censor t f m = pass t $ do
79+ a <- m
80+ return (a, f)
81+
82+instance {-# OVERLAPPING #-} (Monoid w, Monad m) => MonadWriter tag w (WriterT tag w m) where
83+ writer = W.writer
84+ tell = W.tell
85+ listen = W.listen
86+ pass = W.pass
87+
88+instance (Monoid w', MonadWriter tag w m) => MonadWriter tag w (WriterT tag' w' m) where
89+ writer t = lift . writer t
90+ tell t = lift . tell t
91+ listen t = W.liftListen Proxy (listen t)
92+ pass t = W.liftPass Proxy (pass t)
93+
94+-- Instances for other tagged transformers
95+
96+instance (MonadWriter tag w m) => MonadWriter tag w (R.ReaderT tag' r m) where
97+ writer t = lift . writer t
98+ tell t = lift . tell t
99+ listen t = R.mapReaderT Proxy (listen t)
100+ pass t = R.mapReaderT Proxy (pass t)
101+
102+instance (MonadWriter tag w m) => MonadWriter tag w (E.ExceptT tag' e m) where
103+ writer t = lift . writer t
104+ tell t = lift . tell t
105+ listen t = E.liftListen Proxy (listen t)
106+ pass t = E.liftPass Proxy (pass t)
107+
108+instance (MonadWriter tag w m) => MonadWriter tag w (S.StateT tag' e m) where
109+ writer t = lift . writer t
110+ tell t = lift . tell t
111+ listen t = S.liftListen Proxy (listen t)
112+ pass t = S.liftPass Proxy (pass t)
113+
114+-- Instances for mtl transformers
115+
116+instance (MonadWriter tag w m) => MonadWriter tag w (Trans.E.ExceptT e m) where
117+ writer t = lift . writer t
118+ tell t = lift . tell t
119+ listen t = Trans.E.liftListen (listen t)
120+ pass t = Trans.E.liftPass (pass t)
121+
122+instance (MonadWriter tag w m) => MonadWriter tag w (Trans.I.IdentityT m) where
123+ writer t = lift . writer t
124+ tell t = lift . tell t
125+ listen t = Trans.I.mapIdentityT (listen t)
126+ pass t = Trans.I.mapIdentityT (pass t)
127+
128+instance (MonadWriter tag w m) => MonadWriter tag w (Trans.M.MaybeT m) where
129+ writer t = lift . writer t
130+ tell t = lift . tell t
131+ listen t = Trans.M.liftListen (listen t)
132+ pass t = Trans.M.liftPass (pass t)
133+
134+instance (MonadWriter tag w m) => MonadWriter tag w (Trans.R.ReaderT r m) where
135+ writer t = lift . writer t
136+ tell t = lift . tell t
137+ listen t = Trans.R.mapReaderT (listen t)
138+ pass t = Trans.R.mapReaderT (pass t)
139+
140+instance (MonadWriter tag w m) => MonadWriter tag w (Trans.S.Lazy.StateT s m) where
141+ writer t = lift . writer t
142+ tell t = lift . tell t
143+ listen t = Trans.S.Lazy.liftListen (listen t)
144+ pass t = Trans.S.Lazy.liftPass (pass t)
145+
146+instance (MonadWriter tag w m) => MonadWriter tag w (Trans.S.Strict.StateT s m) where
147+ writer t = lift . writer t
148+ tell t = lift . tell t
149+ listen t = Trans.S.Strict.liftListen (listen t)
150+ pass t = Trans.S.Strict.liftPass (pass t)
151+
152+instance (Monoid w', MonadWriter tag w m) => MonadWriter tag w (Trans.W.Lazy.WriterT w' m) where
153+ writer t = lift . writer t
154+ tell t = lift . tell t
155+ listen t = Util.liftListen_WriterT (listen t)
156+ pass t = Util.liftPass_WriterT (pass t)