hasql/library/Hasql/Encoders/Params.hs

module Hasql.Encoders.Params where

import Hasql.Encoders.Value qualified as C
import Hasql.LibPq14 qualified as A
import Hasql.PostgresTypeInfo qualified as D
import Hasql.Prelude
import PostgreSQL.Binary.Encoding qualified as B
import Text.Builder qualified as E

renderReadable :: Params a -> a -> [Text]
renderReadable (Params _ _ _ printer) params =
  printer params
    & toList

compilePreparedStatementData :: Params a -> Bool -> a -> ([A.Oid], [Maybe (ByteString, A.Format)])
compilePreparedStatementData (Params _ columnsMetadata serializer _) integerDatetimes input =
  (oidList, valueAndFormatList)
  where
    (oidList, formatList) =
      columnsMetadata & toList & unzip
    valueAndFormatList =
      serializer integerDatetimes input
        & toList
        & zipWith (\format encoding -> (,format) <$> encoding) formatList

compileUnpreparedStatementData :: Params a -> Bool -> a -> [Maybe (A.Oid, ByteString, A.Format)]
compileUnpreparedStatementData (Params _ columnsMetadata serializer printer) integerDatetimes input =
  zipWith
    ( \(oid, format) encoding ->
        (,,) <$> pure oid <*> encoding <*> pure format
    )
    (toList columnsMetadata)
    (toList (serializer integerDatetimes input))

-- |
-- Encoder of some representation of a parameters product.
data Params a = Params
  { size :: !Int,
    columnsMetadata :: !(DList (A.Oid, A.Format)),
    serializer :: Bool -> a -> DList (Maybe ByteString),
    printer :: a -> DList Text
  }

instance Contravariant Params where
  contramap fn (Params size columnsMetadata oldSerializer oldPrinter) = Params {..}
    where
      serializer idt = oldSerializer idt . fn
      printer = oldPrinter . fn

instance Divisible Params where
  divide
    divisor
    (Params leftSize leftColumnsMetadata leftSerializer leftPrinter)
    (Params rightSize rightColumnsMetadata rightSerializer rightPrinter) =
      Params
        { size = leftSize + rightSize,
          columnsMetadata = leftColumnsMetadata <> rightColumnsMetadata,
          serializer = \idt input -> case divisor input of
            (leftInput, rightInput) -> leftSerializer idt leftInput <> rightSerializer idt rightInput,
          printer = \input -> case divisor input of
            (leftInput, rightInput) -> leftPrinter leftInput <> rightPrinter rightInput
        }
  conquer =
    Params
      { size = 0,
        columnsMetadata = mempty,
        serializer = mempty,
        printer = mempty
      }

instance Semigroup (Params a) where
  Params leftSize leftColumnsMetadata leftSerializer leftPrinter <> Params rightSize rightColumnsMetadata rightSerializer rightPrinter =
    Params
      { size = leftSize + rightSize,
        columnsMetadata = leftColumnsMetadata <> rightColumnsMetadata,
        serializer = \idt input -> leftSerializer idt input <> rightSerializer idt input,
        printer = \input -> leftPrinter input <> rightPrinter input
      }

instance Monoid (Params a) where
  mempty = conquer

value :: C.Value a -> Params a
value (C.Value valueOID _ serialize print) =
  Params
    { size = 1,
      columnsMetadata = pure (pqOid, format),
      serializer = \idt -> pure . Just . B.encodingBytes . serialize idt,
      printer = pure . E.run . print
    }
  where
    D.OID _ pqOid format = valueOID

nullableValue :: C.Value a -> Params (Maybe a)
nullableValue (C.Value valueOID _ serialize print) =
  Params
    { size = 1,
      columnsMetadata = pure (pqOid, format),
      serializer = \idt -> pure . fmap (B.encodingBytes . serialize idt),
      printer = pure . maybe "null" (E.run . print)
    }
  where
    D.OID _ pqOid format = valueOID