module Main.Composite where

import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import qualified Main.Gens as Gens
import Main.Prelude hiding (choose, isLeft, isRight)
import qualified PostgreSQL.Binary.Decoding as Decoding
import qualified PostgreSQL.Binary.Encoding as Encoding
import Test.QuickCheck hiding (vector)

newtype Composite = Composite [CompositeFieldValue]
  deriving (Show, Eq, Ord)

instance Arbitrary Composite where
  arbitrary = Composite <$> listOf arbitrary

data CompositeFieldValue
  = Int4CompositeFieldValue !(Maybe Int32)
  | TextCompositeFieldValue !(Maybe Text)
  | JsonbCompositeFieldValue !(Maybe Aeson.Value)
  deriving (Show, Eq, Ord)

instance Arbitrary CompositeFieldValue where
  arbitrary =
    oneof
      [ Int4CompositeFieldValue <$> arbitrary,
        TextCompositeFieldValue <$> Gens.maybeOf Gens.text,
        JsonbCompositeFieldValue <$> Gens.maybeOf Gens.aeson
      ]

encodeToByteString :: Composite -> ByteString
encodeToByteString = Encoding.encodingBytes . encodeComposite

encodeComposite :: Composite -> Encoding.Encoding
encodeComposite (Composite fields) =
  Encoding.composite $ foldMap compositeField fields
  where
    compositeField = \case
      Int4CompositeFieldValue z -> fieldEncoder 23 Encoding.int4_int32 z
      TextCompositeFieldValue z -> fieldEncoder 25 Encoding.text_strict z
      JsonbCompositeFieldValue z -> fieldEncoder 3802 Encoding.jsonb_ast z
      where
        fieldEncoder oid encoder = \case
          Nothing -> Encoding.nullField oid
          Just value -> Encoding.field oid $ encoder value

decodingProperty :: Composite -> ByteString -> Property
decodingProperty composite input =
  case Decoding.valueParser (decoder composite) input of
    Right p -> p
    Left err -> counterexample (Text.unpack err) False

decoder :: Composite -> Decoding.Value Property
decoder (Composite fields) =
  conjoin <$> Decoding.composite (traverse field fields)
  where
    field = \case
      Int4CompositeFieldValue z -> expect z Decoding.int
      TextCompositeFieldValue z -> expect z Decoding.text_strict
      JsonbCompositeFieldValue z -> expect z Decoding.jsonb_ast
      where
        expect expectedValue decoder =
          case expectedValue of
            Just expectedValue ->
              Decoding.valueComposite decoder <&> (===) expectedValue
            Nothing ->
              Decoding.nullableValueComposite decoder <&> (===) Nothing