conmain.hs

{-# LANGUAGE TemplateHaskell #-}
import Constructors
import Language.Haskell.TH

$( mkGetConstructors ''Foo )

main = do putStrLn $(stringE . show =<< getConstructorNames ''Foo)
          (putStrLn.show) constructors

constructors.hs

{-# LANGUAGE TemplateHaskell #-}
module Constructors where

import Language.Haskell.TH

-- Doesn't need to be in here, but I was getting errors when it was in conmain, and didn't want it to be in a third module.
data Foo = A | B | C deriving (Show)

-- Look up a typename and get a list of the names of it's constructors
-- This will panic if you don't pass it exactly what it needs, I didn't do any error checking.
getConstructorNames :: Name -> Q [Name]
getConstructorNames typeName = do
    (TyConI (DataD [] _typeName [] constructors [])) <- reify typeName
    -- Error if it's not the type we want
    return $ map getConName constructors
        -- Explode if it's not a NormalC
        where getConName (NormalC name []) = name

-- This turns a list of names (of constructors) into an expression that is the names cons'd together.
makeConstructorList :: [Name] -> ExpQ
makeConstructorList [] = [| [] |]
makeConstructorList (c:cs) = [| $(return $ ConE c) : $(makeConstructorList cs) |]

-- This returns a top level function declaration (Dec) that defines a constant called
-- "constructors", which is a list of all the constructors.
-- I don't know how to add the type name to the name of the constant at the moment.
-- If it's called more than once, you'll get some numbers appended, I think.
mkGetConstructors :: Name -> Q [Dec]
mkGetConstructors typeName = do
    fnName <- newName "constructors" -- TODO append typename
    constructors <- getConstructorNames typeName
    fmap (:[]) (funD fnName [clause [] (normalB (makeConstructorList constructors)) []])