Add specialized sconcat implementation for Data.Monoid.First and Data.Semigroup.First

Approved CLC Proposal: https://github.com/haskell/core-libraries-committee/issues/246
Fixes: #24346

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/).

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

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

testsuite/tests/lib/base/First-Monoid-sconcat.hs

+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) : []

testsuite/tests/lib/base/First-Monoid-sconcat.stdout

+First {getFirst = Just 1}
+First {getFirst = Just 2}
+First {getFirst = Just 3}

testsuite/tests/lib/base/First-Semigroup-sconcat.hs

+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 : []

testsuite/tests/lib/base/First-Semigroup-sconcat.stdout

+First {getFirst = 1}
+First {getFirst = 1}

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, [''])