Skip to content
Snippets Groups Projects
Commit c8231408 authored by Ryan Scott's avatar Ryan Scott
Browse files

Add regression test for #13758

parent 7fce4cbc
No related branches found
No related tags found
No related merge requests found
{-# 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)
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'])
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment