{-# LANGUAGE TemplateHaskell #-}
module Database.PostgreSQL.Simple.TypeInfo.Macro
( mkCompats
, inlineTypoid
) where
import Database.PostgreSQL.Simple.TypeInfo.Static
import Database.PostgreSQL.Simple.Types (Oid(..))
import Language.Haskell.TH
mkCompats :: [TypeInfo] -> ExpQ
mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]
where
alt :: TypeInfo -> MatchQ
alt ty = match (inlineTypoidP ty) (normalB [| True |]) []
catchAll :: MatchQ
catchAll = match wildP (normalB [| False |]) []
inlineTypoid :: TypeInfo -> ExpQ
inlineTypoid ty = [| Oid $(litE (getTypoid ty)) |]
inlineTypoidP :: TypeInfo -> PatQ
inlineTypoidP ty = litP (getTypoid ty)
getTypoid :: TypeInfo -> Lit
getTypoid ty = let (Oid x) = typoid ty in integerL (fromIntegral x)