module Hasql.Codecs.Encoders.Array 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
import Hasql.ToBeResolved qualified as ToBeResolved
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)
      -- | Serialization function, deferring the names of types that must be looked up at runtime.
      (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.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 ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
elEncoder a -> TextBuilder
elRenderer) =
    Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> ToBeResolved QualifiedTypeName TypeInfo (a' -> Array)
-> (a' -> TextBuilder)
-> Array a'
forall a.
Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
-> (a -> TextBuilder)
-> Array a
Array Maybe Text
schemaName Text
typeName Bool
textFormat Word
dimensionality Maybe Word32
valueOid Maybe Word32
arrayOid (((a -> Array) -> a' -> Array)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
-> ToBeResolved QualifiedTypeName TypeInfo (a' -> Array)
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 -> Array
encode -> a -> Array
encode (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) ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
elEncoder) (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 ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
serialize a -> TextBuilder
print) ->
    Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
-> (a -> TextBuilder)
-> Array a
forall a.
Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
-> (a -> TextBuilder)
-> Array a
Array
      Maybe Text
schemaName
      Text
typeName
      Bool
textFormat
      Word
dimensionality
      Maybe Word32
scalarOid
      Maybe Word32
arrayOid
      (((a -> Encoding) -> a -> Array)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
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 (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
.) ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
serialize)
      a -> TextBuilder
print
  NullableOrNot.Nullable (Value.Value Maybe Text
schemaName Text
typeName Maybe Word32
scalarOid Maybe Word32
arrayOid Word
dimensionality Bool
textFormat ToBeResolved QualifiedTypeName TypeInfo (a1 -> Encoding)
serialize a1 -> TextBuilder
print) ->
    let maybeSerialize :: (a -> Encoding) -> Maybe a -> Array
maybeSerialize a -> Encoding
encode =
          Array -> (a -> Array) -> Maybe a -> Array
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Array
Binary.nullArray (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
. a -> Encoding
encode)
        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
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
-> (a -> TextBuilder)
-> Array a
forall a.
Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
-> (a -> TextBuilder)
-> Array a
Array
          Maybe Text
schemaName
          Text
typeName
          Bool
textFormat
          Word
dimensionality
          Maybe Word32
scalarOid
          Maybe Word32
arrayOid
          (((a1 -> Encoding) -> a -> Array)
-> ToBeResolved QualifiedTypeName TypeInfo (a1 -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
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 (a1 -> Encoding) -> a -> Array
(a1 -> Encoding) -> Maybe a1 -> Array
forall {a}. (a -> Encoding) -> Maybe a -> Array
maybeSerialize ToBeResolved QualifiedTypeName TypeInfo (a1 -> Encoding)
serialize)
          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 ToBeResolved QualifiedTypeName TypeInfo (b -> Array)
elEncoder b -> TextBuilder
elRenderer) =
  let encoder :: (b -> Array) -> c -> Array
encoder =
        (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
      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
-> ToBeResolved QualifiedTypeName TypeInfo (c -> Array)
-> (c -> TextBuilder)
-> Array c
forall a.
Maybe Text
-> Text
-> Bool
-> Word
-> Maybe Word32
-> Maybe Word32
-> ToBeResolved 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 (((b -> Array) -> c -> Array)
-> ToBeResolved QualifiedTypeName TypeInfo (b -> Array)
-> ToBeResolved QualifiedTypeName TypeInfo (c -> Array)
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 (b -> Array) -> c -> Array
encoder ToBeResolved QualifiedTypeName TypeInfo (b -> Array)
elEncoder) c -> TextBuilder
renderer