module Hasql.Codecs.Encoders.Array where

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.Platform.Prelude
import PostgreSQL.Binary.Encoding qualified as Binary
import TextBuilder qualified as TextBuilder

-- |
-- Generic array encoder.
--
-- Here's an example of its usage:
--
-- @
-- someParamsEncoder :: 'Params' [[Int64]]
-- someParamsEncoder = 'param' ('nonNullable' ('array' ('dimension' 'foldl'' ('dimension' 'foldl'' ('element' ('nonNullable' 'int8'))))))
-- @
--
-- Please note that the PostgreSQL @IN@ keyword does not accept an array, but rather a syntactical list of
-- values, thus this encoder is not suited for that. Use a @value = ANY($1)@ condition instead.
data Array a
  = Array
      -- | Schema name, if any.
      (Maybe Text)
      -- | Type name.
      Text
      -- | Text format?
      Bool
      -- | Dimensionality. If 0 then it is not an array, but a scalar value.
      Word
      -- | OID of the element type.
      (Maybe Word32)
      -- | OID of the array type.
      (Maybe Word32)
      -- | 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.Array)
      -- | Render function for error messages.
      (a -> TextBuilder.TextBuilder)

instance Contravariant Array where
  contramap :: forall a' a. (a' -> a) -> Array a -> Array a'
contramap a' -> a
fn (Array Maybe Text
schemaName Text
typeName Bool
textFormat Word
dimensionality Maybe Word32
valueOid Maybe Word32
arrayOid HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a -> Array
elEncoder a -> TextBuilder
elRenderer) =
    Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a' -> Array)
-> (a' -> TextBuilder)
-> Array a'
forall a.
Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Array)
-> (a -> TextBuilder)
-> Array a
Array Maybe Text
schemaName Text
typeName Bool
textFormat Word
dimensionality Maybe Word32
valueOid Maybe Word32
arrayOid HashSet QualifiedTypeName
unknownTypes (\HashMap QualifiedTypeName TypeInfo
oidCache -> HashMap QualifiedTypeName TypeInfo -> a -> Array
elEncoder HashMap QualifiedTypeName TypeInfo
oidCache (a -> Array) -> (a' -> a) -> a' -> Array
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
fn) (a -> TextBuilder
elRenderer (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
fn)

-- |
-- Lifts a 'Value.Value' encoder into an 'Array' encoder.
element :: NullableOrNot.NullableOrNot Value.Value a -> Array a
element :: forall a. NullableOrNot Value a -> Array a
element = \case
  NullableOrNot.NonNullable (Value.Value Maybe Text
schemaName Text
typeName Maybe Word32
scalarOid Maybe Word32
arrayOid Word
dimensionality Bool
textFormat HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a -> Encoding
serialize a -> TextBuilder
print) ->
    Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Array)
-> (a -> TextBuilder)
-> Array a
forall a.
Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Array)
-> (a -> TextBuilder)
-> Array a
Array
      Maybe Text
schemaName
      Text
typeName
      Bool
textFormat
      Word
dimensionality
      Maybe Word32
scalarOid
      Maybe Word32
arrayOid
      HashSet QualifiedTypeName
unknownTypes
      (\HashMap QualifiedTypeName TypeInfo
oidCache -> Encoding -> Array
Binary.encodingArray (Encoding -> Array) -> (a -> Encoding) -> a -> Array
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
. HashMap QualifiedTypeName TypeInfo -> a -> Encoding
serialize HashMap QualifiedTypeName TypeInfo
oidCache)
      a -> TextBuilder
print
  NullableOrNot.Nullable (Value.Value Maybe Text
schemaName Text
typeName Maybe Word32
scalarOid Maybe Word32
arrayOid Word
dimensionality Bool
textFormat HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a1 -> Encoding
serialize a1 -> TextBuilder
print) ->
    let maybeSerialize :: HashMap QualifiedTypeName TypeInfo -> Maybe a1 -> Array
