From 4dbf59d684d350f691f4d958085f23efe20b04d3 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Sun, 16 Jun 2019 09:59:17 -0400
Subject: [PATCH] testsuite: Add test for #16832
---
.../tests/typecheck/should_compile/T16832.hs | 40 +++++++++++++++++++
.../typecheck/should_compile/T16832.script | 2 +
.../tests/typecheck/should_compile/all.T | 1 +
3 files changed, 43 insertions(+)
create mode 100644 testsuite/tests/typecheck/should_compile/T16832.hs
create mode 100644 testsuite/tests/typecheck/should_compile/T16832.script
diff --git a/testsuite/tests/typecheck/should_compile/T16832.hs b/testsuite/tests/typecheck/should_compile/T16832.hs
new file mode 100644
index 00000000000..8dcd40fe68d
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T16832.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE InstanceSigs #-}
+
+module WorkingGenerics where
+import GHC.Generics
+
+-- type family DiffT (p :: * -> *) :: * -> *
+
+data Void deriving(Generic)
+
+class Diff a where
+ type family Patch a :: *
+ type Patch a = GPatch (Rep a) a
+
+ diff :: a -> a -> Patch a
+ default diff :: (Generic a, GDiff (Rep a), Patch a ~ (GPatch (Rep a)) a) => a -> a -> Patch a
+ diff a a' = gdiff (from a) (from a')
+
+class GDiff (gen :: * -> *) where
+ type family GPatch gen :: * -> *
+ gdiff :: gen a -> gen a -> (GPatch gen) a
+
+instance GDiff V1 where
+ type GPatch V1 = V1
+ gdiff v1 _ = undefined
+
+-- meta info, we simply tunnel through
+instance (GDiff f) => GDiff (M1 i t f) where
+ type GPatch (M1 i t f) = M1 i t (GPatch f)
+ gdiff (M1 x) (M1 x') = M1 $ gdiff x x'
+
+
+instance Diff Void
+
diff --git a/testsuite/tests/typecheck/should_compile/T16832.script b/testsuite/tests/typecheck/should_compile/T16832.script
new file mode 100644
index 00000000000..8bafa2c71d7
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T16832.script
@@ -0,0 +1,2 @@
+:load T16832
+
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index d0f54c0ecaa..8534a2c3275 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -682,3 +682,4 @@ test('UnliftedNewtypesForall', normal, compile, [''])
test('UnlifNewUnify', normal, compile, [''])
test('UnliftedNewtypesLPFamily', normal, compile, [''])
test('UnliftedNewtypesDifficultUnification', normal, compile, [''])
+test('T16832', normal, ghci_script, [''])
--
GitLab