diff options
author | Ben Gamari <ben@smart-cactus.org> | 2019-06-16 09:59:17 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-06-18 16:02:07 -0400 |
commit | 74bd6b225d94838811b885f9fdf943a5900cb424 (patch) | |
tree | 805b4546db469be0300c03d83c9808a6d6691d26 | |
parent | a491e40c5b7b20ef4a579a6697fb47410e0de25a (diff) | |
download | haskell-74bd6b225d94838811b885f9fdf943a5900cb424.tar.gz |
testsuite: Add test for #16832
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T16832.hs | 40 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T16832.script | 2 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 1 |
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, ['']) |