deriving-trans 0.1.0.0 → 0.2.0.0

raw patch · 5 files changed

+194/−105 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• deriving-trans.cabal +44/−38
• src/Control/Monad/Trans/Compose.hs +96/−0
• src/Control/Monad/Trans/Deriving.hs +0/−67
• src/Control/Monad/Trans/Elevator.hs +50/−0

@@ -1,5 +1,9 @@ # Revision history for deriving-trans +## 0.2.0.0 *25 Jan 2022*++* Completely change the idea of this project. Pretty much everything has been changed.+ ## 0.1.0.0 *19 Jun 2021*  * First version. Released on an unsuspecting world.

@@ -1,10 +1,13 @@+cabal-version:       3.0 name:                deriving-trans-version:             0.1.0.0-synopsis:            Derive transformer type classes with DerivingVia-description:         MonadTrans is a prime example of a type class, that is not derivable with-                     GeneralizedNewtypeDeriving.-                     A simple way to still derive such an instance is by using DerivingVia.-license:             BSD3+version:             0.2.0.0+synopsis:            Derive monad type classes with DerivingVia+description:         Deriving type class instances for monad transformer stacks can be tedious.+                     By actually composing transformers with `ComposeT` we don't need to implement+                     each type class for each transformer.+                     Instead we need a single instance for `Elevator`, which will then help us pick+                     the correct instance with DerivingVia.+license:             BSD-3-Clause license-file:        LICENSE author:              Felix Springer maintainer:          felixspringer149@gmail.com@@ -13,38 +16,41 @@ category:            Control build-type:          Simple extra-source-files:  CHANGELOG.md-cabal-version:       >= 1.10  library-  exposed-modules:     Control.Monad.Trans.Deriving+  exposed-modules:+    Control.Monad.Trans.Compose+    Control.Monad.Trans.Elevator   --other-modules:-  build-depends:       base              >= 4.5     && < 5-                     , lifted-base       >= 0.2.3.2 && < 0.2.4-                     , monad-control     >= 1.0.2.0 && < 1.1-                     , mtl               >= 2.2.2   && < 2.3-                     , transformers      >= 0.5.6.2 && < 0.5.7-                     , transformers-base >= 0.4.5.2 && < 0.5-  hs-source-dirs:      src-  default-language:    Haskell2010-  default-extensions:  BangPatterns-                       ConstraintKinds-                       DataKinds-                       DeriveFoldable-                       DeriveFunctor-                       DeriveGeneric-                       DeriveTraversable-                       DerivingStrategies-                       DerivingVia-                       EmptyDataDeriving-                       FlexibleContexts-                       FlexibleInstances-                       FunctionalDependencies-                       GeneralizedNewtypeDeriving-                       MultiParamTypeClasses-                       NamedFieldPuns-                       OverloadedStrings-                       RankNTypes-                       StandaloneDeriving-                       TypeApplications-                       TypeFamilies-  ghc-options:         -Wall+  build-depends:+    , base              >= 4.5     && < 5+    , lifted-base       >= 0.2.3.2 && < 0.2.4+    , monad-control     >= 1.0.2.0 && < 1.1+    , mtl               >= 2.2.2   && < 2.3+    , transformers      >= 0.5.6.2 && < 0.5.7+    , transformers-base >= 0.4.5.2 && < 0.5+  hs-source-dirs: src+  default-language: Haskell2010+  default-extensions:+    BangPatterns+    ConstraintKinds+    DataKinds+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DerivingStrategies+    DerivingVia+    EmptyDataDeriving+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GeneralizedNewtypeDeriving+    MultiParamTypeClasses+    NamedFieldPuns+    OverloadedStrings+    RankNTypes+    StandaloneDeriving+    TypeApplications+    TypeFamilies+  ghc-options: -Wall

