[Template-haskell] Record constructors

Derek Elkins ddarius86@hotmail.com
Thu, 13 Feb 2003 22:09:10 -0500


Quasiquoted expressions involving record construction syntax dies.  
Furthermore, how do you even generate a record constructor declaration?  
There's no place to put the record name.

module Main where
import Language.Haskell.THSyntax
import Text.PrettyPrint.HughesPJ (render)

data Lang a b = Lang {
    tvarAlg :: String -> a,
    arrowAlg :: a -> a -> a,
    varAlg :: String -> b,
    applyAlg :: b -> b -> b,
    lambdaAlg :: (String, a) -> b -> b
}

e = [| let t = Lang { tvarAlg      = \s -> (),
                      arrowAlg     = \x y -> (),
                      varAlg       = \s -> (),
                      applyAlg     = \x y -> (),
                      lambdaAlg    = \x y -> ()
                    }
            in tvarAlg t |]

main = do output <- runQ e
          putStrLn $ render $ pprExp output
          putStrLn "\n"
          putStrLn $ show output

_________________________________________________________________
Add photos to your messages with MSN 8. Get 2 months FREE*.  
http://join.msn.com/?page=features/featuredemail