{-|
Module: Squeal.PostgreSQL.Session.Oid
Description: object identifiers
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

Object identifiers are used internally by PostgreSQL as
primary keys. They are needed to correctly encode
statement parameters.
-}

{-# LANGUAGE
    AllowAmbiguousTypes
  , DataKinds
  , FlexibleContexts
  , FlexibleInstances
  , MultiParamTypeClasses
  , OverloadedStrings
  , PolyKinds
  , ScopedTypeVariables
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
#-}

module Squeal.PostgreSQL.Session.Oid
  ( -- * Oids
    LibPQ.Oid
  , OidOf (..)
  , OidOfArray (..)
  , OidOfNull (..)
  , OidOfField (..)
  ) where

import Control.Monad.Catch
import Control.Monad.Reader
import Data.String
import GHC.TypeLits
import PostgreSQL.Binary.Decoding (valueParser, int)

import qualified Data.ByteString as ByteString
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Generics.SOP as SOP

import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Session.Exception
import Squeal.PostgreSQL.Type.Schema

-- $setup
-- >>> import Squeal.PostgreSQL

-- | The `LibPQ.Oid` of a `PGType`
--
-- >>> :set -XTypeApplications
-- >>> conn <- connectdb @'[] "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
-- >>> runReaderT (oidOf @'[] @'PGbool) conn
-- Oid 16
--
-- >>> finish conn
class OidOf (db :: SchemasType) (pg :: PGType) where
  oidOf :: ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid
-- | The `LibPQ.Oid` of an array
class OidOfArray (db :: SchemasType) (pg :: PGType) where
  oidOfArray :: ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid
instance OidOfArray db pg => OidOf db ('PGvararray (null pg)) where
  oidOf :: ReaderT (K Connection db) IO Oid
oidOf = OidOfArray db pg => ReaderT (K Connection db) IO Oid
forall (db :: SchemasType) (pg :: PGType).
OidOfArray db pg =>
ReaderT (K Connection db) IO Oid
oidOfArray @db @pg
instance OidOfArray db pg => OidOf db ('PGfixarray dims (null pg)) where
  oidOf :: ReaderT (K Connection db) IO Oid
oidOf = OidOfArray db pg => ReaderT (K Connection db) IO Oid
forall (db :: SchemasType) (pg :: PGType).
OidOfArray db pg =>
ReaderT (K Connection db) IO Oid
oidOfArray @db @pg
-- | The `LibPQ.Oid` of a `NullType`
class OidOfNull (db :: SchemasType) (ty :: NullType) where
  oidOfNull :: ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid
instance OidOf db pg => OidOfNull db (null pg) where
  oidOfNull :: ReaderT (K Connection db) IO Oid
oidOfNull = OidOf db pg => ReaderT (K Connection db) IO Oid
forall (db :: SchemasType) (pg :: PGType).
OidOf db pg =>
ReaderT (K Connection db) IO Oid
oidOf @db @pg
-- | The `LibPQ.Oid` of a field
class OidOfField (db :: SchemasType) (field :: (Symbol, NullType)) where
  oidOfField :: ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid
instance OidOfNull db ty => OidOfField db (fld ::: ty) where
  oidOfField :: ReaderT (K Connection db) IO Oid
oidOfField = OidOfNull db ty => ReaderT (K Connection db) IO Oid
forall (db :: SchemasType) (ty :: NullType).
OidOfNull db ty =>
ReaderT (K Connection db) IO Oid
oidOfNull @db @ty

instance OidOf db 'PGbool where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
16
instance OidOfArray db 'PGbool where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1000
instance OidOf db 'PGint2 where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
21
instance OidOfArray db 'PGint2 where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1005
instance OidOf db 'PGint4 where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
23
instance OidOfArray db 'PGint4 where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1007
instance OidOf db 'PGint8 where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
20
instance OidOfArray db 'PGint8 where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1016
instance OidOf db 'PGnumeric where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1700
instance OidOfArray db 'PGnumeric where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1231
instance OidOf db 'PGfloat4 where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
700
instance OidOfArray db 'PGfloat4 where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1021
instance OidOf db 'PGfloat8 where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
701
instance OidOfArray db 'PGfloat8 where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1022
instance OidOf db 'PGmoney where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
790
instance OidOfArray db 'PGmoney where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
791
instance OidOf db ('PGchar n) where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
18
instance OidOfArray db ('PGchar n) where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1002
instance OidOf db ('PGvarchar n) where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1043
instance OidOfArray db ('PGvarchar n) where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1015
instance OidOf db 'PGtext where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
25
instance OidOfArray db 'PGtext where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1009
instance OidOf db 'PGbytea where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
17
instance OidOfArray db 'PGbytea where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1001
instance OidOf db 'PGtimestamp where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1114
instance OidOfArray db 'PGtimestamp where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1115
instance OidOf db 'PGtimestamptz where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1184
instance OidOfArray db 'PGtimestamptz where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1185
instance OidOf db 'PGdate where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1082
instance OidOfArray db 'PGdate where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1182
instance OidOf db 'PGtime where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1083
instance OidOfArray db 'PGtime where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1183
instance OidOf db 'PGtimetz where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1266
instance OidOfArray db 'PGtimetz where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1270
instance OidOf db 'PGinterval where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1186
instance OidOfArray db 'PGinterval where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1187
instance OidOf db 'PGuuid where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
2950
instance OidOfArray db 'PGuuid where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
2951
instance OidOf db 'PGinet where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
869
instance OidOfArray db 'PGinet where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1041
instance OidOf db 'PGjson where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
114
instance OidOfArray db 'PGjson where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
199
instance OidOf db 'PGjsonb where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3802
instance OidOfArray db 'PGjsonb where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3807
instance OidOf db 'PGtsvector where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3614
instance OidOfArray db 'PGtsvector where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3643
instance OidOf db 'PGtsquery where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3615
instance OidOfArray db 'PGtsquery where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3645
instance OidOf db 'PGoid where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
26
instance OidOfArray db 'PGoid where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
1028
instance OidOf db ('PGrange 'PGint4) where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3904
instance OidOfArray db ('PGrange 'PGint4) where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3905
instance OidOf db ('PGrange 'PGint8) where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3926
instance OidOfArray db ('PGrange 'PGint8) where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3927
instance OidOf db ('PGrange 'PGnumeric) where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3906
instance OidOfArray db ('PGrange 'PGnumeric) where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3907
instance OidOf db ('PGrange 'PGtimestamp) where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3908
instance OidOfArray db ('PGrange 'PGtimestamp) where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3909
instance OidOf db ('PGrange 'PGtimestamptz) where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3910
instance OidOfArray db ('PGrange 'PGtimestamptz) where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3911
instance OidOf db ('PGrange 'PGdate) where oidOf :: ReaderT (K Connection db) IO Oid
oidOf = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3912
instance OidOfArray db ('PGrange 'PGdate) where oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = Oid -> ReaderT (K Connection db) IO Oid
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Oid -> ReaderT (K Connection db) IO Oid)
-> Oid -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
3913
instance
  ( KnownSymbol sch
  , KnownSymbol td
  , rels ~ DbRelations db
  , FindQualified "no relation found with row:" rels row ~ '(sch,td)
  ) => OidOf db ('PGcomposite row) where
    oidOf :: ReaderT (K Connection db) IO Oid
oidOf = forall (db :: SchemasType).
(KnownSymbol sch, KnownSymbol td) =>
ReaderT (K Connection db) IO Oid
forall k (sch :: Symbol) (ty :: Symbol) (db :: k).
(KnownSymbol sch, KnownSymbol ty) =>
ReaderT (K Connection db) IO Oid
oidOfTypedef @sch @td
instance
  ( KnownSymbol sch
  , KnownSymbol td
  , rels ~ DbRelations db
  , FindQualified "no relation found with row:" rels row ~ '(sch,td)
  ) => OidOfArray db ('PGcomposite row) where
    oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = forall (db :: SchemasType).
(KnownSymbol sch, KnownSymbol td) =>
ReaderT (K Connection db) IO Oid
forall k (sch :: Symbol) (ty :: Symbol) (db :: k).
(KnownSymbol sch, KnownSymbol ty) =>
ReaderT (K Connection db) IO Oid
oidOfArrayTypedef @sch @td
instance
  ( enums ~ DbEnums db
  , FindQualified "no enum found with labels:" enums labels ~ '(sch,td)
  , KnownSymbol sch
  , KnownSymbol td
  ) => OidOf db ('PGenum labels) where
    oidOf :: ReaderT (K Connection db) IO Oid
oidOf = forall (db :: SchemasType).
(KnownSymbol sch, KnownSymbol td) =>
ReaderT (K Connection db) IO Oid
forall k (sch :: Symbol) (ty :: Symbol) (db :: k).
(KnownSymbol sch, KnownSymbol ty) =>
ReaderT (K Connection db) IO Oid
oidOfTypedef @sch @td
instance
  ( enums ~ DbEnums db
  , FindQualified "no enum found with labels:" enums labels ~ '(sch,td)
  , KnownSymbol sch
  , KnownSymbol td
  ) => OidOfArray db ('PGenum labels) where
    oidOfArray :: ReaderT (K Connection db) IO Oid
oidOfArray = forall (db :: SchemasType).
(KnownSymbol sch, KnownSymbol td) =>
ReaderT (K Connection db) IO Oid
forall k (sch :: Symbol) (ty :: Symbol) (db :: k).
(KnownSymbol sch, KnownSymbol ty) =>
ReaderT (K Connection db) IO Oid
oidOfArrayTypedef @sch @td

oidOfTypedef
  :: forall sch ty db. (KnownSymbol sch, KnownSymbol ty)
  => ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid
oidOfTypedef :: ReaderT (K Connection db) IO Oid
oidOfTypedef = (K Connection db -> IO Oid) -> ReaderT (K Connection db) IO Oid
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((K Connection db -> IO Oid) -> ReaderT (K Connection db) IO Oid)
-> (K Connection db -> IO Oid) -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ \(SOP.K Connection
conn) -> do
  Maybe Result
resultMaybe <- Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO (Maybe Result)
LibPQ.execParams Connection
conn ByteString
q [] Format
LibPQ.Binary
  case Maybe Result
resultMaybe of
    Maybe Result
Nothing -> SquealException -> IO Oid
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO Oid) -> SquealException -> IO Oid
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
oidErr
    Just Result
result -> do
      Row
numRows <- Result -> IO Row
LibPQ.ntuples Result
result
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Row
numRows Row -> Row -> Bool
forall a. Eq a => a -> a -> Bool
/= Row
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SquealException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO ()) -> SquealException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Row -> Row -> SquealException
RowsException Text
oidErr Row
1 Row
numRows
      Maybe ByteString
valueMaybe <- Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue Result
result Row
0 Column
0
      case Maybe ByteString
valueMaybe of
        Maybe ByteString
Nothing -> SquealException -> IO Oid
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO Oid) -> SquealException -> IO Oid
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
oidErr
        Just ByteString
value -> case Value CUInt -> ByteString -> Either Text CUInt
forall a. Value a -> ByteString -> Either Text a
valueParser Value CUInt
forall a. (Integral a, Bits a) => Value a
int ByteString
value of
          Left Text
err -> SquealException -> IO Oid
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO Oid) -> SquealException -> IO Oid
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SquealException
DecodingException Text
oidErr Text
err
          Right CUInt
oid -> Oid -> IO Oid
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid -> IO Oid) -> Oid -> IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
oid
  where
    tyVal :: String
tyVal = Proxy ty -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy ty
forall k (t :: k). Proxy t
SOP.Proxy @ty)
    schVal :: String
schVal = Proxy sch -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sch
forall k (t :: k). Proxy t
SOP.Proxy @sch)
    oidErr :: Text
oidErr = Text
"oidOfTypedef " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (String
schVal String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tyVal)
    q :: ByteString
q = ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
" "
      [ ByteString
"SELECT pg_type.oid"
      , ByteString
"FROM pg_type"
      , ByteString
"INNER JOIN pg_namespace"
      , ByteString
"ON pg_type.typnamespace = pg_namespace.oid"
      , ByteString
"WHERE pg_type.typname = "
      , ByteString
"\'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString String
tyVal ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\'"
      , ByteString
"AND pg_namespace.nspname = "
      , ByteString
"\'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString String
schVal ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\'"
      , ByteString
";" ]

oidOfArrayTypedef
  :: forall sch ty db. (KnownSymbol sch, KnownSymbol ty)
  => ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid
oidOfArrayTypedef :: ReaderT (K Connection db) IO Oid
oidOfArrayTypedef = (K Connection db -> IO Oid) -> ReaderT (K Connection db) IO Oid
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((K Connection db -> IO Oid) -> ReaderT (K Connection db) IO Oid)
-> (K Connection db -> IO Oid) -> ReaderT (K Connection db) IO Oid
forall a b. (a -> b) -> a -> b
$ \(SOP.K Connection
conn) -> do
  Maybe Result
resultMaybe <- Connection
-> ByteString
-> [Maybe (Oid, ByteString, Format)]
-> Format
-> IO (Maybe Result)
LibPQ.execParams Connection
conn ByteString
q [] Format
LibPQ.Binary
  case Maybe Result
resultMaybe of
    Maybe Result
Nothing -> SquealException -> IO Oid
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO Oid) -> SquealException -> IO Oid
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
oidErr
    Just Result
result -> do
      Row
numRows <- Result -> IO Row
LibPQ.ntuples Result
result
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Row
numRows Row -> Row -> Bool
forall a. Eq a => a -> a -> Bool
/= Row
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ SquealException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO ()) -> SquealException -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Row -> Row -> SquealException
RowsException Text
oidErr Row
1 Row
numRows
      Maybe ByteString
valueMaybe <- Result -> Row -> Column -> IO (Maybe ByteString)
LibPQ.getvalue Result
result Row
0 Column
0
      case Maybe ByteString
valueMaybe of
        Maybe ByteString
Nothing -> SquealException -> IO Oid
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO Oid) -> SquealException -> IO Oid
forall a b. (a -> b) -> a -> b
$ Text -> SquealException
ConnectionException Text
oidErr
        Just ByteString
