ether 0.2.1.0 → 0.3.0.0

raw patch · 23 files changed

+288/−509 lines, 23 filesdep +mmorphdep +monad-controldep +transformers-basePVP ok

version bump matches the API change (PVP)

Dependencies added: mmorph, monad-control, transformers-base, transformers-lift

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• ether.cabal +5/−1
• src/Control/Ether/Abbr.hs +1/−1
• src/Control/Ether/Tagged.hs +1/−1
• src/Control/Ether/Util.hs +1/−22
• src/Control/Ether/Wrapped.hs +8/−1
• src/Control/Monad/Ether/Except.hs +0/−1
• src/Control/Monad/Ether/Except/Class.hs +7/−79
• src/Control/Monad/Ether/Implicit/Except.hs +0/−6
• src/Control/Monad/Ether/Implicit/Reader.hs +0/−5
• src/Control/Monad/Ether/Implicit/State/Lazy.hs +0/−5
• src/Control/Monad/Ether/Implicit/State/Strict.hs +0/−5
• src/Control/Monad/Ether/Reader.hs +0/−1
• src/Control/Monad/Ether/Reader/Class.hs +7/−82
• src/Control/Monad/Ether/State/Lazy.hs +0/−1
• src/Control/Monad/Ether/State/Strict.hs +0/−1
• src/Control/Monad/Ether/Writer.hs +0/−1
• src/Control/Monad/Ether/Writer/Class.hs +12/−92
• src/Control/Monad/Trans/Ether/Except.hs +48/−44
• src/Control/Monad/Trans/Ether/Reader.hs +48/−42
• src/Control/Monad/Trans/Ether/State/Lazy.hs +47/−39
• src/Control/Monad/Trans/Ether/State/Strict.hs +47/−39
• src/Control/Monad/Trans/Ether/Writer.hs +49/−40

@@ -1,3 +1,10 @@+0.3.0.0+-------++* `MonadBase`, `MonadControl`, `MonadBaseControl` instances.+* `MFunctor`, `MMonad` instances.+* Use `transformers-lift`.+ 0.2.1.0 ------- 

@@ -1,5 +1,5 @@ name:                ether-version:             0.2.1.0+version:             0.3.0.0 synopsis:            Monad transformers and classes description:     Ether is a Haskell library that extends @mtl@ and @transformers@ with@@ -58,7 +58,11 @@    build-depends:       base >=4.7 && <4.9                ,       transformers >=0.4.2+               ,       transformers-lift >=0.1                ,       mtl >=2.2.1+               ,       mmorph >=1.0.4+               ,       monad-control >=1.0.0.4+               ,       transformers-base >=0.4.4                ,       template-haskell >=2.9                ,       newtype-generics >=0.4.1 

@@ -28,7 +28,7 @@ data tag --> r type instance ReifyAbbr (tag --> r) m = MonadReader tag r m --- | Denotes 'MonadWriter'. The mnemonic is that you write values of @w@+-- | Denotes 'MonadWriter'. The mnemonic is that you write values of type @w@ -- to the writer accumulator tagged by @tag@, thus the arrows points -- from @w@ to @tag@. data tag <-- w

