{-|
Module: Squeal.PostgreSQL.Session.Encode
Description: encoding of statement parameters
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

encoding of statement parameters
-}

{-# LANGUAGE
    AllowAmbiguousTypes
  , ConstraintKinds
  , DataKinds
  , DefaultSignatures
  , FlexibleContexts
  , FlexibleInstances
  , LambdaCase
  , MultiParamTypeClasses
  , PolyKinds
  , RankNTypes
  , ScopedTypeVariables
  , TypeApplications
  , TypeFamilies
  , TypeOperators
  , UndecidableInstances
  , UndecidableSuperClasses
#-}

module Squeal.PostgreSQL.Session.Encode
  ( -- * Encode Parameters
    EncodeParams (..)
  , GenericParams (..)
  , nilParams
  , (.*)
  , (*.)
  , aParam
  , appendParams
  , enumParam
  , rowParam
  , genericRowParams
  , (.#)
  , (#.)
    -- * Encoding Classes
  , ToPG (..)
  , ToParam (..)
  , ToField (..)
  , ToArray (..)
  ) where

import ByteString.StrictBuilder
import Control.Monad
import Control.Monad.Reader
import Data.Bits
import Data.ByteString as Strict (ByteString)
import Data.ByteString.Lazy as Lazy (ByteString)
import Data.Coerce (coerce)
import Data.Functor.Const (Const(Const))
import Data.Functor.Constant (Constant(Constant))
import Data.Functor.Contravariant
import Data.Int (Int16, Int32, Int64)
import Data.Kind
import Data.Scientific (Scientific)
import Data.Text as Strict (Text)
import Data.Text.Lazy as Lazy (Text)
import Data.Time (Day, TimeOfDay, TimeZone, LocalTime, UTCTime, DiffTime)
import Data.UUID.Types (UUID)
import Data.Vector (Vector)
import Data.Word (Word32)
import Foreign.C.Types (CUInt(CUInt))
import GHC.TypeLits
import Network.IP.Addr (NetAddr, IP)
import PostgreSQL.Binary.Encoding

import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as Lazy.ByteString
import qualified Data.Text as Strict.Text
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Generics.SOP as SOP
import qualified Generics.SOP.Record as SOP

import Squeal.PostgreSQL.Expression.Range
import Squeal.PostgreSQL.Session.Oid
import Squeal.PostgreSQL.Type
import Squeal.PostgreSQL.Type.Alias
import Squeal.PostgreSQL.Type.List
import Squeal.PostgreSQL.Type.PG
import Squeal.PostgreSQL.Type.Schema

-- $setup
-- >>> import Squeal.PostgreSQL (connectdb, finish)

-- | A `ToPG` constraint gives an encoding of a Haskell `Type` into
-- into the binary format of a PostgreSQL `PGType`.
class IsPG x => ToPG (db :: SchemasType) (x :: Type) where
  -- | >>> :set -XTypeApplications -XDataKinds
  -- >>> conn <- connectdb @'[] "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
  -- >>> runReaderT (toPG @'[] False) conn
  -- "\NUL"
  --
  -- >>> runReaderT (toPG @'[] (0 :: Int16)) conn
  -- "\NUL\NUL"
  --
  -- >>> runReaderT (toPG @'[] (0 :: Int32)) conn
  -- "\NUL\NUL\NUL\NUL"
  --
  -- >>> :set -XMultiParamTypeClasses -XGeneralizedNewtypeDeriving
  -- >>> newtype UserId = UserId { getUserId :: Int64 } deriving newtype (IsPG, ToPG db)
  -- >>> runReaderT (toPG @'[] (UserId 0)) conn
  -- "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
  --
  -- >>> finish conn
  toPG :: x -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding
instance ToPG db Bool where toPG :: Bool -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Bool -> Encoding)
-> Bool
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Encoding
bool
instance ToPG db Int16 where toPG :: Int16 -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Int16 -> Encoding)
-> Int16
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Encoding
int2_int16
instance ToPG db Int32 where toPG :: Int32 -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Int32 -> Encoding)
-> Int32
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Encoding
int4_int32
instance ToPG db Int64 where toPG :: Int64 -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Int64 -> Encoding)
-> Int64
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Encoding
int8_int64
instance ToPG db Oid where toPG :: Oid -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Oid -> Encoding)
-> Oid
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Encoding
int4_word32 (Word32 -> Encoding) -> (Oid -> Word32) -> Oid -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Oid -> Word32
getOid
instance ToPG db Float where toPG :: Float -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Float -> Encoding)
-> Float
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Encoding
float4
instance ToPG db Double where toPG :: Double -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Double -> Encoding)
-> Double
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Encoding
float8
instance ToPG db Scientific where toPG :: Scientific -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Scientific -> Encoding)
-> Scientific
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Encoding
numeric
instance ToPG db Money where toPG :: Money -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Money -> Encoding)
-> Money
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Encoding
int8_int64 (Int64 -> Encoding) -> (Money -> Int64) -> Money -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Money -> Int64
cents
instance ToPG db UUID where toPG :: UUID -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (UUID -> Encoding)
-> UUID
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Encoding
uuid
instance ToPG db (NetAddr IP) where toPG :: NetAddr IP -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (NetAddr IP -> Encoding)
-> NetAddr IP
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NetAddr IP -> Encoding
inet
instance ToPG db Char where toPG :: Char -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Char -> Encoding)
-> Char
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Encoding
char_utf8
instance ToPG db Strict.Text where toPG :: Text -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Text -> Encoding)
-> Text
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict
instance ToPG db Lazy.Text where toPG :: Text -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Text -> Encoding)
-> Text
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_lazy
instance ToPG db String where
  toPG :: String -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (String -> Encoding)
-> String
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict (Text -> Encoding) -> (String -> Text) -> String -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Strict.Text.pack
instance ToPG db Strict.ByteString where toPG :: ByteString -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (ByteString -> Encoding)
-> ByteString
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
bytea_strict
instance ToPG db Lazy.ByteString where toPG :: ByteString -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (ByteString -> Encoding)
-> ByteString
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
bytea_lazy
instance ToPG db (VarChar n) where toPG :: VarChar n -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (VarChar n -> Encoding)
-> VarChar n
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict (Text -> Encoding) -> (VarChar n -> Text) -> VarChar n -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarChar n -> Text
forall (n :: Nat). VarChar n -> Text
getVarChar
instance ToPG db (FixChar n) where toPG :: FixChar n -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (FixChar n -> Encoding)
-> FixChar n
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict (Text -> Encoding) -> (FixChar n -> Text) -> FixChar n -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FixChar n -> Text
forall (n :: Nat). FixChar n -> Text
getFixChar
instance ToPG db x => ToPG db (Const x tag) where toPG :: Const x tag -> ReaderT (K Connection db) IO Encoding
toPG = ToPG db x => x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db @x (x -> ReaderT (K Connection db) IO Encoding)
-> (Const x tag -> x)
-> Const x tag
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const x tag -> x
coerce
instance ToPG db x => ToPG db (SOP.K x tag) where toPG :: K x tag -> ReaderT (K Connection db) IO Encoding
toPG = ToPG db x => x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db @x (x -> ReaderT (K Connection db) IO Encoding)
-> (K x tag -> x)
-> K x tag
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K x tag -> x
coerce
instance ToPG db x => ToPG db (Constant x tag) where toPG :: Constant x tag -> ReaderT (K Connection db) IO Encoding
toPG = ToPG db x => x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db @x (x -> ReaderT (K Connection db) IO Encoding)
-> (Constant x tag -> x)
-> Constant x tag
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constant x tag -> x
coerce
instance ToPG db Day where toPG :: Day -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Day -> Encoding)
-> Day
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Encoding
date
instance ToPG db TimeOfDay where toPG :: TimeOfDay -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (TimeOfDay -> Encoding)
-> TimeOfDay
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOfDay -> Encoding
time_int
instance ToPG db (TimeOfDay, TimeZone) where toPG :: (TimeOfDay, TimeZone) -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> ((TimeOfDay, TimeZone) -> Encoding)
-> (TimeOfDay, TimeZone)
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeOfDay, TimeZone) -> Encoding
timetz_int
instance ToPG db LocalTime where toPG :: LocalTime -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (LocalTime -> Encoding)
-> LocalTime
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Encoding
timestamp_int
instance ToPG db UTCTime where toPG :: UTCTime -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (UTCTime -> Encoding)
-> UTCTime
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Encoding
timestamptz_int
instance ToPG db DiffTime where toPG :: DiffTime -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (DiffTime -> Encoding)
-> DiffTime
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Encoding
interval_int
instance ToPG db Aeson.Value where toPG :: Value -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Value -> Encoding)
-> Value
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Encoding
json_ast
instance Aeson.ToJSON x => ToPG db (Json x) where
  toPG :: Json x -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Json x -> Encoding)
