module PostgreSQL.Binary.Encoding
(
  -- * Encoding
  Encoding,
  encodingBytes,

  -- * 
  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_ast,
  jsonb_bytes,
  jsonb_ast,

  -- * Array
  Array,
  encodingArray,
  nullArray,
  dimensionArray,
)
where

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


type Encoding =
  C.Builder

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


-- * Values
-------------------------

{-|
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 :: Word32
-> (element -> Maybe Encoding) -> foldable element -> Encoding
array_foldable Word32
oid element -> Maybe Encoding
elementBuilder =
  Word32 -> Array -> Encoding
array Word32
oid (Array -> Encoding)
-> (foldable element -> Array) -> foldable element -> Encoding
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall b. (b -> element -> b) -> b -> foldable element -> b)
-> (element -> Array) -> foldable element -> Array
forall a c.
(forall b. (b -> a -> b) -> b -> c -> b)
-> (a -> Array) -> c -> Array
dimensionArray forall b. (b -> element -> b) -> b -> foldable element -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Array -> (Encoding -> Array) -> Maybe Encoding -> Array
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Array
nullArray Encoding -> Array
encodingArray (Maybe Encoding -> Array)
-> (element -> Maybe Encoding) -> element -> Array
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 :: Word32 -> (element -> Encoding) -> Vector element -> Encoding
array_vector Word32
oid element -> Encoding
elementBuilder Vector element
vector =
  Word32 -> (element -> Encoding) -> Vector element -> Encoding
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 :: Word32
-> (element -> Encoding) -> Vector (Maybe element) -> Encoding
nullableArray_vector Word32
oid element -> Encoding
elementBuilder Vector (Maybe element)
vector =
  Word32
-> (element -> Encoding) -> Vector (Maybe element) -> Encoding
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 :: foldable (Text, Maybe Text) -> Encoding
hStore_foldable =
  (forall a.
 (a -> (Text, Maybe Text) -> a)
 -> a -> foldable (Text, Maybe Text) -> a)
-> foldable (Text, Maybe Text) -> Encoding
forall b.
(forall a. (a -> (Text, Maybe Text) -> a) -> a -> b -> a)
-> b -> Encoding
B.hStoreUsingFoldl forall a.
(a -> (Text, Maybe Text) -> a)
-> a -> foldable (Text, Maybe Text) -> a
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_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_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 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 Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: [Int32]
foldedDimensions
    (Encoding
builder, [Int32]
foldedDimensions, Int32
foldedLength, Bool
nulls) =
      ((Encoding, [Int32], Int32, Bool)
 -> a -> (Encoding, [Int32], Int32, Bool))
-> (Encoding, [Int32], Int32, Bool)
-> c
-> (Encoding, [Int32], Int32, Bool)
forall b. (b -> a -> b) -> b -> c -> b
foldl' (Encoding, [Int32], Int32, Bool)
-> a -> (Encoding, [Int32], Int32, Bool)
step (Encoding, [Int32], Int32, Bool)
forall a c a. (Monoid a, Num c) => (a, [a], c, Bool)
init c
input
      where
        init :: (a, [a], c, Bool)
init =
          (a
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
elementBuilder, [Int32]
elementDimensions, Int32 -> Int32
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