StructuralConformance.hs

-- @generated by keiro-dsl 0.12.0.0 (language keiro-dsl 5) from context mapped-queue structural conformance; do not edit.
module Generated.MappedQueue.StructuralConformance
  ( structuralConformanceAssertions
  ) where

import Data.Aeson qualified as Aeson
import Data.List (nub)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Maybe (isJust, isNothing)
import Data.Proxy (Proxy (..))
import Data.Text qualified as T
import Keiki.Core (fieldWitnessAgrees)
import Keiki.Shape (CanonicalTypeName (..))
import Keiro.Codec.Structural (FixtureCases (..), bindingDomainRoundTrip, bindingShapeRoundTrip, bindingToShape)
import Generated.MappedQueue.StructuralProjections qualified as StructuralProjections
import Conformance.MappedQueue.Bindings qualified as Bindings
import Conformance.MappedQueue.Domain (JobMetadata, JobPayload)
import Generated.MappedQueue.Structural.Shape.JobMetadata qualified as ShapeJobMetadata
import Generated.MappedQueue.Structural.Shape.JobPayload qualified as ShapeJobPayload

structuralConformanceAssertions :: [(String, Bool)]
structuralConformanceAssertions =
  concat
    [ jobMetadataBindingAssertions
    , jobPayloadBindingAssertions
    , vendorGeometryOpaqueAssertions
    , [("fixture coverage: conformance.mapped-queue.JobMetadata.v1", coverageJobMetadata)]
    , [("fixture coverage: conformance.mapped-queue.JobPayload.v1", coverageJobPayload)]
    , structuralProjectionAssertions
    ]

validFixtureLabels :: NonEmpty.NonEmpty (T.Text, value) -> Bool
validFixtureLabels cases =
  all (not . T.null) labels && length labels == length (nub labels)
  where
    labels = map fst (NonEmpty.toList cases)

jobMetadataBindingAssertions :: [(String, Bool)]
jobMetadataBindingAssertions =
  ("fixture labels: conformance.mapped-queue.JobMetadata.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.mapped-queue.JobMetadata.v1", canonicalTypeName (Proxy @JobMetadata) == "conformance.mapped-queue.JobMetadata.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.mapped-queue.JobMetadata.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.jobMetadataBinding value)
      , ("binding shape round-trip: conformance.mapped-queue.JobMetadata.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.jobMetadataBinding (bindingToShape Bindings.jobMetadataBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.jobMetadataCases

jobPayloadBindingAssertions :: [(String, Bool)]
jobPayloadBindingAssertions =
  ("fixture labels: conformance.mapped-queue.JobPayload.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.mapped-queue.JobPayload.v1", canonicalTypeName (Proxy @JobPayload) == "conformance.mapped-queue.JobPayload.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.mapped-queue.JobPayload.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.jobPayloadBinding value)
      , ("binding shape round-trip: conformance.mapped-queue.JobPayload.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.jobPayloadBinding (bindingToShape Bindings.jobPayloadBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.jobPayloadCases

vendorGeometryOpaqueAssertions :: [(String, Bool)]
vendorGeometryOpaqueAssertions =
  ("opaque boundary fixtures: vendor.geometry.json@3", validFixtureLabels cases) :
  [ ("opaque codec round-trip: vendor.geometry.json@3/" <> T.unpack caseLabel, case Aeson.fromJSON (Aeson.toJSON value) of Aeson.Success decoded -> decoded == value; Aeson.Error _ -> False)
  | (caseLabel, value) <- NonEmpty.toList cases
  ]
  where
    cases = fixtureCases Bindings.geometryCases

coverageJobMetadata :: Bool
coverageJobMetadata = any (isNothing . ShapeJobMetadata.note) shapes && any (isJust . ShapeJobMetadata.note) shapes
  where
    shapes = map (bindingToShape Bindings.jobMetadataBinding . snd) (NonEmpty.toList (fixtureCases Bindings.jobMetadataCases))

coverageJobPayload :: Bool
coverageJobPayload = any (isNothing . ShapeJobPayload.metadata) shapes && any (isJust . ShapeJobPayload.metadata) shapes
  where
    shapes = map (bindingToShape Bindings.jobPayloadBinding . snd) (NonEmpty.toList (fixtureCases Bindings.jobPayloadCases))

structuralProjectionAssertions :: [(String, Bool)]
structuralProjectionAssertions =
  [ ("projection witness agreement: conformance.mapped-queue.JobPayload.v1/job_id", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.jobPayloadJobIdWitness (\referenceOwner -> ShapeJobPayload.jobId (bindingToShape Bindings.jobPayloadBinding referenceOwner)) owner) (NonEmpty.toList (fixtureCases Bindings.jobPayloadCases)))
  , ("projection witness agreement: conformance.mapped-queue.JobPayload.v1/label", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.jobPayloadLabelWitness (\referenceOwner -> ShapeJobPayload.label (bindingToShape Bindings.jobPayloadBinding referenceOwner)) owner) (NonEmpty.toList (fixtureCases Bindings.jobPayloadCases)))
  ]