@@ -0,0 +1,96 @@+{-# LANGUAGE QuantifiedConstraints, UndecidableInstances #-}++module Control.Monad.Trans.Compose where++import Control.Monad.Base+import Control.Monad.Error.Class+import Control.Monad.IO.Class+import Control.Monad.Reader.Class+import Control.Monad.State.Class+import Control.Monad.Trans+import Control.Monad.Trans.Control+import Control.Monad.Trans.Elevator+import Control.Monad.Writer.Class+import Data.Kind++newtype ComposeT+  (t1 :: (Type -> Type) -> Type -> Type)+  (t2 :: (Type -> Type) -> Type -> Type)+  (m :: Type -> Type)+  (a :: Type)+    = ComposeT { deComposeT :: t1 (t2 m) a }+  deriving newtype (Applicative, Functor, Monad)++instance (forall m. Monad m => Monad (t2 m), MonadTrans t1, MonadTrans t2) => MonadTrans (ComposeT t1 t2) where+  lift = ComposeT . lift . lift++instance (forall m. Monad m => Monad (t2 m), MonadTransControl t1, MonadTransControl t2) => MonadTransControl (ComposeT t1 t2) where+  type StT (ComposeT t1 t2) a = StT t2 (StT t1 a)+  liftWith f = defaultLiftWith2 ComposeT deComposeT $ \ x -> f x+  restoreT = defaultRestoreT2 ComposeT++-- | Elevated to `m`.+deriving via Elevator (ComposeT t1 t2) m+  instance+    ( Monad (t1 (t2 m))+    , MonadTrans (ComposeT t1 t2)+    , MonadIO m+    ) => MonadIO (ComposeT t1 t2 m)++-- | Elevated to `m`.+deriving via Elevator (ComposeT t1 t2) m+  instance+    ( Monad (t1 (t2 m))+    , MonadTrans (ComposeT t1 t2)+    , MonadBase b m+    ) => MonadBase b (ComposeT t1 t2 m)++-- | Elevated to `m`.+deriving via Elevator (ComposeT t1 t2) m+  instance+    ( Monad (t1 (t2 m))+    , MonadTransControl (ComposeT t1 t2)+    , MonadBaseControl b m+    ) => MonadBaseControl b (ComposeT t1 t2 m)++-- | Elevated to `t2 m`.+deriving via Elevator t1 (t2 (m :: * -> *))+  instance+    ( Monad (t1 (t2 m))+    , MonadTransControl t1+    , MonadError e (t2 m)+    ) => MonadError e (ComposeT t1 t2 m)++-- | Elevated to `t2 m`.+deriving via Elevator t1 (t2 (m :: * -> *))+  instance+    ( Monad (t1 (t2 m))+    , MonadTransControl t1+    , MonadReader r (t2 m)+    ) => MonadReader r (ComposeT t1 t2 m)++-- | Elevated to `t2 m`.+deriving via Elevator t1 (t2 (m :: * -> *))+  instance+    ( Monad (t1 (t2 m))+    , MonadTrans t1+    , MonadState s (t2 m)+    ) => MonadState s (ComposeT t1 t2 m)++-- | Elevated to `t2 m`.+deriving via Elevator t1 (t2 (m :: * -> *))+  instance+    ( Monad (t1 (t2 m))+    , MonadTransControl t1+    , MonadWriter w (t2 m)+    ) => MonadWriter w (ComposeT t1 t2 m)++runComposeT :: (forall a. t1 (t2 m) a -> t2 m (StT t1 a))+            -> (forall a. t2 m a -> m (StT t2 a))+            -> (forall a. ComposeT t1 t2 m a -> m (StT t2 (StT t1 a)))+runComposeT runT1 runT2 = runT2 . runT1 . deComposeT++runComposeT' :: (t1 (t2 m) a -> t2 m a)+             -> (t2 m a -> m a)+             -> (ComposeT t1 t2 m a -> m a)+runComposeT' runT1 runT2 = runT2 . runT1 . deComposeT

@@ -1,67 +0,0 @@-{-# LANGUAGE QuantifiedConstraints, UndecidableInstances #-}--module Control.Monad.Trans.Deriving (-  Stack0T (..)-, Stack1T (..)-, Stack2T (..)-, Stack3T (..)-) where--import Control.Monad.Base-import Control.Monad.Trans-import Control.Monad.Trans.Control-import Data.Kind--newtype Stack0T-  (m :: Type -> Type)-  (a :: Type)-    = Stack0T { unStack0T :: m a }-  deriving (Applicative, Functor, Monad, MonadBase b, MonadBaseControl b)--instance MonadTrans Stack0T where-  lift = Stack0T--instance MonadTransControl Stack0T where-  type StT Stack0T a = a-  liftWith f = Stack0T $ f unStack0T-  restoreT = Stack0T--newtype Stack1T-  (t :: (Type -> Type) -> Type -> Type)-  (m :: Type -> Type)-  (a :: Type)-    = Stack1T { unStack1T :: t m a }-  deriving (Applicative, Functor, Monad, MonadBase b, MonadBaseControl b, MonadTrans, MonadTransControl)--newtype Stack2T-  (t1 :: (Type -> Type) -> Type -> Type)-  (t2 :: (Type -> Type) -> Type -> Type)-  (m :: Type -> Type)-  (a :: Type)-    = Stack2T { unStack2T :: t1 (t2 m) a }-  deriving (Applicative, Functor, Monad, MonadBase b, MonadBaseControl b)--instance (forall m. Monad m => Monad (t2 m), MonadTrans t1, MonadTrans t2) => MonadTrans (Stack2T t1 t2) where-  lift = Stack2T . lift . lift--instance (forall m. Monad m => Monad (t2 m), MonadTransControl t1, MonadTransControl t2) => MonadTransControl (Stack2T t1 t2) where-  type StT (Stack2T t1 t2) a = StT t2 (StT t1 a)-  liftWith f = defaultLiftWith2 Stack2T unStack2T $ \x -> f x-  restoreT = defaultRestoreT2 Stack2T--newtype Stack3T-  (t1 :: (Type -> Type) -> Type -> Type)-  (t2 :: (Type -> Type) -> Type -> Type)-  (t3 :: (Type -> Type) -> Type -> Type)-  (m :: Type -> Type)-  (a :: Type)-    = Stack3T { unStack3T :: t1 (t2 (t3 m)) a }-  deriving (Applicative, Functor, Monad, MonadBase b, MonadBaseControl b)--instance (forall m. Monad m => Monad (t3 m), forall m. Monad m => Monad (t2 (t3 m)), MonadTrans t1, MonadTrans t2, MonadTrans t3) => MonadTrans (Stack3T t1 t2 t3) where-  lift = Stack3T . lift . lift . lift--instance (forall m. Monad m => Monad (t3 m), forall m. Monad m => Monad (t2 (t3 m)), MonadTransControl t1, MonadTransControl t2, MonadTransControl t3) => MonadTransControl (Stack3T t1 t2 t3) where-  type StT (Stack3T t1 t2 t3) a = StT t3 (StT t2 (StT t1 a))-  liftWith f = Stack3T $ liftWith $ \run -> liftWith $ \run' -> liftWith $ \ run'' -> f $ run'' . run' . run . unStack3T-  restoreT = Stack3T . restoreT . restoreT . restoreT

@@ -0,0 +1,50 @@+{-# LANGUAGE QuantifiedConstraints, UndecidableInstances, TupleSections #-}++module Control.Monad.Trans.Elevator where++import Control.Monad.Base+import Control.Monad.Error.Class+import Control.Monad.Reader.Class+import Control.Monad.State.Class+import Control.Monad.Trans+import Control.Monad.Trans.Control+import Control.Monad.Writer.Class+import Data.Kind++newtype Elevator+  (t :: (Type -> Type) -> Type -> Type)+  (m :: Type -> Type)+  (a :: Type)+    = Ascend { descend :: t m a }+  deriving newtype (Applicative, Functor, Monad)++instance (Monad (t m), MonadTrans t, MonadBase b m) => MonadBase b (Elevator t m) where+  liftBase = Ascend . lift . liftBase++instance (Monad (t m), MonadTransControl t, MonadBaseControl b m) => MonadBaseControl b (Elevator t m) where+  type StM (Elevator t m) a = StM m (StT t a)+  liftBaseWith f = Ascend $ liftWith $ \ runT -> liftBaseWith $ \ runInBase -> f $ runInBase . runT . descend+  restoreM = Ascend . restoreT . restoreM++instance (Monad (t m), MonadTrans t, MonadIO m) => MonadIO (Elevator t m) where+  liftIO = Ascend . lift . liftIO++instance (Monad (t m), MonadTransControl t, MonadError e m) => MonadError e (Elevator t m) where+  throwError = Ascend . lift . throwError+  catchError throwing catching = Ascend $ (restoreT . pure =<<) $ liftWith $ \ runT ->+    catchError (runT $ descend throwing) (runT . descend . catching)++instance (Monad (t m), MonadTransControl t, MonadReader r m) => MonadReader r (Elevator t m) where+  ask = Ascend $ lift ask+  local f tma = Ascend $ (restoreT . pure =<<) $ liftWith $ \ runT ->+    local f $ runT $ descend tma++instance (Monad (t m), MonadTrans t, MonadState s m) => MonadState s (Elevator t m) where+  get = Ascend $ lift get+  put = Ascend . lift . put++instance (Monad (t m), MonadTransControl t, MonadWriter w m) => MonadWriter w (Elevator t m) where+  tell = Ascend . lift . tell+  listen tma = Ascend $ liftWith (\ runT -> listen $ runT $ descend tma) >>= \ (sta, w) ->+    (, w) <$> restoreT (pure sta)+  pass tma = Ascend $ lift . pass . pure =<< descend tma