{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -w #-}
module Language.C.Quote.Base (
ToIdent(..),
ToConst(..),
ToExp(..),
qqExp,
qqPat,
quasiquote
) where
import Control.Monad ((>=>))
import qualified Data.ByteString.Char8 as B
import Data.Char (isAscii, isPrint, ord)
import Data.Data (Data(..))
import Data.Generics (extQ)
import Data.Int
import Data.Loc
import Data.Typeable (Typeable(..))
import Data.Word
#ifdef FULL_HASKELL_ANTIQUOTES
import Language.Haskell.Meta (parseExp,parsePat)
#else
import Language.Haskell.ParseExp (parseExp,parsePat)
#endif
import Language.Haskell.TH as TH
#if MIN_VERSION_template_haskell(2,7,0)
import Language.Haskell.TH.Quote (QuasiQuoter(..),
dataToQa,
dataToExpQ,
dataToPatQ)
#else /* !MIN_VERSION_template_haskell(2,7,0) */
import Language.Haskell.TH.Quote (QuasiQuoter(..))
#endif /* !MIN_VERSION_template_haskell(2,7,0) */
import Language.Haskell.TH.Syntax
import Numeric (showOct, showHex)
import qualified Language.C.Parser as P
import qualified Language.C.Syntax as C
newtype LongDouble = LongDouble Double
class ToIdent a where
toIdent :: a -> SrcLoc -> C.Id
instance ToIdent C.Id where
toIdent :: Id -> SrcLoc -> Id
toIdent Id
ident SrcLoc
_ = Id
ident
instance ToIdent (SrcLoc -> C.Id) where
toIdent :: (SrcLoc -> Id) -> SrcLoc -> Id
toIdent SrcLoc -> Id
ident = SrcLoc -> Id
ident
instance ToIdent String where
toIdent :: String -> SrcLoc -> Id
toIdent String
s SrcLoc
loc = String -> SrcLoc -> Id
C.Id String
s SrcLoc
loc
class ToConst a where
toConst :: a -> SrcLoc -> C.Const
instance ToConst C.Const where
toConst :: Const -> SrcLoc -> Const
toConst Const
k SrcLoc
_ = Const
k
instance ToConst Int where
toConst :: Int -> SrcLoc -> Const
toConst = forall a. ToConst a => a -> SrcLoc -> Const
toConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger
instance ToConst Int8 where
toConst :: Int8 -> SrcLoc -> Const
toConst = forall a. ToConst a => a -> SrcLoc -> Const
toConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger
instance ToConst Int16 where
toConst :: Int16 -> SrcLoc -> Const
toConst = forall a. ToConst a => a -> SrcLoc -> Const
toConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger
instance ToConst Int32 where
toConst :: Int32 -> SrcLoc -> Const
toConst = forall a. ToConst a => a -> SrcLoc -> Const
toConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger
instance ToConst Int64 where
toConst :: Int64 -> SrcLoc -> Const
toConst = forall a. ToConst a => a -> SrcLoc -> Const
toConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger
instance ToConst Word where
toConst :: Word -> SrcLoc -> Const
toConst Word
n SrcLoc
loc = String -> Signed -> Integer -> SrcLoc -> Const
C.IntConst (forall a. Show a => a -> String
show Word
n) Signed
C.Unsigned (forall a. Integral a => a -> Integer
toInteger Word
n) SrcLoc
loc
instance ToConst Word8 where
toConst :: Word8 -> SrcLoc -> Const
toConst Word8
n SrcLoc
loc = String -> Signed -> Integer -> SrcLoc -> Const
C.IntConst (forall a. Show a => a -> String
show Word8
n) Signed
C.Unsigned (forall a. Integral a => a -> Integer
toInteger Word8
n) SrcLoc
loc
instance ToConst Word16 where
toConst :: Word16 -> SrcLoc -> Const
toConst Word16
n SrcLoc
loc = String -> Signed -> Integer -> SrcLoc -> Const
C.IntConst (forall a. Show a => a -> String
show Word16
n) Signed
C.Unsigned (forall a. Integral a => a -> Integer
toInteger Word16
n) SrcLoc
loc
instance ToConst Word32 where
toConst :: Word32 -> SrcLoc -> Const
toConst Word32
n SrcLoc
loc = String -> Signed -> Integer -> SrcLoc -> Const
C.IntConst (forall a. Show a => a -> String
show Word32
n) Signed
C.Unsigned (forall a. Integral a => a -> Integer
toInteger Word32
n) SrcLoc
loc
instance ToConst Word64 where
toConst :: Word64 -> SrcLoc -> Const
toConst Word64
n SrcLoc
loc = String -> Signed -> Integer -> SrcLoc -> Const
C.IntConst (forall a. Show a => a -> String
show Word64
n) Signed
C.Unsigned (forall a. Integral a => a -> Integer
toInteger Word64
n) SrcLoc
loc
instance ToConst Integer where
toConst :: Integer -> SrcLoc -> Const
toConst Integer
n SrcLoc
loc = String -> Signed -> Integer -> SrcLoc -> Const
C.IntConst (forall a. Show a => a -> String
show Integer
n) Signed
C.Signed Integer
n SrcLoc
loc
instance ToConst Rational where
toConst :: Rational -> SrcLoc -> Const
toConst Rational
n SrcLoc
loc = forall a. ToConst a => a -> SrcLoc -> Const
toConst (forall a. Fractional a => Rational -> a
fromRational Rational
n :: Double) SrcLoc
loc
instance ToConst Float where
toConst :: Float -> SrcLoc -> Const
toConst Float
n SrcLoc
loc = String -> Float -> SrcLoc -> Const
C.FloatConst (forall a. (RealFloat a, Show a) => a -> String
realFloatToString Float
n forall a. [a] -> [a] -> [a]
++ String
"F") Float
n SrcLoc
loc
instance ToConst Double where
toConst :: Double -> SrcLoc -> Const
toConst Double
n SrcLoc
loc = String -> Double -> SrcLoc -> Const
C.DoubleConst (forall a. (RealFloat a, Show a) => a -> String
realFloatToString Double
n) Double
n SrcLoc
loc
instance ToConst LongDouble where
toConst :: LongDouble -> SrcLoc -> Const
toConst (LongDouble Double
n) SrcLoc
loc = String -> Double -> SrcLoc -> Const
C.LongDoubleConst (forall a. (RealFloat a, Show a) => a -> String
realFloatToString Double
n forall a. [a] -> [a] -> [a]
++ String
"L") Double
n SrcLoc
loc
realFloatToString :: (RealFloat a, Show a) => a -> String
realFloatToString :: forall a. (RealFloat a, Show a) => a -> String
realFloatToString a
n
| forall a. RealFloat a => a -> Bool
isNaN a
n = String
"NAN"
| forall a. RealFloat a => a -> Bool
isInfinite a
n = if a
n forall a. Ord a => a -> a -> Bool
< a
0 then String
"-INFINITY" else String
"INFINITY"
| Bool
otherwise = forall a. Show a => a -> String
show a
n
instance ToConst Char where
toConst :: Char -> SrcLoc -> Const
toConst Char
c SrcLoc
loc = String -> Char -> SrcLoc -> Const
C.CharConst (String
"'" forall a. [a] -> [a] -> [a]
++ Char -> String
charToString Char
c forall a. [a] -> [a] -> [a]
++ String
"'") Char
c SrcLoc
loc
where
charToString :: Char -> String
charToString :: Char -> String
charToString Char
'\0' = String
"\\0"
charToString Char
'\a' = String
"\\a"
charToString Char
'\b' = String
"\\b"
charToString Char
'\f' = String
"\\f"
charToString Char
'\n' = String
"\\n"
charToString Char
'\r' = String
"\\r"
charToString Char
'\t' = String
"\\t"
charToString Char
'\v' = String
"\\v"
charToString Char
'\\' = String
"\\\\"
charToString Char
'\"' = String
"\\\""
charToString Char
c
| Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
isPrint Char
c = [Char
c]
| Char -> Bool
isAscii Char
c = String
"\\x" forall a. [a] -> [a] -> [a]
++ Maybe Int -> Char -> String
hexOf forall a. Maybe a
Nothing Char
c
| Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
< Int
0x10000 = String
"\\u" forall a. [a] -> [a] -> [a]
++ Maybe Int -> Char -> String
hexOf (forall a. a -> Maybe a
Just Int
4) Char
c
| Bool
otherwise = String
"\\U" forall a. [a] -> [a] -> [a]
++ Maybe Int -> Char -> String
hexOf (forall a. a -> Maybe a
Just Int
8) Char
c
where
hexOf :: Maybe Int -> Char -> String
hexOf :: Maybe Int -> Char -> String
hexOf Maybe Int
len Char
c = case Maybe Int
len of
Maybe Int
Nothing -> String
hex
Just Int
i -> forall a. Int -> a -> [a]
replicate (Int
i forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hex) Char
'0' forall a. [a] -> [a] -> [a]
++ String
hex
where
hex :: String
hex :: String
hex = forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
c) String
""
instance ToConst String where
toConst :: String -> SrcLoc -> Const
toConst String
s SrcLoc
loc = [String] -> String -> SrcLoc -> Const
C.StringConst [forall a. Show a => a -> String
show String
s] String
s SrcLoc
loc
class ToExp a where
toExp :: a -> SrcLoc -> C.Exp
instance ToExp C.Exp where
toExp :: Exp -> SrcLoc -> Exp
toExp Exp
e SrcLoc
_ = Exp
e
instance ToExp Int where
toExp :: Int -> SrcLoc -> Exp
toExp Int
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Int
n SrcLoc
loc) SrcLoc
loc
instance ToExp Int8 where
toExp :: Int8 -> SrcLoc -> Exp
toExp Int8
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Int8
n SrcLoc
loc) SrcLoc
loc
instance ToExp Int16 where
toExp :: Int16 -> SrcLoc -> Exp
toExp Int16
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Int16
n SrcLoc
loc) SrcLoc
loc
instance ToExp Int32 where
toExp :: Int32 -> SrcLoc -> Exp
toExp Int32
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Int32
n SrcLoc
loc) SrcLoc
loc
instance ToExp Int64 where
toExp :: Int64 -> SrcLoc -> Exp
toExp Int64
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Int64
n SrcLoc
loc) SrcLoc
loc
instance ToExp Word where
toExp :: Word -> SrcLoc -> Exp
toExp Word
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Word
n SrcLoc
loc) SrcLoc
loc
instance ToExp Word8 where
toExp :: Word8 -> SrcLoc -> Exp
toExp Word8
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Word8
n SrcLoc
loc) SrcLoc
loc
instance ToExp Word16 where
toExp :: Word16 -> SrcLoc -> Exp
toExp Word16
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Word16
n SrcLoc
loc) SrcLoc
loc
instance ToExp Word32 where
toExp :: Word32 -> SrcLoc -> Exp
toExp Word32
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Word32
n SrcLoc
loc) SrcLoc
loc
instance ToExp Word64 where
toExp :: Word64 -> SrcLoc -> Exp
toExp Word64
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Word64
n SrcLoc
loc) SrcLoc
loc
instance ToExp Integer where
toExp :: Integer -> SrcLoc -> Exp
toExp Integer
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Integer
n SrcLoc
loc) SrcLoc
loc
instance ToExp Rational where
toExp :: Rational -> SrcLoc -> Exp
toExp Rational
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Rational
n SrcLoc
loc) SrcLoc
loc
instance ToExp Float where
toExp :: Float -> SrcLoc -> Exp
toExp Float
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Float
n SrcLoc
loc) SrcLoc
loc
instance ToExp Double where
toExp :: Double -> SrcLoc -> Exp
toExp Double
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Double
n SrcLoc
loc) SrcLoc
loc
instance ToExp Char where
toExp :: Char -> SrcLoc -> Exp
toExp Char
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst Char
n SrcLoc
loc) SrcLoc
loc
instance ToExp String where
toExp :: String -> SrcLoc -> Exp
toExp String
n SrcLoc
loc = Const -> SrcLoc -> Exp
C.Const (forall a. ToConst a => a -> SrcLoc -> Const
toConst String
n SrcLoc
loc) SrcLoc
loc
antiVarE :: String -> ExpQ
antiVarE :: String -> ExpQ
antiVarE = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Exp
parseExp
qqLocE :: SrcLoc -> ExpQ
qqLocE :: SrcLoc -> ExpQ
qqLocE SrcLoc
loc = forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ forall a. Typeable a => a -> Maybe ExpQ
qqExp SrcLoc
loc
qqStringE :: String -> Maybe (Q Exp)
qqStringE :: String -> Maybe ExpQ
qqStringE String
s = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Lit -> m Exp
litE forall a b. (a -> b) -> a -> b
$ String -> Lit
stringL String
s
qqIdE :: C.Id -> Maybe (Q Exp)
qqIdE :: Id -> Maybe ExpQ
qqIdE (C.AntiId String
v SrcLoc
loc) = forall a. a -> Maybe a
Just [|toIdent $(antiVarE v) $(qqLocE loc)|]
qqIdE Id
_ = forall a. Maybe a
Nothing
qqDeclSpecE :: C.DeclSpec -> Maybe (Q Exp)
qqDeclSpecE :: DeclSpec -> Maybe ExpQ
qqDeclSpecE (C.AntiDeclSpec String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqDeclSpecE (C.AntiTypeDeclSpec [Storage]
extraStorage [TypeQual]
extraTypeQuals String
v SrcLoc
_) =
forall a. a -> Maybe a
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 DeclSpec
_ = forall a. Maybe a
Nothing
qqDeclE :: C.Decl -> Maybe (Q Exp)
qqDeclE :: Decl -> Maybe ExpQ
qqDeclE (C.AntiTypeDecl String
v SrcLoc
_) =
forall a. a -> Maybe a
Just [|let C.Type _ decl _ = $(antiVarE v) in decl|]
qqDeclE Decl
_ = forall a. Maybe a
Nothing
qqTypeQualE :: C.TypeQual -> Maybe (Q Exp)
qqTypeQualE :: TypeQual -> Maybe ExpQ
qqTypeQualE (C.AntiTypeQual String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqTypeQualE TypeQual
_ = forall a. Maybe a
Nothing
qqTypeQualListE :: [C.TypeQual] -> Maybe (Q Exp)
qqTypeQualListE :: [TypeQual] -> Maybe ExpQ
qqTypeQualListE [] = forall a. a -> Maybe a
Just [|[]|]
qqTypeQualListE (C.AntiTypeQuals String
v SrcLoc
_ : [TypeQual]
stms) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp stms)|]
qqTypeQualListE (TypeQual
stm : [TypeQual]
stms) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp stm) : $(dataToExpQ qqExp stms)|]
qqTypeE :: C.Type -> Maybe (Q Exp)
qqTypeE :: Type -> Maybe ExpQ
qqTypeE (C.AntiType String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqTypeE Type
_ = forall a. Maybe a
Nothing
qqInitializerE :: C.Initializer -> Maybe (Q Exp)
qqInitializerE :: Initializer -> Maybe ExpQ
qqInitializerE (C.AntiInit String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqInitializerE Initializer
_ = forall a. Maybe a
Nothing
qqInitializerListE :: [(Maybe C.Designation, C.Initializer)] -> Maybe (Q Exp)
qqInitializerListE :: [(Maybe Designation, Initializer)] -> Maybe ExpQ
qqInitializerListE [] = forall a. a -> Maybe a
Just [|[]|]
qqInitializerListE ((Maybe Designation
Nothing, C.AntiInits String
v SrcLoc
_) : [(Maybe Designation, Initializer)]
fields) =
forall a. a -> Maybe a
Just [|[(Nothing, init) | init <- $(antiVarE v)] ++ $(dataToExpQ qqExp fields)|]
qqInitializerListE ((Maybe Designation, Initializer)
field : [(Maybe Designation, Initializer)]
fields) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp field) : $(dataToExpQ qqExp fields)|]
qqInitGroupE :: C.InitGroup -> Maybe (Q Exp)
qqInitGroupE :: InitGroup -> Maybe ExpQ
qqInitGroupE (C.AntiDecl String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqInitGroupE InitGroup
_ = forall a. Maybe a
Nothing
qqInitGroupListE :: [C.InitGroup] -> Maybe (Q Exp)
qqInitGroupListE :: [InitGroup] -> Maybe ExpQ
qqInitGroupListE [] = forall a. a -> Maybe a
Just [|[]|]
qqInitGroupListE (C.AntiDecls String
v SrcLoc
_ : [InitGroup]
inits) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp inits)|]
qqInitGroupListE (InitGroup
ini : [InitGroup]
inis) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp ini) : $(dataToExpQ qqExp inis)|]
qqAttrE :: C.Attr -> Maybe (Q Exp)
qqAttrE :: Attr -> Maybe ExpQ
qqAttrE (C.AntiAttr String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqAttrE Attr
_ = forall a. Maybe a
Nothing
qqAttrListE :: [C.Attr] -> Maybe (Q Exp)
qqAttrListE :: [Attr] -> Maybe ExpQ
qqAttrListE [] = forall a. a -> Maybe a
Just [|[]|]
qqAttrListE (C.AntiAttrs String
v SrcLoc
_ : [Attr]
attrs) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp attrs)|]
qqAttrListE (Attr
field : [Attr]
fields) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp field) : $(dataToExpQ qqExp fields)|]
qqFieldGroupE :: C.FieldGroup -> Maybe (Q Exp)
qqFieldGroupE :: FieldGroup -> Maybe ExpQ
qqFieldGroupE (C.AntiSdecl String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqFieldGroupE FieldGroup
_ = forall a. Maybe a
Nothing
qqFieldGroupListE :: [C.FieldGroup] -> Maybe (Q Exp)
qqFieldGroupListE :: [FieldGroup] -> Maybe ExpQ
qqFieldGroupListE [] = forall a. a -> Maybe a
Just [|[]|]
qqFieldGroupListE (C.AntiSdecls String
v SrcLoc
_ : [FieldGroup]
fields) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp fields)|]
qqFieldGroupListE (FieldGroup
field : [FieldGroup]
fields) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp field) : $(dataToExpQ qqExp fields)|]
qqCEnumE :: C.CEnum -> Maybe (Q Exp)
qqCEnumE :: CEnum -> Maybe ExpQ
qqCEnumE (C.AntiEnum String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqCEnumE CEnum
_ = forall a. Maybe a
Nothing
qqCEnumListE :: [C.CEnum] -> Maybe (Q Exp)
qqCEnumListE :: [CEnum] -> Maybe ExpQ
qqCEnumListE [] = forall a. a -> Maybe a
Just [|[]|]
qqCEnumListE (C.AntiEnums String
v SrcLoc
_ : [CEnum]
fields) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp fields)|]
qqCEnumListE (CEnum
field : [CEnum]
fields) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp field) : $(dataToExpQ qqExp fields)|]
qqParamE :: C.Param -> Maybe (Q Exp)
qqParamE :: Param -> Maybe ExpQ
qqParamE (C.AntiParam String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqParamE Param
_ = forall a. Maybe a
Nothing
qqParamListE :: [C.Param] -> Maybe (Q Exp)
qqParamListE :: [Param] -> Maybe ExpQ
qqParamListE [] = forall a. a -> Maybe a
Just [|[]|]
qqParamListE (C.AntiParams String
v SrcLoc
_ : [Param]
args) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp args)|]
qqParamListE (Param
arg : [Param]
args) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp arg) : $(dataToExpQ qqExp args)|]
qqDefinitionE :: C.Definition -> Maybe (Q Exp)
qqDefinitionE :: Definition -> Maybe ExpQ
qqDefinitionE (C.AntiFunc String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|C.FuncDef $(antiVarE v) $(qqLocE loc)|]
qqDefinitionE (C.AntiEsc String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|C.EscDef $(antiVarE v) $(qqLocE loc)|]
qqDefinitionE (C.AntiEdecl String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqDefinitionE (C.AntiObjCMeth String
m SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
m
qqDefinitionE Definition
_ = forall a. Maybe a
Nothing
qqDefinitionListE :: [C.Definition] -> Maybe (Q Exp)
qqDefinitionListE :: [Definition] -> Maybe ExpQ
qqDefinitionListE [] = forall a. a -> Maybe a
Just [|[]|]
qqDefinitionListE (C.AntiEdecls String
v SrcLoc
_ : [Definition]
defs) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp defs)|]
qqDefinitionListE (C.AntiObjCMeths String
m SrcLoc
_ : [Definition]
meths) =
forall a. a -> Maybe a
Just [|$(antiVarE m) ++ $(dataToExpQ qqExp meths)|]
qqDefinitionListE (Definition
def : [Definition]
defs) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp def) : $(dataToExpQ qqExp defs)|]
qqConstE :: C.Const -> Maybe (Q Exp)
qqConstE :: Const -> Maybe ExpQ
qqConstE = Const -> Maybe ExpQ
go
where
go :: Const -> Maybe ExpQ
go (C.AntiConst String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|toConst $(antiVarE v) $(qqLocE loc) :: C.Const|]
go (C.AntiInt String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|C.IntConst $(intConst (antiVarE v)) C.Signed
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiUInt String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|C.IntConst ($(intConst (antiVarE v)) ++ "U") C.Unsigned
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiLInt String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|C.LongIntConst ($(intConst (antiVarE v)) ++ "L") C.Signed
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiULInt String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|C.LongIntConst ($(intConst (antiVarE v)) ++ "UL") C.Unsigned
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiLLInt String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|C.LongLongIntConst ($(intConst (antiVarE v)) ++ "LL") C.Signed
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiULLInt String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|C.LongLongIntConst ($(intConst (antiVarE v)) ++ "ULL") C.Unsigned
(fromIntegral $(antiVarE v))
$(qqLocE loc)|]
go (C.AntiFloat String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|toConst ($(antiVarE v) :: Float) $(qqLocE loc)|]
go (C.AntiDouble String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|toConst ($(antiVarE v) :: Double) $(qqLocE loc)|]
go (C.AntiLongDouble String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|toConst (LongDouble $(antiVarE v)) $(qqLocE loc)|]
go (C.AntiChar String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|toConst $(antiVarE v) $(qqLocE loc)|]
go (C.AntiString String
v SrcLoc
loc) =
forall a. a -> Maybe a
Just [|C.StringConst [show $(antiVarE v)] $(antiVarE v) $(qqLocE loc)|]
go Const
_ = forall a. Maybe a
Nothing
intConst :: ExpQ -> ExpQ
intConst :: ExpQ -> ExpQ
intConst ExpQ
e = [|show $(e)|]
qqExpE :: C.Exp -> Maybe (Q Exp)
qqExpE :: Exp -> Maybe ExpQ
qqExpE (C.AntiExp String
v SrcLoc
loc) = forall a. a -> Maybe a
Just [|toExp $(antiVarE v) $(qqLocE loc) :: C.Exp|]
qqExpE (C.AntiEscExp String
v SrcLoc
loc) = forall a. a -> Maybe a
Just [|C.EscExp $(antiVarE v) $(qqLocE loc) :: C.Exp|]
qqExpE Exp
_ = forall a. Maybe a
Nothing
qqExpListE :: [C.Exp] -> Maybe (Q Exp)
qqExpListE :: [Exp] -> Maybe ExpQ
qqExpListE [] = forall a. a -> Maybe a
Just [|[]|]
qqExpListE (C.AntiArgs String
v SrcLoc
loc : [Exp]
exps) =
forall a. a -> Maybe a
Just [|[toExp v $(qqLocE loc) | v <- $(antiVarE v)] ++
$(dataToExpQ qqExp exps)|]
qqExpListE (Exp
exp : [Exp]
exps) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp exp) : $(dataToExpQ qqExp exps)|]
qqStmE :: C.Stm -> Maybe (Q Exp)
qqStmE :: Stm -> Maybe ExpQ
qqStmE (C.AntiEscStm String
v SrcLoc
loc) = forall a. a -> Maybe a
Just [|C.EscStm $(antiVarE v) $(qqLocE loc)|]
qqStmE (C.AntiPragma String
v SrcLoc
loc) = forall a. a -> Maybe a
Just [|C.Pragma $(antiVarE v) $(qqLocE loc)|]
qqStmE (C.AntiComment String
v Stm
stm SrcLoc
loc) = forall a. a -> Maybe a
Just [|C.Comment $(antiVarE v) $(dataToExpQ qqExp stm) $(qqLocE loc)|]
qqStmE (C.AntiStm String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqStmE Stm
_ = forall a. Maybe a
Nothing
qqStmListE :: [C.Stm] -> Maybe (Q Exp)
qqStmListE :: [Stm] -> Maybe ExpQ
qqStmListE [] = forall a. a -> Maybe a
Just [|[]|]
qqStmListE (C.AntiStms String
v SrcLoc
_ : [Stm]
stms) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp stms)|]
qqStmListE (Stm
stm : [Stm]
stms) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp stm) : $(dataToExpQ qqExp stms)|]
qqBlockItemE :: C.BlockItem -> Maybe (Q Exp)
qqBlockItemE :: BlockItem -> Maybe ExpQ
qqBlockItemE (C.AntiBlockItem String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
v
qqBlockItemE BlockItem
_ = forall a. Maybe a
Nothing
qqBlockItemListE :: [C.BlockItem] -> Maybe (Q Exp)
qqBlockItemListE :: [BlockItem] -> Maybe ExpQ
qqBlockItemListE [] = forall a. a -> Maybe a
Just [|[]|]
qqBlockItemListE (C.BlockDecl (C.AntiDecls String
v SrcLoc
_) : [BlockItem]
items) =
forall a. a -> Maybe a
Just [|map C.BlockDecl $(antiVarE v) ++ $(dataToExpQ qqExp items)|]
qqBlockItemListE (C.BlockStm (C.AntiStms String
v SrcLoc
_) : [BlockItem]
items) =
forall a. a -> Maybe a
Just [|map C.BlockStm $(antiVarE v) ++ $(dataToExpQ qqExp items)|]
qqBlockItemListE (C.AntiBlockItems String
v SrcLoc
_ : [BlockItem]
items) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp items)|]
qqBlockItemListE (BlockItem
stm : [BlockItem]
stms) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp stm) : $(dataToExpQ qqExp stms)|]
qqObjcIfaceDeclE :: C.ObjCIfaceDecl -> Maybe (Q Exp)
qqObjcIfaceDeclE :: ObjCIfaceDecl -> Maybe ExpQ
qqObjcIfaceDeclE (C.AntiObjCProp String
p SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
p
qqObjcIfaceDeclE ObjCIfaceDecl
_ = forall a. Maybe a
Nothing
qqObjcIfaceDeclListE :: [C.ObjCIfaceDecl] -> Maybe (Q Exp)
qqObjcIfaceDeclListE :: [ObjCIfaceDecl] -> Maybe ExpQ
qqObjcIfaceDeclListE [] = forall a. a -> Maybe a
Just [|[]|]
qqObjcIfaceDeclListE (C.AntiObjCProps String
p SrcLoc
_ : [ObjCIfaceDecl]
decls) =
forall a. a -> Maybe a
Just [|$(antiVarE p) ++ $(dataToExpQ qqExp decls)|]
qqObjcIfaceDeclListE (C.AntiObjCIfaceDecls String
v SrcLoc
_ : [ObjCIfaceDecl]
decls) =
forall a. a -> Maybe a
Just [|$(antiVarE v) ++ $(dataToExpQ qqExp decls)|]
qqObjcIfaceDeclListE (C.AntiObjCIfaceDecl String
v SrcLoc
_ : [ObjCIfaceDecl]
decls) =
forall a. a -> Maybe a
Just [|$(antiVarE v) : $(dataToExpQ qqExp decls)|]
qqObjcIfaceDeclListE (ObjCIfaceDecl
decl : [ObjCIfaceDecl]
decls) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp decl) : $(dataToExpQ qqExp decls)|]
qqObjCPropAttrE :: C.ObjCPropAttr -> Maybe (Q Exp)
qqObjCPropAttrE :: ObjCPropAttr -> Maybe ExpQ
qqObjCPropAttrE (C.AntiObjCAttr String
pa SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
pa
qqObjCPropAttrE ObjCPropAttr
_ = forall a. Maybe a
Nothing
qqObjCPropAttrListE :: [C.ObjCPropAttr] -> Maybe (Q Exp)
qqObjCPropAttrListE :: [ObjCPropAttr] -> Maybe ExpQ
qqObjCPropAttrListE [] = forall a. a -> Maybe a
Just [|[]|]
qqObjCPropAttrListE (C.AntiObjCAttrs String
pa SrcLoc
_:[ObjCPropAttr]
attrelems) =
forall a. a -> Maybe a
Just [|$(antiVarE pa) ++ $(dataToExpQ qqExp attrelems)|]
qqObjCPropAttrListE (ObjCPropAttr
pattr : [ObjCPropAttr]
pattrs) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp pattr) : $(dataToExpQ qqExp pattrs)|]
qqObjCDictsE :: [C.ObjCDictElem] -> Maybe (Q Exp)
qqObjCDictsE :: [ObjCDictElem] -> Maybe ExpQ
qqObjCDictsE [] = forall a. a -> Maybe a
Just [|[]|]
qqObjCDictsE (C.AntiObjCDictElems String
e SrcLoc
_:[ObjCDictElem]
elems) =
forall a. a -> Maybe a
Just [|$(antiVarE e) ++ $(dataToExpQ qqExp elems)|]
qqObjCDictsE (ObjCDictElem
elem : [ObjCDictElem]
elems) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp elem) : $(dataToExpQ qqExp elems)|]
qqObjCParamE :: C.ObjCParam -> Maybe (Q Exp)
qqObjCParamE :: ObjCParam -> Maybe ExpQ
qqObjCParamE (C.AntiObjCParam String
p SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
p
qqObjCParamE ObjCParam
_ = forall a. Maybe a
Nothing
qqObjCParamsE :: [C.ObjCParam] -> Maybe (Q Exp)
qqObjCParamsE :: [ObjCParam] -> Maybe ExpQ
qqObjCParamsE [] = forall a. a -> Maybe a
Just [|[]|]
qqObjCParamsE (C.AntiObjCParams String
p SrcLoc
_: [ObjCParam]
props) =
forall a. a -> Maybe a
Just [|$(antiVarE p) ++ $(dataToExpQ qqExp props)|]
qqObjCParamsE (ObjCParam
param : [ObjCParam]
params) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp param) : $(dataToExpQ qqExp params)|]
qqObjCMethodProtoE :: C.ObjCMethodProto -> Maybe (Q Exp)
qqObjCMethodProtoE :: ObjCMethodProto -> Maybe ExpQ
qqObjCMethodProtoE (C.AntiObjCMethodProto String
p SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
p
qqObjCMethodProtoE ObjCMethodProto
_ = forall a. Maybe a
Nothing
qqObjCRecvE :: C.ObjCRecv -> Maybe (Q Exp)
qqObjCRecvE :: ObjCRecv -> Maybe ExpQ
qqObjCRecvE (C.AntiObjCRecv String
p SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
p
qqObjCRecvE ObjCRecv
_ = forall a. Maybe a
Nothing
qqObjCArgE :: C.ObjCArg -> Maybe (Q Exp)
qqObjCArgE :: ObjCArg -> Maybe ExpQ
qqObjCArgE (C.AntiObjCArg String
p SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> ExpQ
antiVarE String
p
qqObjCArgE ObjCArg
_ = forall a. Maybe a
Nothing
qqObjCArgsE :: [C.ObjCArg] -> Maybe (Q Exp)
qqObjCArgsE :: [ObjCArg] -> Maybe ExpQ
qqObjCArgsE [] = forall a. a -> Maybe a
Just [|[]|]
qqObjCArgsE (C.AntiObjCArgs String
a SrcLoc
_: [ObjCArg]
args) =
forall a. a -> Maybe a
Just [|$(antiVarE a) ++ $(dataToExpQ qqExp args)|]
qqObjCArgsE (ObjCArg
arg : [ObjCArg]
args) =
forall a. a -> Maybe a
Just [|$(dataToExpQ qqExp arg) : $(dataToExpQ qqExp args)|]
qqExp :: Typeable a => a -> Maybe (Q Exp)
qqExp :: forall a. Typeable a => a -> Maybe ExpQ
qqExp = forall a b. a -> b -> a
const forall a. Maybe a
Nothing forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` String -> Maybe ExpQ
qqStringE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Id -> Maybe ExpQ
qqIdE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` DeclSpec -> Maybe ExpQ
qqDeclSpecE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Decl -> Maybe ExpQ
qqDeclE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` TypeQual -> Maybe ExpQ
qqTypeQualE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [TypeQual] -> Maybe ExpQ
qqTypeQualListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Type -> Maybe ExpQ
qqTypeE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Initializer -> Maybe ExpQ
qqInitializerE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [(Maybe Designation, Initializer)] -> Maybe ExpQ
qqInitializerListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` InitGroup -> Maybe ExpQ
qqInitGroupE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [InitGroup] -> Maybe ExpQ
qqInitGroupListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Attr -> Maybe ExpQ
qqAttrE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Attr] -> Maybe ExpQ
qqAttrListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` FieldGroup -> Maybe ExpQ
qqFieldGroupE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [FieldGroup] -> Maybe ExpQ
qqFieldGroupListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` CEnum -> Maybe ExpQ
qqCEnumE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [CEnum] -> Maybe ExpQ
qqCEnumListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Param -> Maybe ExpQ
qqParamE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Param] -> Maybe ExpQ
qqParamListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Definition -> Maybe ExpQ
qqDefinitionE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Definition] -> Maybe ExpQ
qqDefinitionListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Const -> Maybe ExpQ
qqConstE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Exp -> Maybe ExpQ
qqExpE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Exp] -> Maybe ExpQ
qqExpListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Stm -> Maybe ExpQ
qqStmE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Stm] -> Maybe ExpQ
qqStmListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` BlockItem -> Maybe ExpQ
qqBlockItemE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [BlockItem] -> Maybe ExpQ
qqBlockItemListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ObjCIfaceDecl -> Maybe ExpQ
qqObjcIfaceDeclE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [ObjCIfaceDecl] -> Maybe ExpQ
qqObjcIfaceDeclListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ObjCPropAttr -> Maybe ExpQ
qqObjCPropAttrE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [ObjCPropAttr] -> Maybe ExpQ
qqObjCPropAttrListE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [ObjCDictElem] -> Maybe ExpQ
qqObjCDictsE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ObjCParam -> Maybe ExpQ
qqObjCParamE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [ObjCParam] -> Maybe ExpQ
qqObjCParamsE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ObjCMethodProto -> Maybe ExpQ
qqObjCMethodProtoE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ObjCRecv -> Maybe ExpQ
qqObjCRecvE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` ObjCArg -> Maybe ExpQ
qqObjCArgE
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [ObjCArg] -> Maybe ExpQ
qqObjCArgsE
antiVarP :: String -> PatQ
antiVarP :: String -> PatQ
antiVarP = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Pat
parsePat
qqStringP :: String -> Maybe (Q Pat)
qqStringP :: String -> Maybe PatQ
qqStringP String
s = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Lit -> m Pat
litP forall a b. (a -> b) -> a -> b
$ String -> Lit
stringL String
s
qqLocP :: Data.Loc.Loc -> Maybe (Q Pat)
qqLocP :: Loc -> Maybe PatQ
qqLocP Loc
_ = forall a. a -> Maybe a
Just forall (m :: * -> *). Quote m => m Pat
wildP
qqIdP :: C.Id -> Maybe (Q Pat)
qqIdP :: Id -> Maybe PatQ
qqIdP (C.AntiId String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
"C.Id") [String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
qqIdP Id
_ = forall a. Maybe a
Nothing
qqDeclSpecP :: C.DeclSpec -> Maybe (Q Pat)
qqDeclSpecP :: DeclSpec -> Maybe PatQ
qqDeclSpecP (C.AntiDeclSpec String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqDeclSpecP C.AntiTypeDeclSpec{} =
forall a. HasCallStack => String -> a
error String
"Illegal antiquoted type in pattern"
qqDeclSpecP DeclSpec
_ = forall a. Maybe a
Nothing
qqDeclP :: C.Decl -> Maybe (Q Pat)
qqDeclP :: Decl -> Maybe PatQ
qqDeclP C.AntiTypeDecl{} =
forall a. HasCallStack => String -> a
error String
"Illegal antiquoted type in pattern"
qqDeclP Decl
_ = forall a. Maybe a
Nothing
qqTypeQualP :: C.TypeQual -> Maybe (Q Pat)
qqTypeQualP :: TypeQual -> Maybe PatQ
qqTypeQualP (C.AntiTypeQual String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqTypeQualP TypeQual
_ = forall a. Maybe a
Nothing
qqTypeQualListP :: [C.TypeQual] -> Maybe (Q Pat)
qqTypeQualListP :: [TypeQual] -> Maybe PatQ
qqTypeQualListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqTypeQualListP [C.AntiTypeQuals String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqTypeQualListP (C.AntiTypeQuals{} : TypeQual
_ : [TypeQual]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of type qualifiers must be last item in quoted list"
qqTypeQualListP (TypeQual
arg : [TypeQual]
args) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat TypeQual
arg, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [TypeQual]
args]
qqTypeP :: C.Type -> Maybe (Q Pat)
qqTypeP :: Type -> Maybe PatQ
qqTypeP (C.AntiType String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqTypeP Type
_ = forall a. Maybe a
Nothing
qqInitializerP :: C.Initializer -> Maybe (Q Pat)
qqInitializerP :: Initializer -> Maybe PatQ
qqInitializerP (C.AntiInit String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqInitializerP Initializer
_ = forall a. Maybe a
Nothing
qqInitializerListP :: [C.Initializer] -> Maybe (Q Pat)
qqInitializerListP :: [Initializer] -> Maybe PatQ
qqInitializerListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqInitializerListP [C.AntiInits String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqInitializerListP (C.AntiInits{} : Initializer
_ : [Initializer]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of initializers must be last item in quoted list"
qqInitializerListP (Initializer
ini : [Initializer]
inis) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat Initializer
ini, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [Initializer]
inis]
qqInitGroupP :: C.InitGroup -> Maybe (Q Pat)
qqInitGroupP :: InitGroup -> Maybe PatQ
qqInitGroupP (C.AntiDecl String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqInitGroupP InitGroup
_ = forall a. Maybe a
Nothing
qqInitGroupListP :: [C.InitGroup] -> Maybe (Q Pat)
qqInitGroupListP :: [InitGroup] -> Maybe PatQ
qqInitGroupListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqInitGroupListP [C.AntiDecls String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqInitGroupListP (C.AntiDecls{} : InitGroup
_ : [InitGroup]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of initialization groups must be last item in quoted list"
qqInitGroupListP (InitGroup
ini : [InitGroup]
inis) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat InitGroup
ini, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [InitGroup]
inis]
qqAttrP :: C.Attr -> Maybe (Q Pat)
qqAttrP :: Attr -> Maybe PatQ
qqAttrP (C.AntiAttr String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqAttrP Attr
_ = forall a. Maybe a
Nothing
qqAttrListP :: [C.Attr] -> Maybe (Q Pat)
qqAttrListP :: [Attr] -> Maybe PatQ
qqAttrListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqAttrListP [C.AntiAttrs String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqAttrListP (C.AntiAttrs{} : Attr
_ : [Attr]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of attrs must be last item in quoted list"
qqAttrListP (Attr
ini : [Attr]
inis) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat Attr
ini, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [Attr]
inis]
qqFieldGroupP :: C.FieldGroup -> Maybe (Q Pat)
qqFieldGroupP :: FieldGroup -> Maybe PatQ
qqFieldGroupP (C.AntiSdecl String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqFieldGroupP FieldGroup
_ = forall a. Maybe a
Nothing
qqFieldGroupListP :: [C.FieldGroup] -> Maybe (Q Pat)
qqFieldGroupListP :: [FieldGroup] -> Maybe PatQ
qqFieldGroupListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqFieldGroupListP [C.AntiSdecls String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqFieldGroupListP (C.AntiSdecls{} : FieldGroup
_ : [FieldGroup]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of struct/union fields must be last item in quoted list"
qqFieldGroupListP (FieldGroup
ini : [FieldGroup]
inis) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat FieldGroup
ini, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [FieldGroup]
inis]
qqCEnumP :: C.CEnum -> Maybe (Q Pat)
qqCEnumP :: CEnum -> Maybe PatQ
qqCEnumP (C.AntiEnum String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqCEnumP CEnum
_ = forall a. Maybe a
Nothing
qqCEnumListP :: [C.CEnum] -> Maybe (Q Pat)
qqCEnumListP :: [CEnum] -> Maybe PatQ
qqCEnumListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqCEnumListP [C.AntiEnums String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqCEnumListP (C.AntiEnums{} : CEnum
_ : [CEnum]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of enumerations must be last item in quoted list"
qqCEnumListP (CEnum
ini : [CEnum]
inis) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat CEnum
ini, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [CEnum]
inis]
qqParamP :: C.Param -> Maybe (Q Pat)
qqParamP :: Param -> Maybe PatQ
qqParamP (C.AntiParam String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqParamP Param
_ = forall a. Maybe a
Nothing
qqParamListP :: [C.Param] -> Maybe (Q Pat)
qqParamListP :: [Param] -> Maybe PatQ
qqParamListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqParamListP [C.AntiParams String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqParamListP (C.AntiParams{} : Param
_ : [Param]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of parameters must be last item in quoted list"
qqParamListP (Param
arg : [Param]
args) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat Param
arg, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [Param]
args]
qqDefinitionP :: C.Definition -> Maybe (Q Pat)
qqDefinitionP :: Definition -> Maybe PatQ
qqDefinitionP (C.AntiFunc String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
"C.FuncDef") [String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
qqDefinitionP (C.AntiEsc String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
"C.EscDef") [String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
qqDefinitionP (C.AntiEdecl String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqDefinitionP Definition
_ = forall a. Maybe a
Nothing
qqDefinitionListP :: [C.Definition] -> Maybe (Q Pat)
qqDefinitionListP :: [Definition] -> Maybe PatQ
qqDefinitionListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqDefinitionListP [C.AntiEdecls String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqDefinitionListP (C.AntiEdecls{} : Definition
_ : [Definition]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of definitions must be last item in quoted list"
qqDefinitionListP (Definition
arg : [Definition]
args) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat Definition
arg, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [Definition]
args]
qqConstP :: C.Const -> Maybe (Q Pat)
qqConstP :: Const -> Maybe PatQ
qqConstP = Const -> Maybe PatQ
go
where
go :: Const -> Maybe PatQ
go (C.AntiInt String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Quote m => String -> [m Pat] -> m Pat
con String
"C.IntConst" [forall (m :: * -> *). Quote m => m Pat
wildP, PatQ
signed, String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
go (C.AntiUInt String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Quote m => String -> [m Pat] -> m Pat
con String
"C.IntConst" [forall (m :: * -> *). Quote m => m Pat
wildP, PatQ
unsigned, String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
go (C.AntiLInt String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Quote m => String -> [m Pat] -> m Pat
con String
"C.LongIntConst" [forall (m :: * -> *). Quote m => m Pat
wildP, PatQ
signed, String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
go (C.AntiULInt String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Quote m => String -> [m Pat] -> m Pat
con String
"C.LongIntConst" [forall (m :: * -> *). Quote m => m Pat
wildP, PatQ
unsigned, String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
go (C.AntiFloat String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Quote m => String -> [m Pat] -> m Pat
con String
"C.FloatConst" [forall (m :: * -> *). Quote m => m Pat
wildP, String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
go (C.AntiDouble String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Quote m => String -> [m Pat] -> m Pat
con String
"C.DoubleConst" [forall (m :: * -> *). Quote m => m Pat
wildP, String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
go (C.AntiLongDouble String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Quote m => String -> [m Pat] -> m Pat
con String
"C.LongDoubleConst" [forall (m :: * -> *). Quote m => m Pat
wildP, String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
go (C.AntiChar String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Quote m => String -> [m Pat] -> m Pat
con String
"C.CharConst" [forall (m :: * -> *). Quote m => m Pat
wildP, String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
go (C.AntiString String
v SrcLoc
_) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. Quote m => String -> [m Pat] -> m Pat
con String
"C.StringConst" [forall (m :: * -> *). Quote m => m Pat
wildP, String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
go Const
_ =
forall a. Maybe a
Nothing
con :: String -> [m Pat] -> m Pat
con String
n = forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
n)
signed :: PatQ
signed = forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
"C.Signed") []
unsigned :: PatQ
unsigned = forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
"C.Unsigned") []
qqExpP :: C.Exp -> Maybe (Q Pat)
qqExpP :: Exp -> Maybe PatQ
qqExpP (C.AntiExp String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqExpP (C.AntiEscExp String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
"C.EscExp") [String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
qqExpP Exp
_ = forall a. Maybe a
Nothing
qqExpListP :: [C.Exp] -> Maybe (Q Pat)
qqExpListP :: [Exp] -> Maybe PatQ
qqExpListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqExpListP [C.AntiArgs String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqExpListP (C.AntiArgs{} : Exp
_ : [Exp]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of arguments must be last item in quoted list"
qqExpListP (Exp
arg : [Exp]
args) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat Exp
arg, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [Exp]
args]
qqStmP :: C.Stm -> Maybe (Q Pat)
qqStmP :: Stm -> Maybe PatQ
qqStmP (C.AntiStm String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqStmP (C.AntiEscStm String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
"C.EscStm") [String -> PatQ
antiVarP String
v, forall (m :: * -> *). Quote m => m Pat
wildP]
qqStmP Stm
_ = forall a. Maybe a
Nothing
qqStmListP :: [C.Stm] -> Maybe (Q Pat)
qqStmListP :: [Stm] -> Maybe PatQ
qqStmListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqStmListP [C.AntiStms String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqStmListP (C.AntiStms{} : Stm
_ : [Stm]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of statements must be last item in quoted list"
qqStmListP (Stm
arg : [Stm]
args) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat Stm
arg, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [Stm]
args]
qqBlockItemP :: C.BlockItem -> Maybe (Q Pat)
qqBlockItemP :: BlockItem -> Maybe PatQ
qqBlockItemP (C.AntiBlockItem String
v SrcLoc
_) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqBlockItemP BlockItem
_ = forall a. Maybe a
Nothing
qqBlockItemListP :: [C.BlockItem] -> Maybe (Q Pat)
qqBlockItemListP :: [BlockItem] -> Maybe PatQ
qqBlockItemListP [] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => [m Pat] -> m Pat
listP []
qqBlockItemListP (C.BlockDecl C.AntiDecls{} : [BlockItem]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of declarations cannot appear in block"
qqBlockItemListP (C.BlockStm C.AntiStms{} : [BlockItem]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of statements cannot appear in block"
qqBlockItemListP [C.AntiBlockItems String
v SrcLoc
_] = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> PatQ
antiVarP String
v
qqBlockItemListP (C.AntiBlockItems{} : BlockItem
_ : [BlockItem]
_) =
forall a. HasCallStack => String -> a
error String
"Antiquoted list of block items must be last item in quoted list"
qqBlockItemListP (BlockItem
arg : [BlockItem]
args) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP (String -> Name
mkName String
":") [forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat BlockItem
arg, forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat [BlockItem]
args]
qqPat :: Typeable a => a -> Maybe (Q Pat)
qqPat :: forall a. Typeable a => a -> Maybe PatQ
qqPat = forall a b. a -> b -> a
const forall a. Maybe a
Nothing forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` String -> Maybe PatQ
qqStringP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Loc -> Maybe PatQ
qqLocP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Id -> Maybe PatQ
qqIdP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` DeclSpec -> Maybe PatQ
qqDeclSpecP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Decl -> Maybe PatQ
qqDeclP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` TypeQual -> Maybe PatQ
qqTypeQualP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [TypeQual] -> Maybe PatQ
qqTypeQualListP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Type -> Maybe PatQ
qqTypeP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Initializer -> Maybe PatQ
qqInitializerP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Initializer] -> Maybe PatQ
qqInitializerListP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` InitGroup -> Maybe PatQ
qqInitGroupP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [InitGroup] -> Maybe PatQ
qqInitGroupListP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Attr -> Maybe PatQ
qqAttrP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Attr] -> Maybe PatQ
qqAttrListP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` FieldGroup -> Maybe PatQ
qqFieldGroupP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` CEnum -> Maybe PatQ
qqCEnumP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [CEnum] -> Maybe PatQ
qqCEnumListP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Param -> Maybe PatQ
qqParamP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Param] -> Maybe PatQ
qqParamListP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Definition -> Maybe PatQ
qqDefinitionP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Definition] -> Maybe PatQ
qqDefinitionListP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Const -> Maybe PatQ
qqConstP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Exp -> Maybe PatQ
qqExpP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Exp] -> Maybe PatQ
qqExpListP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` Stm -> Maybe PatQ
qqStmP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [Stm] -> Maybe PatQ
qqStmListP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` BlockItem -> Maybe PatQ
qqBlockItemP
forall a b q.
(Typeable a, Typeable b) =>
(a -> q) -> (b -> q) -> a -> q
`extQ` [BlockItem] -> Maybe PatQ
qqBlockItemListP
parse :: [C.Extensions]
-> [String]
-> P.P a
-> String
-> Q a
parse :: forall a. [Extensions] -> [String] -> P a -> String -> Q a
parse [Extensions]
exts [String]
typenames P a
p String
s = do
Loc
loc <- Q Loc
location
case forall a.
[Extensions]
-> [String]
-> P a
-> ByteString
-> Maybe Pos
-> Either SomeException a
P.parse (Extensions
C.Antiquotation forall a. a -> [a] -> [a]
: [Extensions]
exts) [String]
typenames P a
p (String -> ByteString
B.pack String
s) (forall a. a -> Maybe a
Just (Loc -> Pos
locToPos Loc
loc)) of
Left SomeException
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show SomeException
err)
Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
where
locToPos :: TH.Loc -> Pos
locToPos :: Loc -> Pos
locToPos TH.Loc {loc_filename :: Loc -> String
loc_filename = String
filename, loc_start :: Loc -> CharPos
loc_start = (Int
line, Int
col)} =
String -> Int -> Int -> Int -> Pos
Pos String
filename Int
line Int
col Int
0
quasiquote :: Data a
=> [C.Extensions]
-> [String]
-> P.P a
-> QuasiQuoter
quasiquote :: forall a. Data a => [Extensions] -> [String] -> P a -> QuasiQuoter
quasiquote [Extensions]
exts [String]
typenames P a
p =
QuasiQuoter { quoteExp :: String -> ExpQ
quoteExp = forall a. [Extensions] -> [String] -> P a -> String -> Q a
parse [Extensions]
exts [String]
typenames P a
p forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Exp)) -> a -> m Exp
dataToExpQ forall a. Typeable a => a -> Maybe ExpQ
qqExp
, quotePat :: String -> PatQ
quotePat = forall a. [Extensions] -> [String] -> P a -> String -> Q a
parse [Extensions]
exts [String]
typenames P a
p forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a.
(Quote m, Data a) =>
(forall b. Data b => b -> Maybe (m Pat)) -> a -> m Pat
dataToPatQ forall a. Typeable a => a -> Maybe PatQ
qqPat
, quoteType :: String -> Q Type
quoteType = forall a. HasCallStack => String -> a
error String
"C type quasiquoter undefined"
, quoteDec :: String -> Q [Dec]
quoteDec = forall a. HasCallStack => String -> a
error String
"C declaration quasiquoter undefined"
}
#if !MIN_VERSION_template_haskell(2,7,0)
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
con :: k
con = mkCon (mkConName mod occ)
where
mod :: String
mod = (tyconModule . dataTypeName . dataTypeOf) t
occ :: String
occ = showConstr constr
mkConName :: String -> String -> Name
mkConName "Prelude" "(:)" = Name (mkOccName ":") NameS
mkConName "Prelude" "[]" = Name (mkOccName "[]") NameS
mkConName "Prelude" "()" = Name (mkOccName "()") NameS
mkConName "Prelude" s@('(' : ',' : rest) = go rest
where
go :: String -> Name
go (',' : rest) = go rest
go ")" = Name (mkOccName s) NameS
go _ = Name (mkOccName occ) (NameQ (mkModName mod))
mkConName "GHC.Real" ":%" = mkNameG_d "base" "GHC.Real" ":%"
mkConName mod occ = Name (mkOccName occ) (NameQ (mkModName mod))
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
#endif /* !MIN_VERSION_template_haskell(2,7,0) */