Array.hs

module Hasql.Codecs.Decoders.Array
  ( Array,
    toValueDecoder,
    toTypeSig,
    toSchema,
    toTypeName,
    toBaseOid,
    toArrayOid,
    toDimensionality,
    dimension,
    element,
  )
where

import CodecVocab.QualifiedTypeName qualified as CodecVocab.QualifiedTypeName
import CodecVocab.TypeInfo qualified as CodecVocab.TypeInfo
import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot
import Hasql.Codecs.Decoders.Value qualified as Value
import Hasql.Platform.Prelude
import Hasql.ToBeResolved qualified as ToBeResolved
import PostgreSQL.Binary.Decoding qualified as Binary
import TextBuilder qualified

-- |
-- Binary generic array decoder.
--
-- Here's how you can use it to produce a specific array value decoder:
--
-- @
-- x :: 'Value.Value' [[Text]]
-- x = 'array' ('dimension' 'replicateM' ('dimension' 'replicateM' ('element' ('nonNullable' 'text'))))
-- @
data Array a
  = Array
      -- | Schema name.
      (Maybe Text)
      -- | Type name for the array element.
      Text
      -- | Statically known OID for the base (element) type.
      (Maybe Word32)
      -- | Statically known OID for the array type.
      (Maybe Word32)
      -- | Number of dimensions.
      Word
      -- | Decoding function
      (ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Array a))
  deriving (Functor)

{-# INLINE toValueDecoder #-}
toValueDecoder :: Array a -> ToBeResolved.ToBeResolved CodecVocab.QualifiedTypeName.QualifiedTypeName CodecVocab.TypeInfo.TypeInfo (Binary.Value a)
toValueDecoder (Array _ _ _ _ _ decoder) =
  fmap Binary.array decoder

-- | Get the type signature for the array based on element type name
{-# INLINE toTypeSig #-}
toTypeSig :: Array a -> Text
toTypeSig (Array schemaName elementTypeName _ _ ndims _) =
  TextBuilder.toText
    ( mconcat
        ( mconcat
            [ foldMap
                (\s -> [TextBuilder.text s, TextBuilder.char '.'])
                schemaName,
              [ TextBuilder.text elementTypeName
              ],
              replicate
                (fromIntegral ndims)
                (TextBuilder.text "[]")
            ]
        )
    )

toSchema :: Array a -> Maybe Text
toSchema (Array schema _ _ _ _ _) = schema

-- | Get the type name for the array based on element type name
{-# INLINE toTypeName #-}
toTypeName :: Array a -> Text
toTypeName (Array _ elementTypeName _ _ _ _) =
  elementTypeName

-- | Get the base OID if statically known
{-# INLINE toBaseOid #-}
toBaseOid :: Array a -> Maybe Word32
toBaseOid (Array _ _ baseOid _ _ _) = baseOid

-- | Get the array OID if statically known
{-# INLINE toArrayOid #-}
toArrayOid :: Array a -> Maybe Word32
toArrayOid (Array _ _ _ arrayOid _ _) = arrayOid

-- | Get the dimensionality of the array
{-# INLINE toDimensionality #-}
toDimensionality :: Array a -> Word
toDimensionality (Array _ _ _ _ ndims _) = ndims

-- * Public API

-- |
-- Binary function for parsing a dimension of an array.
-- Provides support for multi-dimensional arrays.
--
-- Accepts:
--
-- * An implementation of the @replicateM@ function
-- (@Control.Monad.'Control.Monad.replicateM'@, @Data.Vector.'Data.Vector.replicateM'@),
-- which determines the output value.
--
-- * Binary decoder of its components, which can be either another 'dimension' or 'element'.
{-# INLINEABLE dimension #-}
dimension :: (forall m. (Monad m) => Int -> m a -> m b) -> Array a -> Array b
dimension replicateM (Array schema typeName baseOid arrayOid ndims decoder) =
  Array
    schema
    typeName
    baseOid
    arrayOid
    (succ ndims)
    (fmap (Binary.dimensionArray replicateM) decoder)

-- |
-- Lift a 'Value.Value' decoder into an 'Array' decoder for parsing of leaf values.
{-# INLINEABLE element #-}
element :: NullableOrNot.NullableOrNot Value.Value a -> Array a
element = \case
  NullableOrNot.NonNullable imp ->
    Array
      (Value.toSchema imp)
      (Value.toTypeName imp)
      (Value.toBaseOid imp)
      (Value.toArrayOid imp)
      1
      (fmap Binary.valueArray (Value.toDecoder imp))
  NullableOrNot.Nullable imp ->
    Array
      (Value.toSchema imp)
      (Value.toTypeName imp)
      (Value.toBaseOid imp)
      (Value.toArrayOid imp)
      1
      (fmap Binary.nullableValueArray (Value.toDecoder imp))