Commit 131987ad authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Test instance reification (Trac #1835)

parent 51da30f7
{-# LANGUAGE TemplateHaskell, FlexibleInstances,
MultiParamTypeClasses, TypeSynonymInstances #-}
module Main where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
class Eq a => MyClass a
data Foo = Foo deriving Eq
instance MyClass Foo
data Bar = Bar
deriving Eq
type Baz = Bar
instance MyClass Baz
data Quux a = Quux a deriving Eq
data Quux2 a = Quux2 a deriving Eq
instance Eq a => MyClass (Quux a)
instance Num a => MyClass (Quux2 a)
class MyClass2 a b
instance MyClass2 Int Bool
main = do
putStrLn $(do { info <- reify ''MyClass; lift (pprint info) })
print $(isClassInstance ''Eq [ConT ''Foo] >>= lift)
print $(isClassInstance ''MyClass [ConT ''Foo] >>= lift)
print $ not $(isClassInstance ''Show [ConT ''Foo] >>= lift)
print $(isClassInstance ''MyClass [ConT ''Bar] >>= lift) -- this one
print $(isClassInstance ''MyClass [ConT ''Baz] >>= lift)
print $(isClassInstance ''MyClass [AppT (ConT ''Quux) (ConT ''Int)] >>= lift) --this one
print $(isClassInstance ''MyClass [AppT (ConT ''Quux2) (ConT ''Int)] >>= lift) -- this one
print $(isClassInstance ''MyClass2 [ConT ''Int, ConT ''Bool] >>= lift)
print $(isClassInstance ''MyClass2 [ConT ''Bool, ConT ''Bool] >>= lift)
class GHC.Classes.Eq a_0 => Main.MyClass a_0
instance Main.MyClass Main.Foo
instance Main.MyClass Main.Baz
instance GHC.Classes.Eq a_1 => Main.MyClass (Main.Quux a_1)
instance GHC.Num.Num a_2 => Main.MyClass (Main.Quux2 a_2)
......@@ -166,3 +166,4 @@ test('T4056', normal, compile, ['-v0'])
test('T4188', normal, compile, ['-v0'])
test('T4233', normal, compile, ['-v0'])
test('T4169', normal, compile, ['-v0'])
test('T1835', normal, compile_and_run, ['-v0'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment