deriving-trans 0.5.0.1 → 0.5.1.0

raw patch · 4 files changed

+145/−27 lines, 4 filesdep +exceptionsdep +unliftio-corePVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions, unliftio-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• deriving-trans.cabal +25/−2
• src/Control/Monad/Trans/Compose.hs +70/−12
• src/Control/Monad/Trans/Elevator.hs +42/−13

@@ -1,5 +1,13 @@ # Revision history for deriving-trans +## 0.5.1.0 *11 Jan 2023*++* Introduce cabal flags `exceptions`, `mtl` and `unliftio`.+  These flags enable the dependency on additional optional packages, to reduce the requirement of orphan instances.+* Add `MonadUnliftIO` instances to `Elevator` and `ComposeT`.+* Add `MonadThrow` and `MonadCatch` instances to `Elevator` and `ComposeT`.+* Add `MonadThrow` and `MonadCatch` "base-case" instances for `CatchT` to `ComposeT`.+ ## 0.5.0.1 *04 Aug 2022*  * Improve Haddock examples.

@@ -1,6 +1,6 @@ cabal-version:       3.0 name:                deriving-trans-version:             0.5.0.1+version:             0.5.1.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@@ -24,6 +24,21 @@ build-type:          Simple extra-source-files:  CHANGELOG.md +flag exceptions+  default: True+  description:+    Implement instances for 'Control.Monad.Catch.MonadThrow' and 'Control.Monad.Catch.MonadCatch'.++flag mtl+  default: True+  description:+    Implement instances for mtl's type classes.++flag unliftio+  default: True+  description:+    Implement instances for 'Control.Monad.IO.Unlift.MonadUnliftIO'.+ library   exposed-modules:     Control.Monad.Trans.Compose@@ -36,9 +51,17 @@     , base < 5     , monad-control     , monad-control-identity-    , mtl     , transformers     , transformers-base+  if flag(exceptions)+    build-depends:+      , exceptions+  if flag(mtl)+    build-depends:+      , mtl+  if flag(unliftio)+    build-depends:+      , unliftio-core   hs-source-dirs: src   default-language: Haskell2010   default-extensions:

