[Git][ghc/ghc][master] testsuite: Add test for #16832

[Marge Bot]

 Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
74bd6b22 by Ben Gamari at 2019-06-18T20:02:07Z
testsuite: Add test for #16832

- - - - -


3 changed files:

- + testsuite/tests/typecheck/should_compile/T16832.hs
- + testsuite/tests/typecheck/should_compile/T16832.script
- testsuite/tests/typecheck/should_compile/all.T


Changes:

=====================================
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
+


=====================================
testsuite/tests/typecheck/should_compile/T16832.script
=====================================
@@ -0,0 +1,2 @@
+:load T16832
+


=====================================
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, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/74bd6b225d94838811b885f9fdf943a5900cb424

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/74bd6b225d94838811b885f9fdf943a5900cb424
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190618/1f6aa5b8/attachment-0001.html>