module Hasql.Codecs.Encoders.Params
  ( Params,
    noParams,
    param,
    toColumnsMetadata,
    toUnknownTypes,
    toSerializer,
    toPrinter,
  )
where

import Data.HashSet qualified as HashSet
import Data.Vector qualified as Vector
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.Codecs.Vocab.OidCache qualified as Vocab.OidCache
import Hasql.Codecs.Vocab.ParamMeta (ParamMeta (..))
import Hasql.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName
import Hasql.Codecs.Vocab.TypeRef qualified as Vocab.TypeRef
import Hasql.Platform.Prelude
import PostgreSQL.Binary.Encoding qualified as Binary
import TextBuilder qualified

-- | Frozen per-parameter metadata: type reference, dimensionality, text-format flag.
toColumnsMetadata :: Params a -> Vector ParamMeta
toColumnsMetadata :: forall a. Params a -> Vector ParamMeta
toColumnsMetadata (Params Int
_ HashSet QualifiedTypeName
_ DList ParamMeta
columnsMetadata OidCache -> a -> [Maybe ByteString]
_ a -> DList Text
_) = DList ParamMeta -> Vector (Item (DList ParamMeta))
forall {a}. IsList a => a -> Vector (Item a)
freezeColumnsMetadata DList ParamMeta
columnsMetadata
  where
    freezeColumnsMetadata :: a -> Vector (Item a)
freezeColumnsMetadata =
      [Item a] -> Vector (Item a)
forall a. [a] -> Vector a
Vector.fromList ([Item a] -> Vector (Item a))
-> (a -> [Item a]) -> a -> Vector (Item a)
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 -> [Item a]
forall l. IsList l => l -> [Item l]
toList

toUnknownTypes :: Params a -> HashSet Vocab.QualifiedTypeName
toUnknownTypes :: forall a. Params a -> HashSet QualifiedTypeName
toUnknownTypes (Params Int
_ HashSet QualifiedTypeName
unknownTypes DList ParamMeta
_ OidCache -> a -> [Maybe ByteString]
_ a -> DList Text
_) =
  HashSet QualifiedTypeName
unknownTypes

-- | Serialise params to encoded wire values given a resolved OID cache.
toSerializer :: Params a -> Vocab.OidCache -> a -> [Maybe ByteString]
toSerializer :: forall a. Params a -> OidCache -> a -> [Maybe ByteString]
toSerializer (Params Int
_ HashSet QualifiedTypeName
_ DList ParamMeta
_ OidCache -> a -> [Maybe ByteString]
serializer a -> DList Text
_) = OidCache -> a -> [Maybe ByteString]
serializer

-- | Render params in human-readable form (for error reporting).
toPrinter :: Params a -> a -> [Text]
toPrinter :: forall a. Params a -> a -> [Text]
toPrinter (Params Int
_ HashSet QualifiedTypeName
_ DList ParamMeta
_ OidCache -> a -> [Maybe ByteString]
_ a -> DList Text
printer) = DList Text -> [Text]
DList Text -> [Item (DList Text)]
forall l. IsList l => l -> [Item l]
toList (DList Text -> [Text]) -> (a -> DList Text) -> a -> [Text]
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 -> DList Text
printer

-- |
-- Encoder of some representation of a parameters product.
--
-- Has instances of 'Contravariant', 'Divisible' and 'Monoid',
-- which you can use to compose multiple parameters together.
-- E.g.,
--
-- @
-- someParamsEncoder :: 'Params' (Int64, Maybe Text)
-- someParamsEncoder =
--   ('fst' '>$<' 'param' ('nonNullable' 'int8')) '<>'
--   ('snd' '>$<' 'param' ('nullable' 'text'))
-- @
--
-- As a general solution for tuples of any arity, instead of 'fst' and 'snd',
-- consider the functions of the @contrazip@ family
-- from the "contravariant-extras" package.
-- E.g., here's how you can achieve the same as the above:
--
-- @
-- someParamsEncoder :: 'Params' (Int64, Maybe Text)
-- someParamsEncoder =
--   'contrazip2' ('param' ('nonNullable' 'int8')) ('param' ('nullable' 'text'))
-- @
--
-- Here's how you can implement encoders for custom composite types:
--
-- @
-- data Person = Person { name :: Text, gender :: Gender, age :: Int }
--
-- data Gender = Male | Female
--
-- personParams :: 'Params' Person
-- personParams =
--   (name '>$<' 'param' ('nonNullable' 'text')) '<>'
--   (gender '>$<' 'param' ('nonNullable' genderValue)) '<>'
--   ('fromIntegral' . age '>$<' 'param' ('nonNullable' 'int8'))
--
-- genderValue :: 'Value.Value' Gender
-- genderValue = 'enum' Nothing (Just "gender") genderText where
--   genderText gender = case gender of
--     Male -> "male"
--     Female -> "female"
-- @
data Params a = Params
  { forall a. Params a -> Int
size :: Int,
    forall a. Params a -> HashSet QualifiedTypeName
unknownTypes :: HashSet Vocab.QualifiedTypeName,
    -- | (Type reference, dimensionality, Text Format) for each parameter.
    forall a. Params a -> DList ParamMeta
columnsMetadata :: DList ParamMeta,
    forall a. Params a -> OidCache -> a -> [Maybe ByteString]
serializer :: Vocab.OidCache -> a -> [Maybe ByteString],
    forall a. Params a -> a -> DList Text
printer :: a -> DList Text
  }

