-- |
-- A DSL for declaration of statement parameter encoders.
--
-- For compactness of names all the types defined here imply being an encoder.
-- E.g., the `Array` type is an __encoder__ of arrays, not the data-structure itself.
module Hasql.Codecs.Encoders
  ( -- * Parameters product
    Params.Params,
    Params.noParams,
    Params.param,

    -- * Nullability
    NullableOrNot.NullableOrNot,
    NullableOrNot.nonNullable,
    NullableOrNot.nullable,

    -- * Value
    Value.Value,
    Value.bool,
    Value.int2,
    Value.int4,
    Value.int8,
    Value.float4,
    Value.float8,
    Value.numeric,
    Value.char,
    Value.text,
    Value.varchar,
    Value.bpchar,
    Value.bytea,
    Value.date,
    Value.timestamp,
    Value.timestamptz,
    Value.time,
    Value.timetz,
    Value.interval,
    Value.uuid,
    Value.inet,
    Value.macaddr,
    Value.json,
    Value.jsonBytes,
    Value.jsonLazyBytes,
    Value.jsonb,
    Value.jsonbBytes,
    Value.jsonbLazyBytes,
    Value.int4range,
    Value.int8range,
    Value.numrange,
    Value.tsrange,
    Value.tstzrange,
    Value.daterange,
    Value.int4multirange,
    Value.int8multirange,
    Value.nummultirange,
    Value.tsmultirange,
    Value.tstzmultirange,
    Value.datemultirange,
    Value.citext,
    Value.name,
    Value.oid,
    foldableArray,
    array,
    Value.hstore,
    Value.enum,
    composite,
    Value.unknown,
    Value.custom,

    -- * Array
    Array.Array,
    Array.element,
    Array.dimension,

    -- * Composite
    Composite.Composite,
    Composite.field,
  )
where

import Data.HashMap.Strict qualified as HashMap
import Hasql.Codecs.Encoders.Array qualified as Array
import Hasql.Codecs.Encoders.Composite qualified as Composite
import Hasql.Codecs.Encoders.NullableOrNot qualified as NullableOrNot
import Hasql.Codecs.Encoders.Params qualified as Params
import Hasql.Codecs.Encoders.Value qualified as Value
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

-- * Recursive definitions

-- |
-- Lift a value encoder of element into a unidimensional array encoder of a foldable value.
--
-- This function is merely a shortcut to the following expression:
--
-- @
-- ('array' . 'Array.dimension' 'foldl'' . 'Array.element')
-- @
--
-- You can use it like this:
--
-- @
-- vectorOfInts :: Value (Vector Int64)
-- vectorOfInts = 'foldableArray' ('nonNullable' 'int8')
-- @
--
-- Please notice that in case of multidimensional arrays nesting 'foldableArray' encoder
-- won't work. You have to explicitly construct the array encoder using 'array'.
{-# INLINE foldableArray #-}
foldableArray :: (Foldable foldable) => NullableOrNot.NullableOrNot Value.Value element -> Value.Value (foldable element)
foldableArray :: forall (foldable :: * -> *) element.
Foldable foldable =>
NullableOrNot Value element -> Value (foldable element)
foldableArray = Array (foldable element) -> Value (foldable element)
forall a. Array a -> Value a
array (Array (foldable element) -> Value (foldable element))
-> (NullableOrNot Value element -> Array (foldable element))
-> NullableOrNot Value element
-> Value (foldable element)
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
. (forall a. (a -> element -> a) -> a -> foldable element -> a)
-> Array element -> Array (foldable element)
forall b c.
(forall a. (a -> b -> a) -> a -> c -> a) -> Array b -> Array c
Array.dimension (a -> element -> a) -> a -> foldable element -> a
forall a. (a -> element -> a) -> a -> foldable element -> a
forall b a. (b -> a -> b) -> b -> foldable a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Array element -> Array (foldable element))
-> (NullableOrNot Value element -> Array element)
-> NullableOrNot Value element
-> Array (foldable element)
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
. NullableOrNot Value element -> Array element
forall a. NullableOrNot Value a -> Array a
Array.element

-- |
-- Lift an array encoder into a value encoder.
array :: Array.Array a -> Value.Value a
array :: forall a. Array a -> Value a
array (Array.Array Maybe Text
baseTypeSchema Text
baseTypeName Bool
_isText Word
dimensionality Maybe Word32
scalarOidIfKnown Maybe Word32
arrayOidIfKnown HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a -> Array
arrayEncoder a -> TextBuilder
renderer) =
  let encoder :: HashMap QualifiedTypeName TypeInfo -> a -> Encoding
encoder HashMap QualifiedTypeName TypeInfo
oidCache a
input =
        let resolvedOid :: Word32
resolvedOid =
              [Maybe Word32] -> Maybe Word32
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
                [ Maybe Word32
scalarOidIfKnown,
                  HashMap QualifiedTypeName TypeInfo
oidCache
                    HashMap QualifiedTypeName TypeInfo
-> (HashMap QualifiedTypeName TypeInfo -> Maybe TypeInfo)
-> Maybe TypeInfo
forall a b. a -> (a -> b) -> b
& 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
baseTypeSchema Text
baseTypeName)
                    Maybe TypeInfo -> (Maybe TypeInfo -> Maybe Word32) -> Maybe Word32
forall a b. a -> (a -> b) -> b
& (TypeInfo -> Word32) -> Maybe TypeInfo -> Maybe Word32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeInfo -> Word32
Vocab.TypeInfo.toBaseOid
                ]
                -- Should only happen on a bug.
                Maybe Word32 -> (Maybe Word32 -> Word32) -> Word32
