[commit: ghc] master: Test Trac #9747 (dbbffb7)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/dbbffb7bd59c2c0d098afacad7c88c53588f0faa/ghc

>---------------------------------------------------------------

commit dbbffb7bd59c2c0d098afacad7c88c53588f0faa
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Fri Oct 31 08:53:52 2014 +0000

    Test Trac #9747


>---------------------------------------------------------------

dbbffb7bd59c2c0d098afacad7c88c53588f0faa
 .../tests/indexed-types/should_compile/T9747.hs    | 39 ++++++++++++++++++++++
 testsuite/tests/indexed-types/should_compile/all.T |  1 +
 2 files changed, 40 insertions(+)

diff --git a/testsuite/tests/indexed-types/should_compile/T9747.hs b/testsuite/tests/indexed-types/should_compile/T9747.hs
new file mode 100644
index 0000000..05b4397
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T9747.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, TypeFamilies, TypeOperators #-}
+module T9747 where
+import Data.List (intercalate)
+import Data.Proxy
+import GHC.Prim (Constraint)
+
+data HList :: [*] -> * where
+  Nil :: HList '[]
+  Cons :: a -> HList as -> HList (a ': as)
+
+type family HListAll (c :: * -> Constraint) (ts :: [*]) :: Constraint where
+  HListAll c '[] = ()
+  HListAll c (t ': ts) = (c t, HListAll c ts)
+
+showHList :: HListAll Show ts => HList ts -> String
+showHList = ("[" ++ ) . (++"]") . intercalate ", " . go
+  where
+    go :: HListAll Show ts => HList ts -> [String]
+    go Nil = []
+    go (Cons x xs) = show x : go xs
+
+-- Things work okay up to this point
+test :: String
+test = showHList (Cons (2::Int)
+                 (Cons (3.1 :: Float)
+                 (Cons 'c' Nil)))
+
+type family ConFun (t :: *) :: * -> Constraint
+data Tag
+type instance ConFun Tag = Group
+
+class (Show a, Eq a, Ord a) => Group a
+
+-- This is notionally similar to showHList
+bar :: HListAll (ConFun l) ts => Proxy l -> HList ts -> ()
+bar _ _ = ()
+
+baz :: (ConFun l a, ConFun l b) => Proxy l -> HList [a,b] -> ()
+baz = bar
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index 32c42d1..445804a 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -248,3 +248,4 @@ test('T9316', normal, compile, [''])
 test('red-black-delete', normal, compile, [''])
 test('Sock', normal, compile, [''])
 test('T9211', normal, compile, [''])
+test('T9747', normal, compile, [''])