-> Json x
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
json_bytes
    (ByteString -> Encoding)
-> (Json x -> ByteString) -> Json x -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.ByteString.toStrict (ByteString -> ByteString)
-> (Json x -> ByteString) -> Json x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (x -> ByteString) -> (Json x -> x) -> Json x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Json x -> x
forall hask. Json hask -> hask
getJson
instance Aeson.ToJSON x => ToPG db (Jsonb x) where
  toPG :: Jsonb x -> ReaderT (K Connection db) IO Encoding
toPG = Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Jsonb x -> Encoding)
-> Jsonb x
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
jsonb_bytes
    (ByteString -> Encoding)
-> (Jsonb x -> ByteString) -> Jsonb x -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.ByteString.toStrict (ByteString -> ByteString)
-> (Jsonb x -> ByteString) -> Jsonb x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (x -> ByteString) -> (Jsonb x -> x) -> Jsonb x -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Jsonb x -> x
forall hask. Jsonb hask -> hask
getJsonb
instance (NullPG x ~ ty, ToArray db '[] ty x, OidOfNull db ty)
  => ToPG db (VarArray [x]) where
    toPG :: VarArray [x] -> ReaderT (K Connection db) IO Encoding
toPG (VarArray [x]
arr) = do
      Oid
oid <- 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
      let
        dims :: [Int32]
dims = [Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([x] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [x]
arr)]
        nulls :: Bool
nulls = ToArray db '[] ty x => Bool
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
Bool
arrayNulls @db @'[] @ty @x
      Encoding
payload <- (forall b.
 (b -> x -> ReaderT (K Connection db) IO b)
 -> b -> [x] -> ReaderT (K Connection db) IO b)
-> (x -> ReaderT (K Connection db) IO Encoding)
-> [x]
-> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a c.
Functor m =>
(forall b. (b -> a -> m b) -> b -> c -> m b)
-> (a -> m Encoding) -> c -> m Encoding
dimArray forall b.
(b -> x -> ReaderT (K Connection db) IO b)
-> b -> [x] -> ReaderT (K Connection db) IO b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (ToArray db '[] ty x => x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
x -> ReaderT (K Connection db) IO Encoding
arrayPayload @db @'[] @ty @x) [x]
arr
      Encoding -> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoding -> ReaderT (K Connection db) IO Encoding)
-> Encoding -> ReaderT (K Connection db) IO Encoding
forall a b. (a -> b) -> a -> b
$ Int32 -> Bool -> Oid -> [Int32] -> Encoding -> Encoding
encodeArray Int32
1 Bool
nulls Oid
oid [Int32]
dims Encoding
payload
instance (NullPG x ~ ty, ToArray db '[] ty x, OidOfNull db ty)
  => ToPG db (VarArray (Vector x)) where
    toPG :: VarArray (Vector x) -> ReaderT (K Connection db) IO Encoding
toPG (VarArray Vector x
arr) = do
      Oid
oid <- 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
      let
        dims :: [Int32]
dims = [Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector x -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector x
arr)]
        nulls :: Bool
nulls = ToArray db '[] ty x => Bool
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
Bool
arrayNulls @db @'[] @ty @x
      Encoding
payload <- (forall b.
 (b -> x -> ReaderT (K Connection db) IO b)
 -> b -> Vector x -> ReaderT (K Connection db) IO b)
-> (x -> ReaderT (K Connection db) IO Encoding)
-> Vector x
-> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a c.
Functor m =>
(forall b. (b -> a -> m b) -> b -> c -> m b)
-> (a -> m Encoding) -> c -> m Encoding
dimArray forall b.
(b -> x -> ReaderT (K Connection db) IO b)
-> b -> Vector x -> ReaderT (K Connection db) IO b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (ToArray db '[] ty x => x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
x -> ReaderT (K Connection db) IO Encoding
arrayPayload @db @'[] @ty @x) Vector x
arr
      Encoding -> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoding -> ReaderT (K Connection db) IO Encoding)
-> Encoding -> ReaderT (K Connection db) IO Encoding
forall a b. (a -> b) -> a -> b
$ Int32 -> Bool -> Oid -> [Int32] -> Encoding -> Encoding
encodeArray Int32
1 Bool
nulls Oid
oid [Int32]
dims Encoding
payload
instance (ToArray db dims ty x, OidOfNull db ty)
  => ToPG db (FixArray x) where
    toPG :: FixArray x -> ReaderT (K Connection db) IO Encoding
toPG (FixArray x
arr) = do
      Oid
oid <- 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
      Encoding
payload <- x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
x -> ReaderT (K Connection db) IO Encoding
arrayPayload @db @dims @ty x
arr
      let
        dims :: [Int32]
dims = ToArray db dims ty x => [Int32]
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
[Int32]
arrayDims @db @dims @ty @x
        nulls :: Bool
nulls = ToArray db dims ty x => Bool
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
Bool
arrayNulls @db @dims @ty @x
        ndims :: Int32
ndims = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int32] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int32]
dims)
      Encoding -> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoding -> ReaderT (K Connection db) IO Encoding)
-> Encoding -> ReaderT (K Connection db) IO Encoding
forall a b. (a -> b) -> a -> b
$ Int32 -> Bool -> Oid -> [Int32] -> Encoding -> Encoding
encodeArray Int32
ndims Bool
nulls Oid
oid [Int32]
dims Encoding
payload
instance
  ( SOP.IsEnumType x
  , SOP.HasDatatypeInfo x
  , LabelsPG x ~ labels
  ) => ToPG db (Enumerated x) where
    toPG :: Enumerated x -> ReaderT (K Connection db) IO Encoding
toPG =
      let
        gshowConstructor
          :: NP SOP.ConstructorInfo xss
          -> SOP.SOP SOP.I xss
          -> String
        gshowConstructor :: NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor NP ConstructorInfo xss
Nil SOP I xss
_ = String
""
        gshowConstructor (ConstructorInfo x
constructor :* NP ConstructorInfo xs
_) (SOP.SOP (SOP.Z NP I x
_)) =
          ConstructorInfo x -> String
forall (xs :: [*]). ConstructorInfo xs -> String
SOP.constructorName ConstructorInfo x
constructor
        gshowConstructor (ConstructorInfo x
_ :* NP ConstructorInfo xs
constructors) (SOP.SOP (SOP.S NS (NP I) xs
xs)) =
          NP ConstructorInfo xs -> SOP I xs -> String
forall (xss :: [[*]]).
NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor NP ConstructorInfo xs
constructors (NS (NP I) xs -> SOP I xs
forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP.SOP NS (NP I) xs
xs)
      in
        Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (Enumerated x -> Encoding)
-> Enumerated x
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict
        (Text -> Encoding)
-> (Enumerated x -> Text) -> Enumerated x -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Strict.Text.pack
        (String -> Text)
-> (Enumerated x -> String) -> Enumerated x -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP ConstructorInfo (Code x) -> SOP I (Code x) -> String
forall (xss :: [[*]]).
NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor
          (DatatypeInfo (Code x) -> NP ConstructorInfo (Code x)
forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
SOP.constructorInfo (Proxy x -> DatatypeInfo (Code x)
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
SOP.datatypeInfo (Proxy x
forall k (t :: k). Proxy t
SOP.Proxy @x)))
        (SOP I (Code x) -> String)
-> (Enumerated x -> SOP I (Code x)) -> Enumerated x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> SOP I (Code x)
forall a. Generic a => a -> Rep a
SOP.from
        (x -> SOP I (Code x))
