summaryrefslogtreecommitdiff
path: root/testsuite/tests/deriving
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2017-02-21 10:27:41 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2017-02-21 10:30:17 +0000
commitfd841f877ab7a991f667a50b401404927f6f599c (patch)
tree04ab2246376b99915716ec1ffb4faedb63f69931 /testsuite/tests/deriving
parent59026b3be1ba9afed161e1a4cfcd98d3ee021afd (diff)
downloadhaskell-fd841f877ab7a991f667a50b401404927f6f599c.tar.gz
Fix DeriveAnyClass (again)
This patch fixes Trac #13272. The general approach was fine, but we were simply not generating the correct implication constraint (in particular generating fresh unification variables). I added a lot more commentary to Note [Gathering and simplifying constraints for DeriveAnyClass] I'm still not very happy with the overall architecture. It feels more complicate than it should.
Diffstat (limited to 'testsuite/tests/deriving')
-rw-r--r--testsuite/tests/deriving/should_compile/T13272.hs23
-rw-r--r--testsuite/tests/deriving/should_compile/T13272a.hs21
-rw-r--r--testsuite/tests/deriving/should_compile/all.T2
3 files changed, 46 insertions, 0 deletions
diff --git a/testsuite/tests/deriving/should_compile/T13272.hs b/testsuite/tests/deriving/should_compile/T13272.hs
new file mode 100644
index 0000000000..8ce3368d1c
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T13272.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+module T13272 where
+
+import GHC.Generics
+
+class TypeName a where
+ typeName :: forall proxy.
+ proxy a -> String
+ default typeName :: forall proxy d f.
+ (Generic a, Rep a ~ D1 d f, Datatype d)
+ => proxy a -> String
+ typeName _ = gtypeName $ from (undefined :: a)
+
+gtypeName :: Datatype d => D1 d f p -> String
+gtypeName = datatypeName
+
+data T a = MkT a
+ deriving (Generic, TypeName)
diff --git a/testsuite/tests/deriving/should_compile/T13272a.hs b/testsuite/tests/deriving/should_compile/T13272a.hs
new file mode 100644
index 0000000000..3621879749
--- /dev/null
+++ b/testsuite/tests/deriving/should_compile/T13272a.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+module T13272a where
+
+import GHC.Generics
+
+class TypeName a where
+ typeName :: proxy a -> String
+ default typeName :: (Generic a, Rep a ~ gg, gg ~ D1 d f, Datatype d)
+ => proxy a -> String
+ typeName _ = gtypeName $ from (undefined :: a)
+
+gtypeName :: Datatype d => D1 d f p -> String
+gtypeName = datatypeName
+
+data T a = MkT a
+ deriving (Generic, TypeName)
diff --git a/testsuite/tests/deriving/should_compile/all.T b/testsuite/tests/deriving/should_compile/all.T
index 288b3b7fdb..e16bd95034 100644
--- a/testsuite/tests/deriving/should_compile/all.T
+++ b/testsuite/tests/deriving/should_compile/all.T
@@ -82,3 +82,5 @@ test('T12594', normal, compile, [''])
test('T12616', normal, compile, [''])
test('T12688', normal, compile, [''])
test('T12814', normal, compile, ['-Wredundant-constraints'])
+test('T13272', normal, compile, [''])
+test('T13272a', normal, compile, [''])