maybeSerialize HashMap QualifiedTypeName TypeInfo
oidCache =
          Array -> (a1 -> Array) -> Maybe a1 -> Array
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Array
Binary.nullArray (Encoding -> Array
Binary.encodingArray (Encoding -> Array) -> (a1 -> Encoding) -> a1 -> Array
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
. HashMap QualifiedTypeName TypeInfo -> a1 -> Encoding
serialize HashMap QualifiedTypeName TypeInfo
oidCache)
        maybePrint :: Maybe a1 -> TextBuilder
maybePrint =
          TextBuilder -> (a1 -> TextBuilder) -> Maybe a1 -> TextBuilder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> TextBuilder
TextBuilder.string String
"null") a1 -> TextBuilder
print
     in Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Array)
-> (a -> TextBuilder)
-> Array a
forall a.
Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Array)
-> (a -> TextBuilder)
-> Array a
Array
          Maybe Text
schemaName
          Text
typeName
          Bool
textFormat
          Word
dimensionality
          Maybe Word32
scalarOid
          Maybe Word32
arrayOid
          HashSet QualifiedTypeName
unknownTypes
          HashMap QualifiedTypeName TypeInfo -> a -> Array
HashMap QualifiedTypeName TypeInfo -> Maybe a1 -> Array
maybeSerialize
          a -> TextBuilder
Maybe a1 -> TextBuilder
maybePrint

-- |
-- Encoder of an array dimension,
-- which thus provides support for multidimensional arrays.
--
-- Accepts:
--
-- * An implementation of the left-fold operation,
-- such as @Data.Foldable.'foldl''@,
-- which determines the input value.
--
-- * A component encoder, which can be either another 'dimension' or 'element'.
{-# INLINE dimension #-}
dimension :: (forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c
dimension :: forall b c.
(forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c
dimension forall a. (a -> b -> a) -> a -> c -> a
fold (Array Maybe Text
schemaName Text
typeName Bool
textFormat Word
dimensionality Maybe Word32
valueOid Maybe Word32
arrayOid HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> b -> Array
elEncoder b -> TextBuilder
elRenderer) =
  let encoder :: HashMap QualifiedTypeName TypeInfo -> c -> Array
encoder HashMap QualifiedTypeName TypeInfo
oidCache =
        (forall a. (a -> b -> a) -> a -> c -> a)
-> (b -> Array) -> c -> Array
forall a c.
(forall b. (b -> a -> b) -> b -> c -> b)
-> (a -> Array) -> c -> Array
Binary.dimensionArray (b -> b -> b) -> b -> c -> b
forall a. (a -> b -> a) -> a -> c -> a
fold (HashMap QualifiedTypeName TypeInfo -> b -> Array
elEncoder HashMap QualifiedTypeName TypeInfo
oidCache)
      renderer :: c -> TextBuilder
renderer c
els =
        let folded :: TextBuilder
folded =
              let step :: TextBuilder -> b -> TextBuilder
step TextBuilder
builder b
el =
                    if TextBuilder -> Bool
TextBuilder.isEmpty TextBuilder
builder
                      then Char -> TextBuilder
TextBuilder.char Char
'[' TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> b -> TextBuilder
elRenderer b
el
                      else TextBuilder
builder TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> String -> TextBuilder
TextBuilder.string String
", " TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> b -> TextBuilder
elRenderer b
el
               in (TextBuilder -> b -> TextBuilder)
-> TextBuilder -> c -> TextBuilder
forall a. (a -> b -> a) -> a -> c -> a
fold TextBuilder -> b -> TextBuilder
step TextBuilder
forall a. Monoid a => a
mempty c
els
         in if TextBuilder -> Bool
TextBuilder.isEmpty TextBuilder
folded
              then String -> TextBuilder
TextBuilder.string String
"[]"
              else TextBuilder
folded TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Char -> TextBuilder
TextBuilder.char Char
']'
   in Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> c -> Array)
-> (c -> TextBuilder)
-> Array c
forall a.
Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Array)
-> (a -> TextBuilder)
-> Array a
Array Maybe Text
schemaName Text
typeName Bool
textFormat (Word -> Word
forall a. Enum a => a -> a
succ Word
dimensionality) Maybe Word32
valueOid Maybe Word32
arrayOid HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> c -> Array
encoder c -> TextBuilder
renderer