module Hasql.Codecs.Encoders.Composite where

import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as HashSet
import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot
import Hasql.Codecs.Encoders.Value qualified as Value
import Hasql.Codecs.Vocab qualified as Vocab
import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName
import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo
import Hasql.Platform.Prelude hiding (bool)
import PostgreSQL.Binary.Encoding qualified as Binary
import TextBuilder qualified

-- |
-- Composite or row-types encoder.
data Composite a
  = Composite
      -- | Names of types that are not known statically and must be looked up at runtime collected from the nested composite and array encoders.
      (HashSet Vocab.QualifiedTypeName)
      -- | Serialization function given the dictionary of resolved OIDs.
      (HashMap Vocab.QualifiedTypeName Vocab.TypeInfo -> a -> Binary.Composite)
      -- | Render function for error messages.
      (a -> [TextBuilder.TextBuilder])

instance Contravariant Composite where
  contramap :: forall a' a. (a' -> a) -> Composite a -> Composite a'
contramap a' -> a
f (Composite HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a -> Composite
encode a -> [TextBuilder]
print) =
    HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a' -> Composite)
-> (a' -> [TextBuilder])
-> Composite a'
forall a.
HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
Composite HashSet QualifiedTypeName
unknownTypes (\HashMap QualifiedTypeName TypeInfo
oidCache -> HashMap QualifiedTypeName TypeInfo -> a -> Composite
encode HashMap QualifiedTypeName TypeInfo
oidCache (a -> Composite) -> (a' -> a) -> a' -> 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 -> [TextBuilder]
print (a -> [TextBuilder]) -> (a' -> a) -> a' -> [TextBuilder]
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 HashSet QualifiedTypeName
unknownTypesL HashMap QualifiedTypeName TypeInfo -> b -> Composite
encodeL b -> [TextBuilder]
printL) (Composite HashSet QualifiedTypeName
unknownTypesR HashMap QualifiedTypeName TypeInfo -> c -> Composite
encodeR c -> [TextBuilder]
printR) =
    HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
forall a.
HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
Composite
      (HashSet QualifiedTypeName
unknownTypesL HashSet QualifiedTypeName
-> HashSet QualifiedTypeName -> HashSet QualifiedTypeName
forall a. Semigroup a => a -> a -> a
<> HashSet QualifiedTypeName
unknownTypesR)
      (\HashMap QualifiedTypeName TypeInfo
oidCache a
val -> case a -> (b, c)
f a
val of (b
lVal, c
rVal) -> HashMap QualifiedTypeName TypeInfo -> b -> Composite
encodeL HashMap QualifiedTypeName TypeInfo
oidCache b
lVal Composite -> Composite -> Composite
forall a. Semigroup a => a -> a -> a
<> HashMap QualifiedTypeName TypeInfo -> c -> Composite
encodeR HashMap QualifiedTypeName TypeInfo
oidCache c
rVal)
      (\a
val -> case a -> (b, c)
f a
val of (b
lVal, c
rVal) -> b -> [TextBuilder]
printL b
lVal [TextBuilder] -> [TextBuilder] -> [TextBuilder]
forall a. Semigroup a => a -> a -> a
<> c -> [TextBuilder]
printR c
rVal)
  conquer :: forall a. Composite a
conquer = Composite a
forall a. Monoid a => a
mempty

instance Semigroup (Composite a) where
  Composite HashSet QualifiedTypeName
unknownTypesL HashMap QualifiedTypeName TypeInfo -> a -> Composite
encodeL a -> [TextBuilder]
printL <> :: Composite a -> Composite a -> Composite a
<> Composite HashSet QualifiedTypeName
unknownTypesR HashMap QualifiedTypeName TypeInfo -> a -> Composite
encodeR a -> [TextBuilder]
printR =
    HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
forall a.
HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
Composite
      (HashSet QualifiedTypeName
unknownTypesL HashSet QualifiedTypeName
-> HashSet QualifiedTypeName -> HashSet QualifiedTypeName
forall a. Semigroup a => a -> a -> a
<> HashSet QualifiedTypeName
unknownTypesR)
      (\HashMap QualifiedTypeName TypeInfo
oidCache a
val -> HashMap QualifiedTypeName TypeInfo -> a -> Composite
encodeL HashMap QualifiedTypeName TypeInfo
oidCache a
val Composite -> Composite -> Composite
forall a. Semigroup a => a -> a -> a
<> HashMap QualifiedTypeName TypeInfo -> a -> Composite
encodeR HashMap QualifiedTypeName TypeInfo
oidCache a
val)
      (\a
val -> a -> [TextBuilder]
printL a
val [TextBuilder] -> [TextBuilder] -> [TextBuilder]
forall a. Semigroup a => a -> a -> a
<> a -> [TextBuilder]
printR a
val)

instance Monoid (Composite a) where
  mempty :: Composite a
mempty = HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
forall a.
HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
Composite HashSet QualifiedTypeName
forall a. Monoid a => a
mempty HashMap QualifiedTypeName TypeInfo -> a -> Composite
forall a. Monoid a => a
mempty a -> [TextBuilder]
forall a. Monoid a => a
mempty

-- | Single field of a row-type.
field :: NullableOrNot.NullableOrNot Value.Value a -> Composite a
field :: forall a. NullableOrNot Value a -> Composite a
field = \case
  NullableOrNot.NonNullable (Value.Value Maybe Text
schemaName Text
typeName Maybe Word32
scalarOid Maybe Word32
arrayOid Word
dimensionality Bool
_ HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a -> Encoding
encode a -> TextBuilder
print) ->
    let staticOid :: Maybe Word32
staticOid = if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Maybe Word32
scalarOid else Maybe Word32
arrayOid
     in case Maybe Word32
staticOid of
          Just Word32
oid ->
            HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
forall a.
HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
Composite
              HashSet QualifiedTypeName
unknownTypes
              (\HashMap QualifiedTypeName TypeInfo
oidCache a
val -> Word32 -> Encoding -> Composite
Binary.field Word32
oid (HashMap QualifiedTypeName TypeInfo -> a -> Encoding
encode HashMap QualifiedTypeName TypeInfo
oidCache a
val))
              (\a
val -> [a -> TextBuilder
print a
val])
          Maybe Word32
Nothing ->
            HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
forall a.
HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
Composite
              (QualifiedTypeName
-> HashSet QualifiedTypeName -> HashSet QualifiedTypeName
forall a. Hashable a => a -> HashSet a -> HashSet a
HashSet.insert (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName) HashSet QualifiedTypeName
unknownTypes)
              ( \HashMap QualifiedTypeName TypeInfo
oidCache a
val ->
                  let typeInfo :: Maybe TypeInfo
typeInfo = QualifiedTypeName
-> HashMap QualifiedTypeName TypeInfo -> Maybe TypeInfo
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName) HashMap QualifiedTypeName TypeInfo
oidCache
                      oid :: Word32
oid = if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Word32 -> (TypeInfo -> Word32) -> Maybe TypeInfo -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 TypeInfo -> Word32
Vocab.TypeInfo.toBaseOid Maybe TypeInfo
typeInfo else Word32 -> (TypeInfo -> Word32) -> Maybe TypeInfo -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 TypeInfo -> Word32
Vocab.TypeInfo.toArrayOid Maybe TypeInfo
typeInfo
                   in Word32 -> Encoding -> Composite
Binary.field Word32
oid (HashMap QualifiedTypeName TypeInfo -> a -> Encoding
encode HashMap QualifiedTypeName TypeInfo
oidCache a
val)
              )
              (\a
val -> [a -> TextBuilder
print a
val])
  NullableOrNot.Nullable (Value.Value Maybe Text
schemaName Text
typeName Maybe Word32
scalarOid Maybe Word32
arrayOid Word
dimensionality Bool
_ HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a1 -> Encoding
encode a1 -> TextBuilder
print) ->
    let staticOid :: Maybe Word32
staticOid = if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Maybe Word32
scalarOid else Maybe Word32
arrayOid
     in case Maybe Word32
staticOid of
          Just Word32
oid ->
            HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
forall a.
HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
Composite
              HashSet QualifiedTypeName
unknownTypes
              ( \HashMap QualifiedTypeName TypeInfo
oidCache -> \case
                  a
Maybe a1
Nothing -> Word32 -> Composite
Binary.nullField Word32
oid
                  Just a1
val -> Word32 -> Encoding -> Composite
Binary.field Word32
oid (HashMap QualifiedTypeName TypeInfo -> a1 -> Encoding
encode HashMap QualifiedTypeName TypeInfo
oidCache a1
val)
              )
              ( \case
                  a
Maybe a1
Nothing -> [TextBuilder
"NULL"]
                  Just a1
val -> [a1 -> TextBuilder
print a1
val]
              )
          Maybe Word32
Nothing ->
            HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
forall a.
HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Composite)
-> (a -> [TextBuilder])
-> Composite a
Composite
              (QualifiedTypeName
-> HashSet QualifiedTypeName -> HashSet QualifiedTypeName
forall a. Hashable a => a -> HashSet a -> HashSet a
HashSet.insert (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName) HashSet QualifiedTypeName
unknownTypes)
              ( \HashMap QualifiedTypeName TypeInfo
oidCache -> \case
                  a
Maybe a1
Nothing ->
                    let typeInfo :: Maybe TypeInfo
typeInfo = QualifiedTypeName
-> HashMap QualifiedTypeName TypeInfo -> Maybe TypeInfo
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName) HashMap QualifiedTypeName TypeInfo
oidCache
                        oid :: Word32
oid = if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Word32 -> (TypeInfo -> Word32) -> Maybe TypeInfo -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 TypeInfo -> Word32
Vocab.TypeInfo.toBaseOid Maybe TypeInfo
typeInfo else Word32 -> (TypeInfo -> Word32) -> Maybe TypeInfo -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 TypeInfo -> Word32
Vocab.TypeInfo.toArrayOid Maybe TypeInfo
typeInfo
                     in Word32 -> Composite
Binary.nullField Word32
oid
                  Just a1
val ->
                    let typeInfo :: Maybe TypeInfo
typeInfo = QualifiedTypeName
-> HashMap QualifiedTypeName TypeInfo -> Maybe TypeInfo
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HashMap.lookup (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName) HashMap QualifiedTypeName TypeInfo
oidCache
                        oid :: Word32
oid = if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Word32 -> (TypeInfo -> Word32) -> Maybe TypeInfo -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 TypeInfo -> Word32
Vocab.TypeInfo.toBaseOid Maybe TypeInfo
typeInfo else Word32 -> (TypeInfo -> Word32) -> Maybe TypeInfo -> Word32
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word32
0 TypeInfo -> Word32
Vocab.TypeInfo.toArrayOid Maybe TypeInfo
typeInfo
                     in Word32 -> Encoding -> Composite
Binary.field Word32
oid (HashMap QualifiedTypeName TypeInfo -> a1 -> Encoding
encode HashMap QualifiedTypeName TypeInfo
oidCache a1
val)
              )
              ( \case
                  a
Maybe a1
Nothing -> [TextBuilder
"NULL"]
                  Just a1
val -> [a1 -> TextBuilder
print a1
val]
              )