[Git][ghc/ghc][master] Add Control.Monad.thenM and Control.Applicative.thenA

4 Sep 2025


      Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
8b2c72c0 by L0neGamer at 2025-09-04T06:32:03-04:00
Add Control.Monad.thenM and Control.Applicative.thenA

- - - - -


11 changed files:

- compiler/GHC/Data/IOEnv.hs
- libraries/base/changelog.md
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/profiling/should_run/callstack001.stdout


Changes:

=====================================
compiler/GHC/Data/IOEnv.hs
=====================================
@@ -45,7 +45,7 @@ import Data.IORef       ( IORef, newIORef, readIORef, writeIORef, modifyIORef,
                           atomicModifyIORef, atomicModifyIORef' )
 import System.IO.Unsafe ( unsafeInterleaveIO )
 import System.IO        ( fixIO )
-import Control.Monad
+import Control.Monad    ( MonadPlus )
 import Control.Monad.Trans.Reader
 import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
 import GHC.Utils.Monad


=====================================
libraries/base/changelog.md
=====================================
@@ -6,6 +6,7 @@
   * Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338))
   * Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332))
   * `GHC.Exts.IOPort#` and its related operations have been removed  ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213))
+  * Add `thenA` and `thenM`. ([CLC proposal #351](https://github.com/haskell/core-libraries-committee/issues/351))
   * Fix bug where `naturalAndNot` was incorrectly truncating results ([CLC proposal #350](github.com/haskell/core-libraries-committee/issues/350))
   * Remove extra laziness from `Data.Bifunctor.Bifunctor` instances for all tuples to have the same laziness as their `Data.Functor.Functor` counterparts (i.e. they became more strict than before) ([CLC proposal #339](https://github.com/haskell/core-libraries-committee/issues/339))
   * Adjust the strictness of `Data.List.iterate'` to be more reasonable: every element of the output list is forced to WHNF when the `(:)` containing it is forced. ([CLC proposal #335)](https://github.com/haskell/core-libraries-committee/issues/335)


=====================================
libraries/base/src/Control/Applicative.hs
=====================================
@@ -49,6 +49,7 @@ module Control.Applicative (
     liftA, liftA3,
     optional,
     asum,
+    thenA,
     ) where
 
 import GHC.Internal.Control.Category hiding ((.), id)


=====================================
libraries/base/src/Control/Monad.hs
=====================================
@@ -57,6 +57,7 @@ module Control.Monad
      liftM4,
      liftM5,
      ap,
+     thenM,
      -- **  Strict monadic functions
      (<$!>)
      ) where


=====================================
libraries/ghc-internal/src/GHC/Internal/Base.hs
=====================================
@@ -1223,6 +1223,9 @@ class Functor f => Applicative f where
 --
 -- As such this function may be used to implement a `Functor` instance from an `Applicative` one.
 --
+-- This function can be used to define `fmap = liftA`, if `Applicative` is already
+-- defined for a data type.
+--
 -- ==== __Examples__
 -- Using the Applicative instance for Lists:
 --
@@ -1233,7 +1236,6 @@ class Functor f => Applicative f where
 --
 -- >>> liftA (+1) (Just 3)
 -- Just 4
-
 liftA :: Applicative f => (a -> b) -> f a -> f b
 liftA f a = pure f <*> a
 -- Caution: since this may be used for `fmap`, we can't use the obvious
@@ -1253,6 +1255,18 @@ liftA3 f a b c = liftA2 f a b <*> c
 {-# SPECIALISE liftA3 :: (a1->a2->a3->r) ->
                                 Maybe a1 -> Maybe a2 -> Maybe a3 -> Maybe r #-}
 
+-- | Sequence two `Applicative` actions, discarding the result of the first one.
+--
+-- Defined as `thenA fa fb = (id <$ fa) <*> fb`.
+--
+-- This can be used to explicitly define `(*>) = thenA`, which is the default
+-- definition.
+--
+-- @since 4.23.0.0
+thenA :: Applicative f => f a -> f b -> f b
+thenA fa fb = (id <$ fa) <*> fb
+{-# INLINEABLE thenA #-}
+
 -- | The 'join' function is the conventional monad join operator. It
 -- is used to remove one level of monadic structure, projecting its
 -- bound argument into the outer level.
@@ -1453,12 +1467,18 @@ similar problems in nofib.
 
 -- | Promote a function to a monad.
 -- This is equivalent to 'fmap' but specialised to Monads.
+--
+-- This function can be used to define `fmap = liftM`, if `Monad` is already
+-- defined for a data type.
 liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r
 liftM f m1              = do { x1 <- m1; return (f x1) }
 
 -- | Promote a function to a monad, scanning the monadic arguments from
 -- left to right.
 --
+-- This function can be used to define `liftA2 = liftM2`, if `Monad` is already
+-- defined for a data type.
+--
 -- ==== __Examples__
 --
 -- >>> liftM2 (+) [0,1] [0,2]
@@ -1514,6 +1534,9 @@ is equivalent to
...
liftM<n> f x1 x2 ... xn
+This function can be used to define `(<*>) = ap`, if `Monad` is already
+defined for a data type.
+
 ==== __Examples__
...
...
...
pure (\x y z -> x + y * z) `ap` Just 1 `ap` Just 5 `ap` Just 10
@@ -1527,6 +1550,17 @@ ap m1 m2          = do { x1 <- m1; x2 <- m2; return (x1 x2) }
 {-# SPECIALISE ap :: IO (a -> b) -> IO a -> IO b #-}
 {-# SPECIALISE ap :: Maybe (a -> b) -> Maybe a -> Maybe b #-}
+-- | Sequence two monadic actions, discarding the result of the first one.
+--
+-- Defined as `thenM ma mb = ma >>= const mb`.
+--
+-- This can be used to define `(*>) = thenM`.
+--
+-- @since 4.23.0.0
+thenM :: (Monad m) => m a -> m b -> m b
+thenM ma mb = ma >>= const mb
+{-# INLINEABLE thenM #-}
+
 -- instances for Prelude types
 
 -- | @since base-2.01


=====================================
libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
=====================================
@@ -71,6 +71,8 @@ module GHC.Internal.Control.Monad
 
     , ap
 
+    , thenM
+
     -- ** Strict monadic functions
 
     , (<$!>)


=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -34,6 +34,7 @@ module Control.Applicative where
   liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
   liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
   optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Internal.Maybe.Maybe a)
+  thenA :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
 
 module Control.Arrow where
   -- Safety: Safe
@@ -483,6 +484,7 @@ module Control.Monad where
   replicateM_ :: forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Types.Int -> m a -> m ()
   sequence :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Traversable.Traversable t, Monad m) => t (m a) -> m (t a)
   sequence_ :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, Monad m) => t (m a) -> m ()
+  thenM :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
   unless :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f ()
   void :: forall (f :: * -> *) a. Functor f => f a -> f ()
   when :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f ()


=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -34,6 +34,7 @@ module Control.Applicative where
   liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
   liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
   optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Internal.Maybe.Maybe a)
+  thenA :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
 
 module Control.Arrow where
   -- Safety: Safe
@@ -483,6 +484,7 @@ module Control.Monad where
   replicateM_ :: forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Types.Int -> m a -> m ()
   sequence :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Traversable.Traversable t, Monad m) => t (m a) -> m (t a)
   sequence_ :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, Monad m) => t (m a) -> m ()
+  thenM :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
   unless :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f ()
   void :: forall (f :: * -> *) a. Functor f => f a -> f ()
   when :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f ()


=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -34,6 +34,7 @@ module Control.Applicative where
   liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
   liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
   optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Internal.Maybe.Maybe a)
+  thenA :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
 
 module Control.Arrow where
   -- Safety: Safe
@@ -483,6 +484,7 @@ module Control.Monad where
   replicateM_ :: forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Types.Int -> m a -> m ()
   sequence :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Traversable.Traversable t, Monad m) => t (m a) -> m (t a)
   sequence_ :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, Monad m) => t (m a) -> m ()
+  thenM :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
   unless :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f ()
   void :: forall (f :: * -> *) a. Functor f => f a -> f ()
   when :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f ()


=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -34,6 +34,7 @@ module Control.Applicative where
   liftA :: forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
   liftA3 :: forall (f :: * -> *) a b c d. Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
   optional :: forall (f :: * -> *) a. Alternative f => f a -> f (GHC.Internal.Maybe.Maybe a)
+  thenA :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
 
 module Control.Arrow where
   -- Safety: Safe
@@ -483,6 +484,7 @@ module Control.Monad where
   replicateM_ :: forall (m :: * -> *) a. GHC.Internal.Base.Applicative m => GHC.Internal.Types.Int -> m a -> m ()
   sequence :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Traversable.Traversable t, Monad m) => t (m a) -> m (t a)
   sequence_ :: forall (t :: * -> *) (m :: * -> *) a. (GHC.Internal.Data.Foldable.Foldable t, Monad m) => t (m a) -> m ()
+  thenM :: forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
   unless :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f ()
   void :: forall (f :: * -> *) a. Functor f => f a -> f ()
   when :: forall (f :: * -> *). GHC.Internal.Base.Applicative f => GHC.Internal.Types.Bool -> f () -> f ()


=====================================
testsuite/tests/profiling/should_run/callstack001.stdout
=====================================
@@ -1,2 +1,2 @@
-["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1350:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"]
-["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1350:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"]
+["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","Main.mapM.go (callstack001.hs:13:17-19)","Main.f (callstack001.hs:7:7-49)","Main.f (callstack001.hs:7:10-35)","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1364:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"]
+["GHC.Internal.TopHandler.runMainIO1 (<no location info>)","Main.main (callstack001.hs:17:8-21)","Main.mapM (callstack001.hs:10:13-17)","Main.mapM.go (callstack001.hs:(12,21)-(15,25))","GHC.Internal.Base.>>= (libraries/ghc-internal/src/GHC/Internal/Base.hs:1364:5-55)","GHC.Internal.Base.$fMonadIO1 (<no location info>)","GHC.Internal.Stack.CCS.currentCallStack (libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc:126:1-16)","GHC.Internal.Stack.CCS.currentCallStack1 (<no location info>)"]



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b2c72c039ddf3eaa292e32556a29184...

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b2c72c039ddf3eaa292e32556a29184...
You're receiving this email because of your account on gitlab.haskell.org.

    

Marge Bot (＠marge-bot)

tags

participants (1)