{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE UndecidableSuperClasses #-}
#endif
-- |
-- Module: Database.PostgreSQL.Typed.Relation
-- Copyright: 2016 Dylan Simon
-- 
-- Automatically create data types based on tables and other relations.

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

-- |Data types that are based on database relations.
-- Normally these instances are created using 'dataPGRelation'.
class (PGRep a, PGRecordType (PGRepType a)) => PGRelation a where
  -- |Database name of table/relation (i.e., second argument to 'dataPGRelation').  Normally this is the same as @'pgTypeID' . 'pgTypeOfProxy'@, but this preserves any specified schema qualification.
  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
  -- |Database names of columns.
  pgColumnNames :: Proxy a -> [PGName]

-- |Create a new data type corresponding to the given PostgreSQL relation.
-- For example, if you have @CREATE TABLE foo (abc integer NOT NULL, def text)@, then
-- @dataPGRelation \"Foo\" \"foo\" (\"foo_\"++)@ will be equivalent to:
-- 
-- > data Foo = Foo{ foo_abc :: PGVal "integer", foo_def :: Maybe (PGVal "text") }
-- > instance PGType "foo" where PGVal "foo" = Foo
-- > instance PGParameter "foo" Foo where ...
-- > instance PGColumn "foo" Foo where ...
-- > instance PGColumn "foo" (Maybe Foo) where ... -- to handle NULL in not null columns
-- > instance PGRep Foo where PGRepType = "foo"
-- > instance PGRecordType "foo"
-- > instance PGRelation Foo where pgColumnNames _ = ["abc", "def"]
-- > uncurryFoo :: (PGVal "integer", Maybe (PGVal "text")) -> Foo
--
-- (Note that @PGVal "integer" = Int32@ and @PGVal "text" = Text@ by default.)
-- This provides instances for marshalling the corresponding composite/record types, e.g., using @SELECT foo.*::foo FROM foo@.
-- If you want any derived instances, you'll need to create them yourself using StandaloneDeriving.
--
-- Requires language extensions: TemplateHaskell, FlexibleInstances, MultiParamTypeClasses, DataKinds, TypeFamilies, PatternGuards
dataPGRelation :: String -- ^ Haskell type and constructor to create
  -> PGName -- ^ PostgreSQL table/relation name
  -> (String -> String) -- ^ How to generate field names from column names, e.g. @("table_"++)@ (input is 'pgNameString')
  -> 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