-> (Enumerated x -> x) -> Enumerated x -> SOP I (Code x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumerated x -> x
forall enum. Enumerated enum -> enum
getEnumerated
instance
  ( SOP.SListI fields
  , SOP.IsRecord x xs
  , SOP.AllZip (ToField db) fields xs
  , SOP.All (OidOfField db) fields
  , RowPG x ~ fields
  ) => ToPG db (Composite x) where
    toPG :: Composite x -> ReaderT (K Connection db) IO Encoding
toPG = EncodeParams db fields (Composite x)
-> Composite x -> ReaderT (K Connection db) IO Encoding
forall x (row :: [(ConstructorName, NullType)])
       (db :: SchemasType).
(PG x ~ 'PGcomposite row, All (OidOfField db) row) =>
EncodeParams db row x -> x -> ReaderT (K Connection db) IO Encoding
rowParam ((Composite x -> x)
-> EncodeParams db fields x -> EncodeParams db fields (Composite x)
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap Composite x -> x
forall record. Composite record -> record
getComposite EncodeParams db fields x
forall (db :: SchemasType) (row :: [(ConstructorName, NullType)]) x
       (xs :: RecordCode).
(IsRecord x xs, AllZip (ToField db) row xs) =>
EncodeParams db row x
genericRowParams)
instance ToPG db x => ToPG db (Range x) where
  toPG :: Range x -> ReaderT (K Connection db) IO Encoding
toPG Range x
r = do
    Encoding
payload <- case Range x
r of
      Range x
Empty -> Encoding -> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return Encoding
forall a. Monoid a => a
mempty
      NonEmpty Bound x
lower Bound x
upper -> Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
(<>) (Encoding -> Encoding -> Encoding)
-> ReaderT (K Connection db) IO Encoding
-> ReaderT (K Connection db) IO (Encoding -> Encoding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bound x -> ReaderT (K Connection db) IO Encoding
putBound Bound x
lower ReaderT (K Connection db) IO (Encoding -> Encoding)
-> ReaderT (K Connection db) IO Encoding
-> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bound x -> ReaderT (K Connection db) IO Encoding
putBound Bound x
upper
    Encoding -> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoding -> ReaderT (K Connection db) IO Encoding)
-> Encoding -> ReaderT (K Connection db) IO Encoding
forall a b. (a -> b) -> a -> b
$ Word8 -> Encoding
word8 (Range x -> Word8 -> Word8
setFlags Range x
r Word8
0) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
payload
    where
      putBound :: Bound x -> ReaderT (K Connection db) IO Encoding
putBound = \case
        Bound x
Infinite -> Encoding -> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return Encoding
forall a. Monoid a => a
mempty
        Closed x
value -> Encoding -> Encoding
sized (Encoding -> Encoding)
-> ReaderT (K Connection db) IO Encoding
-> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db x
value
        Open x
value -> Encoding -> Encoding
sized (Encoding -> Encoding)
-> ReaderT (K Connection db) IO Encoding
-> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db x
value
      setFlags :: Range x -> Word8 -> Word8
setFlags = \case
        Range x
Empty -> (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
0)
        NonEmpty Bound x
lower Bound x
upper ->
          Bound x -> Word8 -> Word8
forall x. Bound x -> Word8 -> Word8
setLowerFlags Bound x
lower (Word8 -> Word8) -> (Word8 -> Word8) -> Word8 -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bound x -> Word8 -> Word8
forall x. Bound x -> Word8 -> Word8
setUpperFlags Bound x
upper
      setLowerFlags :: Bound x -> Word8 -> Word8
setLowerFlags = \case
        Bound x
Infinite -> (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
3)
        Closed x
_ -> (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
1)
        Open x
_ -> Word8 -> Word8
forall a. a -> a
id
      setUpperFlags :: Bound x -> Word8 -> Word8
setUpperFlags = \case
        Bound x
Infinite -> (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
4)
        Closed x
_ -> (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
2)
        Open x
_ -> Word8 -> Word8
forall a. a -> a
id

-- | A `ToParam` constraint gives an encoding of a Haskell `Type` into
-- into the binary format of a PostgreSQL `NullType`.
-- You should not define instances for `ToParam`,
-- just use the provided instances.
class ToParam (db :: SchemasType) (ty :: NullType) (x :: Type) where
  toParam :: x -> ReaderT (SOP.K LibPQ.Connection db) IO (Maybe Encoding)
instance (ToPG db x, pg ~ PG x) => ToParam db ('NotNull pg) x where
  toParam :: x -> ReaderT (K Connection db) IO (Maybe Encoding)
toParam = (Encoding -> Maybe Encoding)
-> ReaderT (K Connection db) IO Encoding
-> ReaderT (K Connection db) IO (Maybe Encoding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Encoding -> Maybe Encoding
forall a. a -> Maybe a
Just (ReaderT (K Connection db) IO Encoding
 -> ReaderT (K Connection db) IO (Maybe Encoding))
-> (x -> ReaderT (K Connection db) IO Encoding)
-> x
-> ReaderT (K Connection db) IO (Maybe Encoding)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
forall x. ToPG db x => x -> ReaderT (K Connection db) IO Encoding
toPG @db
instance (ToPG db x, pg ~ PG x) => ToParam db ('Null pg) (Maybe x) where
  toParam :: Maybe x -> ReaderT (K Connection db) IO (Maybe Encoding)
toParam = ReaderT (K Connection db) IO (Maybe Encoding)
-> (x -> ReaderT (K Connection db) IO (Maybe Encoding))
-> Maybe x
-> ReaderT (K Connection db) IO (Maybe Encoding)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Encoding -> ReaderT (K Connection db) IO (Maybe Encoding)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Encoding
forall a. Maybe a
Nothing) ((Encoding -> Maybe Encoding)
-> ReaderT (K Connection db) IO Encoding
-> ReaderT (K Connection db) IO (Maybe Encoding)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Encoding -> Maybe Encoding
forall a. a -> Maybe a
Just (ReaderT (K Connection db) IO Encoding
 -> ReaderT (K Connection db) IO (Maybe Encoding))
-> (x -> ReaderT (K Connection db) IO Encoding)
-> x
-> ReaderT (K Connection db) IO (Maybe Encoding)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
forall x. ToPG db x => x -> ReaderT (K Connection db) IO Encoding
toPG @db)

-- | A `ToField` constraint lifts the `ToPG` parser
-- to an encoding of a @(Symbol, Type)@ to a @(Symbol, NullityType)@,
-- encoding `Null`s to `Maybe`s. You should not define instances for
-- `ToField`, just use the provided instances.
class ToField
  (db :: SchemasType)
  (field :: (Symbol, NullType))
  (x :: (Symbol, Type)) where
  toField :: SOP.P x
    -> ReaderT (SOP.K LibPQ.Connection db) IO (SOP.K (Maybe Encoding) field)
instance (fld0 ~ fld1, ToParam db ty x)
  => ToField db (fld0 ::: ty) (fld1 ::: x) where
    toField :: P (fld1 ::: x)
-> ReaderT (K Connection db) IO (K (Maybe Encoding) (fld0 ::: ty))
toField (SOP.P Snd (fld1 ::: x)
x) = Maybe Encoding -> K (Maybe Encoding) (fld0 ::: ty)
forall k a (b :: k). a -> K a b
SOP.K (Maybe Encoding -> K (Maybe Encoding) (fld0 ::: ty))
-> ReaderT (K Connection db) IO (Maybe Encoding)
-> ReaderT (K Connection db) IO (K (Maybe Encoding) (fld0 ::: ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> ReaderT (K Connection db) IO (Maybe Encoding)
forall (db :: SchemasType) (ty :: NullType) x.
ToParam db ty x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
toParam @db @ty x
Snd (fld1 ::: x)
x

-- | A `ToArray` constraint gives an encoding of a Haskell `Type`
-- into the binary format of a PostgreSQL fixed-length array.
-- You should not define instances for
-- `ToArray`, just use the provided instances.
class ToArray
  (db :: SchemasType)
  (dims :: [Nat])
  (ty :: NullType)
  (x :: Type) where
  arrayPayload :: x -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding
  arrayDims :: [Int32]
  arrayNulls :: Bool
instance (ToPG db x, pg ~ PG x)
  => ToArray db '[] ('NotNull pg) x where
  arrayPayload :: x -> ReaderT (K Connection db) IO Encoding
arrayPayload = (Encoding -> Encoding)
-> ReaderT (K Connection db) IO Encoding
-> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Encoding -> Encoding
sized (ReaderT (K Connection db) IO Encoding
 -> ReaderT (K Connection db) IO Encoding)
-> (x -> ReaderT (K Connection db) IO Encoding)
-> x
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToPG db x => x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db @x
  arrayDims :: [Int32]
arrayDims = []
  arrayNulls :: Bool
arrayNulls = Bool
False
instance (ToPG db x, pg ~ PG x)
  => ToArray db '[] ('Null pg) (Maybe x) where
  arrayPayload :: Maybe x -> ReaderT (K Connection db) IO Encoding
arrayPayload = ReaderT (K Connection db) IO Encoding
-> (x -> ReaderT (K Connection db) IO Encoding)
-> Maybe x
-> ReaderT (K Connection db) IO Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Encoding -> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a. Applicative f => a -> f a
pure Encoding
null4) ((Encoding -> Encoding)
-> ReaderT (K Connection db) IO Encoding
-> ReaderT (K Connection db) IO Encoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Encoding -> Encoding
sized (ReaderT (K Connection db) IO Encoding
 -> ReaderT (K Connection db) IO Encoding)
-> (x -> ReaderT (K Connection db) IO Encoding)
-> x
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ToPG db x => x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db @x)
  arrayDims :: [Int32]
arrayDims = []
  arrayNulls :: Bool
arrayNulls = Bool
True
instance
  ( SOP.IsProductType tuple xs
  , Length xs ~ dim
  , SOP.All ((~) x) xs
  , ToArray db dims ty x
  , KnownNat dim )
  => ToArray db (dim ': dims) ty tuple where
    arrayPayload :: tuple -> ReaderT (K Connection db) IO Encoding
arrayPayload
      = (forall b.
 (b -> x -> ReaderT (K Connection db) IO b)
 -> b -> NP I xs -> ReaderT (K Connection db) IO b)
-> (x -> ReaderT (K Connection db) IO Encoding)
-> NP I xs
-> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a c.
Functor m =>
(forall b. (b -> a -> m b) -> b -> c -> m b)
-> (a -> m Encoding) -> c -> m Encoding
dimArray forall b.
(b -> x -> ReaderT (K Connection db) IO b)
-> b -> NP I xs -> ReaderT (K Connection db) IO b
forall x (xs :: [*]) (m :: * -> *) z.
(All ((~) x) xs, Monad m) =>
(z -> x -> m z) -> z -> NP I xs -> m z
foldlNP (ToArray db dims ty x => x -> ReaderT (K Connection db) IO Encoding
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
x -> ReaderT (K Connection db) IO Encoding
arrayPayload @db @dims @ty @x)
      (NP I xs -> ReaderT (K Connection db) IO Encoding)
-> (tuple -> NP I xs)
-> tuple
-> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (NP I) '[xs] -> NP I xs
forall k (f :: k -> *) (x :: k). NS f '[x] -> f x
SOP.unZ (NS (NP I) '[xs] -> NP I xs)
-> (tuple -> NS (NP I) '[xs]) -> tuple -> NP I xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOP I '[xs] -> NS (NP I) '[xs]
forall k (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
SOP.unSOP (SOP I '[xs] -> NS (NP I) '[xs])
-> (tuple -> SOP I '[xs]) -> tuple -> NS (NP I) '[xs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tuple -> SOP I '[xs]
forall a. Generic a => a -> Rep a
SOP.from
    arrayDims :: [Int32]
arrayDims
      = Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy dim -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy dim
forall k (t :: k). Proxy t
SOP.Proxy @dim))
      Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: ToArray db dims ty x => [Int32]
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
[Int32]
arrayDims @db @dims @ty @x
    arrayNulls :: Bool
arrayNulls = ToArray db dims ty x => Bool
forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
Bool
arrayNulls @db @dims @ty @x
foldlNP
  :: (SOP.All ((~) x) xs, Monad m)
  => (z -> x -> m z) -> z -> NP SOP.I xs -> m z
foldlNP :: (z -> x -> m z) -> z -> NP I xs -> m z
foldlNP z -> x -> m z
f z
z = \case
  NP I xs
Nil -> z -> m z
forall (f :: * -> *) a. Applicative f => a -> f a
pure z
z
  SOP.I x
x :* NP I xs
xs -> do
    z
z' <- z -> x -> m z
f z
z x
x
x
    (z -> x -> m z) -> z -> NP I xs -> m z
forall x (xs :: [*]) (m :: * -> *) z.
(All ((~) x) xs, Monad m) =>
(z -> x -> m z) -> z -> NP I xs -> m z
foldlNP z -> x -> m z
f z
z' NP I xs
xs

{- |
`EncodeParams` describes an encoding of a Haskell `Type`
into a list of parameter `NullType`s or into a `RowType`.

>>> conn <- connectdb @'[] "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
>>> :{
let
  encode :: EncodeParams '[]
    '[ 'NotNull 'PGint2, 'NotNull ('PGchar 1), 'NotNull 'PGtext]
    (Int16, (Char, String))
  encode = fst .* fst.snd *. snd.snd
in runReaderT (runEncodeParams encode (1,('a',"foo"))) conn
:}
K (Just "\NUL\SOH") :* K (Just "a") :* K (Just "foo") :* Nil

>>> :{
let
  encode :: EncodeParams '[]
    '["fst" ::: 'NotNull 'PGint2, "snd" ::: 'NotNull ('PGchar 1)]
    (Int16, Char)
  encode = fst `as` #fst #. snd `as` #snd
in runReaderT (runEncodeParams encode (1,'a')) conn
:}
K (Just "\NUL\SOH") :* K (Just "a") :* Nil

>>> finish conn
-}
newtype EncodeParams
  (db :: SchemasType)
  (tys :: [k])
  (x :: Type) = EncodeParams
  { EncodeParams db tys x
-> x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
runEncodeParams :: x
    -> ReaderT (SOP.K LibPQ.Connection db) IO (NP (SOP.K (Maybe Encoding)) tys) }
instance Contravariant (EncodeParams db tys) where
  contramap :: (a -> b) -> EncodeParams db tys b -> EncodeParams db tys a
contramap a -> b
f (EncodeParams b -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
g) = (a -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys a
forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams (b -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
g (b -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> (a -> b)
-> a
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

-- | A `GenericParams` constraint to ensure that a Haskell type
-- is a product type,
-- has a `TuplePG`,
-- and all its terms have known Oids,
-- and can be encoded to corresponding Postgres types.
class
  ( SOP.IsProductType x xs
  , params ~ TuplePG x
  , SOP.All (OidOfNull db) params
  , SOP.AllZip (ToParam db) params xs
  ) => GenericParams db params x xs where
  {- | Parameter encoding for `SOP.Generic` tuples and records.

  >>> import qualified GHC.Generics as GHC
  >>> import qualified Generics.SOP as SOP
  >>> data Two = Two Int16 String deriving (GHC.Generic, SOP.Generic)
  >>> conn <- connectdb @'[] "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
  >>> :{
  let
    encode :: EncodeParams '[] '[ 'NotNull 'PGint2, 'NotNull 'PGtext] Two
    encode = genericParams
  in runReaderT (runEncodeParams encode (Two 2 "two")) conn
  :}
  K (Just "\NUL\STX") :* K (Just "two") :* Nil

  >>> :{
  let
    encode :: EncodeParams '[] '[ 'NotNull 'PGint2, 'NotNull 'PGtext] (Int16, String)
    encode = genericParams
  in runReaderT (runEncodeParams encode (2, "two")) conn
  :}
  K (Just "\NUL\STX") :* K (Just "two") :* Nil

  >>> finish conn
  -}
  genericParams :: EncodeParams db params x
instance
  ( params ~ TuplePG x
  , SOP.All (OidOfNull db) params
  , SOP.IsProductType x xs
  , SOP.AllZip (ToParam db) params xs
  ) => GenericParams db params x xs where
  genericParams :: EncodeParams db params x
genericParams = (x
 -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params))
-> EncodeParams db params x
forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams
    ((x
  -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params))
 -> EncodeParams db params x)
-> (x
    -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params))
-> EncodeParams db params x
forall a b. (a -> b) -> a -> b
$ Proxy (ToParam db)
-> (forall (y :: NullType) x.
    ToParam db y x =>
    I x -> ReaderT (K Connection db) IO (K (Maybe Encoding) y))
-> NP I xs
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params)
forall k k (c :: k -> k -> Constraint) (ys :: [k]) (xs :: [k])
       (m :: * -> *) (f :: k -> *) (g :: k -> *).
(AllZip c ys xs, Applicative m) =>
Proxy c
-> (forall (y :: k) (x :: k). c y x => f x -> m (g y))
-> NP f xs
-> m (NP g ys)
hctransverse (Proxy (ToParam db)
forall k (t :: k). Proxy t
SOP.Proxy @(ToParam db)) forall (y :: NullType) x.
ToParam db y x =>
I x -> ReaderT (K Connection db) IO (K (Maybe Encoding) y)
encodeNullParam
    (NP I xs
 -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params))
-> (x -> NP I xs)
-> x
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS (NP I) '[xs] -> NP I xs
forall k (f :: k -> *) (x :: k). NS f '[x] -> f x
SOP.unZ (NS (NP I) '[xs] -> NP I xs)
-> (x -> NS (NP I) '[xs]) -> x -> NP I xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SOP I '[xs] -> NS (NP I) '[xs]
forall k (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
SOP.unSOP (SOP I '[xs] -> NS (NP I) '[xs])
-> (x -> SOP I '[xs]) -> x -> NS (NP I) '[xs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> SOP I '[xs]
forall a. Generic a => a -> Rep a
SOP.from
    where
      encodeNullParam
        :: forall ty y. ToParam db ty y
        => SOP.I y -> ReaderT (SOP.K LibPQ.Connection db) IO (SOP.K (Maybe Encoding) ty)
      encodeNullParam :: I y -> ReaderT (K Connection db) IO (K (Maybe Encoding) ty)
encodeNullParam = (Maybe Encoding -> K (Maybe Encoding) ty)
-> ReaderT (K Connection db) IO (Maybe Encoding)
-> ReaderT (K Connection db) IO (K (Maybe Encoding) ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Encoding -> K (Maybe Encoding) ty
forall k a (b :: k). a -> K a b
SOP.K (ReaderT (K Connection db) IO (Maybe Encoding)
 -> ReaderT (K Connection db) IO (K (Maybe Encoding) ty))
-> (I y -> ReaderT (K Connection db) IO (Maybe Encoding))
-> I y
-> ReaderT (K Connection db) IO (K (Maybe Encoding) ty)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (db :: SchemasType) (ty :: NullType) x.
ToParam db ty x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
forall x.
ToParam db ty x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
toParam @db @ty (y -> ReaderT (K Connection db) IO (Maybe Encoding))
-> (I y -> y)
-> I y
-> ReaderT (K Connection db) IO (Maybe Encoding)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I y -> y
forall a. I a -> a
SOP.unI

-- | Encode 0 parameters.
nilParams :: EncodeParams db '[] x
nilParams :: EncodeParams db '[] x
nilParams = (x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[]))
-> EncodeParams db '[] x
forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams ((x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[]))
 -> EncodeParams db '[] x)
-> (x
    -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[]))
-> EncodeParams db '[] x
forall a b. (a -> b) -> a -> b
$ \ x
_ -> NP (K (Maybe Encoding)) '[]
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure NP (K (Maybe Encoding)) '[]
forall k (a :: k -> *). NP a '[]
Nil

{- | Cons a parameter encoding.

>>> conn <- connectdb @'[] "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
>>> :{
let
  encode :: EncodeParams '[]
    '[ 'Null 'PGint4, 'NotNull 'PGtext]
    (Maybe Int32, String)
  encode = fst .* snd .* nilParams
in runReaderT (runEncodeParams encode (Nothing, "foo")) conn
:}
K Nothing :* K (Just "foo") :* Nil

>>> finish conn
-}
(.*)
  :: forall db x0 ty x tys. (ToParam db ty x0, ty ~ NullPG x0)
  => (x -> x0) -- ^ head
  -> EncodeParams db tys x -- ^ tail
  -> EncodeParams db (ty ': tys) x
x -> x0
f .* :: (x -> x0) -> EncodeParams db tys x -> EncodeParams db (ty : tys) x
.* EncodeParams x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
params = (x
 -> ReaderT
      (K Connection db) IO (NP (K (Maybe Encoding)) (ty : tys)))
-> EncodeParams db (ty : tys) x
forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams ((x
  -> ReaderT
       (K Connection db) IO (NP (K (Maybe Encoding)) (ty : tys)))
 -> EncodeParams db (ty : tys) x)
-> (x
    -> ReaderT
         (K Connection db) IO (NP (K (Maybe Encoding)) (ty : tys)))
-> EncodeParams db (ty : tys) x
forall a b. (a -> b) -> a -> b
$ \x
x ->
  K (Maybe Encoding) ty
-> NP (K (Maybe Encoding)) tys
-> NP (K (Maybe Encoding)) (ty : tys)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (K (Maybe Encoding) ty
 -> NP (K (Maybe Encoding)) tys
 -> NP (K (Maybe Encoding)) (ty : tys))
-> ReaderT (K Connection db) IO (K (Maybe Encoding) ty)
-> ReaderT
     (K Connection db)
     IO
     (NP (K (Maybe Encoding)) tys -> NP (K (Maybe Encoding)) (ty : tys))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Encoding -> K (Maybe Encoding) ty
forall k a (b :: k). a -> K a b
SOP.K (Maybe Encoding -> K (Maybe Encoding) ty)
-> ReaderT (K Connection db) IO (Maybe Encoding)
-> ReaderT (K Connection db) IO (K (Maybe Encoding) ty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x0 -> ReaderT (K Connection db) IO (Maybe Encoding)
forall (db :: SchemasType) (ty :: NullType) x.
ToParam db ty x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
toParam @db @ty (x -> x0
f x
x)) ReaderT
  (K Connection db)
  IO
  (NP (K (Maybe Encoding)) tys -> NP (K (Maybe Encoding)) (ty : tys))
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
-> ReaderT
     (K Connection db) IO (NP (K (Maybe Encoding)) (ty : tys))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
params x
x
infixr 5 .*

{- | End a parameter encoding.

>>> conn <- connectdb @'[] "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
>>> :{
let
  encode :: EncodeParams '[]
    '[ 'Null 'PGint4, 'NotNull 'PGtext, 'NotNull ('PGchar 1)]
    (Maybe Int32, String, Char)
  encode = (\(x,_,_) -> x) .* (\(_,y,_) -> y) *. (\(_,_,z) -> z)
in runReaderT (runEncodeParams encode (Nothing, "foo", 'z')) conn
:}
K Nothing :* K (Just "foo") :* K (Just "z") :* Nil

>>> finish conn
-}
(*.)
  :: forall db x x0 ty0 x1 ty1
   . ( ToParam db ty0 x0
     , ty0 ~ NullPG x0
     , ToParam db ty1 x1
     , ty1 ~ NullPG x1
     )
  => (x -> x0) -- ^ second to last
  -> (x -> x1) -- ^ last
  -> EncodeParams db '[ty0, ty1] x
x -> x0
f *. :: (x -> x0) -> (x -> x1) -> EncodeParams db '[ty0, ty1] x
*. x -> x1
g = x -> x0
f (x -> x0)
-> EncodeParams db '[ty1] x -> EncodeParams db '[ty0, ty1] x
forall (db :: SchemasType) x0 (ty :: NullType) x
       (tys :: [NullType]).
(ToParam db ty x0, ty ~ NullPG x0) =>
(x -> x0) -> EncodeParams db tys x -> EncodeParams db (ty : tys) x
.* x -> x1
g (x -> x1) -> EncodeParams db '[] x -> EncodeParams db '[ty1] x
forall (db :: SchemasType) x0 (ty :: NullType) x
       (tys :: [NullType]).
(ToParam db ty x0, ty ~ NullPG x0) =>
(x -> x0) -> EncodeParams db tys x -> EncodeParams db (ty : tys) x
.* EncodeParams db '[] x
forall k (db :: SchemasType) x. EncodeParams db '[] x
nilParams
infixl 8 *.

{- | Encode 1 parameter.

>>> conn <- connectdb @'[] "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
>>> :{
let
  encode :: EncodeParams '[] '[ 'NotNull 'PGint4] Int32
  encode = aParam
in runReaderT (runEncodeParams encode 1776) conn
:}
K (Just "\NUL\NUL\ACK\240") :* Nil

>>> finish conn
-}
aParam
  :: forall db x ty. (ToParam db ty x, ty ~ NullPG x)
  => EncodeParams db '[ty] x
  -- ^ a single parameter
aParam :: EncodeParams db '[ty] x
aParam = (x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[ty]))
-> EncodeParams db '[ty] x
forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams ((x
  -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[ty]))
 -> EncodeParams db '[ty] x)
-> (x
    -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[ty]))
-> EncodeParams db '[ty] x
forall a b. (a -> b) -> a -> b
$
  (Maybe Encoding -> NP (K (Maybe Encoding)) '[ty])
-> ReaderT (K Connection db) IO (Maybe Encoding)
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[ty])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Encoding
param -> Maybe Encoding -> K (Maybe Encoding) ty
forall k a (b :: k). a -> K a b
SOP.K Maybe Encoding
param K (Maybe Encoding) ty
-> NP (K (Maybe Encoding)) '[] -> NP (K (Maybe Encoding)) '[ty]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K (Maybe Encoding)) '[]
forall k (a :: k -> *). NP a '[]
Nil) (ReaderT (K Connection db) IO (Maybe Encoding)
 -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[ty]))
-> (x -> ReaderT (K Connection db) IO (Maybe Encoding))
-> x
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) '[ty])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (db :: SchemasType) (ty :: NullType) x.
ToParam db ty x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
forall x.
ToParam db (NullPG x) x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
toParam @db @(NullPG x)

{- | Append parameter encodings.

>>> conn <- connectdb @'[] "host=localhost port=5432 dbname=exampledb user=postgres password=postgres"
>>> :{
let
  encode :: EncodeParams '[]
    '[ 'NotNull 'PGint4, 'NotNull 'PGint2]
    (Int32, Int16)
  encode = contramap fst aParam `appendParams` contramap snd aParam
in runReaderT (runEncodeParams encode (1776, 2)) conn
:}
K (Just "\NUL\NUL\ACK\240") :* K (Just "\NUL\STX") :* Nil

>>> finish conn
-}
appendParams
  :: EncodeParams db params0 x -- ^ left
  -> EncodeParams db params1 x -- ^ right
  -> EncodeParams db (Join params0 params1) x
appendParams :: EncodeParams db params0 x
-> EncodeParams db params1 x
-> EncodeParams db (Join params0 params1) x
appendParams EncodeParams db params0 x
encode0 EncodeParams db params1 x
encode1 = (x
 -> ReaderT
      (K Connection db)
      IO
      (NP (K (Maybe Encoding)) (Join params0 params1)))
-> EncodeParams db (Join params0 params1) x
forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams ((x
  -> ReaderT
       (K Connection db)
       IO
       (NP (K (Maybe Encoding)) (Join params0 params1)))
 -> EncodeParams db (Join params0 params1) x)
-> (x
    -> ReaderT
         (K Connection db)
         IO
         (NP (K (Maybe Encoding)) (Join params0 params1)))
-> EncodeParams db (Join params0 params1) x
forall a b. (a -> b) -> a -> b
$ \x
x -> NP (K (Maybe Encoding)) params1
-> NP (K (Maybe Encoding)) params0
-> NP (K (Maybe Encoding)) (Join params0 params1)
forall a (expr :: [a] -> *) (ys :: [a]) (xs :: [a]).
Additional expr =>
expr ys -> expr xs -> expr (Join xs ys)
also
  (NP (K (Maybe Encoding)) params1
 -> NP (K (Maybe Encoding)) params0
 -> NP (K (Maybe Encoding)) (Join params0 params1))
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params1)
-> ReaderT
     (K Connection db)
     IO
     (NP (K (Maybe Encoding)) params0
      -> NP (K (Maybe Encoding)) (Join params0 params1))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncodeParams db params1 x
-> x
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params1)
forall (db :: SchemasType) k (tys :: [k]) x.
EncodeParams db tys x
-> x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
runEncodeParams EncodeParams db params1 x
encode1 x
x
  ReaderT
  (K Connection db)
  IO
  (NP (K (Maybe Encoding)) params0
   -> NP (K (Maybe Encoding)) (Join params0 params1))
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params0)
-> ReaderT
     (K Connection db)
     IO
     (NP (K (Maybe Encoding)) (Join params0 params1))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EncodeParams db params0 x
-> x
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) params0)
forall (db :: SchemasType) k (tys :: [k]) x.
EncodeParams db tys x
-> x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
runEncodeParams EncodeParams db params0 x
encode0 x
x

{- |
>>> :set -XLambdaCase -XFlexibleInstances
>>> :{
data Dir = North | South | East | West
instance IsPG Dir where
  type PG Dir = 'PGenum '["north", "south", "east", "west"]
instance ToPG db Dir where
  toPG = enumParam $ \case
    North -> label @"north"
    South -> label @"south"
    East -> label @"east"
    West -> label @"west"
:}
-}
enumParam
  :: (PG x ~ 'PGenum labels, SOP.All KnownSymbol labels)
  => (x -> SOP.NS PGlabel labels)
  -- ^ match cases with enum `label`s
  -> (x -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding)
enumParam :: (x -> NS PGlabel labels)
-> x -> ReaderT (K Connection db) IO Encoding
enumParam x -> NS PGlabel labels
casesOf
  = Encoding -> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return
  (Encoding -> ReaderT (K Connection db) IO Encoding)
-> (x -> Encoding) -> x -> ReaderT (K Connection db) IO Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict
  (Text -> Encoding) -> (x -> Text) -> x -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Strict.Text.pack
  (String -> Text) -> (x -> String) -> x -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NS PGlabel labels -> String
forall (lbls :: [ConstructorName]).
All KnownSymbol lbls =>
NS PGlabel lbls -> String
enumCases
  (NS PGlabel labels -> String)
-> (x -> NS PGlabel labels) -> x -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> NS PGlabel labels
casesOf
  where
    enumCases
      :: SOP.All KnownSymbol lbls
      => SOP.NS PGlabel lbls
      -> String
    enumCases :: NS PGlabel lbls -> String
enumCases = \case
      SOP.Z (PGlabel x
_ :: PGlabel lbl) -> Proxy x -> String
forall (n :: ConstructorName) (proxy :: ConstructorName -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy x
forall k (t :: k). Proxy t
SOP.Proxy @lbl)
      SOP.S NS PGlabel xs
cases -> NS PGlabel xs -> String
forall (lbls :: [ConstructorName]).
All KnownSymbol lbls =>
NS PGlabel lbls -> String
enumCases NS PGlabel xs
cases

{- |
>>> :set -XTypeFamilies -XFlexibleInstances
>>> :{
data Complex = Complex
  { real :: Double
  , imaginary :: Double
  }
instance IsPG Complex where
  type PG Complex = 'PGcomposite '[
    "re" ::: 'NotNull 'PGfloat8,
    "im" ::: 'NotNull 'PGfloat8]
instance ToPG db Complex where
  toPG = rowParam $ real `as` #re #. imaginary `as` #im
:}
-}
rowParam
  :: (PG x ~ 'PGcomposite row, SOP.All (OidOfField db) row)
  => EncodeParams db row x
  -- ^ use `(.#)` and `(#.)` to define a row parameter encoding
  -> (x -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding)
rowParam :: EncodeParams db row x -> x -> ReaderT (K Connection db) IO Encoding
rowParam (EncodeParams db row x
enc :: EncodeParams db row x) x
x = do
  let
    compositeSize :: Encoding
compositeSize
      = Int32 -> Encoding
int4_int32
      (Int32 -> Encoding) -> Int32 -> Encoding
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Proxy row -> Int
forall k (xs :: [k]) (proxy :: [k] -> *).
SListI xs =>
proxy xs -> Int
SOP.lengthSList
      (Proxy row -> Int) -> Proxy row -> Int
forall a b. (a -> b) -> a -> b
$ Proxy row
forall k (t :: k). Proxy t
SOP.Proxy @row
    each
      :: OidOfField db field
      => SOP.K (Maybe Encoding) field
      -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding
    each :: K (Maybe Encoding) field -> ReaderT (K Connection db) IO Encoding
each (SOP.K Maybe Encoding
field :: SOP.K (Maybe Encoding) field) = do
      Word32
oid <- Oid -> Word32
getOid (Oid -> Word32)
-> ReaderT (K Connection db) IO Oid
-> ReaderT (K Connection db) IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OidOfField db field => ReaderT (K Connection db) IO Oid
forall (db :: SchemasType) (field :: (ConstructorName, NullType)).
OidOfField db field =>
ReaderT (K Connection db) IO Oid
oidOfField @db @field
      Encoding -> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoding -> ReaderT (K Connection db) IO Encoding)
-> Encoding -> ReaderT (K Connection db) IO Encoding
forall a b. (a -> b) -> a -> b
$ Word32 -> Encoding
int4_word32 Word32
oid Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding -> (Encoding -> Encoding) -> Maybe Encoding -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
null4 Encoding -> Encoding
sized Maybe Encoding
field
  NP (K (Maybe Encoding)) row
fields <- EncodeParams db row x
-> x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) row)
forall (db :: SchemasType) k (tys :: [k]) x.
EncodeParams db tys x
-> x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
runEncodeParams EncodeParams db row x
enc x
x
  Encoding
compositePayload <- Proxy (OidOfField db)
-> (forall (x :: (ConstructorName, NullType)).
    OidOfField db x =>
    K (Maybe Encoding) x -> ReaderT (K Connection db) IO Encoding)
-> NP (K (Maybe Encoding)) row
-> ReaderT (K Connection db) IO Encoding
forall k r (m :: * -> *) (c :: k -> Constraint) (xs :: [k])
       (f :: k -> *).
(Monoid r, Applicative m, All c xs) =>
Proxy c -> (forall (x :: k). c x => f x -> m r) -> NP f xs -> m r
hcfoldMapM
    (Proxy (OidOfField db)
forall k (t :: k). Proxy t
SOP.Proxy @(OidOfField db)) forall (x :: (ConstructorName, NullType)).
OidOfField db x =>
K (Maybe Encoding) x -> ReaderT (K Connection db) IO Encoding
each NP (K (Maybe Encoding)) row
fields
  Encoding -> ReaderT (K Connection db) IO Encoding
forall (m :: * -> *) a. Monad m => a -> m a
return (Encoding -> ReaderT (K Connection db) IO Encoding)
-> Encoding -> ReaderT (K Connection db) IO Encoding
forall a b. (a -> b) -> a -> b
$ Encoding
compositeSize Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
compositePayload

{- | Cons a row parameter encoding for `rowParam`. -}
(.#)
  :: forall db x0 fld ty x tys. (ToParam db ty x0, ty ~ NullPG x0)
  => Aliased ((->) x) (fld ::: x0) -- ^ head
  -> EncodeParams db tys x -- ^ tail
  -> EncodeParams db (fld ::: ty ': tys) x
(x -> ty
f `As` Alias alias
_) .# :: Aliased ((->) x) (fld ::: x0)
-> EncodeParams db tys x -> EncodeParams db ((fld ::: ty) : tys) x
.# EncodeParams x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
params = (x
 -> ReaderT
      (K Connection db)
      IO
      (NP (K (Maybe Encoding)) ((fld ::: ty) : tys)))
-> EncodeParams db ((fld ::: ty) : tys) x
forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams ((x
  -> ReaderT
       (K Connection db)
       IO
       (NP (K (Maybe Encoding)) ((fld ::: ty) : tys)))
 -> EncodeParams db ((fld ::: ty) : tys) x)
-> (x
    -> ReaderT
         (K Connection db)
         IO
         (NP (K (Maybe Encoding)) ((fld ::: ty) : tys)))
-> EncodeParams db ((fld ::: ty) : tys) x
forall a b. (a -> b) -> a -> b
$ \x
x ->
  K (Maybe Encoding) (fld ::: ty)
-> NP (K (Maybe Encoding)) tys
-> NP (K (Maybe Encoding)) ((fld ::: ty) : tys)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (K (Maybe Encoding) (fld ::: ty)
 -> NP (K (Maybe Encoding)) tys
 -> NP (K (Maybe Encoding)) ((fld ::: ty) : tys))
-> ReaderT (K Connection db) IO (K (Maybe Encoding) (fld ::: ty))
-> ReaderT
     (K Connection db)
     IO
     (NP (K (Maybe Encoding)) tys
      -> NP (K (Maybe Encoding)) ((fld ::: ty) : tys))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Encoding -> K (Maybe Encoding) (fld ::: ty)
forall k a (b :: k). a -> K a b
SOP.K (Maybe Encoding -> K (Maybe Encoding) (fld ::: ty))
-> ReaderT (K Connection db) IO (Maybe Encoding)
-> ReaderT (K Connection db) IO (K (Maybe Encoding) (fld ::: ty))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ty -> ReaderT (K Connection db) IO (Maybe Encoding)
forall (db :: SchemasType) (ty :: NullType) x.
ToParam db ty x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
toParam @db @ty (x -> ty
f x
x)) ReaderT
  (K Connection db)
  IO
  (NP (K (Maybe Encoding)) tys
   -> NP (K (Maybe Encoding)) ((fld ::: ty) : tys))
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
-> ReaderT
     (K Connection db) IO (NP (K (Maybe Encoding)) ((fld ::: ty) : tys))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
params x
x
infixr 5 .#

{- | End a row parameter encoding for `rowParam`. -}
(#.)
  :: forall db x x0 fld0 ty0 x1 fld1 ty1
   . ( ToParam db ty0 x0
     , ty0 ~ NullPG x0
     , ToParam db ty1 x1
     , ty1 ~ NullPG x1
     )
  => Aliased ((->) x) (fld0 ::: x0) -- ^ second to last
  -> Aliased ((->) x) (fld1 ::: x1) -- ^ last
  -> EncodeParams db '[fld0 ::: ty0, fld1 ::: ty1] x
Aliased ((->) x) (fld0 ::: x0)
f #. :: Aliased ((->) x) (fld0 ::: x0)
-> Aliased ((->) x) (fld1 ::: x1)
-> EncodeParams db '[fld0 ::: ty0, fld1 ::: ty1] x
#. Aliased ((->) x) (fld1 ::: x1)
g = Aliased ((->) x) (fld0 ::: x0)
f Aliased ((->) x) (fld0 ::: x0)
-> EncodeParams db '[fld1 ::: ty1] x
-> EncodeParams db '[fld0 ::: ty0, fld1 ::: ty1] x
forall (db :: SchemasType) x0 (fld :: ConstructorName)
       (ty :: NullType) x (tys :: [(ConstructorName, NullType)]).
(ToParam db ty x0, ty ~ NullPG x0) =>
Aliased ((->) x) (fld ::: x0)
-> EncodeParams db tys x -> EncodeParams db ((fld ::: ty) : tys) x
.# Aliased ((->) x) (fld1 ::: x1)
g Aliased ((->) x) (fld1 ::: x1)
-> EncodeParams db '[] x -> EncodeParams db '[fld1 ::: ty1] x
forall (db :: SchemasType) x0 (fld :: ConstructorName)
       (ty :: NullType) x (tys :: [(ConstructorName, NullType)]).
(ToParam db ty x0, ty ~ NullPG x0) =>
Aliased ((->) x) (fld ::: x0)
-> EncodeParams db tys x -> EncodeParams db ((fld ::: ty) : tys) x
.# EncodeParams db '[] x
forall k (db :: SchemasType) x. EncodeParams db '[] x
nilParams
infixl 8 #.

instance (ToParam db ty x, ty ~ NullPG x)
  => IsLabel fld (EncodeParams db '[fld ::: ty] x) where
    fromLabel :: EncodeParams db '[fld ::: ty] x
fromLabel
      = (x
 -> ReaderT
      (K Connection db) IO (NP (K (Maybe Encoding)) '[fld ::: ty]))
-> EncodeParams db '[fld ::: ty] x
forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams
      ((x
  -> ReaderT
       (K Connection db) IO (NP (K (Maybe Encoding)) '[fld ::: ty]))
 -> EncodeParams db '[fld ::: ty] x)
-> (x
    -> ReaderT
         (K Connection db) IO (NP (K (Maybe Encoding)) '[fld ::: ty]))
-> EncodeParams db '[fld ::: ty] x
forall a b. (a -> b) -> a -> b
$ (Maybe Encoding -> NP (K (Maybe Encoding)) '[fld ::: ty])
-> ReaderT (K Connection db) IO (Maybe Encoding)
-> ReaderT
     (K Connection db) IO (NP (K (Maybe Encoding)) '[fld ::: ty])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Encoding
param -> Maybe Encoding -> K (Maybe Encoding) (fld ::: ty)
forall k a (b :: k). a -> K a b
SOP.K Maybe Encoding
param K (Maybe Encoding) (fld ::: ty)
-> NP (K (Maybe Encoding)) '[]
-> NP (K (Maybe Encoding)) '[fld ::: ty]
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP (K (Maybe Encoding)) '[]
forall k (a :: k -> *). NP a '[]
Nil)
      (ReaderT (K Connection db) IO (Maybe Encoding)
 -> ReaderT
      (K Connection db) IO (NP (K (Maybe Encoding)) '[fld ::: ty]))
-> (x -> ReaderT (K Connection db) IO (Maybe Encoding))
-> x
-> ReaderT
     (K Connection db) IO (NP (K (Maybe Encoding)) '[fld ::: ty])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (db :: SchemasType) (ty :: NullType) x.
ToParam db ty x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
forall x.
ToParam db (NullPG x) x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
toParam @db @(NullPG x)

{- |
>>> import GHC.Generics as GHC
>>> :{
data L = L {frst :: Int16, scnd :: Char}
  deriving stock (GHC.Generic, Show)
  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
data R = R {thrd :: Bool, frth :: Bool}
  deriving stock (GHC.Generic, Show)
  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
instance IsPG (L,R) where
  type PG (L,R) = 'PGcomposite '[
    "frst" ::: 'NotNull 'PGint2,
    "scnd" ::: 'NotNull ('PGchar 1),
    "thrd" ::: 'NotNull 'PGbool,
    "frth" ::: 'NotNull 'PGbool]
instance ToPG db (L,R) where
  toPG = rowParam $
    contramap fst genericRowParams
    `appendParams`
    contramap snd genericRowParams
:}
-}
genericRowParams
  ::  forall db row x xs.
      ( SOP.IsRecord x xs
      , SOP.AllZip (ToField db) row xs
      )
  => EncodeParams db row x
genericRowParams :: EncodeParams db row x
genericRowParams
  = (x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) row))
-> EncodeParams db row x
forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams
  ((x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) row))
 -> EncodeParams db row x)
-> (x
    -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) row))
-> EncodeParams db row x
forall a b. (a -> b) -> a -> b
$ Proxy (ToField db)
-> (forall (y :: (ConstructorName, NullType))
           (x :: (ConstructorName, *)).
    ToField db y x =>
    P x -> ReaderT (K Connection db) IO (K (Maybe Encoding) y))
-> NP P xs
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) row)
forall k k (c :: k -> k -> Constraint) (ys :: [k]) (xs :: [k])
       (m :: * -> *) (f :: k -> *) (g :: k -> *).
(AllZip c ys xs, Applicative m) =>
Proxy c
-> (forall (y :: k) (x :: k). c y x => f x -> m (g y))
-> NP f xs
-> m (NP g ys)
hctransverse (Proxy (ToField db)
forall k (t :: k). Proxy t
SOP.Proxy @(ToField db)) (forall (db :: SchemasType) (field :: (ConstructorName, NullType))
       (x :: (ConstructorName, *)).
ToField db field x =>
P x -> ReaderT (K Connection db) IO (K (Maybe Encoding) field)
forall (y :: (ConstructorName, NullType))
       (x :: (ConstructorName, *)).
ToField db y x =>
P x -> ReaderT (K Connection db) IO (K (Maybe Encoding) y)
toField @db)
  (NP P xs
 -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) row))
-> (x -> NP P xs)
-> x
-> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) row)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> NP P xs
forall a (_r :: RecordCode). IsRecord a _r => a -> RecordRep a
SOP.toRecord

-- helper functions

getOid :: LibPQ.Oid -> Word32
getOid :: Oid -> Word32
getOid (LibPQ.Oid (CUInt Word32
oid)) = Word32
oid

encodeArray :: Int32 -> Bool -> LibPQ.Oid -> [Int32] -> Encoding -> Encoding
encodeArray :: Int32 -> Bool -> Oid -> [Int32] -> Encoding -> Encoding
encodeArray Int32
ndim Bool
nulls Oid
oid [Int32]
dimensions Encoding
payload = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
  [ Int32 -> Encoding
int4_int32 Int32
ndim
  , if Bool
nulls then Encoding
true4 else Encoding
false4
  , Word32 -> Encoding
int4_word32 (Oid -> Word32
getOid Oid
oid)
  , (Int32 -> Encoding) -> [Int32] -> Encoding
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int32
dimension -> Int32 -> Encoding
int4_int32 Int32
dimension Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
true4) [Int32]
dimensions
  , Encoding
payload ]

dimArray
  :: Functor m
  => (forall b. (b -> a -> m b) -> b -> c -> m b)
  -> (a -> m Encoding) -> c -> m Encoding
dimArray :: (forall b. (b -> a -> m b) -> b -> c -> m b)
-> (a -> m Encoding) -> c -> m Encoding
dimArray forall b. (b -> a -> m b) -> b -> c -> m b
folder a -> m Encoding
elementArray = (Encoding -> a -> m Encoding) -> Encoding -> c -> m Encoding
forall b. (b -> a -> m b) -> b -> c -> m b
folder Encoding -> a -> m Encoding
step Encoding
forall a. Monoid a => a
mempty
  where
    step :: Encoding -> a -> m Encoding
step Encoding
builder a
element = (Encoding
builder Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<>) (Encoding -> Encoding) -> m Encoding -> m Encoding
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m Encoding
elementArray a
element

null4, true4, false4 :: Encoding
null4 :: Encoding
null4 = Int32 -> Encoding
int4_int32 (-Int32
1)
true4 :: Encoding
true4 = Word32 -> Encoding
int4_word32 Word32
1
false4 :: Encoding
false4 = Word32 -> Encoding
int4_word32 Word32
0

sized :: Encoding -> Encoding
sized :: Encoding -> Encoding
sized Encoding
bs = Int32 -> Encoding
int4_int32 (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Encoding -> Int
builderLength Encoding
bs)) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
bs

