module PostgreSQL.Binary.Encoding
  ( -- * Encoding
    Encoding,
    encodingBytes,
    composite,
    array,
    array_foldable,
    array_vector,
    nullableArray_vector,
    hStore_foldable,
    hStore_hashMap,
    hStore_map,

    -- * Primitives
    bool,
    int2_int16,
    int2_word16,
    int4_int32,
    int4_word32,
    int8_int64,
    int8_word64,
    float4,
    float8,
    numeric,
    uuid,
    inet,
    char_utf8,
    text_strict,
    text_lazy,
    bytea_strict,
    bytea_lazy,

    -- ** Time

    -- | Some of the functions in this section are distinguished based
    -- on the @integer_datetimes@ setting of the server.
    date,
    time_int,
    time_float,
    timetz_int,
    timetz_float,
    timestamp_int,
    timestamp_float,
    timestamptz_int,
    timestamptz_float,
    interval_int,
    interval_float,

    -- ** JSON
    json_bytes,
    json_bytes_lazy,
    json_ast,
    jsonb_bytes,
    jsonb_bytes_lazy,
    jsonb_ast,

    -- * Array
    Array,
    encodingArray,
    nullArray,
    dimensionArray,

    -- * Composite
    Composite,
    field,
    nullField,
  )
where

import qualified ByteString.StrictBuilder as C
import qualified Data.Aeson as R
import qualified Data.ByteString.Builder as M
import qualified Data.ByteString.Lazy as N
import qualified Data.Text.Lazy as L
import qualified Data.Vector as A
import qualified Network.IP.Addr as G
import qualified PostgreSQL.Binary.Encoding.Builders as B
import PostgreSQL.Binary.Prelude hiding (bool, length)

type Encoding =
  C.Builder

