module PostgreSQL.Binary.Encoding.Builders where

import ByteString.StrictBuilder
import qualified Data.Aeson as R
import qualified Data.ByteString.Builder as M
import qualified Data.ByteString.Lazy as N
import qualified Data.HashMap.Strict as F
import qualified Data.Map.Strict as Q
import qualified Data.Scientific as D
import qualified Data.Text.Encoding as J
import qualified Data.Text.Lazy as L
import qualified Data.Text.Lazy.Encoding as K
import qualified Data.UUID as E
import qualified Data.Vector as A
import qualified Network.IP.Addr as G
import qualified PostgreSQL.Binary.BuilderPrim as I
import qualified PostgreSQL.Binary.Inet as H
import qualified PostgreSQL.Binary.Interval as P
import qualified PostgreSQL.Binary.Numeric as C
import PostgreSQL.Binary.Prelude hiding (bool)
import qualified PostgreSQL.Binary.Prelude as B
import qualified PostgreSQL.Binary.Time as O

-- * Helpers

{-# NOINLINE null4 #-}
null4 :: Builder
null4 :: Builder
null4 =
  Int -> Builder
int4_int (-Int
1)

{-# INLINE sized #-}
sized :: Builder -> Builder
sized :: Builder -> Builder
sized Builder
payload =
  Int -> Builder
int4_int (Builder -> Int
builderLength Builder
payload)
    forall a. Semigroup a => a -> a -> a
<> Builder
payload

{-# INLINE sizedMaybe #-}
sizedMaybe :: (element -> Builder) -> Maybe element -> Builder
sizedMaybe :: forall element. (element -> Builder) -> Maybe element -> Builder
sizedMaybe element -> Builder
elementBuilder =
  forall b a. b -> (a -> b) -> Maybe a -> b
B.maybe Builder
null4 (Builder -> Builder
sized forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. element -> Builder
elementBuilder)

{-# NOINLINE true1 #-}
true1 :: Builder
true1 :: Builder
true1 =
  Word8 -> Builder
word8 Word8
1

{-# NOINLINE false1 #-}
false1 :: Builder
false1 :: Builder
false1 =
  Word8 -> Builder
word8 Word8
0

{-# NOINLINE true4 #-}
true4 :: Builder
true4 :: Builder
true4 =
  Word32 -> Builder
int4_word32 Word32
1

{-# NOINLINE false4 #-}
false4 :: Builder
false4 :: Builder
false4 =
  Word32 -> Builder
int4_word32 Word32
0

-- * Primitives

{-# INLINE bool #-}
bool :: Bool -> Builder
bool :: Bool -> Builder
bool =
  forall a. a -> a -> Bool -> a
B.bool Builder
false1 Builder
true1

{-# INLINE int2_int16 #-}
int2_int16 :: Int16 -> Builder
int2_int16 :: Int16 -> Builder
int2_int16 =
  Int16 -> Builder
int16BE

{-# INLINE int2_word16 #-}
int2_word16 :: Word16 -> Builder
int2_word16 :: Word16 -> Builder
int2_word16 =
  Word16 -> Builder
word16BE

{-# INLINE int4_int32 #-}
int4_int32 :: Int32 -> Builder
int4_int32 :: Int32 -> Builder
int4_int32 =
  Int32 -> Builder
int32BE

{-# INLINE int4_word32 #-}
int4_word32 :: Word32 -> Builder
int4_word32 :: Word32 -> Builder
int4_word32 =
  Word32 -> Builder
word32BE

{-# INLINE int4_int #-}
int4_int :: Int -> Builder
int4_int :: Int -> Builder
int4_int =
  Int32 -> Builder
int4_int32 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE int8_int64 #-}
int8_int64 :: Int64 -> Builder
int8_int64 :: Int64 -> Builder
int8_int64 =
  Int64 -> Builder
int64BE

{-# INLINE int8_word64 #-}
int8_word64 :: Word64 -> Builder
int8_word64 :: Word64 -> Builder
int8_word64 =
  Word64 -> Builder
word64BE

{-# INLINE float4 #-}
float4 :: Float -> Builder
float4 :: Float -> Builder
float4 =
  Int32 -> Builder
int4_int32 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b
unsafeCoerce

{-# INLINE float8 #-}
float8 :: Double -> Builder
float8 :: Double -> Builder
float8 =
  Int64 -> Builder
int8_int64 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. a -> b
unsafeCoerce

{-# INLINEABLE numeric #-}
numeric :: Scientific -> Builder
numeric :: Scientific -> Builder
numeric Scientific
x =
  Word16 -> Builder
word16BE (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
componentsAmount)
    forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
word16BE (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pointIndex)
    forall a. Semigroup a => a -> a -> a
<> Builder
signCode
    forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
word16BE (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
trimmedExponent)
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word16 -> Builder
word16BE [Word16]
components
  where
    componentsAmount :: Int
componentsAmount =
      forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word16]
components
    coefficient :: Integer
coefficient =
      Scientific -> Integer
D.coefficient Scientific
x
    exponent :: Int
exponent =
      Scientific -> Int
D.base10Exponent Scientific
x
    components :: [Word16]
components =
      forall a. Integral a => a -> [Word16]
C.extractComponents Integer
tunedCoefficient
    pointIndex :: Int
pointIndex =
      Int
componentsAmount forall a. Num a => a -> a -> a
+ (Int
tunedExponent forall a. Integral a => a -> a -> a
`div` Int
4) forall a. Num a => a -> a -> a
- Int
1
    (Integer
tunedCoefficient, Int
tunedExponent) =
      case forall a. Integral a => a -> a -> a
mod Int
exponent Int
4 of
        Int
0 -> (Integer
coefficient, Int
exponent)
        Int
x -> (Integer
coefficient forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
x, Int
exponent forall a. Num a => a -> a -> a
- Int
x)
    trimmedExponent :: Int
trimmedExponent =
      if Int
tunedExponent forall a. Ord a => a -> a -> Bool
>= Int
0
        then Int
0
        else forall a. Num a => a -> a
negate Int
tunedExponent
    signCode :: Builder
signCode =
      if Integer
coefficient forall a. Ord a => a -> a -> Bool
< Integer
0
        then Builder
numericNegSignCode
        else Builder
numericPosSignCode

{-# NOINLINE numericNegSignCode #-}
numericNegSignCode :: Builder
numericNegSignCode :: Builder
numericNegSignCode =
  Word16 -> Builder
int2_word16 Word16
C.negSignCode

{-# NOINLINE numericPosSignCode #-}
numericPosSignCode :: Builder
numericPosSignCode :: Builder
numericPosSignCode =
  Word16 -> Builder
int2_word16 Word16
C.posSignCode

{-# INLINE uuid #-}
uuid :: UUID -> Builder
uuid :: UUID -> Builder
uuid UUID
uuid =
  case UUID -> (Word32, Word32, Word32, Word32)
E.toWords UUID
uuid of
    (Word32
w1, Word32
w2, Word32
w3, Word32
w4) -> Word32 -> Builder
int4_word32 Word32
w1 forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
int4_word32 Word32
w2 forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
int4_word32 Word32
w3 forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
int4_word32 Word32
w4

{-# INLINEABLE ip4 #-}
ip4 :: G.IP4 -> Builder
ip4 :: IP4 -> Builder
ip4 IP4
x =
  case IP4 -> (Word8, Word8, Word8, Word8)
G.ip4ToOctets IP4
x of
    (Word8
w1, Word8
w2, Word8
w3, Word8
w4) -> Word8 -> Builder
word8 Word8
w1 forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
w2 forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
w3 forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
w4

{-# INLINEABLE ip6 #-}
ip6 :: G.IP6 -> Builder
ip6 :: IP6 -> Builder
ip6 IP6
x =
  case IP6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
G.ip6ToWords IP6
x of
    (Word16
w1, Word16
w2, Word16
w3, Word16
w4, Word16
w5, Word16
w6, Word16
w7, Word16
w8) ->
      Word16 -> Builder
int2_word16 Word16
w1 forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w2 forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w3 forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w4
        forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w5
        forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w6
        forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w7
        forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w8

{-# INLINEABLE inet #-}
inet :: G.NetAddr G.IP -> Builder
inet :: NetAddr IP -> Builder
inet NetAddr IP
i =
  case forall n. IsNetAddr n => n -> NetHost n
G.netHost NetAddr IP
i of
    G.IPv4 IP4
x -> Builder
inetAddressFamily forall a. Semigroup a => a -> a -> a
<> Builder
netLength forall a. Semigroup a => a -> a -> a
<> Builder
isCidr forall a. Semigroup a => a -> a -> a
<> Builder
ip4Size forall a. Semigroup a => a -> a -> a
<> IP4 -> Builder
ip4 IP4
x
    G.IPv6 IP6
x -> Builder
inet6AddressFamily forall a. Semigroup a => a -> a -> a
<> Builder
netLength forall a. Semigroup a => a -> a -> a
<> Builder
isCidr forall a. Semigroup a => a -> a -> a
<> Builder
ip6Size forall a. Semigroup a => a -> a -> a
<> IP6 -> Builder
ip6 IP6
x
  where
    netLength :: Builder
netLength =
      Word8 -> Builder
word8 (forall n. IsNetAddr n => n -> Word8
G.netLength NetAddr IP
i)
    isCidr :: Builder
isCidr =
      Builder
false1

{-# NOINLINE inetAddressFamily #-}
inetAddressFamily :: Builder
inetAddressFamily :: Builder
inetAddressFamily =
  Word8 -> Builder
word8 Word8
H.inetAddressFamily

{-# NOINLINE inet6AddressFamily #-}
inet6AddressFamily :: Builder
inet6AddressFamily :: Builder
inet6AddressFamily =
  Word8 -> Builder
word8 Word8
H.inet6AddressFamily

{-# NOINLINE ip4Size #-}
ip4Size :: Builder
ip4Size :: Builder
ip4Size =
  Word8 -> Builder
word8 Word8
4

{-# NOINLINE ip6Size #-}
ip6Size :: Builder
ip6Size :: Builder
ip6Size =
  Word8 -> Builder
word8 Word8
16

-- * Text

-- |
-- A UTF-8-encoded char.
--
-- Note that since it's UTF-8-encoded
-- not the \"char\" but the \"text\" OID should be used with it.
{-# INLINE char_utf8 #-}
char_utf8 :: Char -> Builder
char_utf8 :: Char -> Builder
char_utf8 =
  Char -> Builder
utf8Char

{-# INLINE text_strict #-}
text_strict :: Text -> Builder
text_strict :: Text -> Builder
text_strict =
  Builder -> Builder
bytea_lazyBuilder forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BoundedPrim Word8 -> Text -> Builder
J.encodeUtf8BuilderEscaped BoundedPrim Word8
I.nullByteIgnoringBoundedPrim

{-# INLINE text_lazy #-}
text_lazy :: L.Text -> Builder
text_lazy :: Text -> Builder
text_lazy =
  Builder -> Builder
bytea_lazyBuilder forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BoundedPrim Word8 -> Text -> Builder
K.encodeUtf8BuilderEscaped BoundedPrim Word8
I.nullByteIgnoringBoundedPrim

{-# INLINE bytea_strict #-}
bytea_strict :: ByteString -> Builder
bytea_strict :: ByteString -> Builder
bytea_strict =
  ByteString -> Builder
bytes

{-# INLINE bytea_lazy #-}
bytea_lazy :: N.ByteString -> Builder
bytea_lazy :: ByteString -> Builder
bytea_lazy =
  ByteString -> Builder
lazyBytes

{-# INLINE bytea_lazyBuilder #-}
bytea_lazyBuilder :: M.Builder -> Builder
bytea_lazyBuilder :: Builder -> Builder
bytea_lazyBuilder =
  ByteString -> Builder
lazyBytes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> ByteString
M.toLazyByteString

-- * Time

{-# INLINE date #-}
date :: Day -> Builder
date :: Day -> Builder
date =
  Int32 -> Builder
int4_int32 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Day -> Integer
O.dayToPostgresJulian

{-# INLINEABLE time_int #-}
time_int :: TimeOfDay -> Builder
time_int :: TimeOfDay -> Builder
time_int (TimeOfDay Int
h Int
m Pico
s) =
  let p :: Integer
p = forall a b. a -> b
unsafeCoerce Pico
s :: Integer
      u :: Integer
u = Integer
p forall a. Integral a => a -> a -> a
`div` (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6)
   in Int64 -> Builder
int8_int64 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
u forall a. Num a => a -> a -> a
+ Int64
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 forall a. Num a => a -> a -> a
* Int64
60 forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Num a => a -> a -> a
+ Int64
60 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h))

{-# INLINEABLE time_float #-}
time_float :: TimeOfDay -> Builder
time_float :: TimeOfDay -> Builder
time_float (TimeOfDay Int
h Int
m Pico
s) =
  let p :: Integer
p = forall a b. a -> b
unsafeCoerce Pico
s :: Integer
      u :: Integer
u = Integer
p forall a. Integral a => a -> a -> a
`div` (Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6)
   in Double -> Builder
float8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
u forall a. Fractional a => a -> a -> a
/ Double
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6 forall a. Num a => a -> a -> a
+ Double
60 forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Num a => a -> a -> a
+ Double
60 forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)))

{-# INLINE timetz_int #-}
timetz_int :: (TimeOfDay, TimeZone) -> Builder
timetz_int :: (TimeOfDay, TimeZone) -> Builder
timetz_int (TimeOfDay
timeX, TimeZone
tzX) =
  TimeOfDay -> Builder
time_int TimeOfDay
timeX forall a. Semigroup a => a -> a -> a
<> TimeZone -> Builder
tz TimeZone
tzX

{-# INLINE timetz_float #-}
timetz_float :: (TimeOfDay, TimeZone) -> Builder
timetz_float :: (TimeOfDay, TimeZone) -> Builder
timetz_float (TimeOfDay
timeX, TimeZone
tzX) =
  TimeOfDay -> Builder
time_float TimeOfDay
timeX forall a. Semigroup a => a -> a -> a
<> TimeZone -> Builder
tz TimeZone
tzX

{-# INLINE tz #-}
tz :: TimeZone -> Builder
tz :: TimeZone -> Builder
tz =
  Int -> Builder
int4_int forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall a. Num a => a -> a -> a
* Int
60) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => a -> a
negate forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TimeZone -> Int
timeZoneMinutes

{-# INLINE timestamp_int #-}
timestamp_int :: LocalTime -> Builder
timestamp_int :: LocalTime -> Builder
timestamp_int =
  Int64 -> Builder
int8_int64 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LocalTime -> Int64
O.localTimeToMicros

{-# INLINE timestamp_float #-}
timestamp_float :: LocalTime -> Builder
timestamp_float :: LocalTime -> Builder
timestamp_float =
  Double -> Builder
float8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LocalTime -> Double
O.localTimeToSecs

{-# INLINE timestamptz_int #-}
timestamptz_int :: UTCTime -> Builder
timestamptz_int :: UTCTime -> Builder
timestamptz_int =
  Int64 -> Builder
int8_int64 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTCTime -> Int64
O.utcToMicros

{-# INLINE timestamptz_float #-}
timestamptz_float :: UTCTime -> Builder
timestamptz_float :: UTCTime -> Builder
timestamptz_float =
  Double -> Builder
float8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTCTime -> Double
O.utcToSecs

{-# INLINEABLE interval_int #-}
interval_int :: DiffTime -> Builder
interval_int :: DiffTime -> Builder
interval_int DiffTime
x =
  Int64 -> Builder
int64BE Int64
u
    forall a. Semigroup a => a -> a -> a
<> Int32 -> Builder
int32BE Int32
d
    forall a. Semigroup a => a -> a -> a
<> Int32 -> Builder
int32BE Int32
m
  where
    P.Interval Int64
u Int32
d Int32
m =
      forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error ([Char]
"Too large DiffTime value for an interval " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show DiffTime
x)) forall a b. (a -> b) -> a -> b
$
        DiffTime -> Maybe Interval
P.fromDiffTime DiffTime
x

{-# INLINEABLE interval_float #-}
interval_float :: DiffTime -> Builder
interval_float :: DiffTime -> Builder
interval_float DiffTime
x =
  Double -> Builder
float8 Double
s
    forall a. Semigroup a => a -> a -> a
<> Int32 -> Builder
int32BE Int32
d
    forall a. Semigroup a => a -> a -> a
<> Int32 -> Builder
int32BE Int32
m
  where
    P.Interval Int64
u Int32
d Int32
m =
      forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error ([Char]
"Too large DiffTime value for an interval " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show DiffTime
x)) forall a b. (a -> b) -> a -> b
$
        DiffTime -> Maybe Interval
P.fromDiffTime DiffTime
x
    s :: Double
s =
      forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
u forall a. Fractional a => a -> a -> a
/ (Double
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
6)

-- * JSON

{-# INLINE json_bytes #-}
json_bytes :: ByteString -> Builder
json_bytes :: ByteString -> Builder
json_bytes =
  ByteString -> Builder
bytes

{-# INLINE json_bytes_lazy #-}
json_bytes_lazy :: N.ByteString -> Builder
json_bytes_lazy :: ByteString -> Builder
json_bytes_lazy =
  ByteString -> Builder
lazyBytes

{-# INLINE json_ast #-}
json_ast :: R.Value -> Builder
json_ast :: Value -> Builder
json_ast =
  ByteString -> Builder
lazyBytes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ToJSON a => a -> ByteString
R.encode

{-# INLINE jsonb_bytes #-}
jsonb_bytes :: ByteString -> Builder
jsonb_bytes :: ByteString -> Builder
jsonb_bytes =
  forall a. Monoid a => a -> a -> a
mappend Builder
"\1" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Builder
bytes

{-# INLINE jsonb_bytes_lazy #-}
jsonb_bytes_lazy :: N.ByteString -> Builder
jsonb_bytes_lazy :: ByteString -> Builder
jsonb_bytes_lazy =
  forall a. Monoid a => a -> a -> a
mappend Builder
"\1" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Builder
lazyBytes

{-# INLINE jsonb_ast #-}
jsonb_ast :: R.Value -> Builder
jsonb_ast :: Value -> Builder
jsonb_ast =
  forall a. Monoid a => a -> a -> a
mappend Builder
"\1" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Value -> Builder
json_ast

-- * Array

{-# INLINE array_vector #-}
array_vector :: Word32 -> (element -> Builder) -> Vector element -> Builder
array_vector :: forall element.
Word32 -> (element -> Builder) -> Vector element -> Builder
array_vector Word32
oid element -> Builder
elementBuilder Vector element
vector =
  Word32 -> [Int32] -> Bool -> Builder -> Builder
array Word32
oid [Int32]
dimensions Bool
False Builder
payload
  where
    dimensions :: [Int32]
dimensions =
      [forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
A.length Vector element
vector)]
    payload :: Builder
payload =
      forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Builder -> Builder
sized forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. element -> Builder
elementBuilder) Vector element
vector

{-# INLINE nullableArray_vector #-}
nullableArray_vector :: Word32 -> (element -> Builder) -> Vector (Maybe element) -> Builder
nullableArray_vector :: forall element.
Word32 -> (element -> Builder) -> Vector (Maybe element) -> Builder
nullableArray_vector Word32
oid element -> Builder
elementBuilder Vector (Maybe element)
vector =
  Word32 -> [Int32] -> Bool -> Builder -> Builder
array Word32
oid [Int32]
dimensions Bool
True Builder
payload
  where
    dimensions :: [Int32]
dimensions =
      [forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Vector a -> Int
A.length Vector (Maybe element)
vector)]
    payload :: Builder
payload =
      forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall element. (element -> Builder) -> Maybe element -> Builder
sizedMaybe element -> Builder
elementBuilder) Vector (Maybe element)
vector

{-# INLINEABLE array #-}
array :: Word32 -> [Int32] -> Bool -> Builder -> Builder
array :: Word32 -> [Int32] -> Bool -> Builder -> Builder
array Word32
oid [Int32]
dimensions Bool
nulls Builder
payload =
  Int -> Builder
int4_int (forall (t :: * -> *) a. Foldable t => t a -> Int
B.length [Int32]
dimensions)
    forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
B.bool Builder
false4 Builder
true4 Bool
nulls
    forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
int4_word32 Word32
oid
    forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Int32 -> Builder
arrayDimension [Int32]
dimensions
    forall a. Semigroup a => a -> a -> a
<> Builder
payload

{-# INLINE arrayDimension #-}
arrayDimension :: Int32 -> Builder
arrayDimension :: Int32 -> Builder
arrayDimension Int32
dimension =
  Int32 -> Builder
int4_int32 Int32
dimension forall a. Semigroup a => a -> a -> a
<> Builder
true4

-- * HStore

-- |
-- A polymorphic in-place @HSTORE@ encoder.
--
-- Accepts:
--
-- * An implementation of the @foldl@ function
-- (e.g., @Data.Foldable.'foldl''@),
-- which determines the input value.
--
-- Here's how you can use it to produce a specific encoder:
--
-- @
-- hashMapHStore :: Data.HashMap.Strict.HashMap Text (Maybe Text) -> Builder
-- hashMapHStore =
--   hStoreUsingFoldl foldl'
-- @
{-# INLINEABLE hStoreUsingFoldl #-}
hStoreUsingFoldl :: (forall a. (a -> (Text, Maybe Text) -> a) -> a -> b -> a) -> b -> Builder
hStoreUsingFoldl :: forall b.
(forall a. (a -> (Text, Maybe Text) -> a) -> a -> b -> a)
-> b -> Builder
hStoreUsingFoldl forall a. (a -> (Text, Maybe Text) -> a) -> a -> b -> a
foldl =
  (Int, Builder) -> Builder
exit 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 -> (Text, Maybe Text) -> a) -> a -> b -> a
foldl forall {a}.
Enum a =>
(a, Builder) -> (Text, Maybe Text) -> (a, Builder)
progress forall {a} {b}. (Num a, Monoid b) => (a, b)
enter
  where
    enter :: (a, b)
enter =
      (a
0, forall a. Monoid a => a
mempty)
    progress :: (a, Builder) -> (Text, Maybe Text) -> (a, Builder)
progress (!a
count, !Builder
payload) (Text
key, Maybe Text
value) =
      (forall a. Enum a => a -> a
succ a
count, Builder
payload forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Builder
hStoreRow Text
key Maybe Text
value)
    exit :: (Int, Builder) -> Builder
exit (Int
count, Builder
payload) =
      Int -> Builder
int4_int Int
count forall a. Semigroup a => a -> a -> a
<> Builder
payload

{-# INLINE hStoreUsingFoldMapAndSize #-}
hStoreUsingFoldMapAndSize :: (forall a. Monoid a => ((Text, Maybe Text) -> a) -> b -> a) -> Int -> b -> Builder
hStoreUsingFoldMapAndSize :: forall b.
(forall a. Monoid a => ((Text, Maybe Text) -> a) -> b -> a)
-> Int -> b -> Builder
hStoreUsingFoldMapAndSize forall a. Monoid a => ((Text, Maybe Text) -> a) -> b -> a
foldMap Int
size b
input =
  Int -> Builder
int4_int Int
size forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => ((Text, Maybe Text) -> a) -> b -> a
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Maybe Text -> Builder
hStoreRow) b
input

{-# INLINE hStoreFromFoldMapAndSize #-}
hStoreFromFoldMapAndSize :: (forall a. Monoid a => (Text -> Maybe Text -> a) -> a) -> Int -> Builder
hStoreFromFoldMapAndSize :: (forall a. Monoid a => (Text -> Maybe Text -> a) -> a)
-> Int -> Builder
hStoreFromFoldMapAndSize forall a. Monoid a => (Text -> Maybe Text -> a) -> a
foldMap Int
size =
  Int -> Builder
int4_int Int
size forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => (Text -> Maybe Text -> a) -> a
foldMap Text -> Maybe Text -> Builder
hStoreRow

{-# INLINE hStoreRow #-}
hStoreRow :: Text -> Maybe Text -> Builder
hStoreRow :: Text -> Maybe Text -> Builder
hStoreRow Text
key Maybe Text
value =
  Builder -> Builder
sized (Text -> Builder
text_strict Text
key) forall a. Semigroup a => a -> a -> a
<> forall element. (element -> Builder) -> Maybe element -> Builder
sizedMaybe Text -> Builder
text_strict Maybe Text
value

{-# INLINE hStore_hashMap #-}
hStore_hashMap :: HashMap Text (Maybe Text) -> Builder
hStore_hashMap :: HashMap Text (Maybe Text) -> Builder
hStore_hashMap HashMap Text (Maybe Text)
input =
  Int -> Builder
int4_int (forall k v. HashMap k v -> Int
F.size HashMap Text (Maybe Text)
input)
    forall a. Semigroup a => a -> a -> a
<> forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
F.foldlWithKey' (\Builder
payload Text
key Maybe Text
value -> Builder
payload forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Builder
hStoreRow Text
key Maybe Text
value) forall a. Monoid a => a
mempty HashMap Text (Maybe Text)
input

{-# INLINE hStore_map #-}
hStore_map :: Map Text (Maybe Text) -> Builder
hStore_map :: Map Text (Maybe Text) -> Builder
hStore_map Map Text (Maybe Text)
input =
  Int -> Builder
int4_int (forall k a. Map k a -> Int
Q.size Map Text (Maybe Text)
input)
    forall a. Semigroup a => a -> a -> a
<> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Q.foldlWithKey' (\Builder
payload Text
key Maybe Text
value -> Builder
payload forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Builder
hStoreRow Text
key Maybe Text
value) forall a. Monoid a => a
mempty Map Text (Maybe Text)
input