hctransverse
  :: (SOP.AllZip c ys xs, Applicative m)
  => SOP.Proxy c
  -> (forall y x. c y x => f x -> m (g y))
  -> NP f xs -> m (NP g ys)
hctransverse :: Proxy c
-> (forall (y :: k) (x :: k). c y x => f x -> m (g y))
-> NP f xs
-> m (NP g ys)
hctransverse Proxy c
c forall (y :: k) (x :: k). c y x => f x -> m (g y)
f = \case
  NP f xs
Nil -> NP g '[] -> m (NP g '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure NP g '[]
forall k (a :: k -> *). NP a '[]
Nil
  f x
x :* NP f xs
xs -> g (Head ys) -> NP g (Tail ys) -> NP g (Head ys : Tail ys)
forall k (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) (g (Head ys) -> NP g (Tail ys) -> NP g (Head ys : Tail ys))
-> m (g (Head ys))
-> m (NP g (Tail ys) -> NP g (Head ys : Tail ys))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x -> m (g (Head ys))
forall (y :: k) (x :: k). c y x => f x -> m (g y)
f f x
x m (NP g (Tail ys) -> NP g (Head ys : Tail ys))
-> m (NP g (Tail ys)) -> m (NP g (Head ys : Tail ys))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy c
-> (forall (y :: k) (x :: k). c y x => f x -> m (g y))
-> NP f xs
-> m (NP g (Tail ys))
forall k k (c :: k -> k -> Constraint) (ys :: [k]) (xs :: [k])
       (m :: * -> *) (f :: k -> *) (g :: k -> *).
