diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md index b0a0cc260d7f7d619a8b172816b7df962b09e12a..7e0607ca71316d0ce38f661de14ee56bb29515cf 100644 --- a/libraries/base/changelog.md +++ b/libraries/base/changelog.md @@ -7,6 +7,7 @@ * Implement `stimes` for `instance Semigroup (Endo a)` explicitly ([CLC proposal #4](https://github.com/haskell/core-libraries-committee/issues/4)) * Add `startTimeProfileAtStartup` to `GHC.RTS.Flags` to expose new RTS flag `--no-automatic-heap-samples` in the Haskell API ([CLC proposal #243](https://github.com/haskell/core-libraries-committee/issues/243)). + * Implement `sconcat` for `instance Semigroup Data.Semigroup.First` and `instance Semigroup Data.Monoid.First` explicitly, increasing laziness ([CLC proposal #246](https://github.com/haskell/core-libraries-committee/issues/246)) * Add laws relating between `Foldable` / `Traversable` with `Bifoldable` / `Bitraversable` ([CLC proposal #205](https://github.com/haskell/core-libraries-committee/issues/205)) * The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187)) * Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/). diff --git a/libraries/base/src/Data/Semigroup.hs b/libraries/base/src/Data/Semigroup.hs index 0331c875894e388690e3aeb09d2a5663b8e7a941..a2e3fd20449f515e6ea6b1183016f2c4fb2f2066 100644 --- a/libraries/base/src/Data/Semigroup.hs +++ b/libraries/base/src/Data/Semigroup.hs @@ -458,6 +458,7 @@ instance Enum a => Enum (First a) where instance Semigroup (First a) where a <> _ = a stimes = stimesIdempotent + sconcat (x :| _) = x -- | @since 4.9.0.0 instance Functor First where diff --git a/libraries/ghc-internal/src/Data/Monoid.hs b/libraries/ghc-internal/src/Data/Monoid.hs index 922e7f1ba6aa036a57e5825977285d956643a7d4..5e899c70194098851d3caa9a135dc07c5c557475 100644 --- a/libraries/ghc-internal/src/Data/Monoid.hs +++ b/libraries/ghc-internal/src/Data/Monoid.hs @@ -156,6 +156,10 @@ instance Semigroup (First a) where First Nothing <> b = b a <> _ = a stimes = stimesIdempotentMonoid + sconcat (first@(First m) :| rest) + | Nothing <- m = mconcat rest + | otherwise = first + -- | @since 2.01 instance Monoid (First a) where diff --git a/testsuite/tests/lib/base/First-Monoid-sconcat.hs b/testsuite/tests/lib/base/First-Monoid-sconcat.hs new file mode 100644 index 0000000000000000000000000000000000000000..831c4e11d8dec087bc7341728064d2b69cb4f606 --- /dev/null +++ b/testsuite/tests/lib/base/First-Monoid-sconcat.hs @@ -0,0 +1,10 @@ +module Main where + +import Data.Monoid (First(..)) +import Data.Semigroup (sconcat) +import Data.List.NonEmpty (NonEmpty(..)) + +main = do + print . sconcat $ First Nothing :| First (Just 1) : undefined + print . sconcat $ First (Just 2) :| undefined + print . sconcat $ First Nothing :| First Nothing : First (Just 3) : [] diff --git a/testsuite/tests/lib/base/First-Monoid-sconcat.stdout b/testsuite/tests/lib/base/First-Monoid-sconcat.stdout new file mode 100644 index 0000000000000000000000000000000000000000..c7fa0951888dea54269fd341d3287209b62c18f5 --- /dev/null +++ b/testsuite/tests/lib/base/First-Monoid-sconcat.stdout @@ -0,0 +1,3 @@ +First {getFirst = Just 1} +First {getFirst = Just 2} +First {getFirst = Just 3} diff --git a/testsuite/tests/lib/base/First-Semigroup-sconcat.hs b/testsuite/tests/lib/base/First-Semigroup-sconcat.hs new file mode 100644 index 0000000000000000000000000000000000000000..1fefd0e4f416c6ec7d68a1bc0bcfa207c7b9c3a4 --- /dev/null +++ b/testsuite/tests/lib/base/First-Semigroup-sconcat.hs @@ -0,0 +1,8 @@ +module Main where + +import Data.Semigroup (sconcat, First(..)) +import Data.List.NonEmpty (NonEmpty(..)) + +main = do + print . sconcat $ First 1 :| undefined + print . sconcat $ First 1 :| First 2 : [] diff --git a/testsuite/tests/lib/base/First-Semigroup-sconcat.stdout b/testsuite/tests/lib/base/First-Semigroup-sconcat.stdout new file mode 100644 index 0000000000000000000000000000000000000000..a93d02c16ee390966254db8153fee2b466631423 --- /dev/null +++ b/testsuite/tests/lib/base/First-Semigroup-sconcat.stdout @@ -0,0 +1,2 @@ +First {getFirst = 1} +First {getFirst = 1} diff --git a/testsuite/tests/lib/base/all.T b/testsuite/tests/lib/base/all.T index 10546730824821c887943b7530c34ac871e7de15..e863b8faec89a56e4f526cae8bd2cd97a850cb3f 100644 --- a/testsuite/tests/lib/base/all.T +++ b/testsuite/tests/lib/base/all.T @@ -9,3 +9,5 @@ test('T17472', normal, compile_and_run, ['']) test('T19569b', omit_ghci, compile_and_run, ['']) test('Monoid_ByteArray', normal, compile_and_run, ['']) test('Unsnoc', normal, compile_and_run, ['']) +test('First-Semigroup-sconcat', normal, compile_and_run, ['']) +test('First-Monoid-sconcat', normal, compile_and_run, [''])