-- |
-- 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 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.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

-- * 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 ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
arrayEncoder a -> TextBuilder
renderer) =
  let toEncoder :: Word32 -> (t -> Array) -> t -> Encoding
toEncoder Word32
baseOid t -> Array
encode = \t
input -> Word32 -> Array -> Encoding
Binary.array Word32
baseOid (t -> Array
encode t
input)
      encoder :: ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
encoder = case Maybe Word32
scalarOidIfKnown of
        Just Word32
oid -> ((a -> Array) -> a -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
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 -> Array) -> a -> Encoding
forall {t}. Word32 -> (t -> Array) -> t -> Encoding
toEncoder Word32
oid) ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
arrayEncoder
        Maybe Word32
Nothing ->
          (\TypeInfo
typeInfo -> Word32 -> (a -> Array) -> a -> Encoding
forall {t}. Word32 -> (t -> Array) -> t -> Encoding
toEncoder (TypeInfo -> Word32
CodecsVocab.TypeInfo.toBaseOid TypeInfo
typeInfo))
            (TypeInfo -> (a -> Array) -> a -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo TypeInfo
-> ToBeResolved
     QualifiedTypeName TypeInfo ((a -> Array) -> a -> Encoding)
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
baseTypeSchema Text
baseTypeName)
            ToBeResolved
  QualifiedTypeName TypeInfo ((a -> Array) -> a -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Array)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
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 -> Array)
arrayEncoder
   in Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
-> (a -> TextBuilder)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> ToBeResolved 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 ToBeResolved 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 ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
request a -> [TextBuilder]
print) =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
-> (a -> TextBuilder)
-> Value a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> Bool
-> ToBeResolved 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 ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
encoder a -> TextBuilder
printValue
  where
    encoder :: ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
encoder = ((a -> Composite) -> a -> Encoding)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Composite)
-> ToBeResolved QualifiedTypeName TypeInfo (a -> Encoding)
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 (Composite -> Encoding
Binary.composite (Composite -> Encoding) -> (a -> Composite) -> a -> Encoding
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 -> Composite)
request
    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
")"