instance Contravariant Params where
  contramap :: forall a' a. (a' -> a) -> Params a -> Params a'
contramap a' -> a
fn (Params Int
size HashSet QualifiedTypeName
unknownTypes DList ParamMeta
columnsMetadata OidCache -> a -> [Maybe ByteString]
oldSerializer a -> DList Text
oldPrinter) = Params {Int
DList ParamMeta
HashSet QualifiedTypeName
a' -> DList Text
OidCache -> a' -> [Maybe ByteString]
size :: Int
unknownTypes :: HashSet QualifiedTypeName
columnsMetadata :: DList ParamMeta
serializer :: OidCache -> a' -> [Maybe ByteString]
printer :: a' -> DList Text
size :: Int
unknownTypes :: HashSet QualifiedTypeName
columnsMetadata :: DList ParamMeta
serializer :: OidCache -> a' -> [Maybe ByteString]
printer :: a' -> DList Text
..}
    where
      serializer :: OidCache -> a' -> [Maybe ByteString]
serializer OidCache
oidCache = OidCache -> a -> [Maybe ByteString]
oldSerializer OidCache
oidCache (a -> [Maybe ByteString]) -> (a' -> a) -> a' -> [Maybe ByteString]
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
      printer :: a' -> DList Text
printer = a -> DList Text
oldPrinter (a -> DList Text) -> (a' -> a) -> a' -> DList Text
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

instance Divisible Params where
  divide :: forall a b c. (a -> (b, c)) -> Params b -> Params c -> Params a
divide
    a -> (b, c)
divisor
    (Params Int
leftSize HashSet QualifiedTypeName
leftUnknownTypes DList ParamMeta
leftColumnsMetadata OidCache -> b -> [Maybe ByteString]
leftSerializer b -> DList Text
leftPrinter)
    (Params Int
rightSize HashSet QualifiedTypeName
rightUnknownTypes DList ParamMeta
rightColumnsMetadata OidCache -> c -> [Maybe ByteString]
rightSerializer c -> DList Text
rightPrinter) =
      Params
        { size :: Int
size = Int
leftSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightSize,
          unknownTypes :: HashSet QualifiedTypeName
unknownTypes = HashSet QualifiedTypeName
leftUnknownTypes HashSet QualifiedTypeName
-> HashSet QualifiedTypeName -> HashSet QualifiedTypeName
forall a. Semigroup a => a -> a -> a
<> HashSet QualifiedTypeName
rightUnknownTypes,
          columnsMetadata :: DList ParamMeta
columnsMetadata = DList ParamMeta
leftColumnsMetadata DList ParamMeta -> DList ParamMeta -> DList ParamMeta
forall a. Semigroup a => a -> a -> a
<> DList ParamMeta
rightColumnsMetadata,
          serializer :: OidCache -> a -> [Maybe ByteString]
serializer = \OidCache
oidCache a
input -> case a -> (b, c)
divisor a
input of
            (b
leftInput, c
rightInput) -> OidCache -> b -> [Maybe ByteString]
leftSerializer OidCache
oidCache b
leftInput [Maybe ByteString] -> [Maybe ByteString] -> [Maybe ByteString]
forall a. Semigroup a => a -> a -> a
<> OidCache -> c -> [Maybe ByteString]
rightSerializer OidCache
oidCache c
rightInput,
          printer :: a -> DList Text
printer = \a
input -> case a -> (b, c)
divisor a
input of
            (b
leftInput, c
rightInput) -> b -> DList Text
leftPrinter b
leftInput DList Text -> DList Text -> DList Text
forall a. Semigroup a => a -> a -> a
<> c -> DList Text
rightPrinter c
rightInput
        }
  conquer :: forall a. Params a
conquer =
    Params
      { size :: Int
size = Int
0,
        unknownTypes :: HashSet QualifiedTypeName
unknownTypes = HashSet QualifiedTypeName
forall a. Monoid a => a
mempty,
        columnsMetadata :: DList ParamMeta
columnsMetadata = DList ParamMeta
forall a. Monoid a => a
mempty,
        serializer :: OidCache -> a -> [Maybe ByteString]
serializer = OidCache -> a -> [Maybe ByteString]
forall a. Monoid a => a
mempty,
        printer :: a -> DList Text
printer = a -> DList Text
forall a. Monoid a => a
mempty
      }

instance Semigroup (Params a) where
  Params Int
leftSize HashSet QualifiedTypeName
leftUnknownTypes DList ParamMeta
leftColumnsMetadata OidCache -> a -> [Maybe ByteString]
leftSerializer a -> DList Text
leftPrinter <> :: Params a -> Params a -> Params a
<> Params Int
rightSize HashSet QualifiedTypeName
rightUnknownTypes DList ParamMeta
rightColumnsMetadata OidCache -> a -> [Maybe ByteString]
rightSerializer a -> DList Text
rightPrinter =
    Params
      { size :: Int
size = Int
leftSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rightSize,
        unknownTypes :: HashSet QualifiedTypeName
unknownTypes = HashSet QualifiedTypeName
leftUnknownTypes HashSet QualifiedTypeName
-> HashSet QualifiedTypeName -> HashSet QualifiedTypeName
forall a. Semigroup a => a -> a -> a
<> HashSet QualifiedTypeName
rightUnknownTypes,
        columnsMetadata :: DList ParamMeta
columnsMetadata = DList ParamMeta
leftColumnsMetadata DList ParamMeta -> DList ParamMeta -> DList ParamMeta
forall a. Semigroup a => a -> a -> a
<> DList ParamMeta
rightColumnsMetadata,
        serializer :: OidCache -> a -> [Maybe ByteString]
serializer = \OidCache
oidCache a
input -> OidCache -> a -> [Maybe ByteString]
leftSerializer OidCache
oidCache a
input [Maybe ByteString] -> [Maybe ByteString] -> [Maybe ByteString]
forall a. Semigroup a => a -> a -> a
<> OidCache -> a -> [Maybe ByteString]
rightSerializer OidCache
oidCache a
input,
        printer :: a -> DList Text
printer = \a
input -> a -> DList Text
leftPrinter a
input DList Text -> DList Text -> DList Text
forall a. Semigroup a => a -> a -> a
<> a -> DList Text
rightPrinter a
input
      }

instance Monoid (Params a) where
  mempty :: Params a
mempty = Params a
forall a. Params a
forall (f :: * -> *) a. Divisible f => f a
conquer

value :: Value.Value a -> Params a
value :: forall a. Value a -> Params a
value (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) =
  let staticOid :: Maybe Word32
staticOid = if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Maybe Word32
scalarOid else Maybe Word32
arrayOid
      serializer :: OidCache -> a -> [Maybe ByteString]
serializer OidCache
oidCache = Maybe ByteString -> [Maybe ByteString]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> [Maybe ByteString])
-> (a -> Maybe ByteString) -> a -> [Maybe ByteString]
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
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (a -> ByteString) -> a -> Maybe ByteString
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
. Encoding -> ByteString
Binary.encodingBytes (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
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 (OidCache -> HashMap QualifiedTypeName TypeInfo
Vocab.OidCache.toHashMap OidCache
oidCache)
      printer :: a -> DList Text
printer = Text -> DList Text
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DList Text) -> (a -> Text) -> a -> DList Text
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
. TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (a -> TextBuilder) -> a -> Text
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 -> TextBuilder
print
      size :: a
size = a
1
   in case Maybe Word32
staticOid of
        Just Word32
oid ->
          Params
            { Int
forall {a}. Num a => a
size :: Int
size :: forall {a}. Num a => a
size,
              HashSet QualifiedTypeName
unknownTypes :: HashSet QualifiedTypeName
unknownTypes :: HashSet QualifiedTypeName
unknownTypes,
              columnsMetadata :: DList ParamMeta
columnsMetadata = ParamMeta -> DList ParamMeta
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeRef -> Word -> Bool -> ParamMeta
ParamMeta (Word32 -> TypeRef
Vocab.TypeRef.KnownOid Word32
oid) Word
dimensionality Bool
textFormat),
              OidCache -> a -> [Maybe ByteString]
serializer :: OidCache -> a -> [Maybe ByteString]
serializer :: OidCache -> a -> [Maybe ByteString]
serializer,
              a -> DList Text
printer :: a -> DList Text
printer :: a -> DList Text
printer
            }
        Maybe Word32
