deriving-trans 0.2.2.1 → 0.3.0.0

raw patch · 4 files changed

+164/−29 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• deriving-trans.cabal +1/−1
• src/Control/Monad/Trans/Compose.hs +134/−28
• src/Control/Monad/Trans/Elevator.hs +19/−0

@@ -1,5 +1,15 @@ # Revision history for deriving-trans +## 0.3.0.0 *04 Feb 2022*++* Add "base-case" instances for both lazy and strict transformers (from mtl) to `ComposeT`.+* Add `Alternative` and `MonadPlus` instances to `Elevator`.+* Add `MonadFail` instance to `Elevator`.+* Add `MonadCont` instances to `Elevator` and `ComposeT`.+* Add `MonadCont` "base-case" instance for `ContT` to `ComposeT`.+* Add `MonadRWS` instances to `Elevator` and `ComposeT`. It's not quite clear, whether this is necessary+* Add "base-case" instances for `RWST` to `ComposeT`.+ ## 0.2.2.1 *01 Feb 2022*  * Polish Haddock comments.

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                deriving-trans-version:             0.2.2.1+version:             0.3.0.0 synopsis:            Derive instances for monad transformer stacks description:         Implementing instances for monad transformer stacks can be tedious.                      <https://hackage.haskell.org/package/mtl mtl> defines each instance for each

