    {-# LANGUAGE CPP #-}
    #if __GLASGOW_HASKELL__ >= 800
    {-# LANGUAGE TemplateHaskellQuotes #-}
    #else
    {-# LANGUAGE TemplateHaskell #-}
    #endif

    ------------------------------------------------------------------------------
    -- |
    -- Module:      Database.PostgreSQL.Simple.TypeInfo.Macro
    -- Copyright:   (c) 2013 Leon P Smith
    -- License:     BSD3
    -- Maintainer:  Leon P Smith <leon@melding-monads.com>
    -- Stability:   experimental
    --
    -- A Template Haskell macro for efficiently checking membership in
    -- a set of type oids.
    --
    ------------------------------------------------------------------------------

    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

    -- | Returns an expression that has type @'Oid' -> 'Bool'@,  true if the
    --   oid is equal to any one of the 'typoid's of the given 'TypeInfo's.
    mkCompats :: [TypeInfo] -> ExpQ
    mkCompats :: [TypeInfo] -> ExpQ
    mkCompats [TypeInfo]
    tys = do
        x <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "x"
        lamE [conP 'Oid [varP x]] $ caseE (varE x) (map alt tys ++ [catchAll])
       where
         alt :: TypeInfo -> MatchQ
         alt :: TypeInfo -> Q Match
    alt TypeInfo
    ty = Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match (TypeInfo -> Q Pat
    inlineTypoidP TypeInfo
    ty) (ExpQ -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB [| True |]) []

         catchAll :: MatchQ
         catchAll :: Q Match
    catchAll = Q Pat -> Q Body -> [Q Dec] -> Q Match
    forall (m :: * -> *).
    Quote m =>
    m Pat -> m Body -> [m Dec] -> m Match
    match Q Pat
    forall (m :: * -> *). Quote m => m Pat
    wildP (ExpQ -> Q Body
    forall (m :: * -> *). Quote m => m Exp -> m Body
    normalB [| False |]) []

    -- | Literally substitute the 'typoid' of a 'TypeInfo' expression.
    --   Returns an expression of type 'Oid'.  Useful because GHC tends
    --   not to fold constants.
    inlineTypoid :: TypeInfo -> ExpQ
    inlineTypoid :: TypeInfo -> ExpQ
    inlineTypoid TypeInfo
    ty = Name -> ExpQ
    forall (m :: * -> *). Quote m => Name -> m Exp
    conE 'Oid ExpQ -> ExpQ -> ExpQ
    forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
    `appE` Lit -> ExpQ
    forall (m :: * -> *). Quote m => Lit -> m Exp
    litE (TypeInfo -> Lit
    getTypoid TypeInfo
    ty)

    inlineTypoidP :: TypeInfo -> PatQ
    inlineTypoidP :: TypeInfo -> Q Pat
    inlineTypoidP TypeInfo
    ty = Lit -> Q Pat
    forall (m :: * -> *). Quote m => Lit -> m Pat
    litP (TypeInfo -> Lit
    getTypoid TypeInfo
    ty)

    getTypoid :: TypeInfo -> Lit
    getTypoid :: TypeInfo -> Lit
    getTypoid TypeInfo
    ty = let (Oid CUInt
    x) = TypeInfo -> Oid
    typoid TypeInfo
    ty in Integer -> Lit
    integerL (CUInt -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CUInt
    x)