@@ -49,7 +49,7 @@ class UniqueTag a  type family IsUnique (x :: k) (as :: [k]) :: Constraint where-    IsUnique x (x ': as) = UniqueTag x+    IsUnique x (x ': as) = (UniqueTag x, IsUnique x as)     IsUnique x (a ': as) = IsUnique x as     IsUnique x '[] = () 

@@ -4,17 +4,11 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} module Control.Ether.Util-    ( liftCatch_ExceptT-    , liftListen_WriterT-    , liftPass_WriterT-    , type (++)+    ( type (++)     , MaybeToList     , fmap     ) where -import qualified Control.Monad.Signatures as Sig-import qualified Control.Monad.Trans.Except as Trans-import qualified Control.Monad.Trans.Writer as Trans import Prelude hiding (fmap)  #if __GLASGOW_HASKELL__ < 710@@ -30,21 +24,6 @@ type family MaybeToList (mt :: Maybe k) :: [k] where     MaybeToList 'Nothing = '[]     MaybeToList ('Just t) = '[t]--liftCatch_ExceptT :: Sig.Catch e m (Either e' a) -> Sig.Catch e (Trans.ExceptT e' m) a-liftCatch_ExceptT catchE m h = Trans.ExceptT $ catchE (Trans.runExceptT m) (Trans.runExceptT . h)---- TODO: Not sure if correct-liftListen_WriterT :: Monad m => Sig.Listen w' m (a, w) -> Sig.Listen w' (Trans.WriterT w m) a-liftListen_WriterT listen m = Trans.WriterT $ do-    ~((a, w'), w) <- listen (Trans.runWriterT m)-    return ((a, w), w')---- TODO: Not sure if correct-liftPass_WriterT :: Monad m => Sig.Pass w' m (a, w) -> Sig.Pass w' (Trans.WriterT w m) a-liftPass_WriterT pass m = Trans.WriterT $ pass $ do-    ~((a, f), w) <- Trans.runWriterT m-    return ((a, w), f)  #if __GLASGOW_HASKELL__ < 710 fmap :: Monad f => (a -> b) -> f a -> f b

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}@@ -31,6 +32,9 @@ import Control.Monad (MonadPlus) import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO)+import GHC.Generics (Generic)+import qualified Control.Newtype as NT+ import Control.Monad.Ether.Reader.Class import Control.Monad.Ether.State.Class import Control.Monad.Ether.Except.Class@@ -43,8 +47,11 @@  -- | Wrap a monad to attach a tag to it. newtype WrappedEther tag m a = WrapEther { unwrapEther :: m a }-    deriving ( Functor, Applicative, Alternative, Monad, MonadPlus+    deriving ( Generic+             , Functor, Applicative, Alternative, Monad, MonadPlus              , MonadFix, MonadIO )++instance NT.Newtype (WrappedEther tag m a)  -- | Annotate a polymorphic monadic computation with a tag. ethered :: proxy tag -> WrappedEther tag m a -> m a

@@ -12,7 +12,6 @@     , ExceptT     , exceptT     , runExceptT-    , mapExceptT     -- * Handle functions     , handleT     , handle

@@ -20,27 +20,9 @@ import Data.Monoid #endif -import Data.Proxy (Proxy(Proxy))-import Control.Monad.Trans (lift)- import Control.Monad.Trans.Ether.Except hiding (throw, catch) import qualified Control.Monad.Trans.Ether.Except as E-import qualified Control.Monad.Trans.Ether.Reader as R-import qualified Control.Monad.Trans.Ether.Writer as W-import qualified Control.Monad.Trans.Ether.State.Lazy   as S.L-import qualified Control.Monad.Trans.Ether.State.Strict as S.S-import qualified Control.Ether.Util as Util---- for mtl instances-import qualified Control.Monad.Trans.Except        as Trans.E-import qualified Control.Monad.Trans.Identity      as Trans.I-import qualified Control.Monad.Trans.List          as Trans.L-import qualified Control.Monad.Trans.Maybe         as Trans.M-import qualified Control.Monad.Trans.Reader        as Trans.R-import qualified Control.Monad.Trans.State.Lazy    as Trans.S.Lazy-import qualified Control.Monad.Trans.State.Strict  as Trans.S.Strict-import qualified Control.Monad.Trans.Writer.Lazy   as Trans.W.Lazy-import qualified Control.Monad.Trans.Writer.Strict as Trans.W.Strict+import qualified Control.Monad.Trans.Lift.Catch as Lift   -- | See 'Control.Monad.Except.MonadError'.@@ -57,63 +39,9 @@     throw = E.throw     catch = E.catch -instance MonadExcept tag e m => MonadExcept tag e (ExceptT tag' e' m) where-    throw t = lift . throw t-    catch t = liftCatch Proxy (catch t)---- Instances for other tagged transformers--instance MonadExcept tag e m => MonadExcept tag e (R.ReaderT tag' r m) where-    throw t = lift . throw t-    catch t = R.liftCatch Proxy (catch t)--instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (W.WriterT tag' w m) where-    throw t = lift . throw t-    catch t = W.liftCatch Proxy (catch t)--instance MonadExcept tag e m => MonadExcept tag e (S.L.StateT tag' s m) where-    throw t = lift . throw t-    catch t = S.L.liftCatch Proxy (catch t)--instance MonadExcept tag e m => MonadExcept tag e (S.S.StateT tag' s m) where-    throw t = lift . throw t-    catch t = S.S.liftCatch Proxy (catch t)----- Instances for mtl transformers--instance MonadExcept tag e m => MonadExcept tag e (Trans.E.ExceptT e' m) where-    throw t = lift . throw t-    catch t = Util.liftCatch_ExceptT (catch t)--instance MonadExcept tag e m => MonadExcept tag e (Trans.I.IdentityT m) where-    throw t = lift . throw t-    catch t = Trans.I.liftCatch (catch t)--instance MonadExcept tag e m => MonadExcept tag e (Trans.L.ListT m) where-    throw t = lift . throw t-    catch t = Trans.L.liftCatch (catch t)--instance MonadExcept tag e m => MonadExcept tag e (Trans.M.MaybeT m) where-    throw t = lift . throw t-    catch t = Trans.M.liftCatch (catch t)--instance MonadExcept tag e m => MonadExcept tag e (Trans.R.ReaderT r m) where-    throw t = lift . throw t-    catch t = Trans.R.liftCatch (catch t)--instance MonadExcept tag e m => MonadExcept tag e (Trans.S.Lazy.StateT s m) where-    throw t = lift . throw t-    catch t = Trans.S.Lazy.liftCatch (catch t)--instance MonadExcept tag e m => MonadExcept tag e (Trans.S.Strict.StateT s m) where-    throw t = lift . throw t-    catch t = Trans.S.Strict.liftCatch (catch t)--instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (Trans.W.Lazy.WriterT w m) where-    throw t = lift . throw t-    catch t = Trans.W.Lazy.liftCatch (catch t)--instance (Monoid w, MonadExcept tag e m) => MonadExcept tag e (Trans.W.Strict.WriterT w m) where-    throw t = lift . throw t-    catch t = Trans.W.Strict.liftCatch (catch t)+instance ( Lift.LiftCatch t+         , Monad (t m)+         , MonadExcept tag e m+         ) => MonadExcept tag e (t m) where+    throw t = Lift.lift . throw t+    catch t = Lift.liftCatch (catch t)

@@ -16,7 +16,6 @@     , ExceptT     , exceptT     , runExceptT-    , mapExceptT     -- * Handle functions     , handle     , handleT@@ -53,11 +52,6 @@ -- | See 'Control.Monad.Ether.Except.runExceptT'. runExceptT :: ExceptT e m a -> m (Either e a) runExceptT = Explicit.runExceptT Proxy---- | See 'Control.Monad.Ether.Except.mapExceptT'.--- Note that due to implicit tagging the exception type cannot be changed.-mapExceptT :: (m (Either e a) -> n (Either e b)) -> ExceptT e m a -> ExceptT e n b-mapExceptT = Explicit.mapExceptT Proxy  -- | See 'Control.Monad.Ether.Except.handle'. handle :: (e -> a) -> Except e a -> a

@@ -18,7 +18,6 @@     , ReaderT     , readerT     , runReaderT-    , mapReaderT     ) where  import Data.Proxy@@ -41,10 +40,6 @@ -- | See 'Control.Monad.Ether.Reader.runReader'. runReader :: Reader r a -> r -> a runReader = Explicit.runReader Proxy---- | See 'Control.Monad.Ether.Reader.mapReaderT'.-mapReaderT :: (m a -> n b) -> ReaderT r m a -> ReaderT r n b-mapReaderT = Explicit.mapReaderT Proxy  -- | See 'Control.Monad.Ether.Reader.MonadReader'. type MonadReader r = Explicit.MonadReader r r

@@ -23,7 +23,6 @@     , runStateT     , evalStateT     , execStateT-    , mapStateT     ) where  import Data.Proxy@@ -62,10 +61,6 @@ -- | See 'Control.Monad.Ether.State.Lazy.execState'. execState :: State s a -> s -> s execState = Explicit.execState Proxy---- | See 'Control.Monad.Ether.State.Lazy.mapStateT'.-mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b-mapStateT = Explicit.mapStateT Proxy  -- | See 'Control.Monad.Ether.State.Lazy.MonadState'. type MonadState s = Explicit.MonadState s s

@@ -23,7 +23,6 @@     , runStateT     , evalStateT     , execStateT-    , mapStateT     ) where  import Data.Proxy@@ -62,10 +61,6 @@ -- | See 'Control.Monad.Ether.State.Strict.execState'. execState :: State s a -> s -> s execState = Explicit.execState Proxy---- | See 'Control.Monad.Ether.State.Strict.mapStateT'.-mapStateT :: (m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b-mapStateT = Explicit.mapStateT Proxy  -- | See 'Control.Monad.Ether.State.Strict.MonadState'. type MonadState s = Explicit.MonadState s s

@@ -13,7 +13,6 @@     , ReaderT     , readerT     , runReaderT-    , mapReaderT     ) where  import Control.Monad.Ether.Reader.Class

