StructuralConformance.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from context checked-mapping-replay structural conformance; do not edit.
module Generated.CheckedMappingReplay.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.CheckedMappingReplay.StructuralProjections qualified as StructuralProjections
import Generated.CheckedMappingReplay.Structural.Shape.ReplayEnvelope (ReplayEnvelopeShape(optionalLabels))
import Conformance.CheckedMappingReplay.Bindings qualified as Bindings
import Conformance.CheckedMappingReplay.Domain (ContentHash, ImportantDays, MaybeContentHash, MaybeLabel, ReplayEnvelope, TextLabels)
import Generated.CheckedMappingReplay.Nominals qualified as Nominals
import Generated.CheckedMappingReplay.Structural.NominalLeaves qualified as NominalLeaves
import Generated.CheckedMappingReplay.Structural.Shape.ReplayEnvelope qualified as ShapeReplayEnvelope

structuralConformanceAssertions :: [(String, Bool)]
structuralConformanceAssertions =
  concat
    [ contentHashBindingAssertions
    , importantDaysBindingAssertions
    , maybeContentHashBindingAssertions
    , maybeLabelBindingAssertions
    , replayEnvelopeBindingAssertions
    , textLabelsBindingAssertions
    , [("generated nominal canonical text: conformance.checked-mapping-replay.ReplayEnvelope.v1/RetainedId", all (\(_, value) -> (case bindingToShape Bindings.replayEnvelopeBinding value of ShapeReplayEnvelope.ReplayEnvelope _ _ _ _ field0_4 field0_5 _ -> ((NominalLeaves.encodeRetainedIdLeaf (field0_4) == Aeson.String (Nominals.retainedIdText (field0_4)) && AesonTypes.parseEither NominalLeaves.parseRetainedIdLeaf (NominalLeaves.encodeRetainedIdLeaf (field0_4)) == Right (field0_4))) && ((all (\key1 -> (NominalLeaves.encodeRetainedIdLeaf (key1) == Aeson.String (Nominals.retainedIdText (key1)) && AesonTypes.parseEither NominalLeaves.parseRetainedIdLeaf (NominalLeaves.encodeRetainedIdLeaf (key1)) == Right (key1))) (Map.keys (field0_5)))))) (NonEmpty.toList (fixtureCases Bindings.replayEnvelopeFixtures)))]
    , [("fixture coverage: conformance.checked-mapping-replay.ContentHash.v1", coverageContentHash)]
    , [("fixture coverage: conformance.checked-mapping-replay.ImportantDays.v1", coverageImportantDays)]
    , [("fixture coverage: conformance.checked-mapping-replay.MaybeContentHash.v1", coverageMaybeContentHash)]
    , [("fixture coverage: conformance.checked-mapping-replay.MaybeLabel.v1", coverageMaybeLabel)]
    , [("fixture coverage: conformance.checked-mapping-replay.ReplayEnvelope.v1", coverageReplayEnvelope)]
    , [("fixture coverage: conformance.checked-mapping-replay.TextLabels.v1", coverageTextLabels)]
    , 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)

