Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
-
cc650b4b
by Andrew Lelechenko at 2025-07-17T12:30:24-04:00
6 changed files:
- libraries/base/changelog.md
- libraries/base/src/Data/List/NonEmpty.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
Changes:
| 1 | 1 | # Changelog for [`base` package](http://hackage.haskell.org/package/base)
|
| 2 | 2 | |
| 3 | +## 4.23.0.0 *TBA*
|
|
| 4 | + * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337))
|
|
| 5 | + |
|
| 3 | 6 | ## 4.22.0.0 *TBA*
|
| 4 | 7 | * Define `displayException` of `SomeAsyncException` to unwrap the exception.
|
| 5 | 8 | ([CLC proposal #309](https://github.com/haskell/core-libraries-committee/issues/309))
|
| ... | ... | @@ -78,6 +78,7 @@ module Data.List.NonEmpty ( |
| 78 | 78 | , span -- :: (a -> Bool) -> NonEmpty a -> ([a], [a])
|
| 79 | 79 | , break -- :: (a -> Bool) -> NonEmpty a -> ([a], [a])
|
| 80 | 80 | , filter -- :: (a -> Bool) -> NonEmpty a -> [a]
|
| 81 | + , mapMaybe -- :: (a -> Maybe b) -> NonEmpty a -> [b]
|
|
| 81 | 82 | , partition -- :: (a -> Bool) -> NonEmpty a -> ([a],[a])
|
| 82 | 83 | , group -- :: (Foldable f, Eq a) => f a -> [NonEmpty a]
|
| 83 | 84 | , groupBy -- :: Foldable f => (a -> a -> Bool) -> f a -> [NonEmpty a]
|
| ... | ... | @@ -118,6 +119,7 @@ import qualified Prelude |
| 118 | 119 | |
| 119 | 120 | import Control.Applicative (Applicative (..), Alternative (many))
|
| 120 | 121 | import qualified Data.List as List
|
| 122 | +import qualified Data.Maybe as List (mapMaybe)
|
|
| 121 | 123 | import GHC.Internal.Data.Foldable hiding (length, toList)
|
| 122 | 124 | import qualified GHC.Internal.Data.Foldable as Foldable
|
| 123 | 125 | import GHC.Internal.Data.Function (on)
|
| ... | ... | @@ -442,6 +444,14 @@ break p = span (not . p) |
| 442 | 444 | filter :: (a -> Bool) -> NonEmpty a -> [a]
|
| 443 | 445 | filter p = List.filter p . toList
|
| 444 | 446 | |
| 447 | +-- | The 'mapMaybe' function is a version of 'map' which can throw
|
|
| 448 | +-- out elements. In particular, the functional argument returns
|
|
| 449 | +-- something of type @'Maybe' b@. If this is 'Nothing', no element
|
|
| 450 | +-- is added on to the result list. If it is @'Just' b@, then @b@ is
|
|
| 451 | +-- included in the result list.
|
|
| 452 | +mapMaybe :: (a -> Maybe b) -> NonEmpty a -> [b]
|
|
| 453 | +mapMaybe f (x :| xs) = maybe id (:) (f x) $ List.mapMaybe f xs
|
|
| 454 | + |
|
| 445 | 455 | -- | The 'partition' function takes a predicate @p@ and a stream
|
| 446 | 456 | -- @xs@, and returns a pair of lists. The first list corresponds to the
|
| 447 | 457 | -- elements of @xs@ for which @p@ holds; the second corresponds to the
|
| ... | ... | @@ -1467,6 +1467,7 @@ module Data.List.NonEmpty where |
| 1467 | 1467 | last :: forall a. NonEmpty a -> a
|
| 1468 | 1468 | length :: forall a. NonEmpty a -> GHC.Internal.Types.Int
|
| 1469 | 1469 | map :: forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
|
| 1470 | + mapMaybe :: forall a b. (a -> GHC.Internal.Maybe.Maybe b) -> NonEmpty a -> [b]
|
|
| 1470 | 1471 | nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a)
|
| 1471 | 1472 | nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a
|
| 1472 | 1473 | nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a
|
| ... | ... | @@ -1467,6 +1467,7 @@ module Data.List.NonEmpty where |
| 1467 | 1467 | last :: forall a. NonEmpty a -> a
|
| 1468 | 1468 | length :: forall a. NonEmpty a -> GHC.Internal.Types.Int
|
| 1469 | 1469 | map :: forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
|
| 1470 | + mapMaybe :: forall a b. (a -> GHC.Internal.Maybe.Maybe b) -> NonEmpty a -> [b]
|
|
| 1470 | 1471 | nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a)
|
| 1471 | 1472 | nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a
|
| 1472 | 1473 | nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a
|
| ... | ... | @@ -1467,6 +1467,7 @@ module Data.List.NonEmpty where |
| 1467 | 1467 | last :: forall a. NonEmpty a -> a
|
| 1468 | 1468 | length :: forall a. NonEmpty a -> GHC.Internal.Types.Int
|
| 1469 | 1469 | map :: forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
|
| 1470 | + mapMaybe :: forall a b. (a -> GHC.Internal.Maybe.Maybe b) -> NonEmpty a -> [b]
|
|
| 1470 | 1471 | nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a)
|
| 1471 | 1472 | nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a
|
| 1472 | 1473 | nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a
|
| ... | ... | @@ -1467,6 +1467,7 @@ module Data.List.NonEmpty where |
| 1467 | 1467 | last :: forall a. NonEmpty a -> a
|
| 1468 | 1468 | length :: forall a. NonEmpty a -> GHC.Internal.Types.Int
|
| 1469 | 1469 | map :: forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
|
| 1470 | + mapMaybe :: forall a b. (a -> GHC.Internal.Maybe.Maybe b) -> NonEmpty a -> [b]
|
|
| 1470 | 1471 | nonEmpty :: forall a. [a] -> GHC.Internal.Maybe.Maybe (NonEmpty a)
|
| 1471 | 1472 | nub :: forall a. GHC.Internal.Classes.Eq a => NonEmpty a -> NonEmpty a
|
| 1472 | 1473 | nubBy :: forall a. (a -> a -> GHC.Internal.Types.Bool) -> NonEmpty a -> NonEmpty a
|