{-# LANGUAGE
AllowAmbiguousTypes
, ConstraintKinds
, DataKinds
, DefaultSignatures
, FlexibleContexts
, FlexibleInstances
, LambdaCase
, MultiParamTypeClasses
, PolyKinds
, RankNTypes
, ScopedTypeVariables
, TypeApplications
, TypeFamilies
, TypeOperators
, UndecidableInstances
, UndecidableSuperClasses
#-}
module Squeal.PostgreSQL.Session.Encode
(
EncodeParams (..)
, GenericParams (..)
, nilParams
, (.*)
, (*.)
, aParam
, appendParams
, enumParam
, rowParam
, genericRowParams
, (.#)
, (#.)
, 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 hiding (Composite, field)
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
class IsPG x => ToPG (db :: SchemasType) (x :: Type) where
toPG :: x -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding
instance ToPG db Bool where toPG :: Bool -> ReaderT (K Connection db) IO Encoding
toPG = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Encoding
int4_word32 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Encoding
int8_int64 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). VarChar n -> Text
getVarChar
instance ToPG db (FixChar n) where toPG :: FixChar n -> ReaderT (K Connection db) IO Encoding
toPG = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db @x forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
instance ToPG db x => ToPG db (SOP.K x tag) where toPG :: K x tag -> ReaderT (K Connection db) IO Encoding
toPG = forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db @x forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
instance ToPG db x => ToPG db (Constant x tag) where toPG :: Constant x tag -> ReaderT (K Connection db) IO Encoding
toPG = forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db @x forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
instance ToPG db Day where toPG :: Day -> ReaderT (K Connection db) IO Encoding
toPG = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
json_bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.ByteString.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Aeson.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
jsonb_bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.ByteString.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Aeson.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- forall (db :: SchemasType) (ty :: NullType).
OidOfNull db ty =>
ReaderT (K Connection db) IO Oid
oidOfNull @db @ty
let
dims :: [Int32]
dims = [forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [x]
arr)]
nulls :: Bool
nulls = forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
Bool
arrayNulls @db @'[] @ty @x
Encoding
payload <- forall (m :: * -> *) a c.
Functor m =>
(forall b. (b -> a -> m b) -> b -> c -> m b)
-> (a -> m Encoding) -> c -> m Encoding
dimArray forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall (db :: SchemasType) (ty :: NullType).
OidOfNull db ty =>
ReaderT (K Connection db) IO Oid
oidOfNull @db @ty
let
dims :: [Int32]
dims = [forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector x
arr)]
nulls :: Bool
nulls = forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
Bool
arrayNulls @db @'[] @ty @x
Encoding
payload <- forall (m :: * -> *) a c.
Functor m =>
(forall b. (b -> a -> m b) -> b -> c -> m b)
-> (a -> m Encoding) -> c -> m Encoding
dimArray forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (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
forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall (db :: SchemasType) (ty :: NullType).
OidOfNull db ty =>
ReaderT (K Connection db) IO Oid
oidOfNull @db @ty
Encoding
payload <- 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 = forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
[Int32]
arrayDims @db @dims @ty @x
nulls :: Bool
nulls = forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
Bool
arrayNulls @db @dims @ty @x
ndims :: Int32
ndims = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int32]
dims)
forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall (xss :: [[*]]).
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
_)) =
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)) =
forall (xss :: [[*]]).
NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor NP ConstructorInfo xs
constructors (forall k (f :: k -> *) (xss :: [[k]]). NS (NP f) xss -> SOP f xss
SOP.SOP NS (NP I) xs
xs)
in
forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Strict.Text.pack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (xss :: [[*]]).
NP ConstructorInfo xss -> SOP I xss -> String
gshowConstructor
(forall (xss :: [[*]]). DatatypeInfo xss -> NP ConstructorInfo xss
SOP.constructorInfo (forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> DatatypeInfo (Code a)
SOP.datatypeInfo (forall {k} (t :: k). Proxy t
SOP.Proxy @x)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Generic a => a -> Rep a
SOP.from
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap forall record. Composite record -> record
getComposite 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
NonEmpty Bound x
lower Bound x
upper -> forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bound x -> ReaderT (K Connection db) IO Encoding
putBound Bound x
lower 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> Encoding
word8 (Range x -> Word8 -> Word8
setFlags Range x
r Word8
0) forall a. Semigroup a => a -> a -> a
<> Encoding
payload
where
putBound :: Bound x -> ReaderT (K Connection db) IO Encoding
putBound = \case
Bound x
Infinite -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Closed x
value -> Encoding -> Encoding
sized forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db x
value
Open x
value -> Encoding -> Encoding
sized forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> (forall a. Bits a => a -> Int -> a
`setBit` Int
0)
NonEmpty Bound x
lower Bound x
upper ->
forall {x}. Bound x -> Word8 -> Word8
setLowerFlags Bound x
lower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {x}. Bound x -> Word8 -> Word8
setUpperFlags Bound x
upper
setLowerFlags :: Bound x -> Word8 -> Word8
setLowerFlags = \case
Bound x
Infinite -> (forall a. Bits a => a -> Int -> a
`setBit` Int
3)
Closed x
_ -> (forall a. Bits a => a -> Int -> a
`setBit` Int
1)
Open x
_ -> forall a. a -> a
id
setUpperFlags :: Bound x -> Word8 -> Word8
setUpperFlags = \case
Bound x
Infinite -> (forall a. Bits a => a -> Int -> a
`setBit` Int
4)
Closed x
_ -> (forall a. Bits a => a -> Int -> a
`setBit` Int
2)
Open x
_ -> forall a. a -> a
id
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (db :: SchemasType) 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (db :: SchemasType) x.
ToPG db x =>
x -> ReaderT (K Connection db) IO Encoding
toPG @db)
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) = forall k a (b :: k). a -> K a b
SOP.K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (db :: SchemasType) (ty :: NullType) x.
ToParam db ty x =>
x -> ReaderT (K Connection db) IO (Maybe Encoding)
toParam @db @ty Snd (fld1 ::: x)
x
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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Encoding -> Encoding
sized forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure Encoding
null4) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Encoding -> Encoding
sized forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (m :: * -> *) a c.
Functor m =>
(forall b. (b -> a -> m b) -> b -> c -> m b)
-> (a -> m Encoding) -> c -> m Encoding
dimArray forall x (xs :: [*]) (m :: * -> *) z.
(All ((~) x) xs, Monad m) =>
(z -> x -> m z) -> z -> NP I xs -> m z
foldlNP (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)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
SOP.unZ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
SOP.unSOP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Generic a => a -> Rep a
SOP.from
arrayDims :: [Int32]
arrayDims
= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
SOP.Proxy @dim))
forall a. a -> [a] -> [a]
: forall (db :: SchemasType) (dims :: [Nat]) (ty :: NullType) x.
ToArray db dims ty x =>
[Int32]
arrayDims @db @dims @ty @x
arrayNulls :: Bool
arrayNulls = 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 :: 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 = \case
NP I xs
Nil -> 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
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
newtype EncodeParams
(db :: SchemasType)
(tys :: [k])
(x :: Type) = EncodeParams
{ forall k (db :: SchemasType) (tys :: [k]) x.
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 :: forall a' a.
(a' -> a) -> EncodeParams db tys a -> EncodeParams db tys a'
contramap a' -> a
f (EncodeParams a -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
g) = forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams (a -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a' -> a
f)
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
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 = forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams
forall a b. (a -> b) -> a -> b
$ 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 (forall {k} (t :: k). Proxy t
SOP.Proxy @(ToParam db)) forall (ty :: NullType) y.
ToParam db ty y =>
I y -> ReaderT (K Connection db) IO (K (Maybe Encoding) ty)
encodeNullParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (x :: k). NS f '[x] -> f x
SOP.unZ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (xss :: [[k]]). SOP f xss -> NS (NP f) xss
SOP.unSOP forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (ty :: NullType) y.
ToParam db ty y =>
I y -> ReaderT (K Connection db) IO (K (Maybe Encoding) ty)
encodeNullParam = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a (b :: k). a -> K a b
SOP.K 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)
toParam @db @ty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. I a -> a
SOP.unI
nilParams :: EncodeParams db '[] x
nilParams :: forall {k} (db :: SchemasType) x. EncodeParams db '[] x
nilParams = forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams forall a b. (a -> b) -> a -> b
$ \ x
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (a :: k -> *). NP a '[]
Nil
(.*)
:: forall db x0 ty x tys. (ToParam db ty x0, ty ~ NullPG x0)
=> (x -> x0)
-> EncodeParams db tys x
-> EncodeParams db (ty ': tys) x
x -> x0
f .* :: 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 x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
params = forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams forall a b. (a -> b) -> a -> b
$ \x
x ->
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall k a (b :: k). a -> K a b
SOP.K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)) 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 .*
(*.)
:: forall db x x0 ty0 x1 ty1
. ( ToParam db ty0 x0
, ty0 ~ NullPG x0
, ToParam db ty1 x1
, ty1 ~ NullPG x1
)
=> (x -> x0)
-> (x -> x1)
-> EncodeParams db '[ty0, ty1] x
x -> x0
f *. :: forall (db :: SchemasType) x x0 (ty0 :: NullType) x1
(ty1 :: NullType).
(ToParam db ty0 x0, ty0 ~ NullPG x0, ToParam db ty1 x1,
ty1 ~ NullPG x1) =>
(x -> x0) -> (x -> x1) -> EncodeParams db '[ty0, ty1] x
*. x -> x1
g = x -> x0
f 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 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
.* forall {k} (db :: SchemasType) x. EncodeParams db '[] x
nilParams
infixl 8 *.
aParam
:: forall db x ty. (ToParam db ty x, ty ~ NullPG x)
=> EncodeParams db '[ty] x
aParam :: forall (db :: SchemasType) x (ty :: NullType).
(ToParam db ty x, ty ~ NullPG x) =>
EncodeParams db '[ty] x
aParam = forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Encoding
param -> forall k a (b :: k). a -> K a b
SOP.K Maybe Encoding
param forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (a :: k -> *). NP a '[]
Nil) 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)
toParam @db @(NullPG x)
appendParams
:: EncodeParams db params0 x
-> EncodeParams db params1 x
-> EncodeParams db (Join params0 params1) x
appendParams :: forall {k} (db :: SchemasType) (params0 :: [k]) x (params1 :: [k]).
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 = forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams forall a b. (a -> b) -> a -> b
$ \x
x -> forall {a} (expr :: [a] -> *) (ys :: [a]) (xs :: [a]).
Additional expr =>
expr ys -> expr xs -> expr (Join xs ys)
also
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (db :: SchemasType) (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
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall k (db :: SchemasType) (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
enumParam
:: (PG x ~ 'PGenum labels, SOP.All KnownSymbol labels)
=> (x -> SOP.NS PGlabel labels)
-> (x -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding)
enumParam :: forall {k} x (labels :: [ConstructorName]) (db :: k).
(PG x ~ 'PGenum labels, All KnownSymbol labels) =>
(x -> NS PGlabel labels)
-> x -> ReaderT (K Connection db) IO Encoding
enumParam x -> NS PGlabel labels
casesOf
= forall (m :: * -> *) a. Monad m => a -> m a
return
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Encoding
text_strict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Strict.Text.pack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (lbls :: [ConstructorName]).
All KnownSymbol lbls =>
NS PGlabel lbls -> String
enumCases
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 :: forall (lbls :: [ConstructorName]).
All KnownSymbol lbls =>
NS PGlabel lbls -> String
enumCases = \case
SOP.Z (PGlabel x
_ :: PGlabel lbl) -> forall (n :: ConstructorName) (proxy :: ConstructorName -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall {k} (t :: k). Proxy t
SOP.Proxy @lbl)
SOP.S NS PGlabel xs
cases -> forall (lbls :: [ConstructorName]).
All KnownSymbol lbls =>
NS PGlabel lbls -> String
enumCases NS PGlabel xs
cases
rowParam
:: (PG x ~ 'PGcomposite row, SOP.All (OidOfField db) row)
=> EncodeParams db row x
-> (x -> ReaderT (SOP.K LibPQ.Connection db) IO Encoding)
rowParam :: 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 (EncodeParams db row x
enc :: EncodeParams db row x) x
x = do
let
compositeSize :: Encoding
compositeSize
= Int32 -> Encoding
int4_int32
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral
forall a b. (a -> b) -> a -> b
$ forall k (xs :: [k]) (proxy :: [k] -> *).
SListI xs =>
proxy xs -> Int
SOP.lengthSList
forall a b. (a -> b) -> a -> b
$ 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 :: forall (field :: (ConstructorName, NullType)).
OidOfField db field =>
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (db :: SchemasType) (field :: (ConstructorName, NullType)).
OidOfField db field =>
ReaderT (K Connection db) IO Oid
oidOfField @db @field
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32 -> Encoding
int4_word32 Word32
oid forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
null4 Encoding -> Encoding
sized Maybe Encoding
field
NP (K (Maybe Encoding)) row
fields <- forall k (db :: SchemasType) (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 <- 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
(forall {k} (t :: k). Proxy t
SOP.Proxy @(OidOfField db)) forall (field :: (ConstructorName, NullType)).
OidOfField db field =>
K (Maybe Encoding) field -> ReaderT (K Connection db) IO Encoding
each NP (K (Maybe Encoding)) row
fields
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Encoding
compositeSize forall a. Semigroup a => a -> a -> a
<> Encoding
compositePayload
(.#)
:: forall db x0 fld ty x tys. (ToParam db ty x0, ty ~ NullPG x0)
=> Aliased ((->) x) (fld ::: x0)
-> EncodeParams db tys x
-> EncodeParams db (fld ::: ty ': tys) x
(x -> ty
f `As` Alias alias
_) .# :: 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 x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys)
params = forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams forall a b. (a -> b) -> a -> b
$ \x
x ->
forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall k a (b :: k). a -> K a b
SOP.K forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)) 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 .#
(#.)
:: 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)
-> Aliased ((->) x) (fld1 ::: x1)
-> EncodeParams db '[fld0 ::: ty0, fld1 ::: ty1] x
Aliased ((->) x) (fld0 ::: x0)
f #. :: forall (db :: SchemasType) x x0 (fld0 :: ConstructorName)
(ty0 :: NullType) x1 (fld1 :: ConstructorName) (ty1 :: NullType).
(ToParam db ty0 x0, ty0 ~ NullPG x0, ToParam db ty1 x1,
ty1 ~ NullPG x1) =>
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 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 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
.# 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
= forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Encoding
param -> forall k a (b :: k). a -> K a b
SOP.K Maybe Encoding
param forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (a :: k -> *). NP a '[]
Nil)
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)
toParam @db @(NullPG x)
genericRowParams
:: forall db row x xs.
( SOP.IsRecord x xs
, SOP.AllZip (ToField db) row xs
)
=> EncodeParams db row x
genericRowParams :: forall (db :: SchemasType) (row :: [(ConstructorName, NullType)]) x
(xs :: RecordCode).
(IsRecord x xs, AllZip (ToField db) row xs) =>
EncodeParams db row x
genericRowParams
= forall k (db :: SchemasType) (tys :: [k]) x.
(x -> ReaderT (K Connection db) IO (NP (K (Maybe Encoding)) tys))
-> EncodeParams db tys x
EncodeParams
forall a b. (a -> b) -> a -> b
$ 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 (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)
toField @db)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (_r :: RecordCode). IsRecord a _r => a -> RecordRep a
SOP.toRecord
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 = 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)
, forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Int32
dimension -> Int32 -> Encoding
int4_int32 Int32
dimension 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 (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 -> a -> m b) -> b -> c -> m b
folder a -> m Encoding
elementArray = forall b. (b -> a -> m b) -> b -> c -> m b
folder Encoding -> a -> m Encoding
step forall a. Monoid a => a
mempty
where
step :: Encoding -> a -> m Encoding
step Encoding
builder a
element = (Encoding
builder forall a. Semigroup a => a -> a -> a
<>) 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Encoding -> Int
builderLength Encoding
bs)) 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 :: 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 = \case
NP f xs
Nil -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (a :: k -> *). NP a '[]
Nil
f x
x :* NP f xs
xs -> forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
(:*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (y :: k) (x :: k). c y x => f x -> m (g y)
f f x
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: 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 = \case
NP f xs
Nil -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
f x
x :* NP f xs
xs -> forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (x :: k). c x => f x -> m r
f f x
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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