StructuralConformance.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from context id-admission-domains structural conformance; do not edit.
module Generated.IdAdmissionDomains.StructuralConformance
  ( structuralConformanceAssertions
  ) where

import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as AesonTypes
import Data.List (nub)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map.Strict qualified as Map
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.IdAdmissionDomains.StructuralProjections qualified as StructuralProjections
import Generated.IdAdmissionDomains.Structural.Shape.IdentityEnvelope (IdentityEnvelopeShape(previousId))
import Conformance.IdAdmissionDomains.Bindings qualified as Bindings
import Conformance.IdAdmissionDomains.Domain (IdentityEnvelope)
import Generated.IdAdmissionDomains.Nominals qualified as Nominals
import Generated.IdAdmissionDomains.Structural.NominalLeaves qualified as NominalLeaves
import Generated.IdAdmissionDomains.Structural.Shape.IdentityEnvelope qualified as ShapeIdentityEnvelope

structuralConformanceAssertions :: [(String, Bool)]
structuralConformanceAssertions =
  concat
    [ identityEnvelopeBindingAssertions
    , [("generated nominal canonical text: conformance.id-admission-domains.IdentityEnvelope.v1/LegacyId", all (\(_, value) -> (case bindingToShape Bindings.identityEnvelopeBinding value of ShapeIdentityEnvelope.IdentityEnvelope field0_0 field0_1 field0_2 -> ((NominalLeaves.encodeLegacyIdLeaf (field0_0) == Aeson.String (Nominals.legacyIdText (field0_0)) && AesonTypes.parseEither NominalLeaves.parseLegacyIdLeaf (NominalLeaves.encodeLegacyIdLeaf (field0_0)) == Right (field0_0))) && (maybe True (\item1 -> (NominalLeaves.encodeLegacyIdLeaf (item1) == Aeson.String (Nominals.legacyIdText (item1)) && AesonTypes.parseEither NominalLeaves.parseLegacyIdLeaf (NominalLeaves.encodeLegacyIdLeaf (item1)) == Right (item1))) (field0_1)) && ((all (\key1 -> (NominalLeaves.encodeLegacyIdLeaf (key1) == Aeson.String (Nominals.legacyIdText (key1)) && AesonTypes.parseEither NominalLeaves.parseLegacyIdLeaf (NominalLeaves.encodeLegacyIdLeaf (key1)) == Right (key1))) (Map.keys (field0_2)))))) (NonEmpty.toList (fixtureCases Bindings.identityEnvelopeFixtures)))]
    , [("fixture coverage: conformance.id-admission-domains.IdentityEnvelope.v1", coverageIdentityEnvelope)]
    , 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)

identityEnvelopeBindingAssertions :: [(String, Bool)]
identityEnvelopeBindingAssertions =
  ("fixture labels: conformance.id-admission-domains.IdentityEnvelope.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.id-admission-domains.IdentityEnvelope.v1", canonicalTypeName (Proxy @IdentityEnvelope) == "conformance.id-admission-domains.IdentityEnvelope.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.id-admission-domains.IdentityEnvelope.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.identityEnvelopeBinding value)
      , ("binding shape round-trip: conformance.id-admission-domains.IdentityEnvelope.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.identityEnvelopeBinding (bindingToShape Bindings.identityEnvelopeBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.identityEnvelopeFixtures

coverageIdentityEnvelope :: Bool
coverageIdentityEnvelope = any (isNothing . (.previousId)) shapes && any (isJust . (.previousId)) shapes
  where
    shapes = map (bindingToShape Bindings.identityEnvelopeBinding . snd) (NonEmpty.toList (fixtureCases Bindings.identityEnvelopeFixtures))

structuralProjectionAssertions :: [(String, Bool)]
structuralProjectionAssertions =
  [ ("projection witness agreement: conformance.id-admission-domains.IdentityEnvelope.v1/legacyId", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.identityEnvelopeLegacyIdWitness (\referenceOwner -> StructuralProjections.identityEnvelopeLegacyIdGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.identityEnvelopeFixtures)))
  ]