+section: base

+synopsis: Add definition for Generically's `mconcat` in terms of the type variable's Semigroup instance instead of using the generically derived version.

+issues: #27245

+mrs: !16011

+  * Change `Generically a`'s `Monoid` definition to require a `Semigroup` constraint, and define its `mconcat` using `(<>)` from that constraint. ([CLC proposal #413](https://github.com/haskell/core-libraries-committee/issues/413))

+                   , Semigroup(..), Void)

+-- Note that if you don't generate parent and child instances using the same

+-- method, the result may be incongruous; for example, in previous versions

+-- `mconcat` didn't use the correct `(<>)`, instead preferring a Generic version.

+--

+instance (Generic a, Semigroup a, Monoid (Rep a ())) => Monoid (Generically a) where

+  -- https://github.com/haskell/core-libraries-committee/issues/324

+  mconcat :: [Generically a] -> Generically a

+  mconcat = foldr (coerce @(a -> a -> a) (<>)) mempty

+  {-# INLINE mconcat #-}

+

+{-# LANGUAGE DerivingVia #-}

+{-# LANGUAGE UndecidableInstances #-}

+{-# LANGUAGE AllowAmbiguousTypes #-}

+{-# LANGUAGE ScopedTypeVariables #-}

+

+import GHC.Generics

+import Data.Coerce

+import Data.Semigroup

+import Data.List.NonEmpty qualified as NE

+import Control.Exception

+

+main :: IO ()

+main = do

+  let l1 = L [1]

+      l2 = L [2]

+  -- check append functions; this is a regression test for later down the line

+  print ("sappend", l1 <> l2)

+  print ("mappend", l1 `mappend` l2)

+  print ("gappend", l1 `gappend` l2)

+  -- when `mappend` is removed from `Monoid`, `mappend`'s definition will be

+  -- `mappend = (<>)` at the top level, removing the above `mappend = gappend` issue

+

+  -- check concat functions

+  -- We have the defined method functions, the generic variants, and the

+  -- default implementations written out again

+  let ls = [l1, l2]

+      lsNE = l1 NE.:| [l2]

+  print ("sconcat", sconcat lsNE)

+  print ("mconcat", mconcat ls)

+  print ("gsconcat", gsconcat lsNE)

+  print ("gmconcat", gmconcat ls)

+  print ("dsconcat", dsconcat lsNE)

+  print ("dmconcatMappend", dmconcatMappend ls) -- uses `mappend` which is incorrect, see above

+  print ("dmconcatSappend", dmconcatSappend ls)

+  print ("dmconcatUsingSconcat", dmconcatUsingSconcat ls)

+

+  let undefinedList = l1 : undefined

+      fOn s f = print ("strictness " <> s, f undefinedList)

+  (fOn "mconcat" mconcat `finally` -- derived instance is fine, shows

+    fOn "gmconcat" gmconcat `finally` -- this is too strict - using mappend on lists needs all lists

+    fOn "dmconcatMappend" dmconcatMappend `finally` -- also too strict for the above

+    fOn "dmconcatSappend" dmconcatSappend `finally` -- correct strictness, shows

+    fOn "dmconcatUsingSconcat" dmconcatUsingSconcat -- sconcat is too strict as well

+    ) `catch` \(_ :: SomeException) -> pure ()

+

+newtype L a = L [a]

+  deriving (Generic, Show, Eq)

+  deriving Monoid via (Generically (L a))

+

+-- semigroup instance not derived with Generically, so it could be mis-aligned

+-- with generic monoid definition

+instance Semigroup (L a) where

+  L [] <> l = l

+  l <> _ = l

+

+-- generic (<>)

+gappend :: forall a . (Generic a, Semigroup (Rep a ())) => a -> a -> a

+gappend a b = to (from a <> from b :: Rep a ())

+

+-- generic sconcat

+gsconcat :: forall a . (Generic a, Semigroup (Rep a ())) => NE.NonEmpty a -> a

+gsconcat = to . sconcat @(Rep a ()) . fmap from

+

+-- generic mconcat

+gmconcat :: forall a . (Generic a, Monoid (Rep a ())) => [a] -> a

+gmconcat = to . mconcat @(Rep a ()) . fmap from

+

+-- default sconcat

+dsconcat :: forall a . Semigroup a => NE.NonEmpty a -> a

+dsconcat (a NE.:| as) = go a as where

+  go b (c:cs) = b <> go c cs

+  go b []     = b

+

+-- default mconcat using mappend

+dmconcatMappend :: Monoid a => [a] -> a

+dmconcatMappend = foldr mappend mempty

+

+-- default mconcat using (<>), also the new generically impl

+dmconcatSappend :: Monoid a => [a] -> a

+dmconcatSappend = foldr (<>) mempty

+

+-- incorrect impl, too strict in the spine

+dmconcatUsingSconcat :: Monoid a => [a] -> a

+dmconcatUsingSconcat as = case as of

+  [] -> mempty

+  x : xs -> sconcat (x NE.:| xs)

+("sappend",L [1])

+("mappend",L [1,2])

+("gappend",L [1,2])

+("sconcat",L [1])

+("mconcat",L [1])

+("gsconcat",L [1,2])

+("gmconcat",L [1,2])

+("dsconcat",L [1])

+("dmconcatMappend",L [1,2])

+("dmconcatSappend",L [1])

+("dmconcatUsingSconcat",L [1])

+("strictness mconcat",L [1])

+("strictness dmconcatSappend",L [1])

+test('T27245', normal, compile_and_run, [''])

+instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’

+instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’

+instance forall a. (GHC.Internal.Generics.Generic a, GHC.Internal.Base.Semigroup a, GHC.Internal.Base.Monoid (GHC.Internal.Generics.Rep a ())) => GHC.Internal.Base.Monoid (GHC.Internal.Generics.Generically a) -- Defined in ‘GHC.Internal.Generics’