Language/Haskell/TH/Quote.hs

{-# LANGUAGE RankNTypes, ScopedTypeVariables #-}
module Language.Haskell.TH.Quote(
	QuasiQuoter(..),
 dataToQa, dataToExpQ, dataToPatQ,
 quoteFile
 ) where

import Data.Data
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax

data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp,
 quotePat :: String -> Q Pat,
 quoteType :: String -> Q Type,
 quoteDec :: String -> Q [Dec] }

dataToQa :: forall a k q. Data a
 => (Name -> k)
 -> (Lit -> Q q)
 -> (k -> [Q q] -> Q q)
 -> (forall b . Data b => b -> Maybe (Q q))
 -> a
 -> Q q
dataToQa mkCon mkLit appCon antiQ t =
 case antiQ t of
 Nothing ->
 case constrRep constr of
 AlgConstr _ ->
 appCon (mkCon conName) conArgs
 where
 conName :: Name
 conName =
 case showConstr constr of
 "(:)" -> Name (mkOccName ":") NameS
 con@"[]" -> Name (mkOccName con) NameS
 con@('(':_) -> Name (mkOccName con) NameS
 con -> mkNameG_d (tyConPackage tycon)
 (tyConModule tycon)
 con
 where
 tycon :: TyCon
 tycon = (typeRepTyCon . typeOf) t

 conArgs :: [Q q]
 conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
 IntConstr n ->
 mkLit $ integerL n
 FloatConstr n ->
 mkLit $ rationalL n
 CharConstr c ->
 mkLit $ charL c
 where
 constr :: Constr
 constr = toConstr t

 Just y -> y

-- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the same
-- value. It takes a function to handle type-specific cases.
dataToExpQ :: Data a
 => (forall b . Data b => b -> Maybe (Q Exp))
 -> a
 -> Q Exp
dataToExpQ = dataToQa conE litE (foldl appE)

-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same
-- value. It takes a function to handle type-specific cases.
dataToPatQ :: Data a
 => (forall b . Data b => b -> Maybe (Q Pat))
 -> a
 -> Q Pat
dataToPatQ = dataToQa id litP conP

-- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read
-- the data out of a file. For example, suppose 'asmq' is an 
-- assembly-language quoter, so that you can write [asmq| ld r1, r2 |]
-- as an expression. Then if you define @asmq_f = quoteFile asmq@, then
-- the quote [asmq_f| foo.s |] will take input from file "foo.s" instead
-- of the inline text
quoteFile :: QuasiQuoter -> QuasiQuoter
quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec = qd }) 
 = QuasiQuoter { quoteExp = get qe, quotePat = get qp, quoteType = get qt, quoteDec = get qd }
 where
 get :: (String -> Q a) -> String -> Q a
 get old_quoter file_name = do { file_cts <- runIO (readFile file_name) 
 ; old_quoter file_cts }