{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE UndecidableSuperClasses #-}
#endif
module Database.PostgreSQL.Typed.Relation
( dataPGRelation
) where
import qualified Data.ByteString.Lazy as BSL
import Data.Proxy (Proxy(..))
import qualified Language.Haskell.TH as TH
import Database.PostgreSQL.Typed.Types
import Database.PostgreSQL.Typed.Dynamic
import Database.PostgreSQL.Typed.Protocol
import Database.PostgreSQL.Typed.TypeCache
import Database.PostgreSQL.Typed.TH
class (PGRep a, PGRecordType (PGRepType a)) => PGRelation a where
pgRelationName :: Proxy a -> PGName
pgRelationName = forall (t :: Symbol). PGType t => PGTypeID t -> PGName
pgTypeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Proxy a -> PGTypeID (PGRepType a)
pgTypeOfProxy
pgColumnNames :: Proxy a -> [PGName]
dataPGRelation :: String
-> PGName
-> (String -> String)
-> TH.DecsQ
dataPGRelation :: [Char] -> PGName -> ([Char] -> [Char]) -> DecsQ
dataPGRelation [Char]
typs PGName
pgtab [Char] -> [Char]
colf = do
(PGName
pgid, [(PGName, Name, Type, Bool)]
cold) <- forall a. IO a -> Q a
TH.runIO forall a b. (a -> b) -> a -> b
$ forall a. (PGTypeConnection -> IO a) -> IO a
withTPGTypeConnection forall a b. (a -> b) -> a -> b
$ \PGTypeConnection
tpg -> do
[(OID, (PGName, Name, Type, Bool))]
cl <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\[PGValue
to, PGValue
cn, PGValue
ct, PGValue
cnn] -> do
let c :: PGName
c = forall a. PGRep a => PGValue -> a
pgDecodeRep PGValue
cn :: PGName
n :: Name
n = [Char] -> Name
TH.mkName forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
colf forall a b. (a -> b) -> a -> b
$ PGName -> [Char]
pgNameString PGName
c
o :: OID
o = forall a. PGRep a => PGValue -> a
pgDecodeRep PGValue
ct :: OID
PGName
t <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"dataPGRelation " forall a. [a] -> [a] -> [a]
++ [Char]
typs forall a. [a] -> [a] -> [a]
++ [Char]
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PGName
pgtab forall a. [a] -> [a] -> [a]
++ [Char]
": column '" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PGName
c forall a. [a] -> [a] -> [a]
++ [Char]
"' has unknown type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show OID
o) forall (m :: * -> *) a. Monad m => a -> m a
return
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PGTypeConnection -> OID -> IO (Maybe PGName)
lookupPGType PGTypeConnection
tpg OID
o
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. PGRep a => PGValue -> a
pgDecodeRep PGValue
to, (PGName
c, Name
n, TyLit -> Type
TH.LitT ([Char] -> TyLit
TH.StrTyLit forall a b. (a -> b) -> a -> b
$ PGName -> [Char]
pgNameString PGName
t), Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. PGRep a => PGValue -> a
pgDecodeRep PGValue
cnn)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PGConnection -> ByteString -> IO (Int, [[PGValue]])
pgSimpleQuery (PGTypeConnection -> PGConnection
pgConnection PGTypeConnection
tpg) ([ByteString] -> ByteString
BSL.fromChunks
[ ByteString
"SELECT reltype, attname, atttypid, attnotnull"
, ByteString
" FROM pg_catalog.pg_attribute"
, ByteString
" JOIN pg_catalog.pg_class ON attrelid = pg_class.oid"
, ByteString
" WHERE attrelid = ", forall a. PGRep a => a -> ByteString
pgLiteralRep PGName
pgtab, ByteString
"::regclass"
, ByteString
" AND attnum > 0 AND NOT attisdropped"
, ByteString
" ORDER BY attnum"
])
case [(OID, (PGName, Name, Type, Bool))]
cl of
[] -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"dataPGRelation " forall a. [a] -> [a] -> [a]
++ [Char]
typs forall a. [a] -> [a] -> [a]
++ [Char]
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PGName
pgtab forall a. [a] -> [a] -> [a]
++ [Char]
": no columns found"
(OID
to, (PGName, Name, Type, Bool)
_):[(OID, (PGName, Name, Type, Bool))]
_ -> do
PGName
tt <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"dataPGRelation " forall a. [a] -> [a] -> [a]
++ [Char]
typs forall a. [a] -> [a] -> [a]
++ [Char]
" = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show PGName
pgtab forall a. [a] -> [a] -> [a]
++ [Char]
": table type not found (you may need to use reloadTPGTypes or adjust search_path)") forall (m :: * -> *) a. Monad m => a -> m a
return
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PGTypeConnection -> OID -> IO (Maybe PGName)
lookupPGType PGTypeConnection
tpg OID
to
forall (m :: * -> *) a. Monad m => a -> m a
return (PGName
tt, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(OID, (PGName, Name, Type, Bool))]
cl)
[(Name, Type, Bool)]
cols <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(PGName
c, Name
_, Type
t, Bool
nn) -> do
Name
v <- forall (m :: * -> *). Quote m => [Char] -> m Name
TH.newName forall a b. (a -> b) -> a -> b
$ PGName -> [Char]
pgNameString PGName
c
forall (m :: * -> *) a. Monad m => a -> m a
return (Name
v, Type
t, Bool
nn))
[(PGName, Name, Type, Bool)]
cold
let typl :: Type
typl = TyLit -> Type
TH.LitT ([Char] -> TyLit
TH.StrTyLit forall a b. (a -> b) -> a -> b
$ PGName -> [Char]
pgNameString PGName
pgid)
encfun :: Name -> Dec
encfun Name
f = Name -> [Clause] -> Dec
TH.FunD Name
f [[Pat] -> Body -> [Dec] -> Clause
TH.Clause [Pat
TH.WildP, Name -> [Pat] -> Pat
conP Name
typn (forall a b. (a -> b) -> [a] -> [b]
map (\(Name
v, Type
_, Bool
_) -> Name -> Pat
TH.VarP Name
v) [(Name, Type, Bool)]
cols)]
(Exp -> Body
TH.NormalB forall a b. (a -> b) -> a -> b
$ Name -> Type -> Exp
pgcall Name
f Type
rect Exp -> Exp -> Exp
`TH.AppE`
(Name -> Exp
TH.ConE 'PGRecord Exp -> Exp -> Exp
`TH.AppE` [Exp] -> Exp
TH.ListE (forall a b. (a -> b) -> [a] -> [b]
map (Name -> (Name, Type, Bool) -> Exp
colenc Name
f) [(Name, Type, Bool)]
cols)))
[] ]
Name
dv <- forall (m :: * -> *). Quote m => [Char] -> m Name
TH.newName [Char]
"x"
Name
tv <- forall (m :: * -> *). Quote m => [Char] -> m Name
TH.newName [Char]
"t"
Name
ev <- forall (m :: * -> *). Quote m => [Char] -> m Name
TH.newName [Char]
"e"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
[ Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Dec
TH.DataD
[]
Name
typn
[]
#if MIN_VERSION_template_haskell(2,11,0)
forall a. Maybe a
Nothing
#endif
[ Name -> [VarBangType] -> Con
TH.RecC Name
typn forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(PGName
_, Name
n, Type
t, Bool
nn) ->
( Name
n
#if MIN_VERSION_template_haskell(2,11,0)
, SourceUnpackedness -> SourceStrictness -> Bang
TH.Bang SourceUnpackedness
TH.NoSourceUnpackedness SourceStrictness
TH.NoSourceStrictness
#else
, TH.NotStrict
#endif
, (if Bool
nn then (Name -> Type
TH.ConT ''Maybe Type -> Type -> Type
`TH.AppT`) else forall a. a -> a
id)
(Name -> Type
TH.ConT ''PGVal Type -> Type -> Type
`TH.AppT` Type
t)))
[(PGName, Name, Type, Bool)]
cold
]
[]
, Cxt -> Type -> [Dec] -> Dec
instanceD [] (Name -> Type
TH.ConT ''PGType Type -> Type -> Type
`TH.AppT` Type
typl)
[ Name -> Type -> Type -> Dec
tySynInstD ''PGVal Type
typl Type
typt
]
, Cxt -> Type -> [Dec] -> Dec
instanceD [] (Name -> Type
TH.ConT ''PGParameter Type -> Type -> Type
`TH.AppT` Type
typl Type -> Type -> Type
`TH.AppT` Type
typt)
[ Name -> Dec
encfun 'pgEncode
, Name -> Dec
encfun 'pgLiteral
]
, Cxt -> Type -> [Dec] -> Dec
instanceD [] (Name -> Type
TH.ConT ''PGColumn Type -> Type -> Type
`TH.AppT` Type
typl Type -> Type -> Type
`TH.AppT` Type
typt)
[ Name -> [Clause] -> Dec
TH.FunD 'pgDecode [[Pat] -> Body -> [Dec] -> Clause
TH.Clause [Pat
TH.WildP, Name -> Pat
TH.VarP Name
dv]
([(Guard, Exp)] -> Body
TH.GuardedB
[ ([Stmt] -> Guard
TH.PatG [Pat -> Exp -> Stmt
TH.BindS
(Name -> [Pat] -> Pat
conP 'PGRecord [[Pat] -> Pat
TH.ListP forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (Name, b, Bool) -> Pat
colpat [(Name, Type, Bool)]
cols])
(Name -> Type -> Exp
pgcall 'pgDecode Type
rect Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
dv)]
, forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Exp
f -> Exp -> Exp -> Exp
TH.AppE Exp
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Type, Bool) -> Exp
coldec) (Name -> Exp
TH.ConE Name
typn) [(Name, Type, Bool)]
cols)
, (Exp -> Guard
TH.NormalG (Name -> Exp
TH.ConE 'True)
, Name -> Exp
TH.VarE 'error Exp -> Exp -> Exp
`TH.AppE` Lit -> Exp
TH.LitE ([Char] -> Lit
TH.StringL forall a b. (a -> b) -> a -> b
$ [Char]
"pgDecode " forall a. [a] -> [a] -> [a]
++ [Char]
typs forall a. [a] -> [a] -> [a]
++ [Char]
": NULL in not null record column"))
])
[] ]
]
#if MIN_VERSION_template_haskell(2,11,0)
, Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
TH.InstanceD (forall a. a -> Maybe a
Just Overlap
TH.Overlapping) [] (Name -> Type
TH.ConT ''PGColumn Type -> Type -> Type
`TH.AppT` Type
typl Type -> Type -> Type
`TH.AppT` (Name -> Type
TH.ConT ''Maybe Type -> Type -> Type
`TH.AppT` Type
typt))
[ Name -> [Clause] -> Dec
TH.FunD 'pgDecode [[Pat] -> Body -> [Dec] -> Clause
TH.Clause [Pat
TH.WildP, Name -> Pat
TH.VarP Name
dv]
([(Guard, Exp)] -> Body
TH.GuardedB
[ ([Stmt] -> Guard
TH.PatG [Pat -> Exp -> Stmt
TH.BindS
(Name -> [Pat] -> Pat
conP 'PGRecord [[Pat] -> Pat
TH.ListP forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (Name, b, Bool) -> Pat
colpat [(Name, Type, Bool)]
cols])
(Name -> Type -> Exp
pgcall 'pgDecode Type
rect Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
dv)]
, Name -> Exp
TH.ConE 'Just Exp -> Exp -> Exp
`TH.AppE` forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Exp
f -> Exp -> Exp -> Exp
TH.AppE Exp
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Type, Bool) -> Exp
coldec) (Name -> Exp
TH.ConE Name
typn) [(Name, Type, Bool)]
cols)
, (Exp -> Guard
TH.NormalG (Name -> Exp
TH.ConE 'True)
, Name -> Exp
TH.ConE 'Nothing)
])
[] ]
, Name -> [Clause] -> Dec
TH.FunD 'pgDecodeValue
[ [Pat] -> Body -> [Dec] -> Clause
TH.Clause [Pat
TH.WildP, Pat
TH.WildP, Name -> [Pat] -> Pat
conP 'PGNullValue []]
(Exp -> Body
TH.NormalB forall a b. (a -> b) -> a -> b
$ Name -> Exp
TH.ConE 'Nothing)
[]
, [Pat] -> Body -> [Dec] -> Clause
TH.Clause [Pat
TH.WildP, Name -> Pat
TH.VarP Name
tv, Name -> [Pat] -> Pat
conP 'PGTextValue [Name -> Pat
TH.VarP Name
dv]]
(Exp -> Body
TH.NormalB forall a b. (a -> b) -> a -> b
$ Name -> Exp
TH.VarE 'pgDecode Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
tv Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
dv)
[]
, [Pat] -> Body -> [Dec] -> Clause
TH.Clause [Name -> Pat
TH.VarP Name
ev, Name -> Pat
TH.VarP Name
tv, Name -> [Pat] -> Pat
conP 'PGBinaryValue [Name -> Pat
TH.VarP Name
dv]]
(Exp -> Body
TH.NormalB forall a b. (a -> b) -> a -> b
$ Name -> Exp
TH.VarE 'pgDecodeBinary Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
ev Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
tv Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
dv)
[]
]
]
#endif
, Cxt -> Type -> [Dec] -> Dec
instanceD [] (Name -> Type
TH.ConT ''PGRep Type -> Type -> Type
`TH.AppT` Type
typt)
[ Name -> Type -> Type -> Dec
tySynInstD ''PGRepType Type
typt Type
typl
]
, Cxt -> Type -> [Dec] -> Dec
instanceD [] (Name -> Type
TH.ConT ''PGRecordType Type -> Type -> Type
`TH.AppT` Type
typl) []
, Cxt -> Type -> [Dec] -> Dec
instanceD [] (Name -> Type
TH.ConT ''PGRelation Type -> Type -> Type
`TH.AppT` Type
typt)
[ Name -> [Clause] -> Dec
TH.FunD 'pgRelationName [[Pat] -> Body -> [Dec] -> Clause
TH.Clause [Pat
TH.WildP]
(Exp -> Body
TH.NormalB forall a b. (a -> b) -> a -> b
$ PGName -> Exp
namelit PGName
pgtab)
[] ]
, Name -> [Clause] -> Dec
TH.FunD 'pgColumnNames [[Pat] -> Body -> [Dec] -> Clause
TH.Clause [Pat
TH.WildP]
(Exp -> Body
TH.NormalB forall a b. (a -> b) -> a -> b
$ [Exp] -> Exp
TH.ListE forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(PGName
c, Name
_, Type
_, Bool
_) -> PGName -> Exp
namelit PGName
c) [(PGName, Name, Type, Bool)]
cold)
[] ]
]
, Name -> Type -> Dec
TH.SigD ([Char] -> Name
TH.mkName ([Char]
"uncurry" forall a. [a] -> [a] -> [a]
++ [Char]
typs)) forall a b. (a -> b) -> a -> b
$ Type
TH.ArrowT Type -> Type -> Type
`TH.AppT`
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Type
f (Name
_, Type
t, Bool
n) -> Type
f Type -> Type -> Type
`TH.AppT`
(if Bool
n then (Name -> Type
TH.ConT ''Maybe Type -> Type -> Type
`TH.AppT`) else forall a. a -> a
id)
(Name -> Type
TH.ConT ''PGVal Type -> Type -> Type
`TH.AppT` Type
t))
(Name -> Type
TH.ConT (Int -> Name
TH.tupleTypeName (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name, Type, Bool)]
cols)))
[(Name, Type, Bool)]
cols Type -> Type -> Type
`TH.AppT` Type
typt
, Name -> [Clause] -> Dec
TH.FunD ([Char] -> Name
TH.mkName ([Char]
"uncurry" forall a. [a] -> [a] -> [a]
++ [Char]
typs))
[ [Pat] -> Body -> [Dec] -> Clause
TH.Clause [Name -> [Pat] -> Pat
conP (Int -> Name
TH.tupleDataName (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Name, Type, Bool)]
cols)) (forall a b. (a -> b) -> [a] -> [b]
map (\(Name
v, Type
_, Bool
_) -> Name -> Pat
TH.VarP Name
v) [(Name, Type, Bool)]
cols)]
(Exp -> Body
TH.NormalB forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Exp
f (Name
v, Type
_, Bool
_) -> Exp
f Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
v) (Name -> Exp
TH.ConE Name
typn) [(Name, Type, Bool)]
cols)
[]
]
, Pragma -> Dec
TH.PragmaD forall a b. (a -> b) -> a -> b
$ AnnTarget -> Exp -> Pragma
TH.AnnP (Name -> AnnTarget
TH.TypeAnnotation Name
typn) forall a b. (a -> b) -> a -> b
$ PGName -> Exp
namelit PGName
pgid
, Pragma -> Dec
TH.PragmaD forall a b. (a -> b) -> a -> b
$ AnnTarget -> Exp -> Pragma
TH.AnnP (Name -> AnnTarget
TH.ValueAnnotation Name
typn) forall a b. (a -> b) -> a -> b
$ PGName -> Exp
namelit PGName
pgid
] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (\(PGName
c, Name
n, Type
_, Bool
_) ->
Pragma -> Dec
TH.PragmaD forall a b. (a -> b) -> a -> b
$ AnnTarget -> Exp -> Pragma
TH.AnnP (Name -> AnnTarget
TH.ValueAnnotation Name
n) forall a b. (a -> b) -> a -> b
$ PGName -> Exp
namelit PGName
c) [(PGName, Name, Type, Bool)]
cold
where
typn :: Name
typn = [Char] -> Name
TH.mkName [Char]
typs
typt :: Type
typt = Name -> Type
TH.ConT Name
typn
instanceD :: Cxt -> Type -> [Dec] -> Dec
instanceD = Maybe Overlap -> Cxt -> Type -> [Dec] -> Dec
TH.InstanceD
#if MIN_VERSION_template_haskell(2,11,0)
forall a. Maybe a
Nothing
#endif
tySynInstD :: Name -> Type -> Type -> Dec
tySynInstD Name
c Type
l Type
t = TySynEqn -> Dec
TH.TySynInstD
#if MIN_VERSION_template_haskell(2,15,0)
forall a b. (a -> b) -> a -> b
$ Maybe [TyVarBndr ()] -> Type -> Type -> TySynEqn
TH.TySynEqn forall a. Maybe a
Nothing (Type -> Type -> Type
TH.AppT (Name -> Type
TH.ConT Name
c) Type
l)
#else
c $ TH.TySynEqn [l]
#endif
Type
t
pgcall :: Name -> Type -> Exp
pgcall Name
f Type
t = Name -> Exp
TH.VarE Name
f Exp -> Exp -> Exp
`TH.AppE`
(Name -> Exp
TH.ConE 'PGTypeProxy Exp -> Type -> Exp
`TH.SigE`
(Name -> Type
TH.ConT ''PGTypeID Type -> Type -> Type
`TH.AppT` Type
t))
colenc :: Name -> (Name, Type, Bool) -> Exp
colenc Name
f (Name
v, Type
t, Bool
False) = Name -> Exp
TH.ConE 'Just Exp -> Exp -> Exp
`TH.AppE` (Name -> Type -> Exp
pgcall Name
f Type
t Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
v)
colenc Name
f (Name
v, Type
t, Bool
True) = Name -> Exp
TH.VarE 'fmap Exp -> Exp -> Exp
`TH.AppE` Name -> Type -> Exp
pgcall Name
f Type
t Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
v
colpat :: (Name, b, Bool) -> Pat
colpat (Name
v, b
_, Bool
False) = Name -> [Pat] -> Pat
conP 'Just [Name -> Pat
TH.VarP Name
v]
colpat (Name
v, b
_, Bool
True) = Name -> Pat
TH.VarP Name
v
coldec :: (Name, Type, Bool) -> Exp
coldec (Name
v, Type
t, Bool
False) = Name -> Type -> Exp
pgcall 'pgDecode Type
t Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
v
coldec (Name
v, Type
t, Bool
True) = Name -> Exp
TH.VarE 'fmap Exp -> Exp -> Exp
`TH.AppE` Name -> Type -> Exp
pgcall 'pgDecode Type
t Exp -> Exp -> Exp
`TH.AppE` Name -> Exp
TH.VarE Name
v
rect :: Type
rect = TyLit -> Type
TH.LitT forall a b. (a -> b) -> a -> b
$ [Char] -> TyLit
TH.StrTyLit [Char]
"record"
namelit :: PGName -> Exp
namelit PGName
n = Name -> Exp
TH.ConE 'PGName Exp -> Exp -> Exp
`TH.AppE`
[Exp] -> Exp
TH.ListE (forall a b. (a -> b) -> [a] -> [b]
map (Lit -> Exp
TH.LitE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
TH.IntegerL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral) forall a b. (a -> b) -> a -> b
$ PGName -> [Word8]
pgNameBytes PGName
n)
conP :: Name -> [Pat] -> Pat
conP Name
n [Pat]
p = Name -> Cxt -> [Pat] -> Pat
TH.ConP Name
n
#if MIN_VERSION_template_haskell(2,18,0)
[]
#endif
[Pat]
p