contentHashBindingAssertions :: [(String, Bool)]
contentHashBindingAssertions =
  ("fixture labels: conformance.checked-mapping-replay.ContentHash.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.checked-mapping-replay.ContentHash.v1", canonicalTypeName (Proxy @ContentHash) == "conformance.checked-mapping-replay.ContentHash.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.checked-mapping-replay.ContentHash.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.contentHashBinding value)
      , ("binding shape round-trip: conformance.checked-mapping-replay.ContentHash.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.contentHashBinding (bindingToShape Bindings.contentHashBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.contentHashFixtures

importantDaysBindingAssertions :: [(String, Bool)]
importantDaysBindingAssertions =
  ("fixture labels: conformance.checked-mapping-replay.ImportantDays.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.checked-mapping-replay.ImportantDays.v1", canonicalTypeName (Proxy @ImportantDays) == "conformance.checked-mapping-replay.ImportantDays.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.checked-mapping-replay.ImportantDays.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.importantDaysBinding value)
      , ("binding shape round-trip: conformance.checked-mapping-replay.ImportantDays.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.importantDaysBinding (bindingToShape Bindings.importantDaysBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.importantDaysFixtures

maybeContentHashBindingAssertions :: [(String, Bool)]
maybeContentHashBindingAssertions =
  ("fixture labels: conformance.checked-mapping-replay.MaybeContentHash.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.checked-mapping-replay.MaybeContentHash.v1", canonicalTypeName (Proxy @MaybeContentHash) == "conformance.checked-mapping-replay.MaybeContentHash.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.checked-mapping-replay.MaybeContentHash.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.maybeContentHashBinding value)
      , ("binding shape round-trip: conformance.checked-mapping-replay.MaybeContentHash.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.maybeContentHashBinding (bindingToShape Bindings.maybeContentHashBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.maybeContentHashFixtures

maybeLabelBindingAssertions :: [(String, Bool)]
maybeLabelBindingAssertions =
  ("fixture labels: conformance.checked-mapping-replay.MaybeLabel.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.checked-mapping-replay.MaybeLabel.v1", canonicalTypeName (Proxy @MaybeLabel) == "conformance.checked-mapping-replay.MaybeLabel.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.checked-mapping-replay.MaybeLabel.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.maybeLabelBinding value)
      , ("binding shape round-trip: conformance.checked-mapping-replay.MaybeLabel.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.maybeLabelBinding (bindingToShape Bindings.maybeLabelBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.maybeLabelFixtures

replayEnvelopeBindingAssertions :: [(String, Bool)]
replayEnvelopeBindingAssertions =
  ("fixture labels: conformance.checked-mapping-replay.ReplayEnvelope.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.checked-mapping-replay.ReplayEnvelope.v1", canonicalTypeName (Proxy @ReplayEnvelope) == "conformance.checked-mapping-replay.ReplayEnvelope.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.checked-mapping-replay.ReplayEnvelope.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.replayEnvelopeBinding value)
      , ("binding shape round-trip: conformance.checked-mapping-replay.ReplayEnvelope.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.replayEnvelopeBinding (bindingToShape Bindings.replayEnvelopeBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.replayEnvelopeFixtures

textLabelsBindingAssertions :: [(String, Bool)]
textLabelsBindingAssertions =
  ("fixture labels: conformance.checked-mapping-replay.TextLabels.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.checked-mapping-replay.TextLabels.v1", canonicalTypeName (Proxy @TextLabels) == "conformance.checked-mapping-replay.TextLabels.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.checked-mapping-replay.TextLabels.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.textLabelsBinding value)
      , ("binding shape round-trip: conformance.checked-mapping-replay.TextLabels.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.textLabelsBinding (bindingToShape Bindings.textLabelsBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.textLabelsFixtures

coverageContentHash :: Bool
coverageContentHash = True

coverageImportantDays :: Bool
coverageImportantDays = any null shapes && any (not . null) shapes
  where
    shapes = map (bindingToShape Bindings.importantDaysBinding . snd) (NonEmpty.toList (fixtureCases Bindings.importantDaysFixtures))

coverageMaybeContentHash :: Bool
coverageMaybeContentHash = any isNothing shapes && any isJust shapes
  where
    shapes = map (bindingToShape Bindings.maybeContentHashBinding . snd) (NonEmpty.toList (fixtureCases Bindings.maybeContentHashFixtures))

coverageMaybeLabel :: Bool
coverageMaybeLabel = any isNothing shapes && any isJust shapes
  where
    shapes = map (bindingToShape Bindings.maybeLabelBinding . snd) (NonEmpty.toList (fixtureCases Bindings.maybeLabelFixtures))

coverageReplayEnvelope :: Bool
coverageReplayEnvelope = any (isNothing . (.optionalLabels)) shapes && any (isJust . (.optionalLabels)) shapes
  where
    shapes = map (bindingToShape Bindings.replayEnvelopeBinding . snd) (NonEmpty.toList (fixtureCases Bindings.replayEnvelopeFixtures))

coverageTextLabels :: Bool
coverageTextLabels = True

structuralProjectionAssertions :: [(String, Bool)]
structuralProjectionAssertions =
  [ ("projection witness agreement: conformance.checked-mapping-replay.ReplayEnvelope.v1/primary", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.replayEnvelopePrimaryWitness (\referenceOwner -> StructuralProjections.replayEnvelopePrimaryGet referenceOwner) owner) (NonEmpty.toList (fixtureCases Bindings.replayEnvelopeFixtures)))
  ]