diff options
Diffstat (limited to 'testsuite')
-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, ['']) |