-- |
-- 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.TypeInfo qualified as 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 (Maybe Text, Text)
unknownTypes HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Array
arrayEncoder a -> TextBuilder
renderer) =
  let encoder :: HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Encoding
encoder HashMap (Maybe Text, Text) (Word32, Word32)
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 (Maybe Text, Text) (Word32, Word32)
oidCache
                    HashMap (Maybe Text, Text) (Word32, Word32)
-> (HashMap (Maybe Text, Text) (Word32, Word32)
    -> Maybe (Word32, Word32))
-> Maybe (Word32, Word32)
forall a b. a -> (a -> b) -> b
& (Maybe Text, Text)
-> HashMap (Maybe Text, Text) (Word32, Word32)
-> Maybe (Word32, Word32)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Maybe Text
baseTypeSchema, Text
baseTypeName)
                    Maybe (Word32, Word32)
-> (Maybe (Word32, Word32) -> Maybe Word32) -> Maybe Word32
forall a b. a -> (a -> b) -> b
& ((Word32, Word32) -> Word32)
-> Maybe (Word32, Word32) -> Maybe Word32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32, Word32) -> Word32
forall a b. (a, b) -> a
fst
                ]
                -- 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
TypeInfo.toBaseOid TypeInfo
TypeInfo.unknown)
         in Word32 -> Array -> Encoding
Binary.array Word32
resolvedOid (HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Array
arrayEncoder HashMap (Maybe Text, Text) (Word32, Word32)
oidCache a
input)
   in Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> HashSet (Maybe Text, Text)
-> (HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Encoding)
-> (a -> TextBuilder)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> HashSet (Maybe Text, Text)
-> (HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Encoding)
-> (a -> TextBuilder)
-> Value a
Value.Value Maybe Text
baseTypeSchema Text
baseTypeName Maybe Word32
scalarOidIfKnown Maybe Word32
arrayOidIfKnown Word
dimensionality Bool
False HashSet (Maybe Text, Text)
unknownTypes HashMap (Maybe Text, Text) (Word32, Word32) -> 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 (Maybe Text, Text)
unknownTypes HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Composite
encode a -> [TextBuilder]
print) =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> HashSet (Maybe Text, Text)
-> (HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Encoding)
-> (a -> TextBuilder)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> HashSet (Maybe Text, Text)
-> (HashMap (Maybe Text, Text) (Word32, Word32) -> 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 (Maybe Text, Text)
unknownTypes HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Encoding
encodeValue a -> TextBuilder
printValue
  where
    encodeValue :: HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Encoding
encodeValue HashMap (Maybe Text, Text) (Word32, Word32)
oidCache a
val =
      Composite -> Encoding
Binary.composite (HashMap (Maybe Text, Text) (Word32, Word32) -> a -> Composite
encode HashMap (Maybe Text, Text) (Word32, Word32)
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
")"