@@ -21,29 +21,11 @@ import Data.Monoid #endif -import Data.Proxy (Proxy(Proxy))-import Control.Monad.Trans (lift)--import Control.Monad.Trans.Ether.Writer (WriterT, mapWriterT)-import Control.Monad.Trans.Ether.Except (ExceptT, mapExceptT) import Control.Monad.Trans.Ether.Reader hiding (reader, ask, local) import qualified Control.Monad.Trans.Ether.Reader as R-import qualified Control.Monad.Trans.Ether.State.Lazy   as S.L-import qualified Control.Monad.Trans.Ether.State.Strict as S.S+import qualified Control.Monad.Trans.Lift.Local as Lift import qualified Control.Ether.Util as Util --- for mtl instances-import qualified Control.Monad.Trans.Cont          as Trans        (ContT    , liftLocal)-import qualified Control.Monad.Trans.Except        as Trans        (ExceptT  , mapExceptT)-import qualified Control.Monad.Trans.Identity      as Trans        (IdentityT, mapIdentityT)-import qualified Control.Monad.Trans.List          as Trans        (ListT    , mapListT)-import qualified Control.Monad.Trans.Maybe         as Trans        (MaybeT   , mapMaybeT)-import qualified Control.Monad.Trans.Reader        as Trans        (ReaderT  , mapReaderT)-import qualified Control.Monad.Trans.State.Lazy    as Trans.Lazy   (StateT   , mapStateT)-import qualified Control.Monad.Trans.State.Strict  as Trans.Strict (StateT   , mapStateT)-import qualified Control.Monad.Trans.Writer.Lazy   as Trans.Lazy   (WriterT  , mapWriterT)-import qualified Control.Monad.Trans.Writer.Strict as Trans.Strict (WriterT  , mapWriterT)- -- | See 'Control.Monad.Reader.MonadReader'. class Monad m => MonadReader tag r m | m tag -> r where @@ -84,66 +66,9 @@     local = R.local     reader = R.reader -instance MonadReader tag r m => MonadReader tag r (ReaderT tag' r' m) where-    ask t = lift (ask t)-    local t = mapReaderT Proxy . local t---- Instances for other tagged transformers--instance (Monoid w, MonadReader tag r m) => MonadReader tag r (WriterT tag' w m) where-    ask t = lift (ask t)-    local t = mapWriterT Proxy . local t--instance (MonadReader tag r m) => MonadReader tag r (S.L.StateT tag' s m) where-    ask t = lift (ask t)-    local t = S.L.mapStateT Proxy . local t--instance (MonadReader tag r m) => MonadReader tag r (S.S.StateT tag' s m) where-    ask t = lift (ask t)-    local t = S.S.mapStateT Proxy . local t--instance (MonadReader tag r m) => MonadReader tag r (ExceptT tag' e m) where-    ask t = lift (ask t)-    local t = mapExceptT Proxy . local t---- Instances for mtl transformers--instance MonadReader tag r m => MonadReader tag r (Trans.ContT r' m) where-    ask t = lift (ask t)-    local t = Trans.liftLocal (ask t) (local t)--instance MonadReader tag r m => MonadReader tag r (Trans.ExceptT e m) where-    ask t = lift (ask t)-    local t = Trans.mapExceptT . local t--instance MonadReader tag r m => MonadReader tag r (Trans.IdentityT m) where-    ask t = lift (ask t)-    local t = Trans.mapIdentityT . local t--instance MonadReader tag r m => MonadReader tag r (Trans.ListT m) where-    ask t = lift (ask t)-    local t = Trans.mapListT . local t--instance MonadReader tag r m => MonadReader tag r (Trans.MaybeT m) where-    ask t = lift (ask t)-    local t = Trans.mapMaybeT . local t--instance MonadReader tag r m => MonadReader tag r (Trans.ReaderT r' m) where-    ask t = lift (ask t)-    local t = Trans.mapReaderT . local t--instance MonadReader tag r m => MonadReader tag r (Trans.Lazy.StateT s m) where-    ask t = lift (ask t)-    local t = Trans.Lazy.mapStateT . local t--instance MonadReader tag r m => MonadReader tag r (Trans.Strict.StateT s m) where-    ask t = lift (ask t)-    local t = Trans.Strict.mapStateT . local t--instance (Monoid w, MonadReader tag r m) => MonadReader tag r (Trans.Lazy.WriterT w m) where-    ask t = lift (ask t)-    local t = Trans.Lazy.mapWriterT . local t--instance (Monoid w, MonadReader tag r m) => MonadReader tag r (Trans.Strict.WriterT w m) where-    ask t = lift (ask t)-    local t = Trans.Strict.mapWriterT . local t+instance ( Lift.LiftLocal t+         , Monad (t m)+         , MonadReader tag r m+         ) => MonadReader tag r (t m) where+    ask t = Lift.lift (ask t)+    local t = Lift.liftLocal (ask t) (local t)

@@ -18,7 +18,6 @@     , runStateT     , evalStateT     , execStateT-    , mapStateT     ) where  import Control.Monad.Ether.State.Class

@@ -18,7 +18,6 @@     , runStateT     , evalStateT     , execStateT-    , mapStateT     ) where  import Control.Monad.Ether.State.Class

@@ -16,7 +16,6 @@     , writerT     , runWriterT     , execWriterT-    , mapWriterT     ) where  import Control.Monad.Ether.Writer.Class

