module Hasql.Codecs.Decoders.Composite 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.Codecs.Vocab.QualifiedTypeName qualified as Vocab.QualifiedTypeName
import Hasql.Codecs.Vocab.TypeInfo qualified as Vocab.TypeInfo
import Hasql.Platform.Prelude
import PostgreSQL.Binary.Decoding qualified as Binary

-- |
-- Composable decoder of composite values (rows, records).
newtype Composite a
  = Composite (RequestingOid.RequestingOid (Binary.Composite a))
  deriving
    ((forall a b. (a -> b) -> Composite a -> Composite b)
-> (forall a b. a -> Composite b -> Composite a)
-> Functor Composite
forall a b. a -> Composite b -> Composite a
forall a b. (a -> b) -> Composite a -> Composite 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) -> Composite a -> Composite b
fmap :: forall a b. (a -> b) -> Composite a -> Composite b
$c<$ :: forall a b. a -> Composite b -> Composite a
<$ :: forall a b. a -> Composite b -> Composite a
Functor, Functor Composite
Functor Composite =>
(forall a. a -> Composite a)
-> (forall a b. Composite (a -> b) -> Composite a -> Composite b)
-> (forall a b c.
    (a -> b -> c) -> Composite a -> Composite b -> Composite c)
-> (forall a b. Composite a -> Composite b -> Composite b)
-> (forall a b. Composite a -> Composite b -> Composite a)
-> Applicative Composite
forall a. a -> Composite a
forall a b. Composite a -> Composite b -> Composite a
forall a b. Composite a -> Composite b -> Composite b
forall a b. Composite (a -> b) -> Composite a -> Composite b
forall a b c.
(a -> b -> c) -> Composite a -> Composite b -> Composite c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Composite a
pure :: forall a. a -> Composite a
$c<*> :: forall a b. Composite (a -> b) -> Composite a -> Composite b
<*> :: forall a b. Composite (a -> b) -> Composite a -> Composite b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Composite a -> Composite b -> Composite c
liftA2 :: forall a b c.
(a -> b -> c) -> Composite a -> Composite b -> Composite c
$c*> :: forall a b. Composite a -> Composite b -> Composite b
*> :: forall a b. Composite a -> Composite b -> Composite b
$c<* :: forall a b. Composite a -> Composite b -> Composite a
<* :: forall a b. Composite a -> Composite b -> Composite a
Applicative)
    via (Compose RequestingOid.RequestingOid Binary.Composite)

toValueDecoder :: Composite a -> RequestingOid.RequestingOid (Binary.Value a)
toValueDecoder :: forall a. Composite a -> RequestingOid (Value a)
toValueDecoder (Composite RequestingOid (Composite a)
imp) =
  (Composite a -> Value a)
-> RequestingOid (Composite a)
-> LookingUp QualifiedTypeName TypeInfo (Value a)
forall a b.
(a -> b)
-> LookingUp QualifiedTypeName TypeInfo a
-> LookingUp QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Composite a -> Value a
forall a. Composite a -> Value a
Binary.composite RequestingOid (Composite a)
imp

-- |
-- Lift a 'Value.Value' decoder into a 'Composite' decoder for parsing of component values.
field :: NullableOrNot.NullableOrNot Value.Value a -> Composite a
field :: forall a. NullableOrNot Value a -> Composite a
field = \case
  NullableOrNot.NonNullable Value a
imp ->
    let dimensionality :: Word
dimensionality = Value a -> Word
forall a. Value a -> Word
Value.toDimensionality Value a
imp
        staticOid :: Maybe Word32
staticOid = if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Value a -> Maybe Word32
forall a. Value a -> Maybe Word32
Value.toBaseOid Value a
imp else Value a -> Maybe Word32
forall a. Value a -> Maybe Word32
Value.toArrayOid Value a
imp
     in case Maybe Word32
staticOid of
          Just Word32
oid ->
            RequestingOid (Composite a) -> Composite a
forall a. RequestingOid (Composite a) -> Composite a
Composite ((BinaryParser a -> Composite a)
-> LookingUp QualifiedTypeName TypeInfo (BinaryParser a)
-> RequestingOid (Composite a)
forall a b.
(a -> b)
-> LookingUp QualifiedTypeName TypeInfo a
-> LookingUp QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> BinaryParser a -> Composite a
forall a. Word32 -> Value a -> Composite a
Binary.typedValueComposite Word32
oid) (Value a -> LookingUp QualifiedTypeName TypeInfo (BinaryParser a)
forall a. Value a -> RequestingOid (Value a)
Value.toDecoder Value a
imp))
          Maybe Word32
