-- Copyright (c) 2006-2010
-- The President and Fellows of Harvard College.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions
-- are met:
-- 1. Redistributions of source code must retain the above copyright
-- notice, this list of conditions and the following disclaimer.
-- 2. Redistributions in binary form must reproduce the above copyright
-- notice, this list of conditions and the following disclaimer in the
-- documentation and/or other materials provided with the distribution.
-- 3. Neither the name of the University nor the names of its contributors
-- may be used to endorse or promote products derived from this software
-- without specific prior written permission.
-- THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY AND CONTRIBUTORS ``AS IS'' AND
-- ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
-- ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY OR CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-- LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
-- OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
-- SUCH DAMAGE.
--------------------------------------------------------------------------------
-- |
-- Module : Language.C.Quote
-- Copyright : (c) Harvard University 2006-2010
-- License : BSD-style
-- Maintainer : mainland@eecs.harvard.edu
--
--------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE TemplateHaskell #-}
module Language.C.Quote.Base (
ToExp(..),
quasiquote
) where
import Control.Monad ((>=>))
import qualified Data.ByteString.Char8 as B
import Data.Generics
import Data.Loc
import Data.Symbol
import Language.Haskell.Meta (parseExp, parsePat)
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import qualified Language.C.Parser as P
import qualified Language.C.Syntax as C
class ToExp a where
toExp :: a -> C.Exp
instance ToExp C.Exp where
toExp = id
instance ToExp Int where
toExp n = C.Const (C.IntConst (show n) C.Signed (fromIntegral n) noSrcLoc) noSrcLoc
instance ToExp Integer where
toExp n = C.Const (C.IntConst (show n) C.Signed n noSrcLoc) noSrcLoc
instance ToExp Rational where
toExp n = C.Const (C.DoubleConst (show n) n noSrcLoc) noSrcLoc
instance ToExp Float where
toExp n = C.Const (C.DoubleConst (show n) (toRational n) noSrcLoc) noSrcLoc
instance ToExp Double where
toExp n = C.Const (C.DoubleConst (show n) (toRational n) noSrcLoc) noSrcLoc
instance ToExp Char where
toExp c = C.Const (C.CharConst (show c) c noSrcLoc) noSrcLoc
instance ToExp String where
toExp s = C.Const (C.StringConst [show s] s noSrcLoc) noSrcLoc
antiVarE :: String -> ExpQ
antiVarE = either fail return . parseExp
qqLocE :: SrcLoc -> ExpQ
qqLocE loc = dataToExpQ qqExp loc
qqStringE :: String -> Maybe (Q Exp)
qqStringE s = Just $ litE $ stringL s
qqIdE :: C.Id -> Maybe (Q Exp)
qqIdE (C.AntiId v loc) = Just [|C.Id $(antiVarE v) $(qqLocE loc)|]
qqIdE _ = Nothing
qqDeclSpecE :: C.DeclSpec -> Maybe (Q Exp)
qqDeclSpecE (C.AntiDeclSpec v _) = Just $ antiVarE v
qqDeclSpecE (C.AntiTypeDeclSpec extraStorage extraTypeQuals v _) =
Just [|let C.Type (C.DeclSpec storage typeQuals typeSpec loc) _ _
= $(antiVarE v)
in
C.DeclSpec (storage ++ $(dataToExpQ qqExp extraStorage))
(typeQuals ++ $(dataToExpQ qqExp extraTypeQuals))
typeSpec
loc
|]
qqDeclSpecE _ = Nothing
qqDeclE :: C.Decl -> Maybe (Q Exp)
qqDeclE (C.AntiTypeDecl v _) =
Just [|let C.Type _ decl _ = $(antiVarE v) in decl|]
qqDeclE _ = Nothing
qqTypeE :: C.Type -> Maybe (Q Exp)
qqTypeE (C.AntiType v _) = Just $ antiVarE v
qqTypeE _ = Nothing
qqInitGroupE :: C.InitGroup -> Maybe (Q Exp)
qqInitGroupE (C.AntiDecl v _) = Just $ antiVarE v
qqInitGroupE _ = Nothing
qqInitGroupListE :: [C.InitGroup] -> Maybe (Q Exp)
qqInitGroupListE [] = Just [|[]|]
qqInitGroupListE (C.AntiDecls v _ : inis) =
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp inis)|]
qqInitGroupListE (ini : inis) =
Just [|$(dataToExpQ qqExp ini) : $(dataToExpQ qqExp inis)|]
qqFieldGroupE :: C.FieldGroup -> Maybe (Q Exp)
qqFieldGroupE (C.AntiSdecl v _) = Just $ antiVarE v
qqFieldGroupE _ = Nothing
qqFieldGroupListE :: [C.FieldGroup] -> Maybe (Q Exp)
qqFieldGroupListE [] = Just [|[]|]
qqFieldGroupListE (C.AntiSdecls v _ : fields) =
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp fields)|]
qqFieldGroupListE (field : fields) =
Just [|$(dataToExpQ qqExp field) : $(dataToExpQ qqExp fields)|]
qqCEnumE :: C.CEnum -> Maybe (Q Exp)
qqCEnumE (C.AntiEnum v _) = Just $ antiVarE v
qqCEnumE _ = Nothing
qqCEnumListE :: [C.CEnum] -> Maybe (Q Exp)
qqCEnumListE [] = Just [|[]|]
qqCEnumListE (C.AntiEnums v _ : fields) =
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp fields)|]
qqCEnumListE (field : fields) =
Just [|$(dataToExpQ qqExp field) : $(dataToExpQ qqExp fields)|]
qqParamE :: C.Param -> Maybe (Q Exp)
qqParamE (C.AntiParam v _) = Just $ antiVarE v
qqParamE _ = Nothing
qqParamListE :: [C.Param] -> Maybe (Q Exp)
qqParamListE [] = Just [|[]|]
qqParamListE (C.AntiParams v _ : args) =
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp args)|]
qqParamListE (arg : args) =
Just [|$(dataToExpQ qqExp arg) : $(dataToExpQ qqExp args)|]
qqDefinitionE :: C.Definition -> Maybe (Q Exp)
qqDefinitionE (C.AntiFunc v loc) =
Just [|C.FuncDef $(antiVarE v) $(qqLocE loc)|]
qqDefinitionE (C.AntiEsc v loc) =
Just [|C.EscDef $(antiVarE v) $(qqLocE loc)|]
qqDefinitionE (C.AntiEdecl v _) =
Just $ antiVarE v
qqDefinitionE _ = Nothing
qqDefinitionListE :: [C.Definition] -> Maybe (Q Exp)
qqDefinitionListE [] = Just [|[]|]
qqDefinitionListE (C.AntiEdecls v _ : defs) =
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp defs)|]
qqDefinitionListE (def : defs) =
Just [|$(dataToExpQ qqExp def) : $(dataToExpQ qqExp defs)|]
qqConstE :: C.Const -> Maybe (Q Exp)
qqConstE = go
where
go (C.AntiInt v loc) =
Just [|C.IntConst $(intConst (antiVarE v)) C.Signed
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiUInt v loc) =
Just [|C.IntConst ($(intConst (antiVarE v)) ++ "U") C.Unsigned
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiLInt v loc) =
Just [|C.LongIntConst ($(intConst (antiVarE v)) ++ "L") C.Signed
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiULInt v loc) =
Just [|C.LongIntConst ($(intConst (antiVarE v)) ++ "UL") C.Unsigned
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiFloat v loc) =
Just [|C.FloatConst ($(floatConst (antiVarE v)) ++ "F")
(fromRational $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiDouble v loc) =
Just [|C.DoubleConst ($(floatConst (antiVarE v)))
(fromRational $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiLongDouble v loc) =
Just [|C.LongDoubleConst ($(floatConst (antiVarE v)) ++ "L")
(fromRational $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiChar v loc) =
Just [|C.CharConst (show $(antiVarE v)) $(antiVarE v) $(qqLocE loc)|]
go (C.AntiString v loc) =
Just [|C.StringConst [show $(antiVarE v)] $(antiVarE v) $(qqLocE loc)|]
go _ = Nothing
intConst :: ExpQ -> ExpQ
intConst e = [|show $(e)|]
floatConst :: ExpQ -> ExpQ
floatConst e = [|show (fromRational $(e) :: Double)|]
qqExpE :: C.Exp -> Maybe (Q Exp)
qqExpE (C.AntiExp v _) = Just [|toExp $(antiVarE v) :: C.Exp|]
qqExpE _ = Nothing
qqExpListE :: [C.Exp] -> Maybe (Q Exp)
qqExpListE [] = Just [|[]|]
qqExpListE (C.AntiArgs v _ : exps) =
Just [|map toExp $(antiVarE v) ++ $(dataToExpQ qqExp exps)|]
qqExpListE (exp : exps) =
Just [|$(dataToExpQ qqExp exp) : $(dataToExpQ qqExp exps)|]
qqStmE :: C.Stm -> Maybe (Q Exp)
qqStmE (C.AntiStm v _) = Just $ antiVarE v
qqStmE _ = Nothing
qqStmListE :: [C.Stm] -> Maybe (Q Exp)
qqStmListE [] = Just [|[]|]
qqStmListE (C.AntiStms v _ : stms) =
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp stms)|]
qqStmListE (stm : stms) =
Just [|$(dataToExpQ qqExp stm) : $(dataToExpQ qqExp stms)|]
qqBlockItemE :: C.BlockItem -> Maybe (Q Exp)
qqBlockItemE (C.AntiBlockItem v _) = Just $ antiVarE v
qqBlockItemE _ = Nothing
qqBlockItemListE :: [C.BlockItem] -> Maybe (Q Exp)
qqBlockItemListE [] = Just [|[]|]
qqBlockItemListE (C.BlockDecl (C.AntiDecls v _) : items) =
Just [|map C.BlockDecl $(antiVarE v) ++ $(dataToExpQ qqExp items)|]
qqBlockItemListE (C.BlockStm (C.AntiStms v _) : items) =
Just [|map C.BlockStm $(antiVarE v) ++ $(dataToExpQ qqExp items)|]
qqBlockItemListE (C.AntiBlockItems v _ : items) =
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp items)|]
qqBlockItemListE (stm : stms) =
Just [|$(dataToExpQ qqExp stm) : $(dataToExpQ qqExp stms)|]
qqExp :: Typeable a => a -> Maybe (Q Exp)
qqExp = const Nothing `extQ` qqStringE
`extQ` qqIdE
`extQ` qqDeclSpecE
`extQ` qqDeclE
`extQ` qqTypeE
`extQ` qqInitGroupE
`extQ` qqInitGroupListE
`extQ` qqFieldGroupE
`extQ` qqFieldGroupListE
`extQ` qqCEnumE
`extQ` qqCEnumListE
`extQ` qqParamE
`extQ` qqParamListE
`extQ` qqDefinitionE
`extQ` qqDefinitionListE
`extQ` qqConstE
`extQ` qqExpE
`extQ` qqExpListE
`extQ` qqStmE
`extQ` qqStmListE
`extQ` qqBlockItemE
`extQ` qqBlockItemListE
antiVarP :: String -> PatQ
antiVarP = either fail return . parsePat
qqStringP :: String -> Maybe (Q Pat)
qqStringP s = Just $ litP $ stringL s
qqLocP :: Data.Loc.Loc -> Maybe (Q Pat)
qqLocP _ = Just $ wildP
qqIdP :: C.Id -> Maybe (Q Pat)
qqIdP (C.AntiId v _) = Just $ conP (mkName "C.Id") [antiVarP v, wildP]
qqIdP _ = Nothing
qqDeclSpecP :: C.DeclSpec -> Maybe (Q Pat)
qqDeclSpecP (C.AntiDeclSpec v _) = Just $ antiVarP v
qqDeclSpecP (C.AntiTypeDeclSpec {}) =
error "Illegal antiquoted type in pattern"
qqDeclSpecP _ = Nothing
qqDeclP :: C.Decl -> Maybe (Q Pat)
qqDeclP (C.AntiTypeDecl {}) =
error "Illegal antiquoted type in pattern"
qqDeclP _ = Nothing
qqTypeP :: C.Type -> Maybe (Q Pat)
qqTypeP (C.AntiType v _) = Just $ antiVarP v
qqTypeP _ = Nothing
qqInitGroupP :: C.InitGroup -> Maybe (Q Pat)
qqInitGroupP (C.AntiDecl v _) = Just $ antiVarP v
qqInitGroupP _ = Nothing
qqInitGroupListP :: [C.InitGroup] -> Maybe (Q Pat)
qqInitGroupListP [] = Just $ listP []
qqInitGroupListP [C.AntiDecls v _] = Just $ antiVarP v
qqInitGroupListP (C.AntiDecls {} : _ : _) =
error "Antiquoted list of initialization groups must be last item in quoted list"
qqInitGroupListP (ini : inis) =
Just $ conP (mkName ":") [dataToPatQ qqPat ini, dataToPatQ qqPat inis]
qqFieldGroupP :: C.FieldGroup -> Maybe (Q Pat)
qqFieldGroupP (C.AntiSdecl v _) = Just $ antiVarP v
qqFieldGroupP _ = Nothing
qqFieldGroupListP :: [C.FieldGroup] -> Maybe (Q Pat)
qqFieldGroupListP [] = Just $ listP []
qqFieldGroupListP [C.AntiSdecls v _] = Just $ antiVarP v
qqFieldGroupListP (C.AntiSdecls {} : _ : _) =
error "Antiquoted list of struct/union fields must be last item in quoted list"
qqFieldGroupListP (ini : inis) =
Just $ conP (mkName ":") [dataToPatQ qqPat ini, dataToPatQ qqPat inis]
qqCEnumP :: C.CEnum -> Maybe (Q Pat)
qqCEnumP (C.AntiEnum v _) = Just $ antiVarP v
qqCEnumP _ = Nothing
qqCEnumListP :: [C.CEnum] -> Maybe (Q Pat)
qqCEnumListP [] = Just $ listP []
qqCEnumListP [C.AntiEnums v _] = Just $ antiVarP v
qqCEnumListP (C.AntiEnums {} : _ : _) =
error "Antiquoted list of enumerations must be last item in quoted list"
qqCEnumListP (ini : inis) =
Just $ conP (mkName ":") [dataToPatQ qqPat ini, dataToPatQ qqPat inis]
qqParamP :: C.Param -> Maybe (Q Pat)
qqParamP (C.AntiParam v _) = Just $ antiVarP v
qqParamP _ = Nothing
qqParamListP :: [C.Param] -> Maybe (Q Pat)
qqParamListP [] = Just $ listP []
qqParamListP [C.AntiParams v _] = Just $ antiVarP v
qqParamListP (C.AntiParams {} : _ : _) =
error "Antiquoted list of parameters must be last item in quoted list"
qqParamListP (arg : args) =
Just $ conP (mkName ":") [dataToPatQ qqPat arg, dataToPatQ qqPat args]
qqDefinitionP :: C.Definition -> Maybe (Q Pat)
qqDefinitionP (C.AntiFunc v _) = Just $ conP (mkName "C.FuncDef") [antiVarP v, wildP]
qqDefinitionP (C.AntiEsc v _) = Just $ conP (mkName "C.EscDef") [antiVarP v, wildP]
qqDefinitionP (C.AntiEdecl v _) = Just $ antiVarP v
qqDefinitionP _ = Nothing
qqDefinitionListP :: [C.Definition] -> Maybe (Q Pat)
qqDefinitionListP [] = Just $ listP []
qqDefinitionListP [C.AntiEdecls v _] = Just $ antiVarP v
qqDefinitionListP (C.AntiEdecls {} : _ : _) =
error "Antiquoted list of definitions must be last item in quoted list"
qqDefinitionListP (arg : args) =
Just $ conP (mkName ":") [dataToPatQ qqPat arg, dataToPatQ qqPat args]
qqConstP :: C.Const -> Maybe (Q Pat)
qqConstP = go
where
go (C.AntiInt v _) =
Just $ (con "C.IntConst") [wildP, signed, antiVarP v, wildP]
go (C.AntiUInt v _) =
Just $ (con "C.IntConst") [wildP, unsigned, antiVarP v, wildP]
go (C.AntiLInt v _) =
Just $ (con "C.LongIntConst") [wildP, signed, antiVarP v, wildP]
go (C.AntiULInt v _) =
Just $ (con "C.LongIntConst") [wildP, unsigned, antiVarP v, wildP]
go (C.AntiFloat v _) =
Just $ (con "C.FloatConst") [wildP, antiVarP v, wildP]
go (C.AntiDouble v _) =
Just $ (con "C.DoubleConst") [wildP, antiVarP v, wildP]
go (C.AntiLongDouble v _) =
Just $ (con "C.LongDoubleConst") [wildP, antiVarP v, wildP]
go (C.AntiChar v _) =
Just $ (con "C.CharConst") [wildP, antiVarP v, wildP]
go (C.AntiString v _) =
Just $ (con "C.StringConst") [wildP, antiVarP v, wildP]
go _ =
Nothing
con n = conP (mkName n)
signed = conP (mkName "C.Signed") []
unsigned = conP (mkName "C.Unsigned") []
qqExpP :: C.Exp -> Maybe (Q Pat)
qqExpP (C.AntiExp v _) = Just $ antiVarP v
qqExpP _ = Nothing
qqExpListP :: [C.Exp] -> Maybe (Q Pat)
qqExpListP [] = Just $ listP []
qqExpListP [C.AntiArgs v _] = Just $ antiVarP v
qqExpListP (C.AntiArgs {} : _ : _) =
error "Antiquoted list of arguments must be last item in quoted list"
qqExpListP (arg : args) =
Just $ conP (mkName ":") [dataToPatQ qqPat arg, dataToPatQ qqPat args]
qqStmP :: C.Stm -> Maybe (Q Pat)
qqStmP (C.AntiStm v _) = Just $ antiVarP v
qqStmP _ = Nothing
qqStmListP :: [C.Stm] -> Maybe (Q Pat)
qqStmListP [] = Just $ listP []
qqStmListP [C.AntiStms v _] = Just $ antiVarP v
qqStmListP (C.AntiStms {} : _ : _) =
error "Antiquoted list of statements must be last item in quoted list"
qqStmListP (arg : args) =
Just $ conP (mkName ":") [dataToPatQ qqPat arg, dataToPatQ qqPat args]
qqBlockItemP :: C.BlockItem -> Maybe (Q Pat)
qqBlockItemP (C.AntiBlockItem v _) = Just $ antiVarP v
qqBlockItemP _ = Nothing
qqBlockItemListP :: [C.BlockItem] -> Maybe (Q Pat)
qqBlockItemListP [] = Just $ listP []
qqBlockItemListP (C.BlockDecl (C.AntiDecls {}) : _) =
error "Antiquoted list of declarations cannot appear in block"
qqBlockItemListP (C.BlockStm (C.AntiStms {}) : _) =
error "Antiquoted list of statements cannot appear in block"
qqBlockItemListP [C.AntiBlockItems v _] = Just $ antiVarP v
qqBlockItemListP (C.AntiBlockItems {} : _ : _) =
error "Antiquoted list of block items must be last item in quoted list"
qqBlockItemListP (arg : args) =
Just $ conP (mkName ":") [dataToPatQ qqPat arg, dataToPatQ qqPat args]
qqPat :: Typeable a => a -> Maybe (Q Pat)
qqPat = const Nothing `extQ` qqStringP
`extQ` qqLocP
`extQ` qqIdP
`extQ` qqDeclSpecP
`extQ` qqDeclP
`extQ` qqTypeP
`extQ` qqInitGroupP
`extQ` qqInitGroupListP
`extQ` qqFieldGroupP
`extQ` qqCEnumP
`extQ` qqCEnumListP
`extQ` qqParamP
`extQ` qqParamListP
`extQ` qqDefinitionP
`extQ` qqDefinitionListP
`extQ` qqConstP
`extQ` qqExpP
`extQ` qqExpListP
`extQ` qqStmP
`extQ` qqStmListP
`extQ` qqBlockItemP
`extQ` qqBlockItemListP
parse :: [C.Extensions]
-> [String]
-> P.P a
-> String
-> Q a
parse exts typenames p s = do
loc <- location
case P.parse exts typenames P.ParseQuasiQuote p (B.pack s) (locToPos loc) of
Left err -> fail (show err)
Right x -> return x
where
locToPos :: Language.Haskell.TH.Loc -> Pos
locToPos loc = Pos ((intern . loc_filename) loc)
((fst . loc_start) loc)
((snd . loc_start) loc)
0
quasiquote :: Data a
=> [C.Extensions]
-> [String]
-> P.P a
-> QuasiQuoter
quasiquote exts typenames p =
QuasiQuoter { quoteExp = parse exts typenames p >=> dataToExpQ qqExp
, quotePat = parse exts typenames p >=> dataToPatQ qqPat
}
dataToQa :: forall a k q. Data a
=> (String -> k)
-> (Lit -> Q q)
-> (k -> [Q q] -> Q q)
-> (forall a . Data a => a -> Maybe (Q q))
-> a
-> Q q
dataToQa mkCon mkLit appCon antiQ t =
case antiQ t of
Just x -> x
Nothing ->
case constrRep constr of
AlgConstr _ -> appCon con conArgs
IntConstr n -> mkLit $ integerL n
FloatConstr n -> mkLit $ rationalL (toRational n)
#if MIN_VERSION_template_haskell(2,4,0)
CharConstr c -> mkLit $ charL c
#else /* !MIN_VERSION_template_haskell(2,4,0) */
StringConstr [c] -> mkLit $ charL c
StringConstr s -> mkLit $ stringL s
#endif /* !MIN_VERSION_template_haskell(2,4,0) */
where
constr :: Constr
constr = toConstr t
con :: k
con = mkCon (constrName constr)
where
constrName :: Constr -> String
constrName k =
case showConstr k of
"(:)" -> ":"
name | name `elem` unqualifiedConstructors -> name
| otherwise -> "Language.C.Syntax." ++ name
conArgs :: [Q q]
conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
unqualifiedConstructors :: [String]
unqualifiedConstructors = ["[]", "(,)", "(,,)", ":%",
"True", "False",
"Just", "Nothing",
"Left", "Right",
"Symbol",
"Loc", "NoLoc", "Pos", "SrcLoc"]
dataToExpQ :: Data a
=> (forall a . Data a => a -> Maybe (Q Exp))
-> a
-> Q Exp
dataToExpQ = dataToQa mkCon litE (foldl appE)
where
mkCon :: String -> Q Exp
mkCon ":%" = (varE . mkName) "%"
mkCon s = (conE . mkName) s
dataToPatQ :: Data a
=> (forall a . Data a => a -> Maybe (Q Pat))
-> a
-> Q Pat
dataToPatQ = dataToQa mkName litP conP