content: {-|
  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 (when)
  import Control.Monad.Catch (throwM)
  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 = oidOfArray @db @pg
  instance OidOfArray db pg => OidOf db ('PGfixarray dims (null pg)) where
    oidOf = 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 = 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 = oidOfNull @db @ty
  
  instance OidOf db 'PGbool where oidOf = pure $ LibPQ.Oid 16
  instance OidOfArray db 'PGbool where oidOfArray = pure $ LibPQ.Oid 1000
  instance OidOf db 'PGint2 where oidOf = pure $ LibPQ.Oid 21
  instance OidOfArray db 'PGint2 where oidOfArray = pure $ LibPQ.Oid 1005
  instance OidOf db 'PGint4 where oidOf = pure $ LibPQ.Oid 23
  instance OidOfArray db 'PGint4 where oidOfArray = pure $ LibPQ.Oid 1007
  instance OidOf db 'PGint8 where oidOf = pure $ LibPQ.Oid 20
  instance OidOfArray db 'PGint8 where oidOfArray = pure $ LibPQ.Oid 1016
  instance OidOf db 'PGnumeric where oidOf = pure $ LibPQ.Oid 1700
  instance OidOfArray db 'PGnumeric where oidOfArray = pure $ LibPQ.Oid 1231
  instance OidOf db 'PGfloat4 where oidOf = pure $ LibPQ.Oid 700
  instance OidOfArray db 'PGfloat4 where oidOfArray = pure $ LibPQ.Oid 1021
  instance OidOf db 'PGfloat8 where oidOf = pure $ LibPQ.Oid 701
  instance OidOfArray db 'PGfloat8 where oidOfArray = pure $ LibPQ.Oid 1022
  instance OidOf db 'PGmoney where oidOf = pure $ LibPQ.Oid 790
  instance OidOfArray db 'PGmoney where oidOfArray = pure $ LibPQ.Oid 791
  instance OidOf db ('PGchar n) where oidOf = pure $ LibPQ.Oid 18
  instance OidOfArray db ('PGchar n) where oidOfArray = pure $ LibPQ.Oid 1002
  instance OidOf db ('PGvarchar n) where oidOf = pure $ LibPQ.Oid 1043
  instance OidOfArray db ('PGvarchar n) where oidOfArray = pure $ LibPQ.Oid 1015
  instance OidOf db 'PGtext where oidOf = pure $ LibPQ.Oid 25
  instance OidOfArray db 'PGtext where oidOfArray = pure $ LibPQ.Oid 1009
  instance OidOf db 'PGbytea where oidOf = pure $ LibPQ.Oid 17
  instance OidOfArray db 'PGbytea where oidOfArray = pure $ LibPQ.Oid 1001
  instance OidOf db 'PGtimestamp where oidOf = pure $ LibPQ.Oid 1114
  instance OidOfArray db 'PGtimestamp where oidOfArray = pure $ LibPQ.Oid 1115
  instance OidOf db 'PGtimestamptz where oidOf = pure $ LibPQ.Oid 1184
  instance OidOfArray db 'PGtimestamptz where oidOfArray = pure $ LibPQ.Oid 1185
  instance OidOf db 'PGdate where oidOf = pure $ LibPQ.Oid 1082
  instance OidOfArray db 'PGdate where oidOfArray = pure $ LibPQ.Oid 1182
  instance OidOf db 'PGtime where oidOf = pure $ LibPQ.Oid 1083
  instance OidOfArray db 'PGtime where oidOfArray = pure $ LibPQ.Oid 1183
  instance OidOf db 'PGtimetz where oidOf = pure $ LibPQ.Oid 1266
  instance OidOfArray db 'PGtimetz where oidOfArray = pure $ LibPQ.Oid 1270
  instance OidOf db 'PGinterval where oidOf = pure $ LibPQ.Oid 1186
  instance OidOfArray db 'PGinterval where oidOfArray = pure $ LibPQ.Oid 1187
  instance OidOf db 'PGuuid where oidOf = pure $ LibPQ.Oid 2950
  instance OidOfArray db 'PGuuid where oidOfArray = pure $ LibPQ.Oid 2951
  instance OidOf db 'PGinet where oidOf = pure $ LibPQ.Oid 869
  instance OidOfArray db 'PGinet where oidOfArray = pure $ LibPQ.Oid 1041
  instance OidOf db 'PGjson where oidOf = pure $ LibPQ.Oid 114
  instance OidOfArray db 'PGjson where oidOfArray = pure $ LibPQ.Oid 199
  instance OidOf db 'PGjsonb where oidOf = pure $ LibPQ.Oid 3802
  instance OidOfArray db 'PGjsonb where oidOfArray = pure $ LibPQ.Oid 3807
  instance OidOf db 'PGtsvector where oidOf = pure $ LibPQ.Oid 3614
  instance OidOfArray db 'PGtsvector where oidOfArray = pure $ LibPQ.Oid 3643
  instance OidOf db 'PGtsquery where oidOf = pure $ LibPQ.Oid 3615
  instance OidOfArray db 'PGtsquery where oidOfArray = pure $ LibPQ.Oid 3645
  instance OidOf db 'PGoid where oidOf = pure $ LibPQ.Oid 26
  instance OidOfArray db 'PGoid where oidOfArray = pure $ LibPQ.Oid 1028
  instance OidOf db ('PGrange 'PGint4) where oidOf = pure $ LibPQ.Oid 3904
  instance OidOfArray db ('PGrange 'PGint4) where oidOfArray = pure $ LibPQ.Oid 3905
  instance OidOf db ('PGrange 'PGint8) where oidOf = pure $ LibPQ.Oid 3926
  instance OidOfArray db ('PGrange 'PGint8) where oidOfArray = pure $ LibPQ.Oid 3927
  instance OidOf db ('PGrange 'PGnumeric) where oidOf = pure $ LibPQ.Oid 3906
  instance OidOfArray db ('PGrange 'PGnumeric) where oidOfArray = pure $ LibPQ.Oid 3907
  instance OidOf db ('PGrange 'PGtimestamp) where oidOf = pure $ LibPQ.Oid 3908
  instance OidOfArray db ('PGrange 'PGtimestamp) where oidOfArray = pure $ LibPQ.Oid 3909
  instance OidOf db ('PGrange 'PGtimestamptz) where oidOf = pure $ LibPQ.Oid 3910
  instance OidOfArray db ('PGrange 'PGtimestamptz) where oidOfArray = pure $ LibPQ.Oid 3911
  instance OidOf db ('PGrange 'PGdate) where oidOf = pure $ LibPQ.Oid 3912
  instance OidOfArray db ('PGrange 'PGdate) where oidOfArray = pure $ LibPQ.Oid 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 = 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 = 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 = 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 = oidOfArrayTypedef @sch @td
  
  oidOfTypedef
    :: forall sch ty db. (KnownSymbol sch, KnownSymbol ty)
    => ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid
  oidOfTypedef = ReaderT $ \(SOP.K conn) -> do
    resultMaybe <- LibPQ.execParams conn q [] LibPQ.Binary
    case resultMaybe of
      Nothing -> throwM $ ConnectionException oidErr
      Just result -> do
        numRows <- LibPQ.ntuples result
        when (numRows /= 1) $ throwM $ RowsException oidErr 1 numRows
        valueMaybe <- LibPQ.getvalue result 0 0
        case valueMaybe of
          Nothing -> throwM $ ConnectionException oidErr
          Just value -> case valueParser int value of
            Left err -> throwM $ DecodingException oidErr err
            Right oid -> return $ LibPQ.Oid oid
    where
      tyVal = symbolVal (SOP.Proxy @ty)
      schVal = symbolVal (SOP.Proxy @sch)
      oidErr = "oidOfTypedef " <> fromString (schVal <> "." <> tyVal)
      q = ByteString.intercalate " "
        [ "SELECT pg_type.oid"
        , "FROM pg_type"
        , "INNER JOIN pg_namespace"
        , "ON pg_type.typnamespace = pg_namespace.oid"
        , "WHERE pg_type.typname = "
        , "\'" <> fromString tyVal <> "\'"
        , "AND pg_namespace.nspname = "
        , "\'" <> fromString schVal <> "\'"
        , ";" ]
  
  oidOfArrayTypedef
    :: forall sch ty db. (KnownSymbol sch, KnownSymbol ty)
    => ReaderT (SOP.K LibPQ.Connection db) IO LibPQ.Oid
  oidOfArrayTypedef = ReaderT $ \(SOP.K conn) -> do
    resultMaybe <- LibPQ.execParams conn q [] LibPQ.Binary
    case resultMaybe of
      Nothing -> throwM $ ConnectionException oidErr
      Just result -> do
        numRows <- LibPQ.ntuples result
        when (numRows /= 1) $ throwM $ RowsException oidErr 1 numRows
        valueMaybe <- LibPQ.getvalue result 0 0
        case valueMaybe of
          Nothing -> throwM $ ConnectionException oidErr
          Just value -> case valueParser int value of
            Left err -> throwM $ DecodingException oidErr err
            Right oid -> return $ LibPQ.Oid oid
    where
      tyVal = symbolVal (SOP.Proxy @ty)
      schVal = symbolVal (SOP.Proxy @sch)
      oidErr = "oidOfArrayTypedef " <> fromString (schVal <> "." <> tyVal)
      q = ByteString.intercalate " "
        [ "SELECT pg_type.typelem"
        , "FROM pg_type"
        , "INNER JOIN pg_namespace"
        , "ON pg_type.typnamespace = pg_namespace.oid"
        , "WHERE pg_type.typname = "
        , "\'" <> fromString tyVal <> "\'"
        , "AND pg_namespace.nspname = "
        , "\'" <> fromString schVal <> "\'"
        , ";" ]
  