StructuralConformance.hs

-- @generated by keiro-dsl 0.21.0.0 (language keiro-dsl 6) from context mapped-register-construction structural conformance; do not edit.
module Generated.MappedRegisterConstruction.StructuralConformance
  ( structuralConformanceAssertions
  ) where

import Data.Aeson qualified as Aeson
import Data.List (nub)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text qualified as T
import Keiro.Codec.Structural (FixtureCases (..))
import Conformance.MappedRegisterConstruction.Bindings qualified as Bindings
import Conformance.MappedRegisterConstruction.Domain (MaybeTime)
import Conformance.MappedRegisterConstruction.Lift qualified as Lift
import Data.Time (UTCTime)

structuralConformanceAssertions :: [(String, Bool)]
structuralConformanceAssertions =
  concat
    [ maybeTimeOpaqueAssertions
    , maybeTimeWriteLiftAssertions
    ]

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)

maybeTimeOpaqueAssertions :: [(String, Bool)]
maybeTimeOpaqueAssertions =
  ("opaque boundary fixtures: conformance.MaybeTime.json@1", validFixtureLabels cases) :
  [ ("opaque codec round-trip: conformance.MaybeTime.json@1/" <> T.unpack caseLabel, case Aeson.fromJSON (Aeson.toJSON value) of Aeson.Success decoded -> decoded == value; Aeson.Error _ -> False)
  | (caseLabel, value) <- NonEmpty.toList cases
  ]
  where
    cases = fixtureCases Bindings.maybeTimeCases

maybeTimeWriteLiftAssertions :: [(String, Bool)]
maybeTimeWriteLiftAssertions =
  ("write-lift fixture labels: MaybeTime", all (not . T.null . T.strip) labels && length labels == length (nub labels)) :
  [ ("write-lift case: MaybeTime/" <> T.unpack label, apply input == expected)
  | (label, input, expected) <- NonEmpty.toList cases
  ]
  where
    apply :: UTCTime -> MaybeTime
    apply = Lift.atTime
    cases :: NonEmpty.NonEmpty (T.Text, UTCTime, MaybeTime)
    cases = Lift.atTimeCases
    labels = [label | (label, _, _) <- NonEmpty.toList cases]