@@ -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
15+ -- * MonadWriter class
19+ -- * The Writer monad
23+ -- * The WriterT monad transformer
31+import Data.Proxy (Proxy(Proxy))
32+import Control.Monad.Trans (lift)
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
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
50+class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where
52+ {-# MINIMAL (writer | tell), listen, pass #-}
54+ -- | Embed a simple writer action.
55+ writer :: proxy tag -> (a, w) -> m a
56+ writer t ~(a, w) = do
60+ -- | Append a value to the accumulator within the monad.
61+ tell :: proxy tag -> w -> m ()
62+ tell t w = writer t ((),w)
64+ -- | Execute an action and add its accumulator
65+ -- to the value of the computation.
66+ listen :: proxy tag -> m a -> m (a, w)
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
72+listens :: MonadWriter tag w m => proxy tag -> (w -> b) -> m a -> m (a, b)
74+ ~(a, w) <- listen t m
77+censor :: MonadWriter tag w m => proxy tag -> (w -> w) -> m a -> m a
78+censor t f m = pass t $ do
82+instance {-# OVERLAPPING #-} (Monoid w, Monad m) => MonadWriter tag w (WriterT tag w m) where
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)
94+-- Instances for other tagged transformers
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)
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)
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)
114+-- Instances for mtl transformers
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)
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)
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)
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)
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)
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)
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)