@@ -22,38 +22,11 @@ module Control.Monad.Trans.Ether.Reader
2222 -- * Reader operations
2323 , ask
2424 , local
25− -- * Newtype operations
26− , pack
27− , unpack
2825 ) where
2926
3027import Data.Functor.Identity (Identity(..))
31−import Control.Applicative
32−import Control.Monad (MonadPlus)
33−import Control.Monad.Fix (MonadFix)
34−import Control.Monad.Trans.Class (MonadTrans, lift)
35−import Control.Monad.IO.Class (MonadIO)
36−import Control.Monad.Morph (MFunctor, MMonad)
37−import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
38−import GHC.Generics (Generic)
39−import Data.Coerce (coerce)
40−
41−import qualified Control.Monad.Base as MB
42−import qualified Control.Monad.Trans.Control as MC
4328import qualified Control.Monad.Trans.Reader as Trans
44−
45−import qualified Control.Monad.Trans.Lift.StT as Lift
46−import qualified Control.Monad.Trans.Lift.Local as Lift
47−import qualified Control.Monad.Trans.Lift.Catch as Lift
48−import qualified Control.Monad.Trans.Lift.Listen as Lift
49−import qualified Control.Monad.Trans.Lift.Pass as Lift
50−import qualified Control.Monad.Trans.Lift.CallCC as Lift
51−
52−import qualified Control.Monad.Cont.Class as Class
53−import qualified Control.Monad.Reader.Class as Class
54−import qualified Control.Monad.State.Class as Class
55−import qualified Control.Monad.Writer.Class as Class
56−import qualified Control.Monad.Error.Class as Class
29+import Control.Ether.TT
5730
5831-- | The parameterizable reader monad.
5932--
@@ -68,50 +41,7 @@ type Reader tag r = ReaderT tag r Identity
6841--
6942-- The 'return' function ignores the environment, while '>>=' passes
7043-- the inherited environment to both subcomputations.
71−newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)
72− deriving ( Generic
73− , Functor, Applicative, Alternative, Monad, MonadPlus
74− , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
75− , MonadThrow, MonadCatch, MonadMask )
76−
77−-- | Type-restricted 'coerce'.
78−pack :: Trans.ReaderT r m a -> ReaderT tag r m a
79−pack = coerce
80−
81−-- | Type-restricted 'coerce'.
82−unpack :: ReaderT tag r m a -> Trans.ReaderT r m a
83−unpack = coerce
84−
85−instance MB.MonadBase b m => MB.MonadBase b (ReaderT tag r m) where
86− liftBase = MB.liftBaseDefault
87−
88−instance MC.MonadTransControl (ReaderT tag r) where
89− type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a
90− liftWith = MC.defaultLiftWith pack unpack
91− restoreT = MC.defaultRestoreT pack
92−
93−instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ReaderT tag r m) where
94− type StM (ReaderT tag r m) a = MC.ComposeSt (ReaderT tag r) m a
95− liftBaseWith = MC.defaultLiftBaseWith
96− restoreM = MC.defaultRestoreM
97−
98−type instance Lift.StT (ReaderT tag r) a = MC.StT (ReaderT tag r) a
99−
100−instance Lift.LiftLocal (ReaderT tag r) where
101− liftLocal = Lift.defaultLiftLocal pack unpack
102−
103−instance Lift.LiftCatch (ReaderT tag r) where
104− liftCatch = Lift.defaultLiftCatch pack unpack
105−
106−instance Lift.LiftListen (ReaderT tag r) where
107− liftListen = Lift.defaultLiftListen pack unpack
108−
109−instance Lift.LiftPass (ReaderT tag r) where
110− liftPass = Lift.defaultLiftPass pack unpack
111−
112−instance Lift.LiftCallCC (ReaderT tag r) where
113− liftCallCC = Lift.defaultLiftCallCC pack unpack
114− liftCallCC' = Lift.defaultLiftCallCC' pack unpack
44+type ReaderT tag r = TT tag (Trans.ReaderT r)
11545
11646tagged :: proxy tag -> Trans.ReaderT r m a -> ReaderT tag r m a
11747tagged _ = pack
@@ -154,28 +84,3 @@ local
15484 -- ^ Computation to run in the modified environment.
15585 -> ReaderT tag r m a
15686local t f m = tagged t $ Trans.withReaderT f (untagged t m)
157−
158−-- Instances for mtl classes
159−
160−instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where
161− callCC = Lift.liftCallCC Class.callCC
162−
163−instance Class.MonadReader r' m => Class.MonadReader r' (ReaderT tag r m) where
164− ask = lift Class.ask
165− local = Lift.liftLocal Class.ask Class.local
166− reader = lift . Class.reader
167−
168−instance Class.MonadState s m => Class.MonadState s (ReaderT tag r m) where
169− get = lift Class.get
170− put = lift . Class.put
171− state = lift . Class.state
172−
173−instance Class.MonadWriter w m => Class.MonadWriter w (ReaderT tag r m) where
174− writer = lift . Class.writer
175− tell = lift . Class.tell
176− listen = Lift.liftListen Class.listen
177− pass = Lift.liftPass Class.pass
178−
179−instance Class.MonadError e m => Class.MonadError e (ReaderT tag r m) where
180− throwError = lift . Class.throwError
181− catchError = Lift.liftCatch Class.catchError