@@ -3,12 +3,25 @@ module Control.Monad.Trans.Compose where  import Control.Monad.Base-import Control.Monad.Except-import Control.Monad.Reader-import Control.Monad.State+import Control.Monad.Cont.Class+import Control.Monad.Error.Class+import Control.Monad.IO.Class+import Control.Monad.Reader.Class+import Control.Monad.RWS.Class (MonadRWS)+import Control.Monad.State.Class+import Control.Monad.Trans.Class import Control.Monad.Trans.Control import Control.Monad.Trans.Elevator-import Control.Monad.Writer+import qualified Control.Monad.Trans.Cont as T+import qualified Control.Monad.Trans.Except as T+import qualified Control.Monad.Trans.RWS.Lazy as LT+import qualified Control.Monad.Trans.RWS.Strict as ST+import qualified Control.Monad.Trans.Reader as T+import qualified Control.Monad.Trans.State.Lazy as LT+import qualified Control.Monad.Trans.State.Strict as ST+import qualified Control.Monad.Trans.Writer.Lazy as LT+import qualified Control.Monad.Trans.Writer.Strict as ST+import Control.Monad.Writer.Class import Data.Kind  -- * 'ComposeT'@@ -76,14 +89,29 @@   instance {-# OVERLAPPABLE #-}     ( Monad (t1 (t2 m))     , MonadTransControl t1+    , MonadCont (t2 m)+    ) => MonadCont (ComposeT t1 t2 m)++-- | Set by 'T.ContT'.+deriving via T.ContT r (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    ) => MonadCont (ComposeT (T.ContT r) t2 m)++-- | /OVERLAPPABLE/.+-- Elevated to @(t2 m)@.+deriving via Elevator t1 (t2 (m :: * -> *))+  instance {-# OVERLAPPABLE #-}+    ( Monad (t1 (t2 m))+    , MonadTransControl t1     , MonadError e (t2 m)     ) => MonadError e (ComposeT t1 t2 m) --- | Set by 'ExceptT'.-deriving via ExceptT e (t2 (m :: * -> *))+-- | Set by 'T.ExceptT'.+deriving via T.ExceptT e (t2 (m :: * -> *))   instance     ( Monad (t2 m)-    ) => MonadError e ((ComposeT (ExceptT e) t2) m)+    ) => MonadError e (ComposeT (T.ExceptT e) t2 m)  -- | /OVERLAPPABLE/. -- Elevated to @(t2 m)@.@@ -94,27 +122,84 @@     , MonadReader r (t2 m)     ) => MonadReader r (ComposeT t1 t2 m) --- | Set by 'ReaderT'.-deriving via ReaderT r (t2 (m :: * -> *))+-- | Set by 'T.ReaderT'.+deriving via T.ReaderT r (t2 (m :: * -> *))   instance     ( Monad (t2 m)-    ) => MonadReader r ((ComposeT (ReaderT r) t2) m)+    ) => MonadReader r (ComposeT (T.ReaderT r) t2 m) +-- | Set by 'LT.RWST'.+deriving via LT.RWST r w s (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    , Monoid w+    ) => MonadReader r (ComposeT (LT.RWST r w s) t2 m)++-- | Set by 'ST.RWST'.+deriving via ST.RWST r w s (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    , Monoid w+    ) => MonadReader r (ComposeT (ST.RWST r w s) t2 m)+ -- | /OVERLAPPABLE/. -- Elevated to @(t2 m)@. deriving via Elevator t1 (t2 (m :: * -> *))   instance {-# OVERLAPPABLE #-}     ( Monad (t1 (t2 m))+    , MonadTransControl t1+    , MonadRWS r w s (t2 m)+    ) => MonadRWS r w s (ComposeT t1 t2 m)++-- | Set by 'LT.RWST'.+deriving via LT.RWST r w s (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    , Monoid w+    ) => MonadRWS r w s (ComposeT (LT.RWST r w s) t2 m)++-- | Set by 'ST.RWST'.+deriving via ST.RWST r w s (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    , Monoid w+    ) => MonadRWS r w s (ComposeT (ST.RWST r w s) t2 m)++-- | /OVERLAPPABLE/.+-- Elevated to @(t2 m)@.+deriving via Elevator t1 (t2 (m :: * -> *))+  instance {-# OVERLAPPABLE #-}+    ( Monad (t1 (t2 m))     , MonadTrans t1     , MonadState s (t2 m)     ) => MonadState s (ComposeT t1 t2 m) --- | Set by 'StateT'.-deriving via StateT s (t2 (m :: * -> *))+-- | Set by 'LT.StateT'.+deriving via LT.StateT s (t2 (m :: * -> *))   instance     ( Monad (t2 m)-    ) => MonadState s ((ComposeT (StateT s) t2) m)+    ) => MonadState s (ComposeT (LT.StateT s) t2 m) +-- | Set by 'ST.StateT'.+deriving via ST.StateT s (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    ) => MonadState s (ComposeT (ST.StateT s) t2 m)++-- | Set by 'LT.RWST'.+deriving via LT.RWST r w s (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    , Monoid w+    ) => MonadState s (ComposeT (LT.RWST r w s) t2 m)++-- | Set by 'ST.RWST'.+deriving via ST.RWST r w s (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    , Monoid w+    ) => MonadState s (ComposeT (ST.RWST r w s) t2 m)+ -- | /OVERLAPPABLE/. -- Elevated to @(t2 m)@. deriving via Elevator t1 (t2 (m :: * -> *))@@ -124,14 +209,35 @@     , MonadWriter w (t2 m)     ) => MonadWriter w (ComposeT t1 t2 m) --- | Set by 'WriterT'.-deriving via WriterT w (t2 (m :: * -> *))+-- | Set by 'LT.WriterT'.+deriving via LT.WriterT w (t2 (m :: * -> *))   instance     ( Monad (t2 m)     , Monoid w-    ) => MonadWriter w ((ComposeT (WriterT w) t2) m)+    ) => MonadWriter w (ComposeT (LT.WriterT w) t2 m) +-- | Set by 'ST.WriterT'.+deriving via ST.WriterT w (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    , Monoid w+    ) => MonadWriter w (ComposeT (ST.WriterT w) t2 m) +-- | Set by 'LT.RWST'.+deriving via LT.RWST r w s (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    , Monoid w+    ) => MonadWriter w (ComposeT (LT.RWST r w s) t2 m)++-- | Set by 'ST.RWST'.+deriving via ST.RWST r w s (t2 (m :: * -> *))+  instance+    ( Monad (t2 m)+    , Monoid w+    ) => MonadWriter w (ComposeT (ST.RWST r w s) t2 m)++ -- ** Run 'ComposeT' -- -- $runComposet@@ -141,8 +247,8 @@ -- | Run a transformer stack. -- -- This function takes the two individual monad transformer runners as arguments.-runComposeT :: (forall a. t1 (t2 m) a -> t2 m (StT t1 a)) -- ^ run 't1'-            -> (forall a. t2 m a -> m (StT t2 a)) -- ^ run 't2'+runComposeT :: (forall a. t1 (t2 m) a -> t2 m (StT t1 a)) -- ^ run @t1@+            -> (forall a. t2 m a -> m (StT t2 a)) -- ^ run @t2@             -> (forall a. ComposeT t1 t2 m a -> m (StT t2 (StT t1 a))) runComposeT runT1 runT2 = runT2 . runT1 . deComposeT @@ -150,12 +256,12 @@ -- This is a simple approach when your monad transformer stack doesn't carry monadic state. -- -- @--- 'StT' ('ComposeT' 't1' 't2') a ~ a+-- 'StT' ('ComposeT' t1 t2) a ~ a -- @ -- -- This can be used to improve error messages when modifying a monad transformer stack.-runComposeT' :: (t1 (t2 m) a -> t2 m a) -- ^ run 't1'-             -> (t2 m a -> m a) -- ^ run 't2'+runComposeT' :: (t1 (t2 m) a -> t2 m a) -- ^ run @t1@+             -> (t2 m a -> m a) -- ^ run @t2@              -> (ComposeT t1 t2 m a -> m a) runComposeT' runT1 runT2 = runT2 . runT1 . deComposeT @@ -218,7 +324,7 @@ -- -- @ -- deriving via CustomT (t2 (m :: * -> *))---   instance 'Monad' (t2 m) => MonadCustom (('ComposeT' CustomT t2) m)+--   instance 'Monad' (t2 m) => MonadCustom ('ComposeT' CustomT t2 m) -- @  -- ** Example 3: Build a transformer stack@@ -229,7 +335,7 @@ -- -- @ -- type (|.) = 'ComposeT'--- type Stack = 'StateT' 'Int' |. 'ReaderT' 'Char' |. CustomT |. 'ReaderT' 'Bool' |. 'Control.Monad.Trans.Identity.IdentityT'+-- type Stack = 'LT.StateT' 'Int' |. 'T.ReaderT' 'Char' |. CustomT |. 'T.ReaderT' 'Bool' |. 'Control.Monad.Trans.Identity.IdentityT' -- newtype StackT m a = StackT { unStackT :: Stack m a } --   deriving newtype ('Functor', 'Applicative', 'Monad') -- @@@ -265,20 +371,20 @@ --   runStateT' |. --     runReaderT' |. --       runCustomT |.---         (\\ tma -> 'runReaderT' tma 'True') |.+--         (\\ tma -> 'T.runReaderT' tma 'True') |. --           'Control.Monad.Trans.Identity.runIdentityT' $ unStackT stackTma --   where---     runReaderT' :: 'MonadReader' 'Bool' m => 'ReaderT' 'Char' m a -> m a+--     runReaderT' :: 'MonadReader' 'Bool' m => 'T.ReaderT' 'Char' m a -> m a --     runReaderT' tma = do --       bool <- 'ask' --       let char = if bool --                     then \'Y\' --                     else \'N\'---       'runReaderT' tma char+--       'T.runReaderT' tma char -----     runStateT' :: 'MonadReader' 'Char' m => 'StateT' 'Int' m a -> m (a, 'Int')+--     runStateT' :: 'MonadReader' 'Char' m => 'LT.StateT' 'Int' m a -> m (a, 'Int') --     runStateT' tma = do --       char <- 'ask' --       let num = 'fromEnum' char---       'runStateT' tma num+--       'LT.runStateT' tma num -- @

@@ -2,9 +2,13 @@  module Control.Monad.Trans.Elevator where +import Control.Applicative+import Control.Monad import Control.Monad.Base+import Control.Monad.Cont.Class import Control.Monad.Error.Class import Control.Monad.Reader.Class+import Control.Monad.RWS.Class (MonadRWS) import Control.Monad.State.Class import Control.Monad.Trans import Control.Monad.Trans.Control@@ -44,9 +48,22 @@   liftBaseWith f = liftWith $ \ runT -> liftBaseWith $ \ runInBase -> f $ runInBase . runT   restoreM = restoreT . restoreM +instance (Monad (t m), MonadTransControl t, Monad m, Alternative m) => Alternative (Elevator t m) where+  empty = lift empty+  (<|>) x y = (restoreT . pure =<<) $ liftWith $ \ runT -> runT x <|> runT y++instance (Monad (t m), MonadTrans t, MonadFail m) => MonadFail (Elevator t m) where+  fail = lift . fail+ instance (Monad (t m), MonadTrans t, MonadIO m) => MonadIO (Elevator t m) where   liftIO = lift . liftIO +instance (Monad (t m), MonadTransControl t, MonadPlus m) => MonadPlus (Elevator t m)++instance (Monad (t m), MonadTransControl t, MonadCont m) => MonadCont (Elevator t m) where+  callCC f = (restoreT . pure =<<) $ liftWith $ \ runT ->+    callCC $ \ c -> runT $ f $ \ a -> restoreT $ c =<< runT (pure a)+ instance (Monad (t m), MonadTransControl t, MonadError e m) => MonadError e (Elevator t m) where   throwError = lift . throwError   catchError throwing catching = (restoreT . pure =<<) $ liftWith $ \ runT ->@@ -56,6 +73,8 @@   ask = lift ask   local f tma = (restoreT . pure =<<) $ liftWith $ \ runT ->     local f $ runT tma++instance (Monad (t m), MonadTransControl t, MonadRWS r w s m) => MonadRWS r w s (Elevator t m)  instance (Monad (t m), MonadTrans t, MonadState s m) => MonadState s (Elevator t m) where   get = lift get