module PostgreSQL.Binary.Encoding.Builders
where

import PostgreSQL.Binary.Prelude hiding (bool)
import ByteString.StrictBuilder
import qualified Data.Vector as A
import qualified Data.Scientific as D
import qualified Data.UUID as E
import qualified Data.ByteString.Builder as M
import qualified Data.ByteString.Lazy as N
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.HashMap.Strict as F
import qualified Data.Map.Strict as Q
import qualified Data.Aeson as R
import qualified Network.IP.Addr as G
import qualified PostgreSQL.Binary.Prelude as B
import qualified PostgreSQL.Binary.Numeric as C
import qualified PostgreSQL.Binary.Inet as H
import qualified PostgreSQL.Binary.BuilderPrim as I
import qualified PostgreSQL.Binary.Time as O
import qualified PostgreSQL.Binary.Interval as P


-- * 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) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
payload

{-# INLINE sizedMaybe #-}
sizedMaybe :: (element -> Builder) -> Maybe element -> Builder
sizedMaybe :: (element -> Builder) -> Maybe element -> Builder
sizedMaybe element -> Builder
elementBuilder =
  Builder -> (element -> Builder) -> Maybe element -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
B.maybe Builder
null4 (Builder -> Builder
sized (Builder -> Builder) -> (element -> Builder) -> element -> Builder
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 =
  Builder -> Builder -> Bool -> Builder
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 (Int32 -> Builder) -> (Int -> Int32) -> Int -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Int32
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 (Int32 -> Builder) -> (Float -> Int32) -> Float -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Float -> Int32
forall a b. a -> b
unsafeCoerce

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

{-# INLINABLE numeric #-}
numeric :: Scientific -> Builder
numeric :: Scientific -> Builder
numeric Scientific
x =
  Word16 -> Builder
word16BE (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
componentsAmount) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Word16 -> Builder
word16BE (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pointIndex) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder
signCode Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Word16 -> Builder
word16BE (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
trimmedExponent) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  (Word16 -> Builder) -> [Word16] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Word16 -> Builder
word16BE [Word16]
components
  where
    componentsAmount :: Int
componentsAmount = 
      [Word16] -> Int
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 = 
      Integer -> [Word16]
forall a. Integral a => a -> [Word16]
C.extractComponents Integer
tunedCoefficient
    pointIndex :: Int
pointIndex =
      Int
componentsAmount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
tunedExponent Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    (Integer
tunedCoefficient, Int
tunedExponent) =
      case Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
exponent Int
4 of
        Int
0 -> (Integer
coefficient, Int
exponent)
        Int
x -> (Integer
coefficient Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
x, Int
exponent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
x)
    trimmedExponent :: Int
trimmedExponent =
      if Int
tunedExponent Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then Int
0
        else Int -> Int
forall a. Num a => a -> a
negate Int
tunedExponent
    signCode :: Builder
signCode =
      if Integer
coefficient Integer -> Integer -> Bool
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
int4_word32 Word32
w2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
int4_word32 Word32
w3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
int4_word32 Word32
w4

{-# INLINABLE 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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
w2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
w3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
word8 Word8
w4

{-# INLINABLE 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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w3 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w4 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Word16 -> Builder
int2_word16 Word16
w5 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w6 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w7 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
int2_word16 Word16
w8

{-# INLINABLE inet #-}
inet :: G.NetAddr G.IP -> Builder
inet :: NetAddr IP -> Builder
inet NetAddr IP
i =
  case NetAddr IP -> NetHost (NetAddr IP)
forall n. IsNetAddr n => n -> NetHost n
G.netHost NetAddr IP
i of
    G.IPv4 x -> Builder
inetAddressFamily Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
netLength Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
isCidr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ip4Size Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IP4 -> Builder
ip4 IP4
x
    G.IPv6 x -> Builder
inet6AddressFamily Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
netLength Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
isCidr Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ip6Size Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> IP6 -> Builder
ip6 IP6
x
    where
      netLength :: Builder
netLength =
        Word8 -> Builder
word8 (NetAddr IP -> 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 (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
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 (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
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 (ByteString -> Builder)
-> (Builder -> ByteString) -> Builder -> Builder
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 (Int32 -> Builder) -> (Day -> Int32) -> Day -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> (Day -> Integer) -> Day -> Int32
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

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

{-# INLINABLE time_float #-}
time_float :: TimeOfDay -> Builder
time_float :: TimeOfDay -> Builder
time_float (TimeOfDay Int
h Int
m Pico
s) =
  let
    p :: Integer
p = Pico -> Integer
forall a b. a -> b
unsafeCoerce Pico
s :: Integer
    u :: Integer
u = Integer
p Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` (Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6)
    in Double -> Builder
float8 (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
u Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
60 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
60 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Int -> Double
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 Builder -> Builder -> Builder
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 Builder -> Builder -> Builder
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 (Int -> Builder) -> (TimeZone -> Int) -> TimeZone -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60) (Int -> Int) -> (TimeZone -> Int) -> TimeZone -> Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (TimeZone -> Int) -> TimeZone -> Int
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 (Int64 -> Builder) -> (LocalTime -> Int64) -> LocalTime -> Builder
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 (Double -> Builder)
-> (LocalTime -> Double) -> LocalTime -> Builder
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 (Int64 -> Builder) -> (UTCTime -> Int64) -> UTCTime -> Builder
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 (Double -> Builder) -> (UTCTime -> Double) -> UTCTime -> Builder
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

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

{-# INLINABLE interval_float #-}
interval_float :: DiffTime -> Builder
interval_float :: DiffTime -> Builder
interval_float DiffTime
x =
  Double -> Builder
float8 Double
s Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Int32 -> Builder
int32BE Int32
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Int32 -> Builder
int32BE Int32
m
  where
    P.Interval Int64
u Int32
d Int32
m = 
      Interval -> Maybe Interval -> Interval
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Interval
forall a. HasCallStack => [Char] -> a
error ([Char]
"Too large DiffTime value for an interval " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> DiffTime -> [Char]
forall a. Show a => a -> [Char]
show DiffTime
x)) (Maybe Interval -> Interval) -> Maybe Interval -> Interval
forall a b. (a -> b) -> a -> b
$
      DiffTime -> Maybe Interval
P.fromDiffTime DiffTime
x
    s :: Double
s =
      Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
u Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
10Double -> Integer -> Double
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_ast #-}
json_ast :: R.Value -> Builder
json_ast :: Value -> Builder
json_ast =
  ByteString -> Builder
lazyBytes (ByteString -> Builder)
-> (Value -> ByteString) -> Value -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
R.encode

{-# INLINE jsonb_bytes #-}
jsonb_bytes :: ByteString -> Builder
jsonb_bytes :: ByteString -> Builder
jsonb_bytes =
  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
"\1" (Builder -> Builder)
-> (ByteString -> Builder) -> ByteString -> Builder
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_ast #-}
jsonb_ast :: R.Value -> Builder
jsonb_ast :: Value -> Builder
jsonb_ast =
  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend Builder
"\1" (Builder -> Builder) -> (Value -> Builder) -> Value -> Builder
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 :: 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 =
      [Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector element -> Int
forall a. Vector a -> Int
A.length Vector element
vector)]
    payload :: Builder
payload =
      (element -> Builder) -> Vector element -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Builder -> Builder
sized (Builder -> Builder) -> (element -> Builder) -> element -> Builder
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 :: 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 =
      [Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector (Maybe element) -> Int
forall a. Vector a -> Int
A.length Vector (Maybe element)
vector)]
    payload :: Builder
payload =
      (Maybe element -> Builder) -> Vector (Maybe element) -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((element -> Builder) -> Maybe element -> Builder
forall element. (element -> Builder) -> Maybe element -> Builder
sizedMaybe element -> Builder
elementBuilder) Vector (Maybe element)
vector

{-# INLINABLE 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 ([Int32] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
B.length [Int32]
dimensions) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Builder -> Builder -> Bool -> Builder
forall a. a -> a -> Bool -> a
B.bool Builder
false4 Builder
true4 Bool
nulls Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Word32 -> Builder
int4_word32 Word32
oid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  (Int32 -> Builder) -> [Int32] -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Int32 -> Builder
arrayDimension [Int32]
dimensions Builder -> Builder -> Builder
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 Builder -> Builder -> Builder
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'
@
-}
{-# INLINABLE hStoreUsingFoldl #-}
hStoreUsingFoldl :: (forall a. (a -> (Text, Maybe Text) -> a) -> a -> b -> a) -> b -> Builder
hStoreUsingFoldl :: (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 ((Int, Builder) -> Builder)
-> (b -> (Int, Builder)) -> b -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Int, Builder) -> (Text, Maybe Text) -> (Int, Builder))
-> (Int, Builder) -> b -> (Int, Builder)
forall a. (a -> (Text, Maybe Text) -> a) -> a -> b -> a
foldl (Int, Builder) -> (Text, Maybe Text) -> (Int, Builder)
forall a.
Enum a =>
(a, Builder) -> (Text, Maybe Text) -> (a, Builder)
progress (Int, Builder)
forall a b. (Num a, Monoid b) => (a, b)
enter
  where
    enter :: (a, b)
enter =
      (a
0, b
forall a. Monoid a => a
mempty)
    progress :: (a, Builder) -> (Text, Maybe Text) -> (a, Builder)
progress (!a
count, !Builder
payload) (Text
key, Maybe Text
value) =
      (a -> a
forall a. Enum a => a -> a
succ a
count, Builder
payload Builder -> Builder -> Builder
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 Builder -> Builder -> Builder
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 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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ((Text, Maybe Text) -> Builder) -> b -> Builder
forall a. Monoid a => ((Text, Maybe Text) -> a) -> b -> a
foldMap ((Text -> Maybe Text -> Builder) -> (Text, Maybe Text) -> Builder
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 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Maybe Text -> Builder) -> Builder
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) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder) -> Maybe Text -> Builder
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 (HashMap Text (Maybe Text) -> Int
forall k v. HashMap k v -> Int
F.size HashMap Text (Maybe Text)
input) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  (Builder -> Text -> Maybe Text -> Builder)
-> Builder -> HashMap Text (Maybe Text) -> Builder
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
F.foldlWithKey' (\Builder
payload Text
key Maybe Text
value -> Builder
payload Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Builder
hStoreRow Text
key Maybe Text
value) Builder
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 (Map Text (Maybe Text) -> Int
forall k a. Map k a -> Int
Q.size Map Text (Maybe Text)
input) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  (Builder -> Text -> Maybe Text -> Builder)
-> Builder -> Map Text (Maybe Text) -> Builder
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Q.foldlWithKey' (\Builder
payload Text
key Maybe Text
value -> Builder
payload Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Builder
hStoreRow Text
key Maybe Text
value) Builder
forall a. Monoid a => a
mempty Map Text (Maybe Text)
input