Harness.hs

-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from aggregate Hospital; do not edit.
module Generated.TransferRouting.Hospital.Harness (harnessAssertions) where

import Generated.TransferRouting.Hospital.Domain
import Generated.TransferRouting.Hospital.Codec (encodeHospitalEvent, parseHospitalEvent, hospitalCodec)
import Generated.TransferRouting.Hospital.Transducer (hospitalTransducer)
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer)
import Keiro.Codec (eventType)

-- | (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: AcceptedTransferNeedRouted", roundTrips sampleEventAcceptedTransferNeedRouted)
  , ("accepts RouteAcceptedTransferNeed from HospitalAccepting", acceptRouteAcceptedTransferNeed)
  ]
  ++ forwardReplayRouteAcceptedTransferNeed

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

sampleEventAcceptedTransferNeedRouted :: HospitalEvent
sampleEventAcceptedTransferNeedRouted = (AcceptedTransferNeedRouted (AcceptedTransferNeedRoutedData "sample-transferNeedId" "sample-hospitalId"))

acceptRouteAcceptedTransferNeed :: Bool
acceptRouteAcceptedTransferNeed =
  case step hospitalTransducer (HospitalAccepting, initialHospitalRegs) ((RouteAcceptedTransferNeed (RouteAcceptedTransferNeedData "sample-transferNeedId" "sample-hospitalId"))) of
    Just (v, _, _) -> v == HospitalAccepting
    Nothing -> False

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayRouteAcceptedTransferNeed :: [(String, Bool)]
forwardReplayRouteAcceptedTransferNeed =
  case step hospitalTransducer (HospitalAccepting, initialHospitalRegs) ((RouteAcceptedTransferNeed (RouteAcceptedTransferNeedData "sample-transferNeedId" "sample-hospitalId"))) 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 (HospitalAccepting, initialHospitalRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, _replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              ]
  where
    prefix = "forward/replay equality: RouteAcceptedTransferNeed from HospitalAccepting -- "