diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index df7e6c40ae67fc7dbdc0c55aed931c28a48e6263..11c3a4cbb56acfa99a228dbf57b55fbb2abe8a5a 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -6,6 +6,7 @@ * The `HasField` class now supports representation polymorphism ([CLC proposal #194](https://github.com/haskell/core-libraries-committee/issues/194)) * Make `read` accept binary integer notation ([CLC proposal #177](https://github.com/haskell/core-libraries-committee/issues/177)) * Improve the performance of `Data.List.sort` using an improved merging strategy. Instead of `compare`, `sort` now uses `(>)` which may break *malformed* `Ord` instances ([CLC proposal #236](https://github.com/haskell/core-libraries-committee/issues/236)) + * Add `firstA` and `secondA` to `Data.Bitraversable`. ([CLC proposal #172](https://github.com/haskell/core-libraries-committee/issues/172)) ## 4.20.0.0 *TBA* * Deprecate `GHC.Pack` ([#21461](https://gitlab.haskell.org/ghc/ghc/-/issues/21461)) diff --git a/libraries/base/src/Data/Bitraversable.hs b/libraries/base/src/Data/Bitraversable.hs index a0c1f2e61a6c767a26683c5244fd71c7622dd2f1..374aaf9ee3eddf3a490ab4635c3893e3e9c50588 100644 --- a/libraries/base/src/Data/Bitraversable.hs +++ b/libraries/base/src/Data/Bitraversable.hs @@ -18,6 +18,8 @@ module Data.Bitraversable , bisequenceA , bisequence , bimapM + , firstA + , secondA , bifor , biforM , bimapAccumL @@ -172,6 +174,60 @@ bimapM = bitraverse bisequence :: (Bitraversable t, Applicative f) => t (f a) (f b) -> f (t a b) bisequence = bitraverse id id +-- | Traverses only over the first argument. +-- +-- @'firstA' f ≡ 'bitraverse' f 'pure'@ + +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> firstA listToMaybe (Left []) +-- Nothing +-- +-- >>> firstA listToMaybe (Left [1, 2, 3]) +-- Just (Left 1) +-- +-- >>> firstA listToMaybe (Right [4, 5]) +-- Just (Right [4, 5]) +-- +-- >>> firstA listToMaybe ([1, 2, 3], [4, 5]) +-- Just (1,[4, 5]) +-- +-- >>> firstA listToMaybe ([], [4, 5]) +-- Nothing + +-- @since 4.21.0.0 +firstA :: Bitraversable t => Applicative f => (a -> f c) -> t a b -> f (t c b) +firstA f = bitraverse f pure + +-- | Traverses only over the second argument. +-- +-- @'secondA' f ≡ 'bitraverse' 'pure' f@ +-- +-- ==== __Examples__ +-- +-- Basic usage: +-- +-- >>> secondA (find odd) (Left []) +-- Just (Left []) +-- +-- >>> secondA (find odd) (Left [1, 2, 3]) +-- Just (Left [1,2,3]) +-- +-- >>> secondA (find odd) (Right [4, 5]) +-- Just (Right 5) +-- +-- >>> secondA (find odd) ([1, 2, 3], [4, 5]) +-- Just ([1,2,3],5) +-- +-- >>> secondA (find odd) ([1,2,3], [4]) +-- Nothing +-- +-- @since 4.21.0.0 +secondA :: Bitraversable t => Applicative f => (b -> f c) -> t a b -> f (t a c) +secondA f = bitraverse pure f + -- | Class laws for tuples hold only up to laziness. The -- Bitraversable methods are lazier than their Traversable counterparts. -- For example the law @'bitraverse' 'pure' ≡ 'traverse'@ does diff --git a/testsuite/tests/interface-stability/base-exports.stdout b/testsuite/tests/interface-stability/base-exports.stdout index 968f297ea5289bcad9f6311cd6a2ee6f97369cdd..0e8f2cb9c1c6751434858453375502ac3afdc59e 100644 --- a/testsuite/tests/interface-stability/base-exports.stdout +++ b/testsuite/tests/interface-stability/base-exports.stdout @@ -679,6 +679,8 @@ module Data.Bitraversable where bimapM :: forall (t :: * -> * -> *) (f :: * -> *) a c b d. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) bisequence :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b) bisequenceA :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b) + firstA :: forall (t :: * -> * -> *) (f :: * -> *) a c b. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> t a b -> f (t c b) + secondA :: forall (t :: * -> * -> *) (f :: * -> *) b c a. (Bitraversable t, GHC.Internal.Base.Applicative f) => (b -> f c) -> t a b -> f (t a c) module Data.Bits where -- Safety: Safe diff --git a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs index ef4bcf866fa6149877f34fd9a937e58b59b29708..9a365415902e1ba64b3f0a82761391604312957a 100644 --- a/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs +++ b/testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs @@ -679,6 +679,8 @@ module Data.Bitraversable where bimapM :: forall (t :: * -> * -> *) (f :: * -> *) a c b d. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) bisequence :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b) bisequenceA :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b) + firstA :: forall (t :: * -> * -> *) (f :: * -> *) a c b. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> t a b -> f (t c b) + secondA :: forall (t :: * -> * -> *) (f :: * -> *) b c a. (Bitraversable t, GHC.Internal.Base.Applicative f) => (b -> f c) -> t a b -> f (t a c) module Data.Bits where -- Safety: Safe diff --git a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 b/testsuite/tests/interface-stability/base-exports.stdout-mingw32 index b288c0684ff2e9458b6711e2ae2d8ebffc8d683d..3ee181fb052ad5d5bc8828f36b3d95ab9b264157 100644 --- a/testsuite/tests/interface-stability/base-exports.stdout-mingw32 +++ b/testsuite/tests/interface-stability/base-exports.stdout-mingw32 @@ -679,6 +679,8 @@ module Data.Bitraversable where bimapM :: forall (t :: * -> * -> *) (f :: * -> *) a c b d. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) bisequence :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b) bisequenceA :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b) + firstA :: forall (t :: * -> * -> *) (f :: * -> *) a c b. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> t a b -> f (t c b) + secondA :: forall (t :: * -> * -> *) (f :: * -> *) b c a. (Bitraversable t, GHC.Internal.Base.Applicative f) => (b -> f c) -> t a b -> f (t a c) module Data.Bits where -- Safety: Safe diff --git a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 b/testsuite/tests/interface-stability/base-exports.stdout-ws-32 index 968f297ea5289bcad9f6311cd6a2ee6f97369cdd..0e8f2cb9c1c6751434858453375502ac3afdc59e 100644 --- a/testsuite/tests/interface-stability/base-exports.stdout-ws-32 +++ b/testsuite/tests/interface-stability/base-exports.stdout-ws-32 @@ -679,6 +679,8 @@ module Data.Bitraversable where bimapM :: forall (t :: * -> * -> *) (f :: * -> *) a c b d. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) bisequence :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b) bisequenceA :: forall (t :: * -> * -> *) (f :: * -> *) a b. (Bitraversable t, GHC.Internal.Base.Applicative f) => t (f a) (f b) -> f (t a b) + firstA :: forall (t :: * -> * -> *) (f :: * -> *) a c b. (Bitraversable t, GHC.Internal.Base.Applicative f) => (a -> f c) -> t a b -> f (t c b) + secondA :: forall (t :: * -> * -> *) (f :: * -> *) b c a. (Bitraversable t, GHC.Internal.Base.Applicative f) => (b -> f c) -> t a b -> f (t a c) module Data.Bits where -- Safety: Safe