Harness.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLabels #-}
-- @generated by keiro-dsl 0.8.0.0 (language keiro-dsl 4) from aggregate Thing; do not edit.
module SkelAggregate.Generated.MyService.Thing.Harness (harnessAssertions) where

import SkelAggregate.Generated.MyService.Thing.Domain
import SkelAggregate.Generated.MyService.Thing.Codec (encodeThingEvent, parseThingEvent, thingCodec)
import SkelAggregate.Generated.MyService.Thing.Transducer (thingTransducer)
import Keiki.Core (applyEventsEither, defaultValidationOptions, step, validateTransducer, (!))
import Keiro.Codec (eventType)
import SkelAggregate.Generated.MyService.Nominals (ThingId, parseThingId)

-- | (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 thingTransducer))
  , ("clock-free: spec samples no wall clock", True)
  , ("golden round-trip: ThingCompleted", roundTrips sampleEventThingCompleted)
  , ("accepts DoThing from ThingPending", acceptDoThing)
  ]
  ++ forwardReplayDoThing

roundTrips :: ThingEvent -> Bool
roundTrips e = parseThingEvent (eventType thingCodec e) (encodeThingEvent e) == Right e

sampleEventThingCompleted :: ThingEvent
sampleEventThingCompleted = (ThingCompleted (ThingCompletedData (case parseThingId "thing_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") 0))

acceptDoThing :: Bool
acceptDoThing =
  case step thingTransducer (ThingPending, initialThingRegs) ((DoThing (DoThingData (case parseThingId "thing_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") 0))) of
    Just (v, _, _) -> v == ThingDone
    Nothing -> False

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayDoThing :: [(String, Bool)]
forwardReplayDoThing =
  case step thingTransducer (ThingPending, initialThingRegs) ((DoThing (DoThingData (case parseThingId "thing_01h455vb4pex5vsknk084sn02q" of Right parsed -> parsed; Left _ -> error "generated valid ID sample failed to parse") 0))) of
    Nothing -> [(prefix <> "forward step accepted", False)]
    Just (forwardVertex, forwardRegs, emitted) ->
      case mapM (\event -> parseThingEvent (eventType thingCodec event) (encodeThingEvent event)) emitted of
        Left _ -> [(prefix <> "emitted chain decodes", False)]
        Right decodedEvents ->
          case applyEventsEither thingTransducer (ThingPending, initialThingRegs) decodedEvents of
            Left _ -> [(prefix <> "replay succeeds", False)]
            Right (replayVertex, replayRegs) ->
              [ (prefix <> "final vertex", replayVertex == forwardVertex)
              , (prefix <> "register thingId", (replayRegs ! #thingId) == (forwardRegs ! #thingId))
              ]
  where
    prefix = "forward/replay equality: DoThing from ThingPending -- "