[Haskell-cafe] Type classes to 'reflect' constructor structure

[Jules Bean]

In the thread 'automatic derivation', Joel Reymont is looking for 
metaprogramming functionality with which he wants to automatically 
derive a parser and a pretty printer for his ADT (which is an AST for a 
minilanguage).

I replied showing that a significant amount of the boilerplate could be 
removed anyway just using haskell's built in ability to process parsers 
as 'data'. I could completely automate the nullary constructions, but I 
needed type information for n-ary ones.

A bit of poking around with typeclasses showed a proof-of-concept for 
getting the type-checker to extract that information for us:

{-# OPTIONS -fglasgow-exts #-}
import Data.Typeable


-- Stage 1 is just counting the arguments

class CountArgs s where numArgs :: s -> Integer

data TestType = Nullary | Unary Int | Binary Int String
              | OtherBinary String Int

instance CountArgs TestType where numArgs x = 0
instance CountArgs (a->TestType) where numArgs x = 1
instance CountArgs (a->b->TestType) where numArgs x = 2

-- *Main> numArgs Nullary
-- 0
-- *Main> numArgs Unary
-- 1
-- *Main> numArgs Binary
-- 2

-- Stage 2 actually lists the types of the arguments
-- I'll use a seperate ADT to make the types concrete

data ArgTypes = JInt | JStr deriving (Show)

class ConcreteType t where makeAT :: t -> ArgTypes

instance ConcreteType Int where makeAT _ = JInt
instance ConcreteType String where makeAT _ = JStr

class DescribeArgs s where descArgs :: s -> [ArgTypes]

instance DescribeArgs TestType  where descArgs _ = []
instance ConcreteType a => DescribeArgs (a->TestType)
 where descArgs _ = [makeAT (undefined::a)]
instance (ConcreteType a, ConcreteType b) =>
    DescribeArgs (a->b->TestType)
 where descArgs _ = [makeAT (undefined::a), makeAT (undefined::b)]

-- *Main> descArgs Nullary
-- []
-- *Main> descArgs Unary
-- [JInt]
-- *Main> descArgs Binary
-- [JInt,JStr]
-- *Main> descArgs OtherBinary
-- [JStr,JInt]

-- Stage 3 is just the Data.Typeable version of the stage 2

class DescribeArgs2 s where descArgs2 :: s -> [TypeRep]

instance DescribeArgs2 TestType  where descArgs2 _ = []
instance Typeable a => DescribeArgs2 (a->TestType)
 where descArgs2 _ = [typeOf (undefined::a)]
instance (Typeable a, Typeable b) =>
    DescribeArgs2 (a->b->TestType)
 where descArgs2 _ = [typeOf (undefined::a), typeOf (undefined::b)]

-- *Main> descArgs2 Nullary
-- []
-- *Main> descArgs2 Unary
-- [Int]
-- *Main> descArgs2 Binary
-- [Int,[Char]]
-- *Main> descArgs2 OtherBinary
-- [[Char],Int]


There are still some things this approach fails on: it can't give you a 
complete list of all constructors of TestType, for example. (Such a list 
would necessarily an existential type, like [exists x . DescribeArgs x 
-> x]).

I'm sure my thoughts aren't original. Have other people taken this 
further into interesting directions? Where is the line beyond which you 
need 'true' metaprogramming?

Jules