@@ -22,25 +22,10 @@ import Data.Monoid #endif -import Data.Proxy (Proxy(Proxy))-import Control.Monad.Trans (lift)- import Control.Monad.Trans.Ether.Writer hiding (writer, tell, listen, pass)-import qualified Control.Monad.Trans.Ether.Reader as R-import qualified Control.Monad.Trans.Ether.State.Lazy   as S.L-import qualified Control.Monad.Trans.Ether.State.Strict as S.S-import qualified Control.Monad.Trans.Ether.Except as E import qualified Control.Monad.Trans.Ether.Writer as W-import qualified Control.Ether.Util as Util---- for mtl instances-import qualified Control.Monad.Trans.Except        as Trans.E-import qualified Control.Monad.Trans.Identity      as Trans.I-import qualified Control.Monad.Trans.Maybe         as Trans.M-import qualified Control.Monad.Trans.Reader        as Trans.R-import qualified Control.Monad.Trans.State.Lazy    as Trans.S.Lazy-import qualified Control.Monad.Trans.State.Strict  as Trans.S.Strict-import qualified Control.Monad.Trans.Writer.Lazy   as Trans.W.Lazy+import qualified Control.Monad.Trans.Lift.Listen as Lift+import qualified Control.Monad.Trans.Lift.Pass   as Lift  -- | See 'Control.Monad.Writer.MonadWriter'. class (Monoid w, Monad m) => MonadWriter tag w m | m tag -> w where@@ -84,78 +69,13 @@     listen = W.listen     pass = W.pass -instance (Monoid w', MonadWriter tag w m) => MonadWriter tag w (WriterT tag' w' m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = W.liftListen Proxy (listen t)-    pass   t = W.liftPass Proxy (pass t)---- Instances for other tagged transformers--instance (MonadWriter tag w m) => MonadWriter tag w (R.ReaderT tag' r m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = R.mapReaderT Proxy (listen t)-    pass   t = R.mapReaderT Proxy (pass t)--instance (MonadWriter tag w m) => MonadWriter tag w (E.ExceptT tag' e m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = E.liftListen Proxy (listen t)-    pass   t = E.liftPass Proxy (pass t)--instance (MonadWriter tag w m) => MonadWriter tag w (S.L.StateT tag' e m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = S.L.liftListen Proxy (listen t)-    pass   t = S.L.liftPass Proxy (pass t)--instance (MonadWriter tag w m) => MonadWriter tag w (S.S.StateT tag' e m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = S.S.liftListen Proxy (listen t)-    pass   t = S.S.liftPass Proxy (pass t)---- Instances for mtl transformers--instance (MonadWriter tag w m) => MonadWriter tag w (Trans.E.ExceptT e m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = Trans.E.liftListen (listen t)-    pass   t = Trans.E.liftPass (pass t)--instance (MonadWriter tag w m) => MonadWriter tag w (Trans.I.IdentityT m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = Trans.I.mapIdentityT (listen t)-    pass   t = Trans.I.mapIdentityT (pass t)--instance (MonadWriter tag w m) => MonadWriter tag w (Trans.M.MaybeT m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = Trans.M.liftListen (listen t)-    pass   t = Trans.M.liftPass (pass t)--instance (MonadWriter tag w m) => MonadWriter tag w (Trans.R.ReaderT r m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = Trans.R.mapReaderT (listen t)-    pass   t = Trans.R.mapReaderT (pass t)--instance (MonadWriter tag w m) => MonadWriter tag w (Trans.S.Lazy.StateT s m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = Trans.S.Lazy.liftListen (listen t)-    pass   t = Trans.S.Lazy.liftPass (pass t)--instance (MonadWriter tag w m) => MonadWriter tag w (Trans.S.Strict.StateT s m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = Trans.S.Strict.liftListen (listen t)-    pass   t = Trans.S.Strict.liftPass (pass t)--instance (Monoid w', MonadWriter tag w m) => MonadWriter tag w (Trans.W.Lazy.WriterT w' m) where-    writer t = lift . writer t-    tell   t = lift . tell t-    listen t = Util.liftListen_WriterT (listen t)-    pass   t = Util.liftPass_WriterT (pass t)+instance ( Lift.LiftListen t+         , Lift.LiftPass   t+         , Monad (t m)+         , MonadWriter tag w m+         , Monoid w+         ) => MonadWriter tag w (t m) where+    writer t = Lift.lift . writer t+    tell   t = Lift.lift . tell t+    listen t = Lift.liftListen (listen t)+    pass   t = Lift.liftPass (pass t)

