@@ -26,9 +26,6 @@ module Control.Monad.Trans.Ether.Writer
2626 , tell
2727 , listen
2828 , pass
29− -- * Newtype operations
30− , pack
31− , unpack
3229 ) where
3330
3431#if __GLASGOW_HASKELL__ < 710
@@ -36,32 +33,8 @@ import Data.Monoid
3633#endif
3734
3835import Data.Functor.Identity (Identity(..))
39−import Control.Applicative
40−import Control.Monad (MonadPlus)
41−import Control.Monad.Fix (MonadFix)
42−import Control.Monad.Trans.Class (MonadTrans, lift)
43−import Control.Monad.IO.Class (MonadIO)
44−import Control.Monad.Morph (MFunctor, MMonad)
45−import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
46−import GHC.Generics (Generic)
47−import Data.Coerce (coerce)
48−
49−import qualified Control.Monad.Base as MB
50−import qualified Control.Monad.Trans.Control as MC
5136import qualified Control.Monad.Trans.Writer.Lazy as Trans
52−
53−import qualified Control.Monad.Trans.Lift.StT as Lift
54−import qualified Control.Monad.Trans.Lift.Local as Lift
55−import qualified Control.Monad.Trans.Lift.Catch as Lift
56−import qualified Control.Monad.Trans.Lift.Listen as Lift
57−import qualified Control.Monad.Trans.Lift.Pass as Lift
58−import qualified Control.Monad.Trans.Lift.CallCC as Lift
59−
60−import qualified Control.Monad.Cont.Class as Class
61−import qualified Control.Monad.Reader.Class as Class
62−import qualified Control.Monad.State.Class as Class
63−import qualified Control.Monad.Writer.Class as Class
64−import qualified Control.Monad.Error.Class as Class
37+import Control.Ether.TT
6538
6639-- | The parametrizable writer monad.
6740--
@@ -75,50 +48,7 @@ type Writer tag w = WriterT tag w Identity
7548--
7649-- The 'return' function produces the output 'mempty', while '>>=' combines
7750-- the outputs of the subcomputations using 'mappend'.
78−newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)
79− deriving ( Generic
80− , Functor, Applicative, Alternative, Monad, MonadPlus
81− , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
82− , MonadThrow, MonadCatch, MonadMask )
83−
84−-- | Type-restricted 'coerce'.
85−pack :: Trans.WriterT w m a -> WriterT tag w m a
86−pack = coerce
87−
88−-- | Type-restricted 'coerce'.
89−unpack :: WriterT tag w m a -> Trans.WriterT w m a
90−unpack = coerce
91−
92−instance (Monoid w, MB.MonadBase b m) => MB.MonadBase b (WriterT tag w m) where
93− liftBase = MB.liftBaseDefault
94−
95−instance Monoid w => MC.MonadTransControl (WriterT tag w) where
96− type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a
97− liftWith = MC.defaultLiftWith pack unpack
98− restoreT = MC.defaultRestoreT pack
99−
100−instance (Monoid w, MC.MonadBaseControl b m) => MC.MonadBaseControl b (WriterT tag w m) where
101− type StM (WriterT tag w m) a = MC.ComposeSt (WriterT tag w) m a
102− liftBaseWith = MC.defaultLiftBaseWith
103− restoreM = MC.defaultRestoreM
104−
105−type instance Lift.StT (WriterT tag w) a = MC.StT (WriterT tag w) a
106−
107−instance Monoid w => Lift.LiftLocal (WriterT tag w) where
108− liftLocal = Lift.defaultLiftLocal pack unpack
109−
110−instance Monoid w => Lift.LiftCatch (WriterT tag w) where
111− liftCatch = Lift.defaultLiftCatch pack unpack
112−
113−instance Monoid w => Lift.LiftListen (WriterT tag w) where
114− liftListen = Lift.defaultLiftListen pack unpack
115−
116−instance Monoid w' => Lift.LiftPass (WriterT tag w') where
117− liftPass = Lift.defaultLiftPass pack unpack
118−
119−instance Monoid w => Lift.LiftCallCC (WriterT tag w) where
120− liftCallCC = Lift.defaultLiftCallCC pack unpack
121− liftCallCC' = Lift.defaultLiftCallCC pack unpack
51+type WriterT tag w = TT tag (Trans.WriterT w)
12252
12353tagged :: proxy tag -> Trans.WriterT w m a -> WriterT tag w m a
12454tagged _ = pack
@@ -167,26 +97,3 @@ listen t m = tagged t $ Trans.listen (untagged t m)
16797-- value, applying the function to the accumulator.
16898pass :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a
16999pass t m = tagged t $ Trans.pass (untagged t m)
170−
171−instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where
172− callCC = Lift.liftCallCC Class.callCC
173−
174−instance (Monoid w, Class.MonadReader r m) => Class.MonadReader r (WriterT tag w m) where
175− ask = lift Class.ask
176− local = Lift.liftLocal Class.ask Class.local
177− reader = lift . Class.reader
178−
179−instance (Monoid w, Class.MonadState s m) => Class.MonadState s (WriterT tag w m) where
180− get = lift Class.get
181− put = lift . Class.put
182− state = lift . Class.state
183−
184−instance (Monoid w, Class.MonadWriter w' m) => Class.MonadWriter w' (WriterT tag w m) where
185− writer = lift . Class.writer
186− tell = lift . Class.tell
187− listen = Lift.liftListen Class.listen
188− pass = Lift.liftPass Class.pass
189−
190−instance (Monoid w, Class.MonadError e m) => Class.MonadError e (WriterT tag w m) where
191− throwError = lift . Class.throwError
192− catchError = Lift.liftCatch Class.catchError