{-# INLINE encodingBytes #-}
encodingBytes :: Encoding -> ByteString
encodingBytes :: Encoding -> ByteString
encodingBytes =
  Encoding -> ByteString
C.builderBytes

-- * Values

{-# INLINE composite #-}
composite :: Composite -> Encoding
composite :: Composite -> Encoding
composite (Composite Int
size Encoding
fields) =
  Int -> Encoding
B.int4_int Int
size forall a. Semigroup a => a -> a -> a
<> Encoding
fields

-- |
-- Turn an array builder into final value.
-- The first parameter is OID of the element type.
{-# INLINE array #-}
array :: Word32 -> Array -> Encoding
array :: Word32 -> Array -> Encoding
array Word32
oid (Array Encoding
payload [Int32]
dimensions Bool
nulls) =
  Word32 -> [Int32] -> Bool -> Encoding -> Encoding
B.array Word32
oid [Int32]
dimensions Bool
nulls Encoding
payload

-- |
-- A helper for encoding of arrays of single dimension from foldables.
-- The first parameter is OID of the element type.
{-# INLINE array_foldable #-}
array_foldable :: Foldable foldable => Word32 -> (element -> Maybe Encoding) -> foldable element -> Encoding
array_foldable :: forall (foldable :: * -> *) element.
Foldable foldable =>
Word32
-> (element -> Maybe Encoding) -> foldable element -> Encoding
array_foldable Word32
oid element -> Maybe Encoding
elementBuilder =
  Word32 -> Array -> Encoding
array Word32
oid forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a c.
(forall b. (b -> a -> b) -> b -> c -> b)
-> (a -> Array) -> c -> Array
dimensionArray forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Array
nullArray Encoding -> Array
encodingArray forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. element -> Maybe Encoding
elementBuilder)

-- |
-- A helper for encoding of arrays of single dimension from vectors.
-- The first parameter is OID of the element type.
{-# INLINE array_vector #-}
array_vector :: Word32 -> (element -> Encoding) -> Vector element -> Encoding
array_vector :: forall element.
Word32 -> (element -> Encoding) -> Vector element -> Encoding
array_vector Word32
oid element -> Encoding
elementBuilder Vector element
vector =
  forall element.
Word32 -> (element -> Encoding) -> Vector element -> Encoding
B.array_vector Word32
oid element -> Encoding
elementBuilder Vector element
vector

-- |
-- A helper for encoding of arrays of single dimension from vectors.
-- The first parameter is OID of the element type.
{-# INLINE nullableArray_vector #-}
nullableArray_vector :: Word32 -> (element -> Encoding) -> Vector (Maybe element) -> Encoding
nullableArray_vector :: forall element.
Word32
-> (element -> Encoding) -> Vector (Maybe element) -> Encoding
nullableArray_vector Word32
oid element -> Encoding
elementBuilder Vector (Maybe element)
vector =
  forall element.
Word32
-> (element -> Encoding) -> Vector (Maybe element) -> Encoding
B.nullableArray_vector Word32
oid element -> Encoding
elementBuilder Vector (Maybe element)
vector

-- |
-- A polymorphic @HSTORE@ encoder.
{-# INLINE hStore_foldable #-}
hStore_foldable :: Foldable foldable => foldable (Text, Maybe Text) -> Encoding
hStore_foldable :: forall (foldable :: * -> *).
Foldable foldable =>
foldable (Text, Maybe Text) -> Encoding
hStore_foldable =
  forall b.
(forall a. (a -> (Text, Maybe Text) -> a) -> a -> b -> a)
-> b -> Encoding
B.hStoreUsingFoldl forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl

-- |
-- @HSTORE@ encoder from HashMap.
{-# INLINE hStore_hashMap #-}
hStore_hashMap :: HashMap Text (Maybe Text) -> Encoding
hStore_hashMap :: HashMap Text (Maybe Text) -> Encoding
hStore_hashMap =
  HashMap Text (Maybe Text) -> Encoding
B.hStore_hashMap

-- |
-- @HSTORE@ encoder from Map.
{-# INLINE hStore_map #-}
hStore_map :: Map Text (Maybe Text) -> Encoding
hStore_map :: Map Text (Maybe Text) -> Encoding
hStore_map =
  Map Text (Maybe Text) -> Encoding
B.hStore_map

-- * Primitive

{-# INLINE bool #-}
bool :: Bool -> Encoding
bool :: Bool -> Encoding
bool =
  Bool -> Encoding
B.bool

{-# INLINE int2_int16 #-}
int2_int16 :: Int16 -> Encoding
int2_int16 :: Int16 -> Encoding
int2_int16 =
  Int16 -> Encoding
B.int2_int16

{-# INLINE int2_word16 #-}
int2_word16 :: Word16 -> Encoding
int2_word16 :: Word16 -> Encoding
int2_word16 =
  Word16 -> Encoding
B.int2_word16

{-# INLINE int4_int32 #-}
int4_int32 :: Int32 -> Encoding
int4_int32 :: Int32 -> Encoding
int4_int32 =
  Int32 -> Encoding
B.int4_int32

{-# INLINE int4_word32 #-}
int4_word32 :: Word32 -> Encoding
int4_word32 :: Word32 -> Encoding
int4_word32 =
  Word32 -> Encoding
B.int4_word32

{-# INLINE int8_int64 #-}
int8_int64 :: Int64 -> Encoding
int8_int64 :: Int64 -> Encoding
int8_int64 =
  Int64 -> Encoding
B.int8_int64

{-# INLINE int8_word64 #-}
int8_word64 :: Word64 -> Encoding
int8_word64 :: Word64 -> Encoding
int8_word64 =
  Word64 -> Encoding
B.int8_word64

{-# INLINE float4 #-}
float4 :: Float -> Encoding
float4 :: Float -> Encoding
float4 =
  Float -> Encoding
B.float4

{-# INLINE float8 #-}
float8 :: Double -> Encoding
float8 :: Double -> Encoding
float8 =
  Double -> Encoding
B.float8

{-# INLINE numeric #-}
numeric :: Scientific -> Encoding
numeric :: Scientific -> Encoding
numeric =
  Scientific -> Encoding
B.numeric

{-# INLINE uuid #-}
uuid :: UUID -> Encoding
uuid :: UUID -> Encoding
uuid =
  UUID -> Encoding
B.uuid

{-# INLINE inet #-}
inet :: G.NetAddr G.IP -> Encoding
inet :: NetAddr IP -> Encoding
inet =
  NetAddr IP -> Encoding
B.inet

{-# INLINE char_utf8 #-}
char_utf8 :: Char -> Encoding
char_utf8 :: Char -> Encoding
char_utf8 =
  Char -> Encoding
B.char_utf8

{-# INLINE text_strict #-}
text_strict :: Text -> Encoding
text_strict :: Text -> Encoding
text_strict =
  Text -> Encoding
B.text_strict

{-# INLINE text_lazy #-}
text_lazy :: L.Text -> Encoding
text_lazy :: Text -> Encoding
text_lazy =
  Text -> Encoding
B.text_lazy

{-# INLINE bytea_strict #-}
bytea_strict :: ByteString -> Encoding
bytea_strict :: ByteString -> Encoding
bytea_strict =
  ByteString -> Encoding
B.bytea_strict

{-# INLINE bytea_lazy #-}
bytea_lazy :: N.ByteString -> Encoding
bytea_lazy :: ByteString -> Encoding
bytea_lazy =
  ByteString -> Encoding
B.bytea_lazy

{-# INLINE bytea_lazyBuilder #-}
bytea_lazyBuilder :: M.Builder -> Encoding
bytea_lazyBuilder :: Builder -> Encoding
bytea_lazyBuilder =
  Builder -> Encoding
B.bytea_lazyBuilder

{-# INLINE date #-}
date :: Day -> Encoding
date :: Day -> Encoding
date =
  Day -> Encoding
B.date

{-# INLINE time_int #-}
time_int :: TimeOfDay -> Encoding
time_int :: TimeOfDay -> Encoding
time_int =
  TimeOfDay -> Encoding
B.time_int

{-# INLINE time_float #-}
time_float :: TimeOfDay -> Encoding
time_float :: TimeOfDay -> Encoding
time_float =
  TimeOfDay -> Encoding
B.time_float

{-# INLINE timetz_int #-}
timetz_int :: (TimeOfDay, TimeZone) -> Encoding
timetz_int :: (TimeOfDay, TimeZone) -> Encoding
timetz_int =
  (TimeOfDay, TimeZone) -> Encoding
B.timetz_int

{-# INLINE timetz_float #-}
timetz_float :: (TimeOfDay, TimeZone) -> Encoding
timetz_float :: (TimeOfDay, TimeZone) -> Encoding
timetz_float =
  (TimeOfDay, TimeZone) -> Encoding
B.timetz_float

{-# INLINE timestamp_int #-}
timestamp_int :: LocalTime -> Encoding
timestamp_int :: LocalTime -> Encoding
timestamp_int =
  LocalTime -> Encoding
B.timestamp_int

{-# INLINE timestamp_float #-}
timestamp_float :: LocalTime -> Encoding
timestamp_float :: LocalTime -> Encoding
timestamp_float =
  LocalTime -> Encoding
B.timestamp_float

{-# INLINE timestamptz_int #-}
timestamptz_int :: UTCTime -> Encoding
timestamptz_int :: UTCTime -> Encoding
timestamptz_int =
  UTCTime -> Encoding
B.timestamptz_int

{-# INLINE timestamptz_float #-}
timestamptz_float :: UTCTime -> Encoding
timestamptz_float :: UTCTime -> Encoding
timestamptz_float =
  UTCTime -> Encoding
B.timestamptz_float

{-# INLINE interval_int #-}
interval_int :: DiffTime -> Encoding
interval_int :: DiffTime -> Encoding
interval_int =
  DiffTime -> Encoding
B.interval_int

{-# INLINE interval_float #-}
interval_float :: DiffTime -> Encoding
interval_float :: DiffTime -> Encoding
interval_float =
  DiffTime -> Encoding
B.interval_float

{-# INLINE json_bytes #-}
json_bytes :: ByteString -> Encoding
json_bytes :: ByteString -> Encoding
json_bytes =
  ByteString -> Encoding
B.json_bytes

{-# INLINE json_bytes_lazy #-}
json_bytes_lazy :: N.ByteString -> Encoding
json_bytes_lazy :: ByteString -> Encoding
json_bytes_lazy =
  ByteString -> Encoding
B.json_bytes_lazy

{-# INLINE json_ast #-}
json_ast :: R.Value -> Encoding
json_ast :: Value -> Encoding
json_ast =
  Value -> Encoding
B.json_ast

{-# INLINE jsonb_bytes #-}
jsonb_bytes :: ByteString -> Encoding
jsonb_bytes :: ByteString -> Encoding
jsonb_bytes =
  ByteString -> Encoding
B.jsonb_bytes

{-# INLINE jsonb_bytes_lazy #-}
jsonb_bytes_lazy :: N.ByteString -> Encoding
jsonb_bytes_lazy :: ByteString -> Encoding
jsonb_bytes_lazy =
  ByteString -> Encoding
B.jsonb_bytes_lazy

{-# INLINE jsonb_ast #-}
jsonb_ast :: R.Value -> Encoding
jsonb_ast :: Value -> Encoding
jsonb_ast =
  Value -> Encoding
B.jsonb_ast

-- * Array

-- |
-- Abstraction for encoding into multidimensional array.
data Array
  = Array !Encoding ![Int32] !Bool

encodingArray :: Encoding -> Array
encodingArray :: Encoding -> Array
encodingArray Encoding
value =
  Encoding -> [Int32] -> Bool -> Array
Array (Encoding -> Encoding
B.sized Encoding
value) [] Bool
False

nullArray :: Array
nullArray :: Array
nullArray =
  Encoding -> [Int32] -> Bool -> Array
Array Encoding
B.null4 [] Bool
True

dimensionArray :: (forall b. (b -> a -> b) -> b -> c -> b) -> (a -> Array) -> c -> Array
dimensionArray :: forall a c.
(forall b. (b -> a -> b) -> b -> c -> b)
-> (a -> Array) -> c -> Array
dimensionArray forall b. (b -> a -> b) -> b -> c -> b
foldl' a -> Array
elementArray c
input =
  Encoding -> [Int32] -> Bool -> Array
Array Encoding
builder [Int32]
dimensions Bool
nulls
  where
    dimensions :: [Int32]
dimensions =
      Int32
foldedLength forall a. a -> [a] -> [a]
: [Int32]
foldedDimensions
    (Encoding
builder, [Int32]
foldedDimensions, Int32
foldedLength, Bool
nulls) =
      forall b. (b -> a -> b) -> b -> c -> b
foldl' (Encoding, [Int32], Int32, Bool)
-> a -> (Encoding, [Int32], Int32, Bool)
step forall {a} {c} {a}. (Monoid a, Num c) => (a, [a], c, Bool)
init c
input
      where
        init :: (a, [a], c, Bool)
init =
          (forall a. Monoid a => a
mempty, [], c
0, Bool
False)
        step :: (Encoding, [Int32], Int32, Bool)
-> a -> (Encoding, [Int32], Int32, Bool)
step (!Encoding
builder, [Int32]
_, !Int32
length, !Bool
nulls) a
element =
          (Encoding
builder forall a. Semigroup a => a -> a -> a
<> Encoding
elementBuilder, [Int32]
elementDimensions, forall a. Enum a => a -> a
succ Int32
length, Bool
nulls Bool -> Bool -> Bool
|| Bool
elementNulls)
          where
            Array Encoding
elementBuilder [Int32]
elementDimensions Bool
elementNulls =
              a -> Array
elementArray a
element

-- * Composite

data Composite
  = Composite !Int !Encoding

instance Semigroup Composite where
  Composite Int
lSize Encoding
lFields <> :: Composite -> Composite -> Composite
<> Composite Int
rSize Encoding
rFields =
    Int -> Encoding -> Composite
Composite (Int
lSize forall a. Num a => a -> a -> a
+ Int
rSize) (Encoding
lFields forall a. Semigroup a => a -> a -> a
<> Encoding
rFields)

instance Monoid Composite where
  mempty :: Composite
mempty = Int -> Encoding -> Composite
Composite Int
0 forall a. Monoid a => a
mempty

field :: Word32 -> Encoding -> Composite
field :: Word32 -> Encoding -> Composite
field Word32
oid Encoding
value =
  Int -> Encoding -> Composite
Composite Int
1 (Word32 -> Encoding
B.int4_word32 Word32
oid forall a. Semigroup a => a -> a -> a
<> Encoding -> Encoding
B.sized Encoding
value)

nullField :: Word32 -> Composite
nullField :: Word32 -> Composite
nullField Word32
oid =
  Int -> Encoding -> Composite
Composite Int
1 (Word32 -> Encoding
B.int4_word32 Word32
oid forall a. Semigroup a => a -> a -> a
<> Encoding
B.null4)