[Template-haskell] (no subject)

Sean Seefried sseefried@cse.unsw.EDU.AU
Mon, 11 Aug 2003 17:10:02 +1000 (EST)


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