@@ -18,33 +18,33 @@     , ExceptT     , exceptT     , runExceptT-    , mapExceptT     -- * Exception operations     , throw     , catch-    -- * Lifting other operations-    , liftCallCC-    , liftListen-    , liftPass-    , liftCatch     ) where -import Data.Proxy (Proxy(Proxy)) import Data.Functor.Identity (Identity(..))-import Data.Coerce (coerce) import Control.Applicative import Control.Monad (MonadPlus) import Control.Monad.Fix (MonadFix) import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Morph (MFunctor, MMonad) import Control.Ether.Tagged (Taggable(..), Tagged(..))-import qualified Control.Ether.Util as Util import GHC.Generics (Generic) import qualified Control.Newtype as NT -import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Base as MB+import qualified Control.Monad.Trans.Control as MC import qualified Control.Monad.Trans.Except as Trans +import qualified Control.Monad.Trans.Lift.StT    as Lift+import qualified Control.Monad.Trans.Lift.Local  as Lift+import qualified Control.Monad.Trans.Lift.Catch  as Lift+import qualified Control.Monad.Trans.Lift.Listen as Lift+import qualified Control.Monad.Trans.Lift.Pass   as Lift+import qualified Control.Monad.Trans.Lift.CallCC as Lift+ import qualified Control.Monad.Cont.Class    as Class import qualified Control.Monad.Reader.Class  as Class import qualified Control.Monad.State.Class   as Class@@ -68,14 +68,44 @@ -- -- The 'return' function returns a normal value, while '>>=' exits on -- the first exception.- newtype ExceptT tag e m a = ExceptT (Trans.ExceptT e m a)     deriving ( Generic              , Functor, Applicative, Alternative, Monad, MonadPlus-             , MonadFix, MonadTrans, MonadIO )+             , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )  instance NT.Newtype (ExceptT tag e m a) +instance MB.MonadBase b m => MB.MonadBase b (ExceptT tag e m) where+    liftBase = MB.liftBaseDefault++instance MC.MonadTransControl (ExceptT tag e) where+    type StT (ExceptT tag e) a = MC.StT (Trans.ExceptT e) a+    liftWith = MC.defaultLiftWith NT.pack NT.unpack+    restoreT = MC.defaultRestoreT NT.pack++instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ExceptT tag e m) where+    type StM (ExceptT tag e m) a = MC.ComposeSt (ExceptT tag e) m a+    liftBaseWith = MC.defaultLiftBaseWith+    restoreM = MC.defaultRestoreM++type instance Lift.StT (ExceptT tag e) a = MC.StT (ExceptT tag e) a++instance Lift.LiftLocal (ExceptT tag e) where+    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack++instance Lift.LiftCatch (ExceptT tag e) where+    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack++instance Lift.LiftListen (ExceptT tag e) where+    liftListen = Lift.defaultLiftListen NT.pack NT.unpack++instance Lift.LiftPass (ExceptT tag e) where+    liftPass = Lift.defaultLiftPass NT.pack NT.unpack++instance Lift.LiftCallCC (ExceptT tag e) where+    liftCallCC  = Lift.defaultLiftCallCC NT.pack NT.unpack+    liftCallCC' = Lift.defaultLiftCallCC NT.pack NT.unpack+ instance Taggable (ExceptT tag e m) where     type Tag (ExceptT tag e m) = 'Just tag     type Inner (ExceptT tag e m) = 'Just m@@ -96,46 +126,20 @@ runExceptT :: proxy tag -> ExceptT tag e m a -> m (Either e a) runExceptT t = Trans.runExceptT . untagged t --- | Transforms the computation inside an 'ExceptT'.------ * @'runExceptT' tag ('mapExceptT' tag f m) = f ('runExceptT' tag m)@-mapExceptT-    :: proxy tag-    -> (m (Either e a) -> n (Either e' b))-    -> ExceptT tag e  m a-    -> ExceptT tag e' n b-mapExceptT t f m = tagged t $ Trans.mapExceptT f (coerce m)- -- | Is used within a monadic computation to begin exception processing. throw :: Monad m => proxy tag -> e -> ExceptT tag e m a throw t = tagged t . Trans.throwE  -- | A handler function to handle previous exceptions and return to normal execution. catch :: Monad m => proxy tag -> ExceptT tag e m a -> (e -> ExceptT tag e m a) -> ExceptT tag e m a-catch t m h = tagged t $ Trans.catchE (coerce m) (coerce . h)---- | Lift a @callCC@ operation to the new monad.-liftCallCC :: proxy tag -> Sig.CallCC m (Either e a) (Either e b) -> Sig.CallCC (ExceptT tag e m) a b-liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)---- | Lift a @listen@ operation to the new monad.-liftListen :: Monad m => proxy tag -> Sig.Listen w m (Either e a) -> Sig.Listen w (ExceptT tag e m) a-liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)---- | Lift a @pass@ operation to the new monad.-liftPass :: Monad m => proxy tag -> Sig.Pass w m (Either e a) -> Sig.Pass w (ExceptT tag e m) a-liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)---- | Lift a @catchE@ operation to the new monad.-liftCatch :: proxy tag -> Sig.Catch e m (Either e' a) -> Sig.Catch e (ExceptT tag e' m) a-liftCatch t catchE m h = tagged t $ Util.liftCatch_ExceptT catchE (coerce m) (coerce h)+catch t m h = tagged t $ Trans.catchE (untagged t m) (untagged t . h)  instance Class.MonadCont m => Class.MonadCont (ExceptT tag e m) where-    callCC = liftCallCC Proxy Class.callCC+    callCC = Lift.liftCallCC Class.callCC  instance Class.MonadReader r m => Class.MonadReader r (ExceptT tag e m) where     ask = lift Class.ask-    local = mapExceptT Proxy . Class.local+    local = Lift.liftLocal Class.ask Class.local     reader = lift . Class.reader  instance Class.MonadState s m => Class.MonadState s (ExceptT tag e m) where@@ -146,9 +150,9 @@ instance Class.MonadWriter w m => Class.MonadWriter w (ExceptT tag e m) where     writer = lift . Class.writer     tell   = lift . Class.tell-    listen = liftListen Proxy Class.listen-    pass   = liftPass Proxy Class.pass+    listen = Lift.liftListen Class.listen+    pass   = Lift.liftPass Class.pass  instance Class.MonadError e' m => Class.MonadError e' (ExceptT tag e m) where     throwError = lift . Class.throwError-    catchError = liftCatch Proxy Class.catchError+    catchError = Lift.liftCatch Class.catchError

@@ -18,31 +18,33 @@     , ReaderT     , readerT     , runReaderT-    , mapReaderT-    , withReaderT     -- * Reader operations     , ask     , local-    -- * Lifting other operations-    , liftCatch-    , liftCallCC     ) where -import Data.Proxy (Proxy(Proxy)) import Data.Functor.Identity (Identity(..))-import Data.Coerce (coerce) import Control.Applicative import Control.Monad (MonadPlus) import Control.Monad.Fix (MonadFix) import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Morph (MFunctor, MMonad) import Control.Ether.Tagged (Taggable(..), Tagged(..)) import GHC.Generics (Generic) import qualified Control.Newtype as NT -import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Base as MB+import qualified Control.Monad.Trans.Control as MC import qualified Control.Monad.Trans.Reader as Trans +import qualified Control.Monad.Trans.Lift.StT    as Lift+import qualified Control.Monad.Trans.Lift.Local  as Lift+import qualified Control.Monad.Trans.Lift.Catch  as Lift+import qualified Control.Monad.Trans.Lift.Listen as Lift+import qualified Control.Monad.Trans.Lift.Pass   as Lift+import qualified Control.Monad.Trans.Lift.CallCC as Lift+ import qualified Control.Monad.Cont.Class    as Class import qualified Control.Monad.Reader.Class  as Class import qualified Control.Monad.State.Class   as Class@@ -65,10 +67,41 @@ newtype ReaderT tag r m a = ReaderT (Trans.ReaderT r m a)     deriving ( Generic              , Functor, Applicative, Alternative, Monad, MonadPlus-             , MonadFix, MonadTrans, MonadIO )+             , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )  instance NT.Newtype (ReaderT tag r m a) +instance MB.MonadBase b m => MB.MonadBase b (ReaderT tag r m) where+    liftBase = MB.liftBaseDefault++instance MC.MonadTransControl (ReaderT tag r) where+    type StT (ReaderT tag r) a = MC.StT (Trans.ReaderT r) a+    liftWith = MC.defaultLiftWith NT.pack NT.unpack+    restoreT = MC.defaultRestoreT NT.pack++instance MC.MonadBaseControl b m => MC.MonadBaseControl b (ReaderT tag r m) where+    type StM (ReaderT tag r m) a = MC.ComposeSt (ReaderT tag r) m a+    liftBaseWith = MC.defaultLiftBaseWith+    restoreM = MC.defaultRestoreM++type instance Lift.StT (ReaderT tag r) a = MC.StT (ReaderT tag r) a++instance Lift.LiftLocal (ReaderT tag r) where+    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack++instance Lift.LiftCatch (ReaderT tag r) where+    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack++instance Lift.LiftListen (ReaderT tag r) where+    liftListen = Lift.defaultLiftListen NT.pack NT.unpack++instance Lift.LiftPass (ReaderT tag r) where+    liftPass = Lift.defaultLiftPass NT.pack NT.unpack++instance Lift.LiftCallCC (ReaderT tag r) where+    liftCallCC  = Lift.defaultLiftCallCC  NT.pack NT.unpack+    liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack+ instance Taggable (ReaderT tag r m) where     type Tag (ReaderT tag r m) = 'Just tag     type Inner (ReaderT tag r m) = 'Just m@@ -95,33 +128,6 @@ runReader :: proxy tag -> Reader tag r a -> r -> a runReader t = Trans.runReader . untagged t --- | Transform the computation inside a 'ReaderT'.------ * @'runReaderT' tag ('mapReaderT' tag f m) = f . 'runReaderT' tag m@-mapReaderT :: proxy tag -> (m a -> n b) -> ReaderT tag r m a -> ReaderT tag r n b-mapReaderT t f m = tagged t $ Trans.mapReaderT f (coerce m)---- | Execute a computation in a modified environment--- (a more general version of 'local').------ * @'runReaderT' tag ('withReaderT' tag f m) = 'runReaderT' tag m . f@-withReaderT-    :: proxy tag-    -> (r' -> r)-    -- ^ The function to modify the environment.-    -> ReaderT tag r  m a-    -- ^ Computation to run in the modified environment.-    -> ReaderT tag r' m a-withReaderT t f m = tagged t $ Trans.withReaderT f (coerce m)---- | Lift a @catchE@ operation to the new monad.-liftCatch :: proxy tag -> Sig.Catch e m a -> Sig.Catch e (ReaderT tag r m) a-liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)---- | Lift a @callCC@ operation to the new monad.-liftCallCC :: proxy tag -> Sig.CallCC m a b -> Sig.CallCC (ReaderT tag r m) a b-liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)- -- | Fetch the value of the environment. ask :: Monad m => proxy tag -> ReaderT tag r m r ask t = tagged t Trans.ask@@ -137,16 +143,16 @@     -> ReaderT tag r m a     -- ^ Computation to run in the modified environment.     -> ReaderT tag r m a-local = withReaderT+local t f m = tagged t $ Trans.withReaderT f (untagged t m)  -- Instances for mtl classes  instance Class.MonadCont m => Class.MonadCont (ReaderT tag r m) where-    callCC = liftCallCC Proxy Class.callCC+    callCC = Lift.liftCallCC Class.callCC  instance Class.MonadReader r' m => Class.MonadReader r' (ReaderT tag r m) where     ask = lift Class.ask-    local = mapReaderT Proxy . Class.local+    local = Lift.liftLocal Class.ask Class.local     reader = lift . Class.reader  instance Class.MonadState s m => Class.MonadState s (ReaderT tag r m) where@@ -157,9 +163,9 @@ instance Class.MonadWriter w m => Class.MonadWriter w (ReaderT tag r m) where     writer = lift . Class.writer     tell   = lift . Class.tell-    listen = mapReaderT Proxy Class.listen-    pass   = mapReaderT Proxy Class.pass+    listen = Lift.liftListen Class.listen+    pass   = Lift.liftPass Class.pass  instance Class.MonadError e m => Class.MonadError e (ReaderT tag r m) where     throwError = lift . Class.throwError-    catchError = liftCatch Proxy Class.catchError+    catchError = Lift.liftCatch Class.catchError

