StructuralConformance.hs

-- @generated by keiro-dsl 0.12.0.0 (language keiro-dsl 4) from context aggregate-scalar-expressions structural conformance; do not edit.
module Generated.AggregateScalarExpressions.StructuralConformance
  ( structuralConformanceAssertions
  ) where

import Data.List (nub)
import Data.List.NonEmpty qualified as NonEmpty
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.AggregateScalarExpressions.StructuralProjections qualified as StructuralProjections
import Generated.AggregateScalarExpressions.Structural.Shape.Limits qualified as ShapeLimits
import ScalarExpressions.Bindings qualified as Bindings
import ScalarExpressions.Domain (Limits)

structuralConformanceAssertions :: [(String, Bool)]
structuralConformanceAssertions =
  concat
    [ limitsBindingAssertions
    , [("fixture coverage: scalar-expressions.Limits.v1", coverageLimits)]
    , 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)

limitsBindingAssertions :: [(String, Bool)]
limitsBindingAssertions =
  ("fixture labels: scalar-expressions.Limits.v1", validFixtureLabels cases) :
  ("canonical identity: scalar-expressions.Limits.v1", canonicalTypeName (Proxy @Limits) == "scalar-expressions.Limits.v1") :
  concat
    [ [ ("binding domain round-trip: scalar-expressions.Limits.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.limitsBinding value)
      , ("binding shape round-trip: scalar-expressions.Limits.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.limitsBinding (bindingToShape Bindings.limitsBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.limitsCases

coverageLimits :: Bool
coverageLimits = True

structuralProjectionAssertions :: [(String, Bool)]
structuralProjectionAssertions =
  [ ("projection witness agreement: scalar-expressions.Limits.v1/ceiling", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.limitsCeilingWitness (\referenceOwner -> ShapeLimits.ceiling (bindingToShape Bindings.limitsBinding referenceOwner)) owner) (NonEmpty.toList (fixtureCases Bindings.limitsCases)))
  , ("projection witness agreement: scalar-expressions.Limits.v1/minimum", all (\(_, owner) -> fieldWitnessAgrees StructuralProjections.limitsMinimumWitness (\referenceOwner -> ShapeLimits.minimum (bindingToShape Bindings.limitsBinding referenceOwner)) owner) (NonEmpty.toList (fixtureCases Bindings.limitsCases)))
  ]