Harness.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedStrings #-}

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

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

{- | (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 -- "