Harness.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
-- @generated by keiro-dsl; do not edit. Regenerated from the .keiro spec.
module SkelProcess.Generated.MyService.Hospital.Harness (harnessAssertions) where

import SkelProcess.Generated.MyService.Hospital.Domain
import SkelProcess.Generated.MyService.Hospital.Codec (encodeHospitalEvent, parseHospitalEvent, hospitalCodec)
import SkelProcess.MyService.Hospital.Holes (hospitalTransducer)
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer)
import Keiro.Codec (eventType)
import SkelProcess.Generated.MyService.Nominals (HospitalId (..))

{- | (label, passed). A driver runs these and exits non-zero on any False,
naming the failing assertion. Filling a hole wrongly turns a specific
entry False; the scaffold cannot.
-}
harnessAssertions :: [(String, Bool)]
harnessAssertions =
  [ ("validateTransducer is empty", null (validateTransducer defaultValidationOptions hospitalTransducer))
  , ("clock-free: spec samples no wall clock", True)
  , ("golden round-trip: SurgeActivated", roundTrips sampleEventSurgeActivated)
  , ("accepts ActivateSurge from HospitalOperational", acceptActivateSurge)
  ]
  ++ forwardReplayActivateSurge

roundTrips :: HospitalEvent -> Bool
roundTrips e = parseHospitalEvent (eventType hospitalCodec e) (encodeHospitalEvent e) == Right e

sampleEventSurgeActivated :: HospitalEvent
sampleEventSurgeActivated = (SurgeActivated (SurgeActivatedData (HospitalId "sample")))

acceptActivateSurge :: Bool
acceptActivateSurge =
  case step hospitalTransducer (HospitalOperational, initialHospitalRegs) ((ActivateSurge (ActivateSurgeData (HospitalId "sample")))) of
    Just (v, _, _) -> v == HospitalSurging
    Nothing -> False

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayActivateSurge :: [(String, Bool)]
forwardReplayActivateSurge =
  case step hospitalTransducer (HospitalOperational, initialHospitalRegs) ((ActivateSurge (ActivateSurgeData (HospitalId "sample")))) of
    Nothing -> [(prefix <> "forward step accepted", False)]
    Just (forwardVertex, _forwardRegs, emitted) ->
      case mapM (\event -> parseHospitalEvent (eventType hospitalCodec event) (encodeHospitalEvent event)) emitted of
        Left _ -> [(prefix <> "emitted chain decodes", False)]
        Right decodedEvents ->
          case applyEventsEither hospitalTransducer (HospitalOperational, initialHospitalRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, _replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              ]
  where
    prefix = "forward/replay equality: ActivateSurge from HospitalOperational -- "