StructuralConformance.hs

-- @generated by keiro-dsl 0.22.0.0 (language keiro-dsl 6) from context mapped-structural-enum-equality structural conformance; do not edit.
module Generated.MappedStructuralEnumEquality.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 (checkFieldProjectionOwner, checkFieldProjectionKey)
import Keiki.Shape (CanonicalTypeName (..))
import Keiro.Codec.Structural (FixtureCases (..), bindingDomainRoundTrip, bindingShapeRoundTrip, bindingToShape)
import Generated.MappedStructuralEnumEquality.StructuralProjections qualified as StructuralProjections
import Conformance.MappedStructuralEnumEquality.Bindings qualified as Bindings
import Conformance.MappedStructuralEnumEquality.Domain (Request, RequiredScope)
import Generated.MappedStructuralEnumEquality.Structural.Shape.RequiredScope qualified as ShapeRequiredScope

structuralConformanceAssertions :: [(String, Bool)]
structuralConformanceAssertions =
  concat
    [ requestBindingAssertions
    , requiredScopeBindingAssertions
    , [("fixture coverage: conformance.Request.v1", coverageRequest)]
    , [("fixture coverage: conformance.RequiredScope.v1", coverageRequiredScope)]
    , 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)

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

requiredScopeBindingAssertions :: [(String, Bool)]
requiredScopeBindingAssertions =
  ("fixture labels: conformance.RequiredScope.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.RequiredScope.v1", canonicalTypeName (Proxy @RequiredScope) == "conformance.RequiredScope.v1") :
  [("exhaustive enum shape round-trip: conformance.RequiredScope.v1", all (bindingShapeRoundTrip Bindings.requiredScopeBinding) [ShapeRequiredScope.PipelineScope, ShapeRequiredScope.DiagnosticScope])] <> concat
    [ [ ("binding domain round-trip: conformance.RequiredScope.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.requiredScopeBinding value)
      , ("binding shape round-trip: conformance.RequiredScope.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.requiredScopeBinding (bindingToShape Bindings.requiredScopeBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.requiredScopeFixtures

coverageRequest :: Bool
coverageRequest = True

coverageRequiredScope :: Bool
coverageRequiredScope = any (\case ShapeRequiredScope.PipelineScope -> True; _ -> False) shapes && any (\case ShapeRequiredScope.DiagnosticScope -> True; _ -> False) shapes
  where
    shapes = map (bindingToShape Bindings.requiredScopeBinding . snd) (NonEmpty.toList (fixtureCases Bindings.requiredScopeFixtures))

structuralProjectionAssertions :: [(String, Bool)]
structuralProjectionAssertions =
  [ ("projection owner law: conformance.RequiredScope.v1", all (\(_, owner) -> either (const False) (const True) (checkFieldProjectionOwner StructuralProjections.requiredScopeWitness owner)) (NonEmpty.toList (fixtureCases Bindings.requiredScopeFixtures))),
  ("projection key law: conformance.RequiredScope.v1", all (either (const False) (const True) . checkFieldProjectionKey StructuralProjections.requiredScopeWitness) ["pipeline", "diagnostic"])
  ]