StructuralConformance.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from context structural-text-sets structural conformance; do not edit.
module Generated.StructuralTextSets.StructuralConformance
  ( structuralConformanceAssertions
  ) where

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.Shape (CanonicalTypeName (..))
import Keiro.Codec.Structural (FixtureCases (..), bindingDomainRoundTrip, bindingShapeRoundTrip, bindingToShape)
import Generated.StructuralTextSets.Structural.Shape.LabelEnvelope (LabelEnvelopeShape(optionalLabels))
import Conformance.StructuralTextSets.Bindings qualified as Bindings
import Conformance.StructuralTextSets.Domain (LabelEnvelope, MaybeTextLabels, TextLabels)

structuralConformanceAssertions :: [(String, Bool)]
structuralConformanceAssertions =
  concat
    [ labelEnvelopeBindingAssertions
    , maybeTextLabelsBindingAssertions
    , textLabelsBindingAssertions
    , [("fixture coverage: conformance.structural-text-sets.LabelEnvelope.v1", coverageLabelEnvelope)]
    , [("fixture coverage: conformance.structural-text-sets.MaybeTextLabels.v1", coverageMaybeTextLabels)]
    , [("fixture coverage: conformance.structural-text-sets.TextLabels.v1", coverageTextLabels)]
    ]

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)

labelEnvelopeBindingAssertions :: [(String, Bool)]
labelEnvelopeBindingAssertions =
  ("fixture labels: conformance.structural-text-sets.LabelEnvelope.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.structural-text-sets.LabelEnvelope.v1", canonicalTypeName (Proxy @LabelEnvelope) == "conformance.structural-text-sets.LabelEnvelope.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.structural-text-sets.LabelEnvelope.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.labelEnvelopeBinding value)
      , ("binding shape round-trip: conformance.structural-text-sets.LabelEnvelope.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.labelEnvelopeBinding (bindingToShape Bindings.labelEnvelopeBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.labelEnvelopeFixtures

maybeTextLabelsBindingAssertions :: [(String, Bool)]
maybeTextLabelsBindingAssertions =
  ("fixture labels: conformance.structural-text-sets.MaybeTextLabels.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.structural-text-sets.MaybeTextLabels.v1", canonicalTypeName (Proxy @MaybeTextLabels) == "conformance.structural-text-sets.MaybeTextLabels.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.structural-text-sets.MaybeTextLabels.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.maybeTextLabelsBinding value)
      , ("binding shape round-trip: conformance.structural-text-sets.MaybeTextLabels.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.maybeTextLabelsBinding (bindingToShape Bindings.maybeTextLabelsBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.maybeTextLabelsFixtures

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

coverageLabelEnvelope :: Bool
coverageLabelEnvelope = any (isNothing . (.optionalLabels)) shapes && any (isJust . (.optionalLabels)) shapes
  where
    shapes = map (bindingToShape Bindings.labelEnvelopeBinding . snd) (NonEmpty.toList (fixtureCases Bindings.labelEnvelopeFixtures))

coverageMaybeTextLabels :: Bool
coverageMaybeTextLabels = any isNothing shapes && any isJust shapes
  where
    shapes = map (bindingToShape Bindings.maybeTextLabelsBinding . snd) (NonEmpty.toList (fixtureCases Bindings.maybeTextLabelsFixtures))

coverageTextLabels :: Bool
coverageTextLabels = True