-- |
-- A DSL for declaration of query parameter encoders.
module Hasql.Encoders.All where

import Data.Aeson qualified as Aeson
import Data.ByteString.Lazy qualified as LazyByteString
import Hasql.Encoders.Array qualified as Array
import Hasql.Encoders.Params qualified as Params
import Hasql.Encoders.Value qualified as Value
import Hasql.PostgresTypeInfo qualified as PTI
import Hasql.Prelude hiding (bool)
import Hasql.Prelude qualified as Prelude
import Network.IP.Addr qualified as NetworkIp
import PostgreSQL.Binary.Encoding qualified as A
import Text.Builder qualified as C

-- * Parameters Product Encoder

-- |
-- Encoder of some representation of a parameters product.
--
-- Has instances of 'Contravariant', 'Divisible' and 'Monoid',
-- which you can use to compose multiple parameters together.
-- E.g.,
--
-- @
-- someParamsEncoder :: 'Params' (Int64, Maybe Text)
-- someParamsEncoder =
--   ('fst' '>$<' 'param' ('nonNullable' 'int8')) '<>'
--   ('snd' '>$<' 'param' ('nullable' 'text'))
-- @
--
-- As a general solution for tuples of any arity, instead of 'fst' and 'snd',
-- consider the functions of the @contrazip@ family
-- from the \"contravariant-extras\" package.
-- E.g., here's how you can achieve the same as the above:
--
-- @
-- someParamsEncoder :: 'Params' (Int64, Maybe Text)
-- someParamsEncoder =
--   'contrazip2' ('param' ('nonNullable' 'int8')) ('param' ('nullable' 'text'))
-- @
--
-- Here's how you can implement encoders for custom composite types:
--
-- @
-- data Person = Person { name :: Text, gender :: Gender, age :: Int }
--
-- data Gender = Male | Female
--
-- personParams :: 'Params' Person
-- personParams =
--   (name '>$<' 'param' ('nonNullable' 'text')) '<>'
--   (gender '>$<' 'param' ('nonNullable' genderValue)) '<>'
--   ('fromIntegral' . age '>$<' 'param' ('nonNullable' 'int8'))
--
-- genderValue :: 'Value' Gender
-- genderValue = 'enum' genderText 'text' where
--   genderText gender = case gender of
--     Male -> "male"
--     Female -> "female"
-- @
newtype Params a = Params (Params.Params a)
  deriving ((forall a' a. (a' -> a) -> Params a -> Params a')
-> (forall b a. b -> Params b -> Params a) -> Contravariant Params
forall b a. b -> Params b -> Params a
forall a' a. (a' -> a) -> Params a -> Params a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
$ccontramap :: forall a' a. (a' -> a) -> Params a -> Params a'
contramap :: forall a' a. (a' -> a) -> Params a -> Params a'
$c>$ :: forall b a. b -> Params b -> Params a
>$ :: forall b a. b -> Params b -> Params a
Contravariant, Contravariant Params
Contravariant Params =>
(forall a b c. (a -> (b, c)) -> Params b -> Params c -> Params a)
-> (forall a. Params a) -> Divisible Params
forall a. Params a
forall a b c. (a -> (b, c)) -> Params b -> Params c -> Params a
forall (f :: * -> *).
Contravariant f =>
(forall a b c. (a -> (b, c)) -> f b -> f c -> f a)
-> (forall a. f a) -> Divisible f
$cdivide :: forall a b c. (a -> (b, c)) -> Params b -> Params c -> Params a
divide :: forall a b c. (a -> (b, c)) -> Params b -> Params c -> Params a
$cconquer :: forall a. Params a
conquer :: forall a. Params a
Divisible, Divisible Params
Divisible Params =>
(forall a. (a -> Void) -> Params a)
-> (forall a b c.
    (a -> Either b c) -> Params b -> Params c -> Params a)
