Harness.hs

{-# LANGUAGE OverloadedLabels #-}
-- @generated by keiro-dsl 0.9.0.0 (language keiro-dsl 4) from aggregate Reservation; do not edit.
module Generated.HospitalCapacity.Reservation.Harness (harnessAssertions) where

import Generated.HospitalCapacity.Reservation.Domain
import Generated.HospitalCapacity.Reservation.Codec (encodeReservationEvent, parseReservationEvent, reservationCodec)
import Generated.HospitalCapacity.Reservation.Transducer (reservationTransducer)
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer, (!))
import Keiro.Codec (eventType)
import Generated.HospitalCapacity.Nominals (CommandId, parseCommandId, DivertStatus (..), HospitalId, parseHospitalId, PatientAcuity (..), TransferReservationId, parseTransferReservationId)

-- | (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 reservationTransducer))
  , ("clock-free: spec samples no wall clock", True)
  , ("golden round-trip: TransferReservationCreated", roundTrips sampleEventTransferReservationCreated)
  , ("golden round-trip: TransferReservationConfirmed", roundTrips sampleEventTransferReservationConfirmed)
  , ("accepts RequestTransferReservation from ReservationUnrequested", acceptRequestTransferReservation)
  ]
  ++ forwardReplayRequestTransferReservation

roundTrips :: ReservationEvent -> Bool
roundTrips e = parseReservationEvent (eventType reservationCodec e) (encodeReservationEvent e) == Right e

sampleEventTransferReservationCreated :: ReservationEvent
sampleEventTransferReservationCreated = (TransferReservationCreated (TransferReservationCreatedData (case parseTransferReservationId "rsv_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") (case parseHospitalId "hosp_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") (case parseCommandId "cmd_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") RedTag Open False))

sampleEventTransferReservationConfirmed :: ReservationEvent
sampleEventTransferReservationConfirmed = (TransferReservationConfirmed (TransferReservationConfirmedData (case parseTransferReservationId "rsv_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") (case parseHospitalId "hosp_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") (case parseCommandId "cmd_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse")))

acceptRequestTransferReservation :: Bool
acceptRequestTransferReservation =
  case step reservationTransducer (ReservationUnrequested, initialReservationRegs) ((RequestTransferReservation (RequestTransferReservationData (case parseTransferReservationId "rsv_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") (case parseHospitalId "hosp_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") (case parseCommandId "cmd_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") RedTag Open False))) of
    Just (v, _, _) -> v == ReservationHeld
    Nothing -> False

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayRequestTransferReservation :: [(String, Bool)]
forwardReplayRequestTransferReservation =
  case step reservationTransducer (ReservationUnrequested, initialReservationRegs) ((RequestTransferReservation (RequestTransferReservationData (case parseTransferReservationId "rsv_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") (case parseHospitalId "hosp_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") (case parseCommandId "cmd_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") RedTag Open False))) of
    Nothing -> [(prefix <> "forward step accepted", False)]
    Just (forwardVertex, forwardRegs, emitted) ->
      case mapM (\event -> parseReservationEvent (eventType reservationCodec event) (encodeReservationEvent event)) emitted of
        Left _ -> [(prefix <> "emitted chain decodes", False)]
        Right decodedEvents ->
          case applyEventsEither reservationTransducer (ReservationUnrequested, initialReservationRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              , (prefix <> "register reservationId", (replayRegs ! #reservationId) == (forwardRegs ! #reservationId))
              , (prefix <> "register hospitalId", (replayRegs ! #hospitalId) == (forwardRegs ! #hospitalId))
              , (prefix <> "register patientAcuity", (replayRegs ! #patientAcuity) == (forwardRegs ! #patientAcuity))
              ]
  where
    prefix = "forward/replay equality: RequestTransferReservation from ReservationUnrequested -- "