ComposeT

.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,14 +46,17 @@ jobs:
       - name: Build
         run: cabal build
 
+      - name: Test
+        run: cabal test
+
   mhs:
     runs-on: ubuntu-latest
     steps:
       - name: checkout mhs repo
         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

Control/Monad/Trans/Compose.hs

@@ -0,0 +1,100 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE Trustworthy #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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.
+-- Potentially useful for when a single transformer is required as a type
+-- argument.
+-----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Compose (
+    ComposeT (..),
+) where
+
+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.Classes (Eq1, Ord1)
+import Data.Functor.Compose (Compose)
+import Data.Functor.Contravariant (Contravariant)
+import Data.Kind (Type)
+#ifdef __GLASGOW_HASKELL__
+import GHC.Generics (Generic)
+#endif
+
+infixr 9 `ComposeT`
+
+-- | 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) $ 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 }
+    deriving stock (
+        Functor,
+        Traversable,
+        Foldable,
+        Eq,
+        Ord,
+        Read,
+        Show,
+#ifdef __GLASGOW_HASKELL__
+        Generic,
+#endif
+        Data)
+    deriving newtype (
+        Contravariant,
+        Applicative,
+        Monad,
+        MonadIO,
+        Alternative,
+        MonadFail,
+        MonadPlus,
+        MonadFix,
+        MonadZip,
+        Semigroup,
+        Monoid,
+        Eq1,
+        Ord1,
+        Bounded,
+        Enum,
+        Fractional,
+        Floating,
+        Real,
+        RealFrac,
+        RealFloat,
+        Integral,
+        Num)
+
+instance (MonadTrans t1, MonadTrans t2) => MonadTrans (ComposeT t1 t2) where
+    lift = ComposeT . lift . lift
+    {-# INLINE lift #-}

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

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
@@ -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
@@ -82,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