@@ -1,19 +1,28 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE UndecidableInstances #-}  module Control.Monad.Trans.Compose where  import Control.Monad.Base-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.Control.Identity import Control.Monad.Trans.Elevator+import Data.Kind++#if defined(VERSION_exceptions)+import Control.Monad.Catch+import qualified Control.Monad.Catch.Pure as T+#endif++#if defined(VERSION_mtl)+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 qualified Control.Monad.Trans.Cont as T import qualified Control.Monad.Trans.Except as T import qualified Control.Monad.Trans.RWS.Lazy as LT@@ -24,8 +33,12 @@ 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+#endif +#if defined(VERSION_unliftio_core)+import Control.Monad.IO.Unlift+#endif+ -- * 'ComposeT' -- -- $composet@@ -98,12 +111,45 @@     , MonadBaseControlIdentity b m     ) => MonadBaseControlIdentity b (ComposeT t1 t2 m) +#if defined(VERSION_exceptions) -- | /OVERLAPPABLE/. -- Elevated to @(t2 m)@. deriving via Elevator t1 (t2 (m :: Type -> Type))   instance {-# OVERLAPPABLE #-}     ( Monad (t1 (t2 m))+    , MonadTrans t1+    , MonadThrow (t2 m)+    ) => MonadThrow (ComposeT t1 t2 m)++-- | Set by 'T.CatchT'.+deriving via T.CatchT (t2 (m :: Type -> Type))+  instance+    ( Monad (t2 m)+    ) => MonadThrow (ComposeT T.CatchT t2 m)++-- | /OVERLAPPABLE/.+-- Elevated to @(t2 m)@.+deriving via Elevator t1 (t2 (m :: Type -> Type))+  instance {-# OVERLAPPABLE #-}+    ( Monad (t1 (t2 m))     , MonadTransControl t1+    , MonadCatch (t2 m)+    ) => MonadCatch (ComposeT t1 t2 m)++-- | Set by 'T.CatchT'.+deriving via T.CatchT (t2 (m :: Type -> Type))+  instance+    ( Monad (t2 m)+    ) => MonadCatch (ComposeT T.CatchT t2 m)+#endif++#if defined(VERSION_mtl)+-- | /OVERLAPPABLE/.+-- Elevated to @(t2 m)@.+deriving via Elevator t1 (t2 (m :: Type -> Type))+  instance {-# OVERLAPPABLE #-}+    ( Monad (t1 (t2 m))+    , MonadTransControl t1     , MonadCont (t2 m)     ) => MonadCont (ComposeT t1 t2 m) @@ -251,8 +297,20 @@     ( Monad (t2 m)     , Monoid w     ) => MonadWriter w (ComposeT (ST.RWST r w s) t2 m)+#endif +#if defined(VERSION_unliftio_core)+-- | Elevated to @m@.+deriving via Elevator (ComposeT t1 t2) m+  instance+    ( Monad (t1 (t2 m))+    , MonadTransControlIdentity (ComposeT t1 t2)+    , MonadUnliftIO m+    ) =>+    MonadUnliftIO (ComposeT t1 t2 m)+#endif + -- ** Run 'ComposeT' -- -- $runComposet@@ -361,14 +419,14 @@ -- -- @ --   deriving newtype ('MonadTrans', 'MonadTransControl')---   deriving newtype ('MonadState' 'Int')+--   deriving newtype ('Control.Monad.State.Class.MonadState' 'Int') --   deriving newtype MonadCustom -- @ -- -- We can even access instances, that would have been shadowed in a regular transformer stack. -- -- @---   deriving newtype ('MonadReader' 'Bool')+--   deriving newtype ('Control.Monad.Reader.Class.MonadReader' 'Bool') -- @  -- ** Example 4: Run a transformer stack@@ -390,15 +448,15 @@ --     'Control.Monad.Trans.Compose.Infix../>' runStateT' --     $ unAppT appTma --  where---   runReaderT' :: 'MonadReader' 'Bool' m => 'T.ReaderT' 'Char' m a -> m a+--   runReaderT' :: 'Control.Monad.Reader.Class.MonadReader' 'Bool' m => 'T.ReaderT' 'Char' m a -> m a --   runReaderT' tma = do---     bool <- 'ask'+--     bool <- 'Control.Monad.Reader.Class.ask' --     let char = if bool then \'Y\' else \'N\' --     'T.runReaderT' tma char -----   runStateT' :: 'MonadReader' 'Char' m => 'LT.StateT' 'Int' m a -> m (a, 'Int')+--   runStateT' :: 'Control.Monad.Reader.Class.MonadReader' 'Char' m => 'LT.StateT' 'Int' m a -> m (a, 'Int') --   runStateT' tma = do---     char <- 'ask'+--     char <- 'Control.Monad.Reader.Class.ask' --     let num = 'fromEnum' char --     'LT.runStateT' tma num -- @

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TupleSections #-}@@ -7,19 +8,31 @@ import Control.Applicative import Control.Monad import Control.Monad.Base+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Control+import Control.Monad.Trans.Control.Identity+import Control.Monad.Zip+import Data.Kind++#if defined(VERSION_exceptions)+import Control.Monad.Catch+#endif++#if defined(VERSION_mtl) import Control.Monad.Cont.Class import Control.Monad.Error.Class-import Control.Monad.Fix 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-import Control.Monad.Trans.Control.Identity import Control.Monad.Writer.Class-import Control.Monad.Zip-import Data.Kind+#endif +#if defined(VERSION_unliftio_core)+import Control.Monad.IO.Unlift+#endif+ -- * 'Elevator' -- -- $elevator@@ -77,6 +90,16 @@   mzip x y = liftWithIdentity $ \ runT ->     mzip (runT x) (runT y) +#if defined(VERSION_exceptions)+instance (Monad (t m), MonadTrans t, MonadThrow m) => MonadThrow (Elevator t m) where+  throwM = lift . throwM++instance (Monad (t m), MonadTransControl t, MonadCatch m) => MonadCatch (Elevator t m) where+  catch throwing catching = (restoreT . pure =<<) $ liftWith $ \ runT ->+    catch (runT throwing) (runT . catching)+#endif++#if defined(VERSION_mtl) 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)@@ -102,7 +125,13 @@   listen tma = liftWith (\ runT -> listen $ runT tma) >>= \ (sta, w) ->     (, w) <$> restoreT (pure sta)   pass tma = lift . pass . pure =<< tma+#endif +#if defined(VERSION_unliftio_core)+instance (Monad (t m), MonadTransControlIdentity t, MonadUnliftIO m) => MonadUnliftIO (Elevator t m) where+  withRunInIO f = liftWithIdentity $ \runT -> withRunInIO $ \runInIO -> f $ runInIO . runT+#endif+ -- * Examples  -- ** Example 1: Recover submerged instances@@ -116,13 +145,13 @@ --   deriving newtype ('Functor', 'Applicative', 'Monad') -- @ ----- Now you want to expose the inner @('MonadReader' 'Bool')@ instance with @(StackT m)@.+-- Now you want to expose the inner @('Control.Monad.Reader.Class.MonadReader' 'Bool')@ instance with @(StackT m)@. ----- Normally it's shadowed by the @('MonadReader' 'Char')@ instance, but we can use 'Elevator' to+-- Normally it's shadowed by the @('Control.Monad.Reader.Class.MonadReader' 'Char')@ instance, but we can use 'Elevator' to -- access the inner transformer. -- -- @---   deriving ('MonadReader' 'Bool') via 'Elevator' ('Control.Monad.Trans.Reader.ReaderT' 'Char') ('Control.Monad.Trans.Reader.ReaderT' 'Bool' m)+--   deriving ('Control.Monad.Reader.Class.MonadReader' 'Bool') via 'Elevator' ('Control.Monad.Trans.Reader.ReaderT' 'Char') ('Control.Monad.Trans.Reader.ReaderT' 'Bool' m) -- @  -- ** Example 2: Custom transformer without boilerplate@@ -147,13 +176,13 @@ --   deriving newtype ('Functor', 'Applicative', 'Monad') -- @ ----- Unfortunately we can't derive a @('Monad' m => 'MonadReader' 'Bool' (StackT m))@ instance with+-- Unfortunately we can't derive a @('Monad' m => 'Control.Monad.Reader.Class.MonadReader' 'Bool' (StackT m))@ instance with -- /GeneralizedNewtypeDeriving/, without also adding the instance to @CustomT@. -- -- To still derive this trivial instance we can use 'Elevator' with /DerivingVia/. -- -- @---   deriving ('MonadReader' 'Bool') via ('Elevator' CustomT ('Control.Monad.Trans.Reader.ReaderT' 'Bool' m))+--   deriving ('Control.Monad.Reader.Class.MonadReader' 'Bool') via ('Elevator' CustomT ('Control.Monad.Trans.Reader.ReaderT' 'Bool' m)) -- @  -- ** Example 3: Adding an instance for 'Elevator'@@ -182,5 +211,5 @@ -- @ -- -- Some useful examples (or exercises) are the instances for--- [mtl](https://hackage.haskell.org/package/mtl)'s type classes ('MonadError', 'MonadReader',--- 'MonadState', 'MonadWriter').+-- [mtl](https://hackage.haskell.org/package/mtl)'s type classes ('Control.Monad.Error.Class.MonadError', 'Control.Monad.Reader.Class.MonadReader',+-- 'Control.Monad.State.Class.MonadState', 'Control.Monad.Writer.Class.MonadWriter').