testsuite: Add test for #16832wip/T16832

3 files changed, 43 insertions, 0 deletions

diff --git a/testsuite/tests/typecheck/should_compile/T16832.hs b/testsuite/tests/typecheck/should_compile/T16832.hs
new file mode 100644
index 0000000000..8dcd40fe68
--- /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 0000000000..8bafa2c71d
--- /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 d0f54c0eca..8534a2c327 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, [''])