-> Decidable Params
forall a. (a -> Void) -> Params a
forall a b c. (a -> Either b c) -> Params b -> Params c -> Params a
forall (f :: * -> *).
Divisible f =>
(forall a. (a -> Void) -> f a)
-> (forall a b c. (a -> Either b c) -> f b -> f c -> f a)
-> Decidable f
$close :: forall a. (a -> Void) -> Params a
lose :: forall a. (a -> Void) -> Params a
$cchoose :: forall a b c. (a -> Either b c) -> Params b -> Params c -> Params a
choose :: forall a b c. (a -> Either b c) -> Params b -> Params c -> Params a
Decidable, Semigroup (Params a)
Params a
Semigroup (Params a) =>
Params a
-> (Params a -> Params a -> Params a)
-> ([Params a] -> Params a)
-> Monoid (Params a)
[Params a] -> Params a
Params a -> Params a -> Params a
forall a. Semigroup (Params a)
forall a. Params a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [Params a] -> Params a
forall a. Params a -> Params a -> Params a
$cmempty :: forall a. Params a
mempty :: Params a
$cmappend :: forall a. Params a -> Params a -> Params a
mappend :: Params a -> Params a -> Params a
$cmconcat :: forall a. [Params a] -> Params a
mconcat :: [Params a] -> Params a
Monoid, NonEmpty (Params a) -> Params a
Params a -> Params a -> Params a
(Params a -> Params a -> Params a)
-> (NonEmpty (Params a) -> Params a)
-> (forall b. Integral b => b -> Params a -> Params a)
-> Semigroup (Params a)
forall b. Integral b => b -> Params a -> Params a
forall a. NonEmpty (Params a) -> Params a
forall a. Params a -> Params a -> Params a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> Params a -> Params a
$c<> :: forall a. Params a -> Params a -> Params a
<> :: Params a -> Params a -> Params a
$csconcat :: forall a. NonEmpty (Params a) -> Params a
sconcat :: NonEmpty (Params a) -> Params a
$cstimes :: forall a b. Integral b => b -> Params a -> Params a
stimes :: forall b. Integral b => b -> Params a -> Params a
Semigroup)

-- |
-- No parameters. Same as `mempty` and `conquered`.
noParams :: Params ()
noParams :: Params ()
noParams = Params ()
forall a. Monoid a => a
mempty

-- |
-- Lift a single parameter encoder, with its nullability specified,
-- associating it with a single placeholder.
param :: NullableOrNot Value a -> Params a
param :: forall a. NullableOrNot Value a -> Params a
param = \case
  NonNullable (Value Value a
valueEnc) -> Params a -> Params a
forall a. Params a -> Params a
Params (Value a -> Params a
forall a. Value a -> Params a
Params.value Value a
valueEnc)
  Nullable (Value Value a
valueEnc) -> Params a -> Params a
forall a. Params a -> Params a
Params (Value a -> Params (Maybe a)
forall a. Value a -> Params (Maybe a)
Params.nullableValue Value a
valueEnc)

-- * Nullability

-- |
-- Extensional specification of nullability over a generic encoder.
data NullableOrNot encoder a where
  NonNullable :: encoder a -> NullableOrNot encoder a
  Nullable :: encoder a -> NullableOrNot encoder (Maybe a)

-- |
-- Specify that an encoder produces a non-nullable value.
nonNullable :: encoder a -> NullableOrNot encoder a
nonNullable :: forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
nonNullable = encoder a -> NullableOrNot encoder a
forall (encoder :: * -> *) a. encoder a -> NullableOrNot encoder a
NonNullable

-- |
-- Specify that an encoder produces a nullable value.
nullable :: encoder a -> NullableOrNot encoder (Maybe a)
nullable :: forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
nullable = encoder a -> NullableOrNot encoder (Maybe a)
forall (encoder :: * -> *) a.
encoder a -> NullableOrNot encoder (Maybe a)
Nullable

-- * Value

-- |
-- Value encoder.
newtype Value a = Value (Value.Value a)
  deriving ((forall a' a. (a' -> a) -> Value a -> Value a')
-> (forall b a. b -> Value b -> Value a) -> Contravariant Value
forall b a. b -> Value b -> Value a
forall a' a. (a' -> a) -> Value a -> Value a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
$ccontramap :: forall a' a. (a' -> a) -> Value a -> Value a'
contramap :: forall a' a. (a' -> a) -> Value a -> Value a'
$c>$ :: forall b a. b -> Value b -> Value a
>$ :: forall b a. b -> Value b -> Value a
Contravariant)

