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
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 []
Sean Seefried replied:
I think the following should do the job [...] test :: TypeQ -> ExpQ test rtype = lamE [varP "x"] (sigE (appE (varE "read") (varE "x")) rtype) [...] main = putStrLn (show ($(test rtype) "123.45"))
Thanks. This seems to be subtly different from what I want though. What I want is for the string to be parsed at compile time based on a type that is provided in the code being compiled. Your code seems to generate code which will parse the string at runtime. The example of parsing a string is a vastly simplified variant of my actual goal. The reason I want to do things at compile time is that I want to use typeclasses to control how code generation is done. The idea is that the user would define a bunch of typeclasses containing code generators and then when they invoke a template, the appropriate code generator would be selected according to the type they specify. After much pondering of what template haskell would have to do for this to work (dictionary lookups, etc.), I suspect that template haskell can't do this. Instead of defining instances of typeclasses, I will have templates that add entries to a Typ-indexed lookup table and instead of type splicing I will do lookups in the table. It's not as elegant as I'd hoped (because it will largely duplicate the typeclass mechanism) but it will work. -- Alastair
participants (2)
-
Alastair Reid -
Sean Seefried