Add regression test for #13758

2 files changed, 59 insertions, 1 deletions

diff --git a/testsuite/tests/deriving/should_compile/T13758.hs b/testsuite/tests/deriving/should_compile/T13758.hs
new file mode 100644
index 0000000000..91ddd99b77
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T13758.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# Language ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+module T13758 where
+
+import Data.Coerce
+import GHC.Generics
+import Data.Semigroup
+
+-----
+
+class Monoid' f where
+  mempty'  :: f x
+  mappend' :: f x -> f x -> f x
+
+instance Monoid' U1 where
+  mempty' = U1
+  mappend' U1 U1 = U1
+
+instance Monoid a => Monoid' (K1 i a) where
+  mempty' = K1 mempty
+  mappend' (K1 x) (K1 y) = K1 (x `mappend` y)
+
+instance Monoid' f => Monoid' (M1 i c f) where
+  mempty' = M1 mempty'
+  mappend' (M1 x) (M1 y) = M1 (x `mappend'` y)
+
+instance (Monoid' f, Monoid' h) => Monoid' (f :*: h) where
+  mempty' = mempty' :*: mempty'
+  mappend' (x1 :*: y1) (x2 :*: y2) = mappend' x1 x2 :*: mappend' y1 y2
+
+memptydefault :: (Generic a, Monoid' (Rep a)) => a
+memptydefault = to mempty'
+
+mappenddefault :: (Generic a, Monoid' (Rep a)) => a -> a -> a
+mappenddefault x y = to (mappend' (from x) (from y))
+
+-----
+
+newtype GenericMonoid a = GenericMonoid a
+
+instance (Generic a, Monoid' (Rep a)) => Semigroup (GenericMonoid a) where
+  (<>) = coerce (mappenddefault :: a -> a -> a)
+
+instance (Generic a, Monoid' (Rep a)) => Monoid (GenericMonoid a) where
+  mempty  = coerce (memptydefault  :: a)
+  mappend = coerce (mappenddefault :: a -> a -> a)
+
+data Urls = Urls String String String
+  deriving (Show, Generic)
+
+newtype UrlsDeriv = UD (GenericMonoid Urls)
+  deriving (Semigroup, Monoid)
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 837bb04856..36476d5f9c 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -1,6 +1,6 @@
 def just_the_deriving( msg ):
   return msg[0:msg.find('Filling in method body')]
-  
+
 test('drv001', normal, compile, [''])
 test('drv002', normal, compile, [''])
 test('drv003', normal, compile, [''])
@@ -88,5 +88,6 @@ test('T12814', normal, compile, ['-Wredundant-constraints'])
 test('T13272', normal, compile, [''])
 test('T13272a', normal, compile, [''])
 test('T13297', normal, compile, [''])
+test('T13758', normal, compile, [''])
 test('drv-empty-data', [normalise_errmsg_fun(just_the_deriving)],compile, ['-ddump-deriv -dsuppress-uniques'])
 test('drv-phantom', [normalise_errmsg_fun(just_the_deriving)],compile, ['-ddump-deriv -dsuppress-uniques'])