Nothing ->
          Params
            { Int
forall {a}. Num a => a
size :: Int
size :: forall {a}. Num a => a
size,
              unknownTypes :: HashSet QualifiedTypeName
unknownTypes = QualifiedTypeName
-> HashSet QualifiedTypeName -> HashSet QualifiedTypeName
forall a. Hashable a => a -> HashSet a -> HashSet a
HashSet.insert (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName) HashSet QualifiedTypeName
unknownTypes,
              columnsMetadata :: DList ParamMeta
columnsMetadata = ParamMeta -> DList ParamMeta
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeRef -> Word -> Bool -> ParamMeta
ParamMeta (QualifiedTypeName -> TypeRef
Vocab.TypeRef.NamedType (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName)) Word
dimensionality Bool
textFormat),
              OidCache -> a -> [Maybe ByteString]
serializer :: OidCache -> a -> [Maybe ByteString]
serializer :: OidCache -> a -> [Maybe ByteString]
serializer,
              a -> DList Text
printer :: a -> DList Text
printer :: a -> DList Text
printer
            }

nullableValue :: Value.Value a -> Params (Maybe a)
nullableValue :: forall a. Value a -> Params (Maybe a)
nullableValue (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) =
  let staticOid :: Maybe Word32
staticOid = if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Maybe Word32
scalarOid else Maybe Word32
arrayOid
      serializer :: OidCache -> Maybe a -> [Maybe ByteString]
