module Hasql.Codecs.Decoders.Composite 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

-- |
-- Composable decoder of composite values (rows, records).
newtype Composite a
  = Composite (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (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 (ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo) Binary.Composite)

toValueDecoder :: Composite a -> ToBeResolved.ToBeResolved CodecsVocab.QualifiedTypeName.QualifiedTypeName CodecsVocab.TypeInfo.TypeInfo (Binary.Value a)
toValueDecoder :: forall a.
Composite a -> ToBeResolved QualifiedTypeName TypeInfo (Value a)
toValueDecoder (Composite ToBeResolved QualifiedTypeName TypeInfo (Composite a)
imp) =
  (Composite a -> Value a)
-> ToBeResolved QualifiedTypeName TypeInfo (Composite 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 Composite a -> Value a
forall a. Composite a -> Value a
Binary.composite ToBeResolved QualifiedTypeName TypeInfo (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 ->
            ToBeResolved QualifiedTypeName TypeInfo (Composite a)
-> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (Composite a)
-> Composite a
Composite ((Value a -> Composite a)
-> ToBeResolved QualifiedTypeName TypeInfo (Value a)
-> ToBeResolved QualifiedTypeName TypeInfo (Composite 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 (Word32 -> Value a -> Composite a
forall a. Word32 -> Value a -> Composite a
Binary.typedValueComposite Word32
oid) (Value a -> ToBeResolved QualifiedTypeName TypeInfo (Value a)
forall a.
Value a -> ToBeResolved QualifiedTypeName TypeInfo (Value a)
Value.toDecoder Value a
imp))
          Maybe Word32
Nothing ->
            ToBeResolved QualifiedTypeName TypeInfo (Composite a)
-> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (Composite a)
-> Composite a
Composite
              ( (\TypeInfo
typeInfo Value a
decoder -> Word32 -> Value 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
CodecsVocab.TypeInfo.toBaseOid TypeInfo
typeInfo else TypeInfo -> Word32
CodecsVocab.TypeInfo.toArrayOid TypeInfo
typeInfo) Value a
decoder)
                  (TypeInfo -> Value a -> Composite a)
-> ToBeResolved QualifiedTypeName TypeInfo TypeInfo
-> ToBeResolved QualifiedTypeName TypeInfo (Value a -> Composite a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedTypeName
-> ToBeResolved QualifiedTypeName TypeInfo TypeInfo
forall k v. k -> ToBeResolved k v v
ToBeResolved.lookup (Maybe Text -> Text -> QualifiedTypeName
CodecsVocab.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))
                  ToBeResolved QualifiedTypeName TypeInfo (Value a -> Composite a)
-> ToBeResolved QualifiedTypeName TypeInfo (Value a)
-> ToBeResolved QualifiedTypeName TypeInfo (Composite a)
forall a b.
ToBeResolved QualifiedTypeName TypeInfo (a -> b)
-> ToBeResolved QualifiedTypeName TypeInfo a
-> ToBeResolved QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 ->
    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 ->
            ToBeResolved QualifiedTypeName TypeInfo (Composite a)
-> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (Composite a)
-> Composite a
Composite ((Value a1 -> Composite a)
-> ToBeResolved QualifiedTypeName TypeInfo (Value a1)
-> ToBeResolved QualifiedTypeName TypeInfo (Composite 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 (Word32 -> Value a1 -> Composite (Maybe a1)
forall a. Word32 -> Value a -> Composite (Maybe a)
Binary.typedNullableValueComposite Word32
oid) (Value a1 -> ToBeResolved QualifiedTypeName TypeInfo (Value a1)
forall a.
Value a -> ToBeResolved QualifiedTypeName TypeInfo (Value a)
Value.toDecoder Value a1
imp))
          Maybe Word32
Nothing ->
            ToBeResolved QualifiedTypeName TypeInfo (Composite a)
-> Composite a
forall a.
ToBeResolved QualifiedTypeName TypeInfo (Composite a)
-> Composite a
Composite
              ( (\TypeInfo
typeInfo Value a1
decoder -> Word32 -> Value 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
CodecsVocab.TypeInfo.toBaseOid TypeInfo
typeInfo else TypeInfo -> Word32
CodecsVocab.TypeInfo.toArrayOid TypeInfo
typeInfo) Value a1
decoder)
                  (TypeInfo -> Value a1 -> Composite a)
-> ToBeResolved QualifiedTypeName TypeInfo TypeInfo
-> ToBeResolved
     QualifiedTypeName TypeInfo (Value a1 -> Composite a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualifiedTypeName
-> ToBeResolved QualifiedTypeName TypeInfo TypeInfo
forall k v. k -> ToBeResolved k v v
ToBeResolved.lookup (Maybe Text -> Text -> QualifiedTypeName
CodecsVocab.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))
                  ToBeResolved QualifiedTypeName TypeInfo (Value a1 -> Composite a)
-> ToBeResolved QualifiedTypeName TypeInfo (Value a1)
-> ToBeResolved QualifiedTypeName TypeInfo (Composite a)
forall a b.
ToBeResolved QualifiedTypeName TypeInfo (a -> b)
-> ToBeResolved QualifiedTypeName TypeInfo a
-> ToBeResolved QualifiedTypeName TypeInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value a1 -> ToBeResolved QualifiedTypeName TypeInfo (Value a1)
forall a.
Value a -> ToBeResolved QualifiedTypeName TypeInfo (Value a)
Value.toDecoder Value a1
imp
              )