@@ -22,32 +22,33 @@     , runStateT     , evalStateT     , execStateT-    , mapStateT     -- * State operations     , get     , put-    -- * Litfing other operations-    , liftCatch-    , liftCallCC'-    , liftListen-    , liftPass     ) where -import Data.Proxy (Proxy(Proxy)) import Data.Functor.Identity (Identity(..))-import Data.Coerce (coerce) import Control.Applicative import Control.Monad (MonadPlus) import Control.Monad.Fix (MonadFix) import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Morph (MFunctor) import Control.Ether.Tagged (Taggable(..), Tagged(..)) import GHC.Generics (Generic) import qualified Control.Newtype as NT -import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Base as MB+import qualified Control.Monad.Trans.Control as MC import qualified Control.Monad.Trans.State.Lazy as Trans +import qualified Control.Monad.Trans.Lift.StT    as Lift+import qualified Control.Monad.Trans.Lift.Local  as Lift+import qualified Control.Monad.Trans.Lift.Catch  as Lift+import qualified Control.Monad.Trans.Lift.Listen as Lift+import qualified Control.Monad.Trans.Lift.Pass   as Lift+import qualified Control.Monad.Trans.Lift.CallCC as Lift+ import qualified Control.Monad.Cont.Class    as Class import qualified Control.Monad.Reader.Class  as Class import qualified Control.Monad.State.Class   as Class@@ -70,10 +71,41 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)     deriving ( Generic              , Functor, Applicative, Alternative, Monad, MonadPlus-             , MonadFix, MonadTrans, MonadIO )+             , MonadFix, MonadTrans, MonadIO, MFunctor )  instance NT.Newtype (StateT tag s m a) +instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where+    liftBase = MB.liftBaseDefault++instance MC.MonadTransControl (StateT tag s) where+    type StT (StateT tag s) a = MC.StT (Trans.StateT s) a+    liftWith = MC.defaultLiftWith NT.pack NT.unpack+    restoreT = MC.defaultRestoreT NT.pack++instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where+    type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a+    liftBaseWith = MC.defaultLiftBaseWith+    restoreM = MC.defaultRestoreM++type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a++instance Lift.LiftLocal (StateT tag s) where+    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack++instance Lift.LiftCatch (StateT tag s) where+    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack++instance Lift.LiftListen (StateT tag s) where+    liftListen = Lift.defaultLiftListen NT.pack NT.unpack++instance Lift.LiftPass (StateT tag s) where+    liftPass = Lift.defaultLiftPass NT.pack NT.unpack++instance Lift.LiftCallCC (StateT tag s) where+    liftCallCC  = Lift.defaultLiftCallCC  NT.pack NT.unpack+    liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack+ instance Taggable (StateT tag s m) where     type Tag (StateT tag s m) = 'Just tag     type Inner (StateT tag s m) = 'Just m@@ -120,12 +152,6 @@ execState :: proxy tag -> State tag s a -> s -> s execState t = Trans.execState . untagged t --- | Transform the computation inside a 'StateT'.------ * @'runStateT' tag ('mapStateT' tag f m) = f . 'runStateT' tag m@-mapStateT :: proxy tag -> (m (a, s) -> n (b, s)) -> StateT tag s m a -> StateT tag s n b-mapStateT t f m = tagged t $ Trans.mapStateT f (coerce m)- -- | Fetch the current value of the state within the monad. get :: Monad m => proxy tag -> StateT tag s m s get t = tagged t Trans.get@@ -134,32 +160,14 @@ put :: Monad m => proxy tag -> s -> StateT tag s m () put t = tagged t . Trans.put --- | Lift a @catchE@ operation to the new monad.-liftCatch :: proxy tag -> Sig.Catch e m (a, s) -> Sig.Catch e (StateT tag s m) a-liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)---- | Lift a @listen@ operation to the new monad.-liftListen :: Monad m => proxy tag -> Sig.Listen w m (a, s) -> Sig.Listen w (StateT tag s m) a-liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)---- | In-situ lifting of a @callCC@ operation to the new monad.--- This version uses the current state on entering the continuation.--- It does not satisfy the uniformity property (see "Control.Monad.Signatures").-liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b-liftCallCC' t callCC f = tagged t $ Trans.liftCallCC' callCC (coerce f)---- | Lift a @pass@ operation to the new monad.-liftPass :: Monad m => proxy tag -> Sig.Pass w m (a,s) -> Sig.Pass w (StateT tag s m) a-liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)- -- Instances for mtl classes  instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where-    callCC = liftCallCC' Proxy Class.callCC+    callCC = Lift.liftCallCC' Class.callCC  instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where     ask = lift Class.ask-    local = mapStateT Proxy . Class.local+    local = Lift.liftLocal Class.ask Class.local     reader = lift . Class.reader  instance Class.MonadState s' m => Class.MonadState s' (StateT tag s m) where@@ -170,9 +178,9 @@ instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s m) where     writer = lift . Class.writer     tell   = lift . Class.tell-    listen = liftListen Proxy Class.listen-    pass   = liftPass Proxy Class.pass+    listen = Lift.liftListen Class.listen+    pass   = Lift.liftPass Class.pass  instance Class.MonadError e m => Class.MonadError e (StateT tag s m) where     throwError = lift . Class.throwError-    catchError = liftCatch Proxy Class.catchError+    catchError = Lift.liftCatch Class.catchError

