Hi Alastair,
Is there any way that I can use a Typ (i.e., a reified Type) as a Type inside a template so that I can use the Typ to select an instance of a type class.
For example, I'd like to be able to write (this doesn't parse):
$(test [t[ Float ]] "1.0") test :: Q Typ -> String -> Q [Dec] test qty x = do ty <- qty print (read x :: $ty) -- The ':: $ty' part is the important bit return []
I think the following should do the job -------- {- TypeSplices.hs -} module TypeSplices where import Language.Haskell.THSyntax rtype :: TypeQ rtype = return (ConT "Float") test :: TypeQ -> ExpQ test rtype = lamE [varP "x"] (sigE (appE (varE "read") (varE "x")) rtype) ----------- {- Main.hs -} module Main where import TypeSplices import Language.Haskell.THSyntax main :: IO () main = putStrLn (show ($(test rtype) "123.45")) ---------- This compiles under ghc-6.1 and will require a few subtle changes for ghc-6.0. It correctly reads "123.45" as a float. Interestingly, declaring test as: test rtype = [| \x -> read x :: $(rtype) |] does not work as we get a parse error on "$(". Something to get fixed? Note that you cannot pass the reified type (rtype) as an argument at run-time, and you must declare rtype in TypeSplices.hs. This may not be what you wanted of course, but this is outside the scope of what Template Haskell is capable of. Sean