@@ -22,38 +22,11 @@ module Control.Monad.Trans.Ether.Except
2222 -- * Exception operations
2323 , throw
2424 , catch
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)
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.Except 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
5932-- | The parameterizable exception monad.
@@ -72,50 +45,7 @@ runExcept t = Trans.runExcept . untagged t
7245--
7346-- The 'return' function returns a normal value, while '>>=' exits on
7447-- the first exception.
75−newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)
76− deriving ( Generic
77− , Functor, Applicative, Alternative, Monad, MonadPlus
78− , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad
79− , MonadThrow, MonadCatch )
80−
81−-- | Type-restricted 'coerce'.
82−pack :: Trans.ExceptT e m a -> ExceptT tag e m a
83−pack = coerce
84−
85−-- | Type-restricted 'coerce'.
86−unpack :: ExceptT tag e m a -> Trans.ExceptT e m a
87−unpack = coerce
88−
89−instance MB.MonadBase b m => MB.MonadBase b (ExceptT tag e m) where
90− liftBase = MB.liftBaseDefault
91−
92−instance MC.MonadTransControl (ExceptT tag e) where
93− type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a
94− liftWith = MC.defaultLiftWith pack unpack
95− restoreT = MC.defaultRestoreT pack
96−
97−instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ExceptT tag e m) where
98− type StM (ExceptT tag e m) a = MC.ComposeSt (ExceptT tag e) m a
99− liftBaseWith = MC.defaultLiftBaseWith
100− restoreM = MC.defaultRestoreM
101−
102−type instance Lift.StT (ExceptT tag e) a = MC.StT (ExceptT tag e) a
103−
104−instance Lift.LiftLocal (ExceptT tag e) where
105− liftLocal = Lift.defaultLiftLocal pack unpack
106−
107−instance Lift.LiftCatch (ExceptT tag e) where
108− liftCatch = Lift.defaultLiftCatch pack unpack
109−
110−instance Lift.LiftListen (ExceptT tag e) where
111− liftListen = Lift.defaultLiftListen pack unpack
112−
113−instance Lift.LiftPass (ExceptT tag e) where
114− liftPass = Lift.defaultLiftPass pack unpack
115−
116−instance Lift.LiftCallCC (ExceptT tag e) where
117− liftCallCC = Lift.defaultLiftCallCC pack unpack
118− liftCallCC' = Lift.defaultLiftCallCC pack unpack
48+type ExceptT tag e = TT tag (Trans.ExceptT e)
11949
12050tagged :: proxy tag -> Trans.ExceptT e m a -> ExceptT tag e m a
12151tagged _ = pack
@@ -143,26 +73,3 @@ throw t = tagged t . Trans.throwE
14373-- | A handler function to handle previous exceptions and return to normal execution.
14474catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a
14575catch t m h = tagged t $ Trans.catchE (untagged t m) (untagged t . h)
146−
147−instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where
148− callCC = Lift.liftCallCC Class.callCC
149−
150−instance Class.MonadReader r m => Class.MonadReader r (ExceptT tag e m) where
151− ask = lift Class.ask
152− local = Lift.liftLocal Class.ask Class.local
153− reader = lift . Class.reader
154−
155−instance Class.MonadState s m => Class.MonadState s (ExceptT tag e m) where
156− get = lift Class.get
157− put = lift . Class.put
158− state = lift . Class.state
159−
160−instance Class.MonadWriter w m => Class.MonadWriter w (ExceptT tag e m) where
161− writer = lift . Class.writer
162− tell = lift . Class.tell
163− listen = Lift.liftListen Class.listen
164− pass = Lift.liftPass Class.pass
165−
166−instance Class.MonadError e' m => Class.MonadError e' (ExceptT tag e m) where
167− throwError = lift . Class.throwError
168− catchError = Lift.liftCatch Class.catchError