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.Codecs.RequestingOid qualified as RequestingOid
import Hasql.Platform.Prelude
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
      (RequestingOid.RequestingOid (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 -> RequestingOid.RequestingOid (Binary.Value a)
toValueDecoder :: forall a. Array a -> RequestingOid (Value a)
toValueDecoder (Array Maybe Text
_ Text
_ Maybe Word32
_ Maybe Word32
_ Word
_ RequestingOid (Array a)
decoder) =
  (Array a -> Value a)
-> RequestingOid (Array a)
-> LookingUp (Maybe Text, Text) (Word32, Word32) (Value a)
forall a b.
(a -> b)
-> LookingUp (Maybe Text, Text) (Word32, Word32) a
-> LookingUp (Maybe Text, Text) (Word32, Word32) 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 RequestingOid (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 RequestingOid (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
_ RequestingOid (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
_ RequestingOid (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
_ RequestingOid (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
_ RequestingOid (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 RequestingOid (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 RequestingOid (Array a)
decoder) =
  Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Array b)
-> Array b
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (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)
-> RequestingOid (Array a) -> RequestingOid (Array b)
forall a b.
(a -> b)
-> LookingUp (Maybe Text, Text) (Word32, Word32) a
-> LookingUp (Maybe Text, Text) (Word32, Word32) 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) RequestingOid (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
-> RequestingOid (Array a)
-> Array a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (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)
-> LookingUp (Maybe Text, Text) (Word32, Word32) (Value a)
-> RequestingOid (Array a)
forall a b.
(a -> b)
-> LookingUp (Maybe Text, Text) (Word32, Word32) a
-> LookingUp (Maybe Text, Text) (Word32, Word32) 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 -> LookingUp (Maybe Text, Text) (Word32, Word32) (Value a)
forall a. Value a -> RequestingOid (Value a)
Value.toDecoder Value a
imp))
  NullableOrNot.Nullable Value a1
imp ->
    Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (Array a)
-> Array a
forall a.
Maybe Text
-> Text
-> Maybe Word32
-> Maybe Word32
-> Word
-> RequestingOid (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)
-> LookingUp (Maybe Text, Text) (Word32, Word32) (Value a1)
-> RequestingOid (Array a)
forall a b.
(a -> b)
-> LookingUp (Maybe Text, Text) (Word32, Word32) a
-> LookingUp (Maybe Text, Text) (Word32, Word32) 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
-> LookingUp (Maybe Text, Text) (Word32, Word32) (Value a1)
forall a. Value a -> RequestingOid (Value a)
Value.toDecoder Value a1
imp))