@@ -22,32 +22,33 @@     , runStateT     , evalStateT     , execStateT-    , mapStateT     -- * State operations     , get     , put-    -- * Litfing other operations-    , liftCatch-    , liftCallCC'-    , liftListen-    , liftPass     ) where -import Data.Proxy (Proxy(Proxy)) import Data.Functor.Identity (Identity(..))-import Data.Coerce (coerce) import Control.Applicative import Control.Monad (MonadPlus) import Control.Monad.Fix (MonadFix) import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Morph (MFunctor) import Control.Ether.Tagged (Taggable(..), Tagged(..)) import GHC.Generics (Generic) import qualified Control.Newtype as NT -import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Base as MB+import qualified Control.Monad.Trans.Control as MC import qualified Control.Monad.Trans.State.Strict as Trans +import qualified Control.Monad.Trans.Lift.StT    as Lift+import qualified Control.Monad.Trans.Lift.Local  as Lift+import qualified Control.Monad.Trans.Lift.Catch  as Lift+import qualified Control.Monad.Trans.Lift.Listen as Lift+import qualified Control.Monad.Trans.Lift.Pass   as Lift+import qualified Control.Monad.Trans.Lift.CallCC as Lift+ import qualified Control.Monad.Cont.Class    as Class import qualified Control.Monad.Reader.Class  as Class import qualified Control.Monad.State.Class   as Class@@ -70,10 +71,41 @@ newtype StateT tag s m a = StateT (Trans.StateT s m a)     deriving ( Generic              , Functor, Applicative, Alternative, Monad, MonadPlus-             , MonadFix, MonadTrans, MonadIO )+             , MonadFix, MonadTrans, MonadIO, MFunctor )  instance NT.Newtype (StateT tag s m a) +instance MB.MonadBase b m => MB.MonadBase b (StateT tag s m) where+    liftBase = MB.liftBaseDefault++instance MC.MonadTransControl (StateT tag s) where+    type StT (StateT tag s) a = MC.StT (Trans.StateT s) a+    liftWith = MC.defaultLiftWith NT.pack NT.unpack+    restoreT = MC.defaultRestoreT NT.pack++instance MC.MonadBaseControl b m => MC.MonadBaseControl b (StateT tag s m) where+    type StM (StateT tag s m) a = MC.ComposeSt (StateT tag s) m a+    liftBaseWith = MC.defaultLiftBaseWith+    restoreM = MC.defaultRestoreM++type instance Lift.StT (StateT tag s) a = MC.StT (StateT tag s) a++instance Lift.LiftLocal (StateT tag s) where+    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack++instance Lift.LiftCatch (StateT tag s) where+    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack++instance Lift.LiftListen (StateT tag s) where+    liftListen = Lift.defaultLiftListen NT.pack NT.unpack++instance Lift.LiftPass (StateT tag s) where+    liftPass = Lift.defaultLiftPass NT.pack NT.unpack++instance Lift.LiftCallCC (StateT tag s) where+    liftCallCC  = Lift.defaultLiftCallCC  NT.pack NT.unpack+    liftCallCC' = Lift.defaultLiftCallCC' NT.pack NT.unpack+ instance Taggable (StateT tag s m) where     type Tag (StateT tag s m) = 'Just tag     type Inner (StateT tag s m) = 'Just m@@ -120,12 +152,6 @@ execState :: proxy tag -> State tag s a -> s -> s execState t = Trans.execState . untagged t --- | Transform the computation inside a 'StateT'.------ * @'runStateT' tag ('mapStateT' tag f m) = f . 'runStateT' tag m@-mapStateT :: proxy tag -> (m (a, s) -> n (b, s)) -> StateT tag s m a -> StateT tag s n b-mapStateT t f m = tagged t $ Trans.mapStateT f (coerce m)- -- | Fetch the current value of the state within the monad. get :: Monad m => proxy tag -> StateT tag s m s get t = tagged t Trans.get@@ -134,32 +160,14 @@ put :: Monad m => proxy tag -> s -> StateT tag s m () put t = tagged t . Trans.put --- | Lift a @catchE@ operation to the new monad.-liftCatch :: proxy tag -> Sig.Catch e m (a, s) -> Sig.Catch e (StateT tag s m) a-liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)---- | Lift a @listen@ operation to the new monad.-liftListen :: Monad m => proxy tag -> Sig.Listen w m (a, s) -> Sig.Listen w (StateT tag s m) a-liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)---- | In-situ lifting of a @callCC@ operation to the new monad.--- This version uses the current state on entering the continuation.--- It does not satisfy the uniformity property (see "Control.Monad.Signatures").-liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b-liftCallCC' t callCC f = tagged t $ Trans.liftCallCC' callCC (coerce f)---- | Lift a @pass@ operation to the new monad.-liftPass :: Monad m => proxy tag -> Sig.Pass w m (a,s) -> Sig.Pass w (StateT tag s m) a-liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)- -- Instances for mtl classes  instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where-    callCC = liftCallCC' Proxy Class.callCC+    callCC = Lift.liftCallCC' Class.callCC  instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where     ask = lift Class.ask-    local = mapStateT Proxy . Class.local+    local = Lift.liftLocal Class.ask Class.local     reader = lift . Class.reader  instance Class.MonadState s' m => Class.MonadState s' (StateT tag s m) where@@ -170,9 +178,9 @@ instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s m) where     writer = lift . Class.writer     tell   = lift . Class.tell-    listen = liftListen Proxy Class.listen-    pass   = liftPass Proxy Class.pass+    listen = Lift.liftListen Class.listen+    pass   = Lift.liftPass Class.pass  instance Class.MonadError e m => Class.MonadError e (StateT tag s m) where     throwError = lift . Class.throwError-    catchError = liftCatch Proxy Class.catchError+    catchError = Lift.liftCatch Class.catchError

