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 con conArgs
IntConstr n ->
mkLit $ integerL n
FloatConstr n ->
mkLit $ rationalL (toRational n)
CharConstr c ->
mkLit $ charL c
where
constr :: Constr
constr = toConstr t
constrName :: Constr -> String
constrName k =
case showConstr k of
"(:)" -> ":"
name -> name
con :: k
con = mkCon (mkName (constrName constr))
conArgs :: [Q q]
conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
Just y -> y
dataToExpQ :: Data a
=> (forall b . Data b => b -> Maybe (Q Exp))
-> a
-> Q Exp
dataToExpQ = dataToQa conE litE (foldl appE)
dataToPatQ :: Data a
=> (forall b . Data b => b -> Maybe (Q Pat))
-> a
-> Q Pat
dataToPatQ = dataToQa id litP conP
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 }