value -> case Value CUInt -> ByteString -> Either Text CUInt
forall a. Value a -> ByteString -> Either Text a
valueParser Value CUInt
forall a. (Integral a, Bits a) => Value a
int ByteString
value of
          Left Text
err -> SquealException -> IO Oid
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (SquealException -> IO Oid) -> SquealException -> IO Oid
forall a b. (a -> b) -> a -> b
$ Text -> Text -> SquealException
DecodingException Text
oidErr Text
err
          Right CUInt
oid -> Oid -> IO Oid
forall (m :: * -> *) a. Monad m => a -> m a
return (Oid -> IO Oid) -> Oid -> IO Oid
forall a b. (a -> b) -> a -> b
$ CUInt -> Oid
LibPQ.Oid CUInt
oid
  where
    tyVal :: String
tyVal = Proxy ty -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy ty
forall k (t :: k). Proxy t
SOP.Proxy @ty)
    schVal :: String
schVal = Proxy sch -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sch
forall k (t :: k). Proxy t
SOP.Proxy @sch)
    oidErr :: Text
oidErr = Text
"oidOfArrayTypedef " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. IsString a => String -> a
fromString (String
schVal String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tyVal)
    q :: ByteString
q = ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
" "
      [ ByteString
"SELECT pg_type.typelem"
      , ByteString
"FROM pg_type"
      , ByteString
"INNER JOIN pg_namespace"
      , ByteString
"ON pg_type.typnamespace = pg_namespace.oid"
      , ByteString
"WHERE pg_type.typname = "
      , ByteString
"\'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString String
tyVal ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\'"
      , ByteString
"AND pg_namespace.nspname = "
      , ByteString
"\'" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fromString String
schVal ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\'"
      , ByteString
";" ]