From 909e68f733beb16ac94c7af09829b2bde9241de4 Mon Sep 17 00:00:00 2001 From: Celso Bonutti Date: Sat, 7 Feb 2026 15:35:05 -0500 Subject: [PATCH 1/9] add ComposeT and its MonadTrans instance --- Control/Monad/Trans/Compose.hs | 40 ++++++++++++++++++++++++++++++++++ transformers.cabal | 1 + 2 files changed, 41 insertions(+) create mode 100644 Control/Monad/Trans/Compose.hs diff --git a/Control/Monad/Trans/Compose.hs b/Control/Monad/Trans/Compose.hs new file mode 100644 index 0000000..d1141be --- /dev/null +++ b/Control/Monad/Trans/Compose.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +#endif +#if __GLASGOW_HASKELL__ >= 810 +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE StandaloneKindSignatures #-} +#endif + +module Control.Monad.Trans.Compose where + +import Control.Monad.Trans.Class (MonadTrans (lift)) +import Data.Kind (Type) + +infixr 9 `ComposeT` + +#if __GLASGOW_HASKELL__ >= 810 +type ComposeT :: (k3 -> k2 -> Type) -> (k1 -> k3) -> (k1 -> k2 -> Type) +#endif +newtype ComposeT trans1 trans2 m a = ComposeT (trans1 (trans2 m) a) +#if __GLASGOW_HASKELL__ >= 806 + deriving newtype (Functor, Applicative, Monad) +#endif + +#if __GLASGOW_HASKELL__ < 806 +instance (Functor (trans1 (trans2 m))) => Functor (ComposeT trans1 trans2 m) where + fmap f (ComposeT x) = ComposeT (fmap f x) + +instance (Applicative (trans1 (trans2 m))) => Applicative (ComposeT trans1 trans2 m) where + pure x = ComposeT (pure x) + ComposeT a <*> ComposeT b = ComposeT (a <*> b) + +instance (Monad (trans1 (trans2 m))) => Monad (ComposeT trans1 trans2 m) where + return x = ComposeT (return x) + (ComposeT x) >>= f = ComposeT (x >>= (\(ComposeT x') -> x') . f) +#endif + +instance (MonadTrans trans1, MonadTrans trans2) => MonadTrans (ComposeT trans1 trans2) where + lift = ComposeT . lift . lift diff --git a/transformers.cabal b/transformers.cabal index 90b3131..a9a31ce 100644 --- a/transformers.cabal +++ b/transformers.cabal @@ -63,6 +63,7 @@ library Control.Monad.Signatures Control.Monad.Trans.Accum Control.Monad.Trans.Class + Control.Monad.Trans.Compose Control.Monad.Trans.Cont Control.Monad.Trans.Except Control.Monad.Trans.Identity From 6512880d903fd2bdf1885a8f65f2f54c3cb97749 Mon Sep 17 00:00:00 2001 From: Celso Bonutti Date: Sat, 7 Feb 2026 15:44:32 -0500 Subject: [PATCH 2/9] use #else instead of separate #if --- Control/Monad/Trans/Compose.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Control/Monad/Trans/Compose.hs b/Control/Monad/Trans/Compose.hs index d1141be..571207c 100644 --- a/Control/Monad/Trans/Compose.hs +++ b/Control/Monad/Trans/Compose.hs @@ -21,9 +21,7 @@ type ComposeT :: (k3 -> k2 -> Type) -> (k1 -> k3) -> (k1 -> k2 -> Type) newtype ComposeT trans1 trans2 m a = ComposeT (trans1 (trans2 m) a) #if __GLASGOW_HASKELL__ >= 806 deriving newtype (Functor, Applicative, Monad) -#endif - -#if __GLASGOW_HASKELL__ < 806 +#else instance (Functor (trans1 (trans2 m))) => Functor (ComposeT trans1 trans2 m) where fmap f (ComposeT x) = ComposeT (fmap f x) From 6ddfd34fa2aa58b0829dcd864867868019db3423 Mon Sep 17 00:00:00 2001 From: Steven Shuck Date: Sun, 31 May 2026 09:13:48 -0400 Subject: [PATCH 3/9] Shore up Control.Monad.Trans.Compose * Comments, Trustworthy, export list * Add runComposeT field accessor * Remove support for old GHC versions * Support MHS by declaring kind vars * Add Generic instance * INLINE lift * Make type variable names more like others in the library --- Control/Monad/Trans/Compose.hs | 67 ++++++++++++++++++++++------------ 1 file changed, 44 insertions(+), 23 deletions(-) diff --git a/Control/Monad/Trans/Compose.hs b/Control/Monad/Trans/Compose.hs index 571207c..5536cef 100644 --- a/Control/Monad/Trans/Compose.hs +++ b/Control/Monad/Trans/Compose.hs @@ -1,38 +1,59 @@ {-# LANGUAGE CPP #-} -#if __GLASGOW_HASKELL__ >= 806 +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -#endif -#if __GLASGOW_HASKELL__ >= 810 {-# LANGUAGE PolyKinds #-} {-# LANGUAGE StandaloneKindSignatures #-} -#endif +{-# LANGUAGE Trustworthy #-} +----------------------------------------------------------------------------- +-- | +-- Module : Control.Monad.Trans.Except +-- Copyright : (C) 2026 The MTL Authors +-- License : BSD-style (see the file LICENSE) +-- +-- This combines two transformers into a single compound transformer. +-- Potentially useful for when a single transformer is required as a type +-- argument. +----------------------------------------------------------------------------- -module Control.Monad.Trans.Compose where +module Control.Monad.Trans.Compose ( + ComposeT(..), +) where +import Data.Functor.Compose (Compose) +import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (MonadTrans (lift)) import Data.Kind (Type) - -infixr 9 `ComposeT` - -#if __GLASGOW_HASKELL__ >= 810 -type ComposeT :: (k3 -> k2 -> Type) -> (k1 -> k3) -> (k1 -> k2 -> Type) +#ifdef __GLASGOW_HASKELL__ +import GHC.Generics (Generic) #endif -newtype ComposeT trans1 trans2 m a = ComposeT (trans1 (trans2 m) a) -#if __GLASGOW_HASKELL__ >= 806 - deriving newtype (Functor, Applicative, Monad) -#else -instance (Functor (trans1 (trans2 m))) => Functor (ComposeT trans1 trans2 m) where - fmap f (ComposeT x) = ComposeT (fmap f x) -instance (Applicative (trans1 (trans2 m))) => Applicative (ComposeT trans1 trans2 m) where - pure x = ComposeT (pure x) - ComposeT a <*> ComposeT b = ComposeT (a <*> b) +infixr 9 `ComposeT` -instance (Monad (trans1 (trans2 m))) => Monad (ComposeT trans1 trans2 m) where - return x = ComposeT (return x) - (ComposeT x) >>= f = ComposeT (x >>= (\(ComposeT x') -> x') . f) +-- | Like its analogue @Compose@, @ComposeT@ is polykinded; typically it will +-- have kind +-- +-- > ((Type -> Type) -> Type -> Type) -> ((Type -> Type) -> Type -> Type) -> (Type -> Type) -> Type -> Type +-- +-- After enabling @{-# LANGUAGE TypeOperators #-}@, the `ComposeT` type +-- constructor may be written in infix notation in signatures and is +-- right-associative, mirroring `(.)`. Example: +-- +-- > type FallibleCountT = ExceptT String `ComposeT` StateT Int +-- > +-- > checkNonNeg :: (Monad m) => FallibleCountT m () +-- > checkNonNeg = ComposeT $ do +-- > count <- lift get +-- > when (count < 0) $ `throwError` $ "count is negative (" ++ show count ++ ")" +-- +type ComposeT :: forall k1 k2 k3. (k3 -> k2 -> Type) -> (k1 -> k3) -> (k1 -> k2 -> Type) +newtype ComposeT t1 t2 m a = ComposeT { runComposeT :: t1 (t2 m) a } + deriving newtype (Functor, Applicative, Monad, MonadIO) +#ifdef __GLASGOW_HASKELL__ + deriving stock (Generic) #endif -instance (MonadTrans trans1, MonadTrans trans2) => MonadTrans (ComposeT trans1 trans2) where +instance (MonadTrans t1, MonadTrans t2) => MonadTrans (ComposeT t1 t2) where lift = ComposeT . lift . lift + {-# INLINE lift #-} From 91abde4e4220383ccf9e9f53c3a2913ef1f3d4a3 Mon Sep 17 00:00:00 2001 From: Steven Shuck Date: Sun, 31 May 2026 09:41:48 -0400 Subject: [PATCH 4/9] Fix ComposeT Haddock [skip ci] --- Control/Monad/Trans/Compose.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Control/Monad/Trans/Compose.hs b/Control/Monad/Trans/Compose.hs index 5536cef..e9cddca 100644 --- a/Control/Monad/Trans/Compose.hs +++ b/Control/Monad/Trans/Compose.hs @@ -31,7 +31,7 @@ import GHC.Generics (Generic) infixr 9 `ComposeT` --- | Like its analogue @Compose@, @ComposeT@ is polykinded; typically it will +-- | Like its analogue `Compose`, @ComposeT@ is polykinded; typically it will -- have kind -- -- > ((Type -> Type) -> Type -> Type) -> ((Type -> Type) -> Type -> Type) -> (Type -> Type) -> Type -> Type From 91b484c9931b92533f7508a74784c6d223d207d7 Mon Sep 17 00:00:00 2001 From: Steven Shuck Date: Sun, 31 May 2026 12:20:08 -0400 Subject: [PATCH 5/9] Begin adding tests, starting with ComposeT; fix corresponding Haddock --- .github/workflows/ci.yml | 5 ++++- Control/Monad/Trans/Compose.hs | 2 +- test/ComposeT.hs | 25 +++++++++++++++++++++++++ transformers.cabal | 7 +++++++ 4 files changed, 37 insertions(+), 2 deletions(-) create mode 100644 test/ComposeT.hs diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b3edf57..5cb0e54 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -14,7 +14,7 @@ jobs: strategy: matrix: os: [ubuntu-latest, macos-latest, windows-latest] - ghc: ['8.10', '9.2', '9.8', '9.10', '9.12', 9.14] + ghc: ['8.10', '9.2', '9.8', '9.10', '9.12', '9.14'] exclude: - os: macos-latest ghc: '8.10' # ghc-8.10 does not support ARM @@ -46,6 +46,9 @@ jobs: - name: Build run: cabal build + - name: Test + run: cabal test + mhs: runs-on: ubuntu-latest steps: diff --git a/Control/Monad/Trans/Compose.hs b/Control/Monad/Trans/Compose.hs index e9cddca..87c42a5 100644 --- a/Control/Monad/Trans/Compose.hs +++ b/Control/Monad/Trans/Compose.hs @@ -45,7 +45,7 @@ infixr 9 `ComposeT` -- > checkNonNeg :: (Monad m) => FallibleCountT m () -- > checkNonNeg = ComposeT $ do -- > count <- lift get --- > when (count < 0) $ `throwError` $ "count is negative (" ++ show count ++ ")" +-- > when (count < 0) $ throwE $ "count is negative (" ++ show count ++ ")" -- type ComposeT :: forall k1 k2 k3. (k3 -> k2 -> Type) -> (k1 -> k3) -> (k1 -> k2 -> Type) newtype ComposeT t1 t2 m a = ComposeT { runComposeT :: t1 (t2 m) a } diff --git a/test/ComposeT.hs b/test/ComposeT.hs new file mode 100644 index 0000000..6b73862 --- /dev/null +++ b/test/ComposeT.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE TypeOperators #-} + +module Main (main) where + +import Data.Functor.Identity +import Control.Monad +import Control.Monad.Trans.Class +import Control.Monad.Trans.Except +import Control.Monad.Trans.State.Lazy +import Control.Monad.Trans.Compose +import System.Exit + +type FallibleCountT = ExceptT String `ComposeT` StateT Int + +checkNonNeg :: (Monad m) => FallibleCountT m () +checkNonNeg = ComposeT $ do + count <- lift get + when (count < 0) $ throwE $ "count is negative (" ++ show count ++ ")" + +main :: IO () +main = do + let negateAndCheck = lift (modify negate) >> runComposeT checkNonNeg + unitOrE = runIdentity $ evalStateT (runExceptT negateAndCheck) (-10) + + either die return unitOrE diff --git a/transformers.cabal b/transformers.cabal index a9a31ce..07d8efe 100644 --- a/transformers.cabal +++ b/transformers.cabal @@ -83,3 +83,10 @@ library Control.Monad.Trans.Writer.Strict Data.Functor.Constant Data.Functor.Reverse + +test-suite ComposeT + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: ComposeT.hs + default-language: Haskell2010 + build-depends: base, transformers From 2585959bd77f56c8ffd5f62be243f11bdeae20dd Mon Sep 17 00:00:00 2001 From: Steven Shuck Date: Sun, 31 May 2026 13:00:17 -0400 Subject: [PATCH 6/9] Fix Control.Monad.Trans.Compose header [skip ci] --- Control/Monad/Trans/Compose.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Control/Monad/Trans/Compose.hs b/Control/Monad/Trans/Compose.hs index 87c42a5..f1fd855 100644 --- a/Control/Monad/Trans/Compose.hs +++ b/Control/Monad/Trans/Compose.hs @@ -8,8 +8,8 @@ {-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- | --- Module : Control.Monad.Trans.Except --- Copyright : (C) 2026 The MTL Authors +-- Module : Control.Monad.Trans.Compose +-- Copyright : (C) 2026 The transformers Authors -- License : BSD-style (see the file LICENSE) -- -- This combines two transformers into a single compound transformer. From 1fea93b4e3a14efdb3b8ed660e1fb65ef0c3507b Mon Sep 17 00:00:00 2001 From: Steven Shuck Date: Mon, 1 Jun 2026 23:30:57 -0400 Subject: [PATCH 7/9] Add many instances to ComposeT --- Control/Monad/Trans/Compose.hs | 48 ++++++++++++++++++++++++++++++---- 1 file changed, 43 insertions(+), 5 deletions(-) diff --git a/Control/Monad/Trans/Compose.hs b/Control/Monad/Trans/Compose.hs index f1fd855..b3cd271 100644 --- a/Control/Monad/Trans/Compose.hs +++ b/Control/Monad/Trans/Compose.hs @@ -1,5 +1,7 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -18,12 +20,18 @@ ----------------------------------------------------------------------------- module Control.Monad.Trans.Compose ( - ComposeT(..), + ComposeT (..), ) where -import Data.Functor.Compose (Compose) +import Control.Applicative (Alternative) +import Control.Monad (MonadPlus) +import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (MonadTrans (lift)) +import Control.Monad.Zip (MonadZip) +import Data.Data (Data) +import Data.Functor.Compose (Compose) +import Data.Functor.Contravariant (Contravariant) import Data.Kind (Type) #ifdef __GLASGOW_HASKELL__ import GHC.Generics (Generic) @@ -47,12 +55,42 @@ infixr 9 `ComposeT` -- > count <- lift get -- > when (count < 0) $ throwE $ "count is negative (" ++ show count ++ ")" -- -type ComposeT :: forall k1 k2 k3. (k3 -> k2 -> Type) -> (k1 -> k3) -> (k1 -> k2 -> Type) +type ComposeT :: forall k1 k2 k3. + (k3 -> k2 -> Type) -> (k1 -> k3) -> (k1 -> k2 -> Type) newtype ComposeT t1 t2 m a = ComposeT { runComposeT :: t1 (t2 m) a } - deriving newtype (Functor, Applicative, Monad, MonadIO) + deriving stock ( + Functor, + Traversable, + Foldable, + Eq, + Ord, + Read, + Show, #ifdef __GLASGOW_HASKELL__ - deriving stock (Generic) + Generic, #endif + Data) + deriving newtype ( + Contravariant, + Applicative, + Monad, + MonadIO, + Alternative, + MonadFail, + MonadPlus, + MonadFix, + MonadZip, + Semigroup, + Monoid, + Bounded, + Enum, + Fractional, + Floating, + Real, + RealFrac, + RealFloat, + Integral, + Num) instance (MonadTrans t1, MonadTrans t2) => MonadTrans (ComposeT t1 t2) where lift = ComposeT . lift . lift From 3695d0467c506087e027d189eed5ce88594a81d5 Mon Sep 17 00:00:00 2001 From: Steven Shuck Date: Tue, 2 Jun 2026 17:55:30 -0400 Subject: [PATCH 8/9] Bump MicroHS to 0.16.0.0 to resolve DeriveTraversable issues --- .github/workflows/ci.yml | 2 +- transformers.cabal | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 5cb0e54..292ffd8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -56,7 +56,7 @@ jobs: uses: actions/checkout@v4 with: repository: augustss/MicroHs - ref: v0.15.4.0 + ref: v0.16.0.0 path: mhs - name: make and install mhs diff --git a/transformers.cabal b/transformers.cabal index 07d8efe..5894e4f 100644 --- a/transformers.cabal +++ b/transformers.cabal @@ -46,7 +46,7 @@ tested-with: ghc ==9.14 ghc ==9.2 ghc ==9.8 - mhs ==0.15 + mhs ==0.16 source-repository head type: git From 9b71899819cf964036532a9a2f973d4674e56312 Mon Sep 17 00:00:00 2001 From: Steven Shuck Date: Tue, 2 Jun 2026 21:36:04 -0400 Subject: [PATCH 9/9] Add Eq1 and Ord1 instances to ComposeT --- Control/Monad/Trans/Compose.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Control/Monad/Trans/Compose.hs b/Control/Monad/Trans/Compose.hs index b3cd271..ec9a06c 100644 --- a/Control/Monad/Trans/Compose.hs +++ b/Control/Monad/Trans/Compose.hs @@ -30,6 +30,7 @@ import Control.Monad.IO.Class (MonadIO) import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Zip (MonadZip) import Data.Data (Data) +import Data.Functor.Classes (Eq1, Ord1) import Data.Functor.Compose (Compose) import Data.Functor.Contravariant (Contravariant) import Data.Kind (Type) @@ -82,6 +83,8 @@ newtype ComposeT t1 t2 m a = ComposeT { runComposeT :: t1 (t2 m) a } MonadZip, Semigroup, Monoid, + Eq1, + Ord1, Bounded, Enum, Fractional,