serializer OidCache
oidCache = Maybe ByteString -> [Maybe ByteString]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> [Maybe ByteString])
-> (Maybe a -> Maybe ByteString) -> Maybe a -> [Maybe ByteString]
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 -> ByteString) -> Maybe a -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Encoding -> ByteString
Binary.encodingBytes (Encoding -> ByteString) -> (a -> Encoding) -> a -> ByteString
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 (OidCache -> HashMap QualifiedTypeName TypeInfo
Vocab.OidCache.toHashMap OidCache
oidCache))
      printer :: Maybe a -> DList Text
printer = Text -> DList Text
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> DList Text) -> (Maybe a -> Text) -> Maybe a -> DList Text
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
. Text -> (a -> Text) -> Maybe a -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"null" (TextBuilder -> Text
TextBuilder.toText (TextBuilder -> Text) -> (a -> TextBuilder) -> a -> Text
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 -> TextBuilder
print)
      size :: a
size = a
1
   in case Maybe Word32
staticOid of
        Just Word32
oid ->
          Params
            { Int
forall {a}. Num a => a
size :: Int
size :: forall {a}. Num a => a
size,
              HashSet QualifiedTypeName
unknownTypes :: HashSet QualifiedTypeName
unknownTypes :: HashSet QualifiedTypeName
unknownTypes,
              columnsMetadata :: DList ParamMeta
columnsMetadata = ParamMeta -> DList ParamMeta
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeRef -> Word -> Bool -> ParamMeta
ParamMeta (Word32 -> TypeRef
Vocab.TypeRef.KnownOid Word32
oid) Word
dimensionality Bool
textFormat),
              OidCache -> Maybe a -> [Maybe ByteString]
serializer :: OidCache -> Maybe a -> [Maybe ByteString]
serializer :: OidCache -> Maybe a -> [Maybe ByteString]
serializer,
              Maybe a -> DList Text
printer :: Maybe a -> DList Text
printer :: Maybe a -> DList Text
printer
            }
        Maybe Word32
Nothing ->
          Params
            { Int
forall {a}. Num a => a
size :: Int
size :: forall {a}. Num a => a
size,
              unknownTypes :: HashSet QualifiedTypeName
unknownTypes = QualifiedTypeName
-> HashSet QualifiedTypeName -> HashSet QualifiedTypeName
forall a. Hashable a => a -> HashSet a -> HashSet a
HashSet.insert (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName) HashSet QualifiedTypeName
unknownTypes,
              columnsMetadata :: DList ParamMeta
columnsMetadata = ParamMeta -> DList ParamMeta
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeRef -> Word -> Bool -> ParamMeta
ParamMeta (QualifiedTypeName -> TypeRef
Vocab.TypeRef.NamedType (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName Maybe Text
schemaName Text
typeName)) Word
dimensionality Bool
textFormat),
              OidCache -> Maybe a -> [Maybe ByteString]
serializer :: OidCache -> Maybe a -> [Maybe ByteString]
serializer :: OidCache -> Maybe a -> [Maybe ByteString]
serializer,
              Maybe a -> DList Text
printer :: Maybe a -> DList Text
printer :: Maybe a -> DList Text
printer
            }

-- |
-- No parameters. Same as `mempty` and `conquered`.
noParams :: Params ()
noParams :: Params ()
noParams = Params ()
forall a. Monoid a => a
mempty

-- |
-- Lift a single parameter encoder, with its nullability specified,
-- associating it with a single placeholder.
param :: NullableOrNot.NullableOrNot Value.Value a -> Params a
param :: forall a. NullableOrNot Value a -> Params a
param = \case
  NullableOrNot.NonNullable Value a
valueEnc -> Value a -> Params a
forall a. Value a -> Params a
value Value a
valueEnc
  NullableOrNot.Nullable Value a1
valueEnc -> Value a1 -> Params (Maybe a1)
forall a. Value a -> Params (Maybe a)
nullableValue Value a1
valueEnc