-- |
-- Encoder of @BOOL@ values.
{-# INLINEABLE bool #-}
bool :: Value Bool
bool :: Value Bool
bool = Value Bool -> Value Bool
forall a. Value a -> Value a
Value (PTI -> (Bool -> Bool -> Encoding) -> Value Bool
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.bool ((Bool -> Encoding) -> Bool -> Bool -> Encoding
forall a b. a -> b -> a
const Bool -> Encoding
A.bool))

-- |
-- Encoder of @INT2@ values.
{-# INLINEABLE int2 #-}
int2 :: Value Int16
int2 :: Value Int16
int2 = Value Int16 -> Value Int16
forall a. Value a -> Value a
Value (PTI -> (Bool -> Int16 -> Encoding) -> Value Int16
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.int2 ((Int16 -> Encoding) -> Bool -> Int16 -> Encoding
forall a b. a -> b -> a
const Int16 -> Encoding
A.int2_int16))

-- |
-- Encoder of @INT4@ values.
{-# INLINEABLE int4 #-}
int4 :: Value Int32
int4 :: Value Int32
int4 = Value Int32 -> Value Int32
forall a. Value a -> Value a
Value (PTI -> (Bool -> Int32 -> Encoding) -> Value Int32
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.int4 ((Int32 -> Encoding) -> Bool -> Int32 -> Encoding
forall a b. a -> b -> a
const Int32 -> Encoding
A.int4_int32))

-- |
-- Encoder of @INT8@ values.
{-# INLINEABLE int8 #-}
int8 :: Value Int64
int8 :: Value Int64
int8 = Value Int64 -> Value Int64
forall a. Value a -> Value a
Value (PTI -> (Bool -> Int64 -> Encoding) -> Value Int64
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.int8 ((Int64 -> Encoding) -> Bool -> Int64 -> Encoding
forall a b. a -> b -> a
const Int64 -> Encoding
A.int8_int64))

-- |
-- Encoder of @FLOAT4@ values.
{-# INLINEABLE float4 #-}
float4 :: Value Float
float4 :: Value Float
float4 = Value Float -> Value Float
forall a. Value a -> Value a
Value (PTI -> (Bool -> Float -> Encoding) -> Value Float
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.float4 ((Float -> Encoding) -> Bool -> Float -> Encoding
forall a b. a -> b -> a
const Float -> Encoding
A.float4))

-- |
-- Encoder of @FLOAT8@ values.
{-# INLINEABLE float8 #-}
float8 :: Value Double
float8 :: Value Double
float8 = Value Double -> Value Double
forall a. Value a -> Value a
Value (PTI -> (Bool -> Double -> Encoding) -> Value Double
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.float8 ((Double -> Encoding) -> Bool -> Double -> Encoding
forall a b. a -> b -> a
const Double -> Encoding
A.float8))

-- |
-- Encoder of @NUMERIC@ values.
{-# INLINEABLE numeric #-}
numeric :: Value Scientific
numeric :: Value Scientific
numeric = Value Scientific -> Value Scientific
forall a. Value a -> Value a
Value (PTI -> (Bool -> Scientific -> Encoding) -> Value Scientific
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.numeric ((Scientific -> Encoding) -> Bool -> Scientific -> Encoding
forall a b. a -> b -> a
const Scientific -> Encoding
A.numeric))

-- |
-- Encoder of @CHAR@ values.
--
-- Note that it supports Unicode values and
-- identifies itself under the @TEXT@ OID because of that.
{-# INLINEABLE char #-}
char :: Value Char
char :: Value Char
char = Value Char -> Value Char
forall a. Value a -> Value a
Value (PTI -> (Bool -> Char -> Encoding) -> Value Char
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.text ((Char -> Encoding) -> Bool -> Char -> Encoding
forall a b. a -> b -> a
const Char -> Encoding
A.char_utf8))

-- |
-- Encoder of @TEXT@ values.
{-# INLINEABLE text #-}
text :: Value Text
text :: Value Text
text = Value Text -> Value Text
forall a. Value a -> Value a
Value (PTI -> (Bool -> Text -> Encoding) -> Value Text
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.text ((Text -> Encoding) -> Bool -> Text -> Encoding
forall a b. a -> b -> a
const Text -> Encoding
A.text_strict))

-- |
-- Encoder of @BYTEA@ values.
{-# INLINEABLE bytea #-}
bytea :: Value ByteString
bytea :: Value ByteString
bytea = Value ByteString -> Value ByteString
forall a. Value a -> Value a
Value (PTI -> (Bool -> ByteString -> Encoding) -> Value ByteString
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.bytea ((ByteString -> Encoding) -> Bool -> ByteString -> Encoding
forall a b. a -> b -> a
const ByteString -> Encoding
A.bytea_strict))

-- |
-- Encoder of @DATE@ values.
{-# INLINEABLE date #-}
date :: Value Day
date :: Value Day
date = Value Day -> Value Day
forall a. Value a -> Value a
Value (PTI -> (Bool -> Day -> Encoding) -> Value Day
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.date ((Day -> Encoding) -> Bool -> Day -> Encoding
forall a b. a -> b -> a
const Day -> Encoding
A.date))

-- |
-- Encoder of @TIMESTAMP@ values.
{-# INLINEABLE timestamp #-}
timestamp :: Value LocalTime
timestamp :: Value LocalTime
timestamp = Value LocalTime -> Value LocalTime
forall a. Value a -> Value a
Value (PTI -> (Bool -> LocalTime -> Encoding) -> Value LocalTime
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.timestamp ((LocalTime -> Encoding)
-> (LocalTime -> Encoding) -> Bool -> LocalTime -> Encoding
forall a. a -> a -> Bool -> a
Prelude.bool LocalTime -> Encoding
A.timestamp_float LocalTime -> Encoding
A.timestamp_int))

-- |
-- Encoder of @TIMESTAMPTZ@ values.
{-# INLINEABLE timestamptz #-}
timestamptz :: Value UTCTime
timestamptz :: Value UTCTime
timestamptz = Value UTCTime -> Value UTCTime
forall a. Value a -> Value a
Value (PTI -> (Bool -> UTCTime -> Encoding) -> Value UTCTime
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.timestamptz ((UTCTime -> Encoding)
-> (UTCTime -> Encoding) -> Bool -> UTCTime -> Encoding
forall a. a -> a -> Bool -> a
Prelude.bool UTCTime -> Encoding
A.timestamptz_float UTCTime -> Encoding
A.timestamptz_int))

-- |
-- Encoder of @TIME@ values.
{-# INLINEABLE time #-}
time :: Value TimeOfDay
time :: Value TimeOfDay
time = Value TimeOfDay -> Value TimeOfDay
forall a. Value a -> Value a
Value (PTI -> (Bool -> TimeOfDay -> Encoding) -> Value TimeOfDay
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.time ((TimeOfDay -> Encoding)
-> (TimeOfDay -> Encoding) -> Bool -> TimeOfDay -> Encoding
forall a. a -> a -> Bool -> a
Prelude.bool TimeOfDay -> Encoding
A.time_float TimeOfDay -> Encoding
A.time_int))

-- |
-- Encoder of @TIMETZ@ values.
{-# INLINEABLE timetz #-}
timetz :: Value (TimeOfDay, TimeZone)
timetz :: Value (TimeOfDay, TimeZone)
timetz = Value (TimeOfDay, TimeZone) -> Value (TimeOfDay, TimeZone)
forall a. Value a -> Value a
Value (PTI
-> (Bool -> (TimeOfDay, TimeZone) -> Encoding)
-> Value (TimeOfDay, TimeZone)
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.timetz (((TimeOfDay, TimeZone) -> Encoding)
-> ((TimeOfDay, TimeZone) -> Encoding)
-> Bool
-> (TimeOfDay, TimeZone)
-> Encoding
forall a. a -> a -> Bool -> a
Prelude.bool (TimeOfDay, TimeZone) -> Encoding
A.timetz_float (TimeOfDay, TimeZone) -> Encoding
A.timetz_int))

-- |
-- Encoder of @INTERVAL@ values.
{-# INLINEABLE interval #-}
interval :: Value DiffTime
interval :: Value DiffTime
interval = Value DiffTime -> Value DiffTime
forall a. Value a -> Value a
Value (PTI -> (Bool -> DiffTime -> Encoding) -> Value DiffTime
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.interval ((DiffTime -> Encoding)
-> (DiffTime -> Encoding) -> Bool -> DiffTime -> Encoding
forall a. a -> a -> Bool -> a
Prelude.bool DiffTime -> Encoding
A.interval_float DiffTime -> Encoding
A.interval_int))

-- |
-- Encoder of @UUID@ values.
{-# INLINEABLE uuid #-}
uuid :: Value UUID
uuid :: Value UUID
uuid = Value UUID -> Value UUID
forall a. Value a -> Value a
Value (PTI -> (Bool -> UUID -> Encoding) -> Value UUID
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.uuid ((UUID -> Encoding) -> Bool -> UUID -> Encoding
forall a b. a -> b -> a
const UUID -> Encoding
A.uuid))

-- |
-- Encoder of @INET@ values.
{-# INLINEABLE inet #-}
inet :: Value (NetworkIp.NetAddr NetworkIp.IP)
inet :: Value (NetAddr IP)
inet = Value (NetAddr IP) -> Value (NetAddr IP)
forall a. Value a -> Value a
Value (PTI -> (Bool -> NetAddr IP -> Encoding) -> Value (NetAddr IP)
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.inet ((NetAddr IP -> Encoding) -> Bool -> NetAddr IP -> Encoding
forall a b. a -> b -> a
const NetAddr IP -> Encoding
A.inet))

-- |
-- Encoder of @JSON@ values from JSON AST.
{-# INLINEABLE json #-}
json :: Value Aeson.Value
json :: Value Value
json = Value Value -> Value Value
forall a. Value a -> Value a
Value (PTI -> (Bool -> Value -> Encoding) -> Value Value
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.json ((Value -> Encoding) -> Bool -> Value -> Encoding
forall a b. a -> b -> a
const Value -> Encoding
A.json_ast))

-- |
-- Encoder of @JSON@ values from raw JSON.
{-# INLINEABLE jsonBytes #-}
jsonBytes :: Value ByteString
jsonBytes :: Value ByteString
jsonBytes = Value ByteString -> Value ByteString
forall a. Value a -> Value a
Value (PTI -> (Bool -> ByteString -> Encoding) -> Value ByteString
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.json ((ByteString -> Encoding) -> Bool -> ByteString -> Encoding
forall a b. a -> b -> a
const ByteString -> Encoding
A.json_bytes))

-- |
-- Encoder of @JSON@ values from raw JSON as lazy ByteString.
{-# INLINEABLE jsonLazyBytes #-}
jsonLazyBytes :: Value LazyByteString.ByteString
jsonLazyBytes :: Value ByteString
jsonLazyBytes = Value ByteString -> Value ByteString
forall a. Value a -> Value a
Value (PTI -> (Bool -> ByteString -> Encoding) -> Value ByteString
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.json ((ByteString -> Encoding) -> Bool -> ByteString -> Encoding
forall a b. a -> b -> a
const ByteString -> Encoding
A.json_bytes_lazy))

-- |
-- Encoder of @JSONB@ values from JSON AST.
{-# INLINEABLE jsonb #-}
jsonb :: Value Aeson.Value
jsonb :: Value Value
jsonb = Value Value -> Value Value
forall a. Value a -> Value a
Value (PTI -> (Bool -> Value -> Encoding) -> Value Value
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.jsonb ((Value -> Encoding) -> Bool -> Value -> Encoding
forall a b. a -> b -> a
const Value -> Encoding
A.jsonb_ast))

-- |
-- Encoder of @JSONB@ values from raw JSON.
{-# INLINEABLE jsonbBytes #-}
jsonbBytes :: Value ByteString
jsonbBytes :: Value ByteString
jsonbBytes = Value ByteString -> Value ByteString
forall a. Value a -> Value a
Value (PTI -> (Bool -> ByteString -> Encoding) -> Value ByteString
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.jsonb ((ByteString -> Encoding) -> Bool -> ByteString -> Encoding
forall a b. a -> b -> a
const ByteString -> Encoding
A.jsonb_bytes))

-- |
-- Encoder of @JSONB@ values from raw JSON as lazy ByteString.
{-# INLINEABLE jsonbLazyBytes #-}
jsonbLazyBytes :: Value LazyByteString.ByteString
jsonbLazyBytes :: Value ByteString
jsonbLazyBytes = Value ByteString -> Value ByteString
forall a. Value a -> Value a
Value (PTI -> (Bool -> ByteString -> Encoding) -> Value ByteString
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.jsonb ((ByteString -> Encoding) -> Bool -> ByteString -> Encoding
forall a b. a -> b -> a
const ByteString -> Encoding
A.jsonb_bytes_lazy))

-- |
-- Encoder of @OID@ values.
{-# INLINEABLE oid #-}
oid :: Value Int32
oid :: Value Int32
oid = Value Int32 -> Value Int32
forall a. Value a -> Value a
Value (PTI -> (Bool -> Int32 -> Encoding) -> Value Int32
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.oid ((Int32 -> Encoding) -> Bool -> Int32 -> Encoding
forall a b. a -> b -> a
const Int32 -> Encoding
A.int4_int32))

-- |
-- Encoder of @NAME@ values.
{-# INLINEABLE name #-}
name :: Value Text
name :: Value Text
name = Value Text -> Value Text
forall a. Value a -> Value a
Value (PTI -> (Bool -> Text -> Encoding) -> Value Text
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.name ((Text -> Encoding) -> Bool -> Text -> Encoding
forall a b. a -> b -> a
const Text -> Encoding
A.text_strict))

-- |
-- Given a function,
-- which maps a value into a textual enum label used on the DB side,
-- produces an encoder of that value.
{-# INLINEABLE enum #-}
enum :: (a -> Text) -> Value a
enum :: forall a. (a -> Text) -> Value a
enum a -> Text
mapping = Value a -> Value a
forall a. Value a -> Value a
Value (PTI -> (Bool -> a -> Encoding) -> (a -> Builder) -> Value a
forall a.
PTI -> (Bool -> a -> Encoding) -> (a -> Builder) -> Value a
Value.unsafePTI PTI
PTI.text ((a -> Encoding) -> Bool -> a -> Encoding
forall a b. a -> b -> a
const (Text -> Encoding
A.text_strict (Text -> Encoding) -> (a -> Text) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Text
mapping)) (Text -> Builder
C.text (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Text
mapping))

-- |
-- Variation of 'enum' with unknown OID.
-- This function does not identify the type to Postgres,
-- so Postgres must be able to derive the type from context.
-- When you find yourself in such situation just provide an explicit type in the query
-- using the :: operator.
{-# INLINEABLE unknownEnum #-}
unknownEnum :: (a -> Text) -> Value a
unknownEnum :: forall a. (a -> Text) -> Value a
unknownEnum a -> Text
mapping = Value a -> Value a
forall a. Value a -> Value a
Value (PTI -> (Bool -> a -> Encoding) -> (a -> Builder) -> Value a
forall a.
PTI -> (Bool -> a -> Encoding) -> (a -> Builder) -> Value a
Value.unsafePTI PTI
PTI.binaryUnknown ((a -> Encoding) -> Bool -> a -> Encoding
forall a b. a -> b -> a
const (Text -> Encoding
A.text_strict (Text -> Encoding) -> (a -> Text) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Text
mapping)) (Text -> Builder
C.text (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Text
mapping))

-- |
-- Identifies the value with the PostgreSQL's \"unknown\" type,
-- thus leaving it up to Postgres to infer the actual type of the value.
--
-- The value transimitted is any value encoded in the Postgres' Text data format.
-- For reference, see the
-- <https://www.postgresql.org/docs/10/static/protocol-overview.html#PROTOCOL-FORMAT-CODES Formats and Format Codes>
-- section of the Postgres' documentation.
--
-- __Warning:__ Do not use this as part of composite encoders like 'array' since
-- it is the only encoder that doesn't use the binary format.
{-# INLINEABLE unknown #-}
unknown :: Value ByteString
unknown :: Value ByteString
unknown = Value ByteString -> Value ByteString
forall a. Value a -> Value a
Value (PTI -> (Bool -> ByteString -> Encoding) -> Value ByteString
forall a. Show a => PTI -> (Bool -> a -> Encoding) -> Value a
Value.unsafePTIWithShow PTI
PTI.textUnknown ((ByteString -> Encoding) -> Bool -> ByteString -> Encoding
forall a b. a -> b -> a
const ByteString -> Encoding
A.bytea_strict))

-- |
-- Lift an array encoder into a value encoder.
array :: Array a -> Value a
array :: forall a. Array a -> Value a
array (Array (Array.Array OID
valueOID OID
arrayOID Bool -> a -> Array
arrayEncoder a -> Builder
renderer)) =
  let encoder :: Bool -> a -> Encoding
encoder Bool
env a
input = Word32 -> Array -> Encoding
A.array (OID -> Word32
PTI.oidWord32 OID
valueOID) (Bool -> a -> Array
arrayEncoder Bool
env a
input)
   in Value a -> Value a
forall a. Value a -> Value a
Value (OID -> OID -> (Bool -> a -> Encoding) -> (a -> Builder) -> Value a
forall a.
OID -> OID -> (Bool -> a -> Encoding) -> (a -> Builder) -> Value a
Value.Value OID
arrayOID OID
arrayOID Bool -> a -> Encoding
encoder a -> Builder
renderer)

-- |
-- Lift a composite encoder into a value encoder.
composite :: Composite a -> Value a
composite :: forall a. Composite a -> Value a
composite (Composite a -> Bool -> Composite
encode a -> [Builder]
print) =
  Value a -> Value a
forall a. Value a -> Value a
Value (PTI -> (Bool -> a -> Encoding) -> (a -> Builder) -> Value a
forall a.
PTI -> (Bool -> a -> Encoding) -> (a -> Builder) -> Value a
Value.unsafePTI PTI
PTI.binaryUnknown Bool -> a -> Encoding
encodeValue a -> Builder
printValue)
  where
    encodeValue :: Bool -> a -> Encoding
encodeValue Bool
idt a
val =
      Composite -> Encoding
A.composite (Composite -> Encoding) -> Composite -> Encoding
forall a b. (a -> b) -> a -> b
$ a -> Bool -> Composite
encode a
val Bool
idt
    printValue :: a -> Builder
printValue a
val =
      Builder
"ROW (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> [Builder] -> Builder
forall (foldable :: * -> *).
Foldable foldable =>
Builder -> foldable Builder -> Builder
C.intercalate Builder
", " (a -> [Builder]
print a
val) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
")"

-- |
-- Lift a value encoder of element into a unidimensional array encoder of a foldable value.
--
-- This function is merely a shortcut to the following expression:
--
-- @
-- ('array' . 'dimension' 'foldl'' . 'element')
-- @
--
-- You can use it like this:
--
-- @
-- vectorOfInts :: Value (Vector Int64)
-- vectorOfInts = 'foldableArray' ('nonNullable' 'int8')
-- @
--
-- Please notice that in case of multidimensional arrays nesting 'foldableArray' encoder
-- won't work. You have to explicitly construct the array encoder using 'array'.
{-# INLINE foldableArray #-}
foldableArray :: (Foldable foldable) => NullableOrNot Value element -> Value (foldable element)
foldableArray :: forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
foldableArray = Array (foldable element) -> Value (foldable element)
forall a. Array a -> Value a
array (Array (foldable element) -> Value (foldable element))
-> (NullableOrNot Value element -> Array (foldable element))
-> NullableOrNot Value element
-> Value (foldable element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. (a -> element -> a) -> a -> foldable element -> a)
-> Array element -> Array (foldable element)
forall b c.
(forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c
dimension (a -> element -> a) -> a -> foldable element -> a
forall a. (a -> element -> a) -> a -> foldable element -> a
forall b a. (b -> a -> b) -> b -> foldable a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Array element -> Array (foldable element))
-> (NullableOrNot Value element -> Array element)
-> NullableOrNot Value element
-> Array (foldable element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NullableOrNot Value element -> Array element
forall a. NullableOrNot Value a -> Array a
element

-- * Array

-- |
-- Generic array encoder.
--
-- Here's an example of its usage:
--
-- @
-- someParamsEncoder :: 'Params' [[Int64]]
-- someParamsEncoder = 'param' ('nonNullable' ('array' ('dimension' 'foldl'' ('dimension' 'foldl'' ('element' ('nonNullable' 'int8'))))))
-- @
--
-- Please note that the PostgreSQL @IN@ keyword does not accept an array, but rather a syntactical list of
-- values, thus this encoder is not suited for that. Use a @value = ANY($1)@ condition instead.
newtype Array a = Array (Array.Array a)
  deriving ((forall a' a. (a' -> a) -> Array a -> Array a')
-> (forall b a. b -> Array b -> Array a) -> Contravariant Array
forall b a. b -> Array b -> Array a
forall a' a. (a' -> a) -> Array a -> Array a'
forall (f :: * -> *).
(forall a' a. (a' -> a) -> f a -> f a')
-> (forall b a. b -> f b -> f a) -> Contravariant f
$ccontramap :: forall a' a. (a' -> a) -> Array a -> Array a'
contramap :: forall a' a. (a' -> a) -> Array a -> Array a'
$c>$ :: forall b a. b -> Array b -> Array a
>$ :: forall b a. b -> Array b -> Array a
Contravariant)

-- |
-- Lifts a 'Value' encoder into an 'Array' encoder.
element :: NullableOrNot Value a -> Array a
element :: forall a. NullableOrNot Value a -> Array a
element = \case
  NonNullable (Value (Value.Value OID
elementOID OID
arrayOID Bool -> a -> Encoding
encoder a -> Builder
renderer)) ->
    Array a -> Array a
forall a. Array a -> Array a
Array (OID -> OID -> (Bool -> a -> Encoding) -> (a -> Builder) -> Array a
forall a.
OID -> OID -> (Bool -> a -> Encoding) -> (a -> Builder) -> Array a
Array.value OID
elementOID OID
arrayOID Bool -> a -> Encoding
encoder a -> Builder
renderer)
  Nullable (Value (Value.Value OID
elementOID OID
arrayOID Bool -> a -> Encoding
encoder a -> Builder
renderer)) ->
    Array a -> Array a
forall a. Array a -> Array a
Array (OID
-> OID
-> (Bool -> a -> Encoding)
-> (a -> Builder)
-> Array (Maybe a)
forall a.
OID
-> OID
-> (Bool -> a -> Encoding)
-> (a -> Builder)
-> Array (Maybe a)
Array.nullableValue OID
elementOID OID
arrayOID Bool -> a -> Encoding
encoder a -> Builder
renderer)

-- |
-- Encoder of an array dimension,
-- which thus provides support for multidimensional arrays.
--
-- Accepts:
--
-- * An implementation of the left-fold operation,
-- such as @Data.Foldable.'foldl''@,
-- which determines the input value.
--
-- * A component encoder, which can be either another 'dimension' or 'element'.
{-# INLINEABLE dimension #-}
dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c
dimension :: forall b c.
(forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c
dimension forall a. (a -> b -> a) -> a -> c -> a
foldl (Array Array b
imp) = Array c -> Array c
forall a. Array a -> Array a
Array ((forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c
forall b c.
(forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c
Array.dimension (a -> b -> a) -> a -> c -> a
forall a. (a -> b -> a) -> a -> c -> a
foldl Array b
imp)

-- * Composite

-- |
-- Composite or row-types encoder.
data Composite a
  = Composite
      (a -> Bool -> A.Composite)
      (a -> [C.Builder])

instance Contravariant Composite where
  contramap :: forall a' a. (a' -> a) -> Composite a -> Composite a'
contramap a' -> a
f (Composite a -> Bool -> Composite
encode a -> [Builder]
print) =
    (a' -> Bool -> Composite) -> (a' -> [Builder]) -> Composite a'
forall a.
(a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
Composite (a -> Bool -> Composite
encode (a -> Bool -> Composite) -> (a' -> a) -> a' -> Bool -> Composite
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a' -> a
f) (a -> [Builder]
print (a -> [Builder]) -> (a' -> a) -> a' -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a' -> a
f)

instance Divisible Composite where
  divide :: forall a b c.
(a -> (b, c)) -> Composite b -> Composite c -> Composite a
divide a -> (b, c)
f (Composite b -> Bool -> Composite
encodeL b -> [Builder]
printL) (Composite c -> Bool -> Composite
encodeR c -> [Builder]
printR) =
    (a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
forall a.
(a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
Composite
      (\a
val Bool
idt -> case a -> (b, c)
f a
val of (b
lVal, c
rVal) -> b -> Bool -> Composite
encodeL b
lVal Bool
idt Composite -> Composite -> Composite
forall a. Semigroup a => a -> a -> a
<> c -> Bool -> Composite
encodeR c
rVal Bool
idt)
      (\a
val -> case a -> (b, c)
f a
val of (b
lVal, c
rVal) -> b -> [Builder]
printL b
lVal [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> c -> [Builder]
printR c
rVal)
  conquer :: forall a. Composite a
conquer = Composite a
forall a. Monoid a => a
mempty

instance Semigroup (Composite a) where
  Composite a -> Bool -> Composite
encodeL a -> [Builder]
printL <> :: Composite a -> Composite a -> Composite a
<> Composite a -> Bool -> Composite
encodeR a -> [Builder]
printR =
    (a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
forall a.
(a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
Composite
      (\a
val Bool
idt -> a -> Bool -> Composite
encodeL a
val Bool
idt Composite -> Composite -> Composite
forall a. Semigroup a => a -> a -> a
<> a -> Bool -> Composite
encodeR a
val Bool
idt)
      (\a
val -> a -> [Builder]
printL a
val [Builder] -> [Builder] -> [Builder]
forall a. Semigroup a => a -> a -> a
<> a -> [Builder]
printR a
val)

instance Monoid (Composite a) where
  mempty :: Composite a
mempty = (a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
forall a.
(a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
Composite a -> Bool -> Composite
forall a. Monoid a => a
mempty a -> [Builder]
forall a. Monoid a => a
mempty

-- | Single field of a row-type.
field :: NullableOrNot Value a -> Composite a
field :: forall a. NullableOrNot Value a -> Composite a
field = \case
  NonNullable (Value (Value.Value OID
elementOID OID
arrayOID Bool -> a -> Encoding
encode a -> Builder
print)) ->
    (a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
forall a.
(a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
Composite
      (\a
val Bool
idt -> Word32 -> Encoding -> Composite
A.field (OID -> Word32
PTI.oidWord32 OID
elementOID) (Bool -> a -> Encoding
encode Bool
idt a
val))
      (\a
val -> [a -> Builder
print a
val])
  Nullable (Value (Value.Value OID
elementOID OID
arrayOID Bool -> a -> Encoding
encode a -> Builder
print)) ->
    (a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
forall a.
(a -> Bool -> Composite) -> (a -> [Builder]) -> Composite a
Composite
      ( \a
val Bool
idt -> case a
val of
          a
Maybe a
Nothing -> Word32 -> Composite
A.nullField (OID -> Word32
PTI.oidWord32 OID
elementOID)
          Just a
val -> Word32 -> Encoding -> Composite
A.field (OID -> Word32
PTI.oidWord32 OID
elementOID) (Bool -> a -> Encoding
encode Bool
idt a
val)
      )
      ( \a
val ->
          case a
val of
            a
Maybe a
Nothing -> [Builder
"NULL"]
            Just a
val -> [a -> Builder
print a
val]
      )