forall a b. a -> (a -> b) -> b
& Word32 -> Maybe Word32 -> Word32
forall a. a -> Maybe a -> a
fromMaybe (TypeInfo -> Word32
Vocab.TypeInfo.toBaseOid TypeInfo
Vocab.TypeInfo.unknown)
         in Word32 -> Array -> Encoding
Binary.array Word32
resolvedOid (HashMap QualifiedTypeName TypeInfo -> a -> Array
arrayEncoder HashMap QualifiedTypeName TypeInfo
oidCache a
input)
   in Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Encoding)
-> (a -> TextBuilder)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Encoding)
-> (a -> TextBuilder)
-> Value a
Value.Value Maybe Text
baseTypeSchema Text
baseTypeName Maybe Word32
scalarOidIfKnown Maybe Word32
arrayOidIfKnown Word
dimensionality Bool
False HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a -> Encoding
encoder a -> TextBuilder
renderer

-- |
-- Lift a composite encoder into a value encoder for named composite types.
--
-- This function is for named composite types where the type name is known.
-- If you need to encode an anonymous composite type (like those created with the ROW constructor),
-- PostgreSQL itself does not support that.
composite ::
  -- | Schema name where the composite type is defined.
  Maybe Text ->
  -- | Composite type name.
  Text ->
  Composite.Composite a ->
  Value.Value a
composite :: forall a. Maybe Text -> Text -> Composite a -> Value a
composite Maybe Text
schema Text
name (Composite.Composite HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a -> Composite
encode a -> [TextBuilder]
print) =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Encoding)
-> (a -> TextBuilder)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> HashSet QualifiedTypeName
-> (HashMap QualifiedTypeName TypeInfo -> a -> Encoding)
-> (a -> TextBuilder)
-> Value a
Value.Value Maybe Text
schema Text
name Maybe Word32
forall a. Maybe a
Nothing Maybe Word32
forall a. Maybe a
Nothing Word
0 Bool
False HashSet QualifiedTypeName
unknownTypes HashMap QualifiedTypeName TypeInfo -> a -> Encoding
encodeValue a -> TextBuilder
printValue
  where
    encodeValue :: HashMap QualifiedTypeName TypeInfo -> a -> Encoding
encodeValue HashMap QualifiedTypeName TypeInfo
oidCache a
val =
      Composite -> Encoding
Binary.composite (HashMap QualifiedTypeName TypeInfo -> a -> Composite
encode HashMap QualifiedTypeName TypeInfo
oidCache a
val)
    printValue :: a -> TextBuilder
printValue a
val =
      TextBuilder
"ROW (" TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder -> [TextBuilder] -> TextBuilder
forall (f :: * -> *).
Foldable f =>
TextBuilder -> f TextBuilder -> TextBuilder
TextBuilder.intercalate TextBuilder
", " (a -> [TextBuilder]
print a
val) TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
")"