StructuralConformance.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from context refined-base16 structural conformance; do not edit.
module Generated.RefinedBase16.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.RefinedBase16.Structural.Shape.HashEnvelope (HashEnvelopeShape(optionalHash))
import Conformance.RefinedBase16.Bindings qualified as Bindings
import Conformance.RefinedBase16.Domain (ContentHash, HashEnvelope, MaybeContentHash)

structuralConformanceAssertions :: [(String, Bool)]
structuralConformanceAssertions =
  concat
    [ contentHashBindingAssertions
    , hashEnvelopeBindingAssertions
    , maybeContentHashBindingAssertions
    , [("fixture coverage: conformance.refined-base16.ContentHash.v1", coverageContentHash)]
    , [("fixture coverage: conformance.refined-base16.HashEnvelope.v1", coverageHashEnvelope)]
    , [("fixture coverage: conformance.refined-base16.MaybeContentHash.v1", coverageMaybeContentHash)]
    ]

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.refined-base16.ContentHash.v1", validFixtureLabels cases) :
  ("canonical identity: conformance.refined-base16.ContentHash.v1", canonicalTypeName (Proxy @ContentHash) == "conformance.refined-base16.ContentHash.v1") :
  concat
    [ [ ("binding domain round-trip: conformance.refined-base16.ContentHash.v1/" <> T.unpack label, bindingDomainRoundTrip Bindings.contentHashBinding value)
      , ("binding shape round-trip: conformance.refined-base16.ContentHash.v1/" <> T.unpack label, bindingShapeRoundTrip Bindings.contentHashBinding (bindingToShape Bindings.contentHashBinding value))
      ]
    | (label, value) <- NonEmpty.toList cases
    ]
  where
    cases = fixtureCases Bindings.contentHashFixtures

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

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

coverageContentHash :: Bool
coverageContentHash = True

coverageHashEnvelope :: Bool
coverageHashEnvelope = any (isNothing . (.optionalHash)) shapes && any (isJust . (.optionalHash)) shapes
  where
    shapes = map (bindingToShape Bindings.hashEnvelopeBinding . snd) (NonEmpty.toList (fixtureCases Bindings.hashEnvelopeFixtures))

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