Nothing ->
            RequestingOid (Composite a) -> Composite a
forall a. RequestingOid (Composite a) -> Composite a
Composite
              ( QualifiedTypeName
-> (TypeInfo -> BinaryParser a -> Composite a)
-> LookingUp QualifiedTypeName TypeInfo (BinaryParser a)
-> RequestingOid (Composite a)
forall a b.
QualifiedTypeName
-> (TypeInfo -> a -> b) -> RequestingOid a -> RequestingOid b
RequestingOid.hoistLookingUp
                  (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName (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))
                  (\TypeInfo
typeInfo BinaryParser a
decoder -> Word32 -> BinaryParser a -> Composite a
forall a. Word32 -> Value a -> Composite a
Binary.typedValueComposite (if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then TypeInfo -> Word32
Vocab.TypeInfo.toBaseOid TypeInfo
typeInfo else TypeInfo -> Word32
Vocab.TypeInfo.toArrayOid TypeInfo
typeInfo) BinaryParser a
decoder)
                  (Value a -> LookingUp QualifiedTypeName TypeInfo (BinaryParser a)
forall a. Value a -> RequestingOid (Value a)
Value.toDecoder Value a
imp)
              )
  NullableOrNot.Nullable Value a1
imp ->
    let dimensionality :: Word
dimensionality = Value a1 -> Word
forall a. Value a -> Word
Value.toDimensionality Value a1
imp
        staticOid :: Maybe Word32
staticOid = if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then Value a1 -> Maybe Word32
forall a. Value a -> Maybe Word32
Value.toBaseOid Value a1
imp else Value a1 -> Maybe Word32
forall a. Value a -> Maybe Word32
Value.toArrayOid Value a1
imp
     in case Maybe Word32
staticOid of
          Just Word32
oid ->
            RequestingOid (Composite a) -> Composite a
forall a. RequestingOid (Composite a) -> Composite a
Composite ((BinaryParser a1 -> Composite a)
-> LookingUp QualifiedTypeName TypeInfo (BinaryParser a1)
-> RequestingOid (Composite a)
forall a b.
(a -> b)
-> LookingUp QualifiedTypeName TypeInfo a
-> LookingUp QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> BinaryParser a1 -> Composite (Maybe a1)
forall a. Word32 -> Value a -> Composite (Maybe a)
Binary.typedNullableValueComposite Word32
oid) (Value a1 -> LookingUp QualifiedTypeName TypeInfo (BinaryParser a1)
forall a. Value a -> RequestingOid (Value a)
Value.toDecoder Value a1
imp))
          Maybe Word32
Nothing ->
            RequestingOid (Composite a) -> Composite a
forall a. RequestingOid (Composite a) -> Composite a
Composite
              ( QualifiedTypeName
-> (TypeInfo -> BinaryParser a1 -> Composite a)
-> LookingUp QualifiedTypeName TypeInfo (BinaryParser a1)
-> RequestingOid (Composite a)
forall a b.
QualifiedTypeName
-> (TypeInfo -> a -> b) -> RequestingOid a -> RequestingOid b
RequestingOid.hoistLookingUp
                  (Maybe Text -> Text -> QualifiedTypeName
Vocab.QualifiedTypeName.QualifiedTypeName (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))
                  (\TypeInfo
typeInfo BinaryParser a1
decoder -> Word32 -> BinaryParser a1 -> Composite (Maybe a1)
forall a. Word32 -> Value a -> Composite (Maybe a)
Binary.typedNullableValueComposite (if Word
dimensionality Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0 then TypeInfo -> Word32
Vocab.TypeInfo.toBaseOid TypeInfo
typeInfo else TypeInfo -> Word32
Vocab.TypeInfo.toArrayOid TypeInfo
typeInfo) BinaryParser a1
decoder)
                  (Value a1 -> LookingUp QualifiedTypeName TypeInfo (BinaryParser a1)
forall a. Value a -> RequestingOid (Value a)
Value.toDecoder Value a1
imp)
              )