StructuralConformance.hs

-- @generated by keiro-dsl 0.18.0.0 (language keiro-dsl 6) from context calendar-days structural conformance; do not edit.
module Generated.CalendarDays.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.CalendarDays.Structural.Shape.CalendarEnvelope (CalendarEnvelopeShape(optionalDay))
import Conformance.CalendarDays.Bindings qualified as Bindings
import Conformance.CalendarDays.Domain (CalendarEnvelope, LocalDay, MaybeLocalDay)

structuralConformanceAssertions :: [(String, Bool)]
structuralConformanceAssertions =
  concat
    [ calendarEnvelopeBindingAssertions
    , localDayBindingAssertions
    , maybeLocalDayBindingAssertions
    , [("fixture coverage: conformance.calendar-days.CalendarEnvelope.v1", coverageCalendarEnvelope)]
    , [("fixture coverage: conformance.calendar-days.LocalDay.v1", coverageLocalDay)]
    , [("fixture coverage: conformance.calendar-days.MaybeLocalDay.v1", coverageMaybeLocalDay)]
    ]

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)

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

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

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

coverageCalendarEnvelope :: Bool
coverageCalendarEnvelope = any (isNothing . (.optionalDay)) shapes && any (isJust . (.optionalDay)) shapes
  where
    shapes = map (bindingToShape Bindings.calendarEnvelopeBinding . snd) (NonEmpty.toList (fixtureCases Bindings.calendarEnvelopeFixtures))

coverageLocalDay :: Bool
coverageLocalDay = True

coverageMaybeLocalDay :: Bool
coverageMaybeLocalDay = any isNothing shapes && any isJust shapes
  where
    shapes = map (bindingToShape Bindings.maybeLocalDayBinding . snd) (NonEmpty.toList (fixtureCases Bindings.maybeLocalDayFixtures))