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

import Hasql.Codecs.Decoders.NullableOrNot qualified as NullableOrNot
import Hasql.Codecs.Decoders.Value qualified as Value
import Hasql.CodecsVocab.QualifiedTypeName qualified as CodecsVocab.QualifiedTypeName
import Hasql.CodecsVocab.TypeInfo qualified as CodecsVocab.TypeInfo
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 CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Binary.Array a))
  deriving ((forall a b. (a -> b) -> Array a -> Array b)
-> (forall a b. a -> Array b -> Array a) -> Functor Array
forall a b. a -> Array b -> Array a
forall a b. (a -> b) -> Array a -> Array b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Array a -> Array b
fmap :: forall a b. (a -> b) -> Array a -> Array b
$c<$ :: forall a b. a -> Array b -> Array a
<$ :: forall a b. a -> Array b -> Array a
Functor)

{-# INLINE toValueDecoder #-}
toValueDecoder :: Array a -> ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Binary.Value a)
toValueDecoder :: forall a.
Array a -> ToBeResolved QualifiedTypeName TypeInfo (Value a)
toValueDecoder (Array Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
_ Word
_ ToBeResolved QualifiedTypeName TypeInfo (Array a)
decoder) =
  (Array a -> Value a)
-> ToBeResolved QualifiedTypeName TypeInfo (Array a)
-> ToBeResolved QualifiedTypeName TypeInfo (Value a)
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 Array a -> Value a
forall a. Array a -> Value a
Binary.array ToBeResolved QualifiedTypeName TypeInfo (Array a)
decoder

