module Hasql.Codecs.Encoders.Composite where

import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot
import Hasql.Codecs.Encoders.Value qualified as Value
import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName
import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo
import Hasql.Platform.Prelude hiding (bool)
import Hasql.ToBeResolved qualified as ToBeResolved
import PostgreSQL.Binary.Encoding qualified as Binary
import TextBuilder qualified

-- |
-- Composite or row-types encoder.
data Composite a
  = Composite
      -- | Serialization function, deferring the names of types that must be looked up at runtime.
      (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.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 ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
request a -> [TextBuilder]
print) =
    ToBeResolved QualifiedTypeName TypeInfo (a' -> Composite)
-> (a' -> [TextBuilder]) -> Composite a'
forall a.
ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
Composite (((a -> Composite) -> a' -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a' -> Composite)
forall a b.
(a -> b)
-> ToBeResolved QualifiedTypeName TypeInfo a
-> ToBeResolved QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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) ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
request) (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 ToBeResolved QualifiedTypeName TypeInfo (b -> Composite)
requestL b -> [TextBuilder]
printL) (Composite ToBeResolved QualifiedTypeName TypeInfo (c -> Composite)
requestR c -> [TextBuilder]
printR) =
    ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
Composite
      ( ((b -> Composite) -> (c -> Composite) -> a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (b -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (c -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
forall a b c.
(a -> b -> c)
-> ToBeResolved QualifiedTypeName TypeInfo a
-> ToBeResolved QualifiedTypeName TypeInfo b
-> ToBeResolved QualifiedTypeName TypeInfo c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
          (\b -> Composite
encodeL c -> Composite
encodeR a
val -> case a -> (b, c)
f a
val of (b
lVal, c
rVal) -> b -> Composite
encodeL b
lVal Composite -> Composite -> Composite
forall a. Semigroup a => a -> a -> a
<> c -> Composite
encodeR c
rVal)
          ToBeResolved QualifiedTypeName TypeInfo (b -> Composite)
requestL
          ToBeResolved QualifiedTypeName TypeInfo (c -> Composite)
requestR
      )
      (\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 ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
requestL a -> [TextBuilder]
printL <> :: Composite a -> Composite a -> Composite a
<> Composite ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
requestR a -> [TextBuilder]
printR =
    ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
Composite
      (((a -> Composite) -> (a -> Composite) -> a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
forall a b c.
(a -> b -> c)
-> ToBeResolved QualifiedTypeName TypeInfo a
-> ToBeResolved QualifiedTypeName TypeInfo b
-> ToBeResolved QualifiedTypeName TypeInfo c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\a -> Composite
encodeL a -> Composite
encodeR a
val -> a -> Composite
encodeL a
val Composite -> Composite -> Composite
forall a. Semigroup a => a -> a -> a
<> a -> Composite
encodeR a
val) ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
requestL ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
requestR)
      (\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 = ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
Composite ((a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
forall a. a -> ToBeResolved QualifiedTypeName TypeInfo a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
_ ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
serialize 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
        toField :: Word32 -> (t -> Encoding) -> t -> Composite
toField Word32
oid t -> Encoding
encode = \t
val -> Word32 -> Encoding -> Composite
Binary.field Word32
oid (t -> Encoding
encode t
val)
     in case Maybe Word32
staticOid of
          Just Word32
oid ->
            ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
Composite (((a -> Encoding) -> a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
forall a b.
(a -> b)
-> ToBeResolved QualifiedTypeName TypeInfo a
-> ToBeResolved QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> (a -> Encoding) -> a -> Composite
forall {t}. Word32 -> (t -> Encoding) -> t -> Composite
toField Word32
oid) ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
serialize) (\a
val -> [a -> TextBuilder
print a
val])
          Maybe Word32
Nothing ->
            ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
Composite
              ( (\TypeInfo
typeInfo -> Word32 -> (a -> Encoding) -> a -> Composite
forall {t}. Word32 -> (t -> Encoding) -> t -> Composite
toField (if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then TypeInfo -> Word32
CodecsVocab.TypeInfo.toBaseOid TypeInfo
typeInfo else TypeInfo -> Word32
CodecsVocab.TypeInfo.toArrayOid TypeInfo
typeInfo))
                  (TypeInfo -> (a -> Encoding) -> a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo TypeInfo
-> ToBeResolved
     QualifiedTypeName TypeInfo ((a -> Encoding) -> a -> Composite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedTypeName
-> ToBeResolved QualifiedTypeName TypeInfo TypeInfo
forall k v. k -> ToBeResolved k v v
ToBeResolved.lookup (Maybe Text -> Text -> QualifiedTypeName
CodecsVocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName)
                  ToBeResolved
  QualifiedTypeName TypeInfo ((a -> Encoding) -> a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
forall a b.
ToBeResolved QualifiedTypeName TypeInfo (a -> b)
-> ToBeResolved QualifiedTypeName TypeInfo a
-> ToBeResolved QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
serialize
              )
              (\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
_ ToBeResolved QualifiedTypeName TypeInfo (a1 -> Encoding)
serialize 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
        toField :: Word32 -> (a -> Encoding) -> Maybe a -> Composite
toField Word32
oid a -> Encoding
encode = Composite -> (a -> Composite) -> Maybe a -> Composite
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Word32 -> Composite
Binary.nullField Word32
oid) (Word32 -> Encoding -> Composite
Binary.field Word32
oid (Encoding -> Composite) -> (a -> Encoding) -> 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 -> Encoding
encode)
     in case Maybe Word32
staticOid of
          Just Word32
oid ->
            ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
Composite (((a1 -> Encoding) -> a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a1 -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
forall a b.
(a -> b)
-> ToBeResolved QualifiedTypeName TypeInfo a
-> ToBeResolved QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> (a1 -> Encoding) -> Maybe a1 -> Composite
forall {a}. Word32 -> (a -> Encoding) -> Maybe a -> Composite
toField Word32
oid) ToBeResolved QualifiedTypeName TypeInfo (a1 -> Encoding)
serialize) ([TextBuilder] -> (a1 -> [TextBuilder]) -> Maybe a1 -> [TextBuilder]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [TextBuilder
"NULL"] (\a1
val -> [a1 -> TextBuilder
print a1
val]))
          Maybe Word32
Nothing ->
            ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> (a -> [TextBuilder]) -> Composite a
Composite
              ( (\TypeInfo
typeInfo -> Word32 -> (a1 -> Encoding) -> Maybe a1 -> Composite
forall {a}. Word32 -> (a -> Encoding) -> Maybe a -> Composite
toField (if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then TypeInfo -> Word32
CodecsVocab.TypeInfo.toBaseOid TypeInfo
typeInfo else TypeInfo -> Word32
CodecsVocab.TypeInfo.toArrayOid TypeInfo
typeInfo))
                  (TypeInfo -> (a1 -> Encoding) -> a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo TypeInfo
-> ToBeResolved
     QualifiedTypeName TypeInfo ((a1 -> Encoding) -> a -> Composite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedTypeName
-> ToBeResolved QualifiedTypeName TypeInfo TypeInfo
forall k v. k -> ToBeResolved k v v
ToBeResolved.lookup (Maybe Text -> Text -> QualifiedTypeName
CodecsVocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName)
                  ToBeResolved
  QualifiedTypeName TypeInfo ((a1 -> Encoding) -> a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a1 -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
forall a b.
ToBeResolved QualifiedTypeName TypeInfo (a -> b)
-> ToBeResolved QualifiedTypeName TypeInfo a
-> ToBeResolved QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ToBeResolved QualifiedTypeName TypeInfo (a1 -> Encoding)
serialize
              )
              ([TextBuilder] -> (a1 -> [TextBuilder]) -> Maybe a1 -> [TextBuilder]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [TextBuilder
"NULL"] (\a1
val -> [a1 -> TextBuilder
print a1
val]))