@@ -21,38 +21,38 @@     , writerT     , runWriterT     , execWriterT-    , mapWriterT     -- * Writer operations     , tell     , listen     , pass-    -- * Lifting other operations-    , liftCallCC-    , liftCatch-    , liftListen-    , liftPass     ) where  #if __GLASGOW_HASKELL__ < 710 import Data.Monoid #endif -import Data.Proxy (Proxy(Proxy)) import Data.Functor.Identity (Identity(..))-import Data.Coerce (coerce) import Control.Applicative import Control.Monad (MonadPlus) import Control.Monad.Fix (MonadFix) import Control.Monad.Trans.Class (MonadTrans, lift) import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Morph (MFunctor, MMonad) import Control.Ether.Tagged (Taggable(..), Tagged(..))-import qualified Control.Ether.Util as Util import GHC.Generics (Generic) import qualified Control.Newtype as NT -import qualified Control.Monad.Signatures as Sig+import qualified Control.Monad.Base as MB+import qualified Control.Monad.Trans.Control as MC import qualified Control.Monad.Trans.Writer.Lazy as Trans +import qualified Control.Monad.Trans.Lift.StT    as Lift+import qualified Control.Monad.Trans.Lift.Local  as Lift+import qualified Control.Monad.Trans.Lift.Catch  as Lift+import qualified Control.Monad.Trans.Lift.Listen as Lift+import qualified Control.Monad.Trans.Lift.Pass   as Lift+import qualified Control.Monad.Trans.Lift.CallCC as Lift+ import qualified Control.Monad.Cont.Class    as Class import qualified Control.Monad.Reader.Class  as Class import qualified Control.Monad.State.Class   as Class@@ -74,10 +74,41 @@ newtype WriterT tag w m a = WriterT (Trans.WriterT w m a)     deriving ( Generic              , Functor, Applicative, Alternative, Monad, MonadPlus-             , MonadFix, MonadTrans, MonadIO )+             , MonadFix, MonadTrans, MonadIO, MFunctor, MMonad )  instance NT.Newtype (WriterT tag w m a) +instance (Monoid w, MB.MonadBase b m) => MB.MonadBase b (WriterT tag w m) where+    liftBase = MB.liftBaseDefault++instance Monoid w => MC.MonadTransControl (WriterT tag w) where+    type StT (WriterT tag w) a = MC.StT (Trans.WriterT w) a+    liftWith = MC.defaultLiftWith NT.pack NT.unpack+    restoreT = MC.defaultRestoreT NT.pack++instance (Monoid w, MC.MonadBaseControl b m) => MC.MonadBaseControl b (WriterT tag w m) where+    type StM (WriterT tag w m) a = MC.ComposeSt (WriterT tag w) m a+    liftBaseWith = MC.defaultLiftBaseWith+    restoreM = MC.defaultRestoreM++type instance Lift.StT (WriterT tag w) a = MC.StT (WriterT tag w) a++instance Monoid w => Lift.LiftLocal (WriterT tag w) where+    liftLocal = Lift.defaultLiftLocal NT.pack NT.unpack++instance Monoid w => Lift.LiftCatch (WriterT tag w) where+    liftCatch = Lift.defaultLiftCatch NT.pack NT.unpack++instance Monoid w => Lift.LiftListen (WriterT tag w) where+    liftListen = Lift.defaultLiftListen NT.pack NT.unpack++instance Monoid w' => Lift.LiftPass (WriterT tag w') where+    liftPass = Lift.defaultLiftPass NT.pack NT.unpack++instance Monoid w => Lift.LiftCallCC (WriterT tag w) where+    liftCallCC  = Lift.defaultLiftCallCC NT.pack NT.unpack+    liftCallCC' = Lift.defaultLiftCallCC NT.pack NT.unpack+ instance Taggable (WriterT tag w m) where     type Tag (WriterT tag w m) = 'Just tag     type Inner (WriterT tag w m) = 'Just m@@ -114,47 +145,25 @@ execWriter :: proxy tag -> Writer tag w a -> w execWriter t = Trans.execWriter . untagged t --- | Transform the computation inside a 'WriterT'.------ * @'runWriterT' tag ('mapWriterT' tag f m) = f ('runWriterT' tag m)@-mapWriterT :: proxy tag -> (m (a, w) -> n (b, w')) -> WriterT tag w m a -> WriterT tag w' n b-mapWriterT t f m = tagged t $ Trans.mapWriterT f (coerce m)- -- | Appends a value to the accumulator within the monad. tell :: Monad m => proxy tag -> w -> WriterT tag w m () tell t w = writer t ((), w)  -- | Executes an action and adds its accumulator to the value of the computation. listen :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m a -> WriterT tag w m (a, w)-listen t m = tagged t $ Trans.listen (coerce m)+listen t m = tagged t $ Trans.listen (untagged t m)  -- | Executes an action which returns a value and a function, and returns the -- value, applying the function to the accumulator. pass :: (Monoid w, Monad m) => proxy tag -> WriterT tag w m (a, w -> w) -> WriterT tag w m a-pass t m = tagged t $ Trans.pass (coerce m)---- | Lift a @catchE@ operation to the new monad.-liftCatch :: proxy tag -> Sig.Catch e m (a, w) -> Sig.Catch e (WriterT tag w m) a-liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)---- | Lift a @callCC@ operation to the new monad.-liftCallCC :: Monoid w => proxy tag -> Sig.CallCC m (a, w) (b, w) -> Sig.CallCC (WriterT tag w m) a b-liftCallCC t callCC f = tagged t $ Trans.liftCallCC callCC (coerce f)---- | Lift a @listen@ operation to the new monad.-liftListen :: Monad m => proxy tag -> Sig.Listen w' m (a, w) -> Sig.Listen w' (WriterT tag w m) a-liftListen t f m = tagged t $ Util.liftListen_WriterT f (coerce m)---- | Lift a @pass@ operation to the new monad.-liftPass :: Monad m => proxy tag -> Sig.Pass w' m (a, w) -> Sig.Pass w' (WriterT tag w m) a-liftPass t f m = tagged t $ Util.liftPass_WriterT f (coerce m)+pass t m = tagged t $ Trans.pass (untagged t m)  instance (Monoid w, Class.MonadCont m) => Class.MonadCont (WriterT tag w m) where-    callCC = liftCallCC Proxy Class.callCC+    callCC = Lift.liftCallCC Class.callCC  instance (Monoid w, Class.MonadReader r m) => Class.MonadReader r (WriterT tag w m) where     ask = lift Class.ask-    local = mapWriterT Proxy . Class.local+    local = Lift.liftLocal Class.ask Class.local     reader = lift . Class.reader  instance (Monoid w, Class.MonadState s m) => Class.MonadState s (WriterT tag w m) where@@ -165,9 +174,9 @@ instance (Monoid w, Class.MonadWriter w' m) => Class.MonadWriter w' (WriterT tag w m) where     writer = lift . Class.writer     tell   = lift . Class.tell-    listen = liftListen Proxy Class.listen-    pass   = liftPass Proxy Class.pass+    listen = Lift.liftListen Class.listen+    pass   = Lift.liftPass Class.pass  instance (Monoid w, Class.MonadError e m) => Class.MonadError e (WriterT tag w m) where     throwError = lift . Class.throwError-    catchError = liftCatch Proxy Class.catchError+    catchError = Lift.liftCatch Class.catchError