-- | Get the type signature for the array based on element type name
{-# INLINE toTypeSig #-}
toTypeSig :: Array a -> Text
toTypeSig :: forall a. Array a -> Text
toTypeSig (Array Maybe Text
schemaName Text
elementTypeName Maybe Word32
_ Maybe Word32
_ Word
ndims ToBeResolved QualifiedTypeName TypeInfo (Array a)
_) =
  TextBuilder -> Text
TextBuilder.toText
    ( [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
        ( [[TextBuilder]] -> [TextBuilder]
forall a. Monoid a => [a] -> a
mconcat
            [ (Text -> [TextBuilder]) -> Maybe Text -> [TextBuilder]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                (\Text
s -> [Text -> TextBuilder
TextBuilder.text Text
s, Char -> TextBuilder
TextBuilder.char Char
'.'])
                Maybe Text
schemaName,
              [ Text -> TextBuilder
TextBuilder.text Text
elementTypeName
              ],
              Int -> TextBuilder -> [TextBuilder]
forall a. Int -> a -> [a]
replicate
                (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
ndims)
                (Text -> TextBuilder
TextBuilder.text Text
"[]")
            ]
        )
    )

toSchema :: Array a -> Maybe Text
toSchema :: forall a. Array a -> Maybe Text
toSchema (Array Maybe Text
schema Text
_ Maybe Word32
_ Maybe Word32
_ Word
_ ToBeResolved QualifiedTypeName TypeInfo (Array a)
_) = Maybe Text
schema

-- | Get the type name for the array based on element type name
{-# INLINE toTypeName #-}
toTypeName :: Array a -> Text
toTypeName :: forall a. Array a -> Text
toTypeName (Array Maybe Text
_ Text
elementTypeName Maybe Word32
_ Maybe Word32
_ Word
_ ToBeResolved QualifiedTypeName TypeInfo (Array a)
_) =
  Text
elementTypeName

-- | Get the base OID if statically known
{-# INLINE toBaseOid #-}
toBaseOid :: Array a -> Maybe Word32
toBaseOid :: forall a. Array a -> Maybe Word32
toBaseOid (Array Maybe Text
_ Text
_ Maybe Word32
baseOid Maybe Word32
_ Word
_ ToBeResolved QualifiedTypeName TypeInfo (Array a)
_) = Maybe Word32
baseOid

-- | Get the array OID if statically known
{-# INLINE toArrayOid #-}
toArrayOid :: Array a -> Maybe Word32
toArrayOid :: forall a. Array a -> Maybe Word32
toArrayOid (Array Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
arrayOid Word
_ ToBeResolved QualifiedTypeName TypeInfo (Array a)
_) = Maybe Word32
arrayOid

-- | Get the dimensionality of the array
{-# INLINE toDimensionality #-}
toDimensionality :: Array a -> Word
toDimensionality :: forall a. Array a -> Word
toDimensionality (Array Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
_ Word
ndims ToBeResolved QualifiedTypeName TypeInfo (Array a)
_) = Word
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 :: forall a b.
(forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
dimension forall (m :: * -> *). Monad m => Int -> m a -> m b
replicateM (Array Maybe Text
schema Text
typeName Maybe Word32
baseOid Maybe Word32
arrayOid Word
ndims ToBeResolved QualifiedTypeName TypeInfo (Array a)
decoder) =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> ToBeResolved QualifiedTypeName TypeInfo (Array b)
-> Array b
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> ToBeResolved QualifiedTypeName TypeInfo (Array a)
-> Array a
Array
    Maybe Text
schema
    Text
typeName
    Maybe Word32
baseOid
    Maybe Word32
arrayOid
    (Word -> Word
forall a. Enum a => a -> a
succ Word
ndims)
    ((Array a -> Array b)
-> ToBeResolved QualifiedTypeName TypeInfo (Array a)
-> ToBeResolved QualifiedTypeName TypeInfo (Array b)
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 ((forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
forall a b.
(forall (m :: * -> *). Monad m => Int -> m a -> m b)
-> Array a -> Array b
Binary.dimensionArray Int -> m a -> m b
forall (m :: * -> *). Monad m => Int -> m a -> m b
replicateM) ToBeResolved QualifiedTypeName TypeInfo (Array a)
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 :: forall a. NullableOrNot Value a -> Array a
element = \case
  NullableOrNot.NonNullable Value a
imp ->
    Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> ToBeResolved QualifiedTypeName TypeInfo (Array a)
-> Array a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> ToBeResolved QualifiedTypeName TypeInfo (Array a)
-> Array a
Array
      (Value a -> Maybe Text
forall a. Value a -> Maybe Text
Value.toSchema Value a
imp)
      (Value a -> Text
forall a. Value a -> Text
Value.toTypeName Value a
imp)
      (Value a -> Maybe Word32
forall a. Value a -> Maybe Word32
Value.toBaseOid Value a
imp)
      (Value a -> Maybe Word32
forall a. Value a -> Maybe Word32
Value.toArrayOid Value a
imp)
      Word
1
      ((Value a -> Array a)
-> ToBeResolved QualifiedTypeName TypeInfo (Value a)
-> ToBeResolved QualifiedTypeName TypeInfo (Array a)
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 Value a -> Array a
forall a. Value a -> Array a
Binary.valueArray (Value a -> ToBeResolved QualifiedTypeName TypeInfo (Value a)
forall a.
Value a -> ToBeResolved QualifiedTypeName TypeInfo (Value a)
Value.toDecoder Value a
imp))
  NullableOrNot.Nullable Value a1
imp ->
    Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> ToBeResolved QualifiedTypeName TypeInfo (Array a)
-> Array a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> ToBeResolved QualifiedTypeName TypeInfo (Array a)
-> Array a
Array
      (Value a1 -> Maybe Text
forall a. Value a -> Maybe Text
Value.toSchema Value a1
imp)
      (Value a1 -> Text
forall a. Value a -> Text
Value.toTypeName Value a1
imp)
      (Value a1 -> Maybe Word32
forall a. Value a -> Maybe Word32
Value.toBaseOid Value a1
imp)
      (Value a1 -> Maybe Word32
forall a. Value a -> Maybe Word32
Value.toArrayOid Value a1
imp)
      Word
1
      ((Value a1 -> Array a)
-> ToBeResolved QualifiedTypeName TypeInfo (Value a1)
-> ToBeResolved QualifiedTypeName TypeInfo (Array a)
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 Value a1 -> Array a
Value a1 -> Array (Maybe a1)
forall a. Value a -> Array (Maybe a)
Binary.nullableValueArray (Value a1 -> ToBeResolved QualifiedTypeName TypeInfo (Value a1)
forall a.
Value a -> ToBeResolved QualifiedTypeName TypeInfo (Value a)
Value.toDecoder Value a1
imp))