(AllZip c ys xs, Applicative m) =>
Proxy c
-> (forall (y :: k) (x :: k). c y x => f x -> m (g y))
-> NP f xs
-> m (NP g ys)
hctransverse Proxy c
c forall (y :: k) (x :: k). c y x => f x -> m (g y)
f NP f xs
xs

hcfoldMapM
  :: (Monoid r, Applicative m, SOP.All c xs)
  => SOP.Proxy c
  -> (forall x. c x => f x -> m r)
  -> NP f xs -> m r
hcfoldMapM :: Proxy c -> (forall (x :: k). c x => f x -> m r) -> NP f xs -> m r
hcfoldMapM Proxy c
c forall (x :: k). c x => f x -> m r
f = \case
  NP f xs
Nil -> r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
forall a. Monoid a => a
mempty
  f x
x :* NP f xs
xs -> r -> r -> r
forall a. Semigroup a => a -> a -> a
(<>) (r -> r -> r) -> m r -> m (r -> r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f x -> m r
forall (x :: k). c x => f x -> m r
f f x
x m (r -> r) -> m r -> m r
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy c -> (forall (x :: k). c x => f x -> m r) -> NP f xs -> m r
forall k r (m :: * -> *) (c :: k -> Constraint) (xs :: [k])
       (f :: k -> *).
(Monoid r, Applicative m, All c xs) =>
Proxy c -> (forall (x :: k). c x => f x -> m r) -> NP f xs -> m r
hcfoldMapM Proxy c
c forall (x :: k). c x => f x -> m r
f NP f xs
xs