Harness.hs

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

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

import AggregateScalars.ScalarLedger.Holes (scalarLedgerTransducer)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..), picosecondsToDiffTime)
import Generated.AggregateScalars.ScalarLedger.Codec (encodeScalarLedgerEvent, parseScalarLedgerEvent, scalarLedgerCodec)
import Generated.AggregateScalars.ScalarLedger.Domain
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 scalarLedgerTransducer))
    , ("clock-free: spec samples no wall clock", True)
    , ("golden round-trip: ScalarsRecorded", roundTrips sampleEventScalarsRecorded)
    , ("accepts Record from ScalarLedgerEmpty", acceptRecord)
    ]
        ++ forwardReplayRecord

roundTrips :: ScalarLedgerEvent -> Bool
roundTrips e = parseScalarLedgerEvent (eventType scalarLedgerCodec e) (encodeScalarLedgerEvent e) == Right e

sampleEventScalarsRecorded :: ScalarLedgerEvent
sampleEventScalarsRecorded = (ScalarsRecorded (ScalarsRecordedData (UTCTime (fromGregorian 2026 1 2) (picosecondsToDiffTime 11045123456789012)) 0))

acceptRecord :: Bool
acceptRecord =
    case step scalarLedgerTransducer (ScalarLedgerEmpty, initialScalarLedgerRegs) ((Record (RecordData (UTCTime (fromGregorian 2026 1 2) (picosecondsToDiffTime 11045123456789012)) 0))) of
        Just (v, _, _) -> v == ScalarLedgerRecorded
        Nothing -> False

-- forward/replay equality (plan 147): cross the persisted codec boundary,
-- replay the emitted chain, and compare the final vertex and every register.
forwardReplayRecord :: [(String, Bool)]
forwardReplayRecord =
    case step scalarLedgerTransducer (ScalarLedgerEmpty, initialScalarLedgerRegs) ((Record (RecordData (UTCTime (fromGregorian 2026 1 2) (picosecondsToDiffTime 11045123456789012)) 0))) of
        Nothing -> [(prefix <> "forward step accepted", False)]
        Just (forwardVertex, forwardRegs, emitted) ->
            case mapM (\event -> parseScalarLedgerEvent (eventType scalarLedgerCodec event) (encodeScalarLedgerEvent event)) emitted of
                Left _ -> [(prefix <> "emitted chain decodes", False)]
                Right decodedEvents ->
                    case applyEventsEither scalarLedgerTransducer (ScalarLedgerEmpty, initialScalarLedgerRegs) decodedEvents of
                        Left _ -> [(prefix <> "replay succeeds", False)]
                        Right (replayVertex, replayRegs) ->
                            [ (prefix <> "final vertex", replayVertex == forwardVertex)
                            , (prefix <> "register observedAt", (replayRegs ! #observedAt) == (forwardRegs ! #observedAt))
                            , (prefix <> "register revision", (replayRegs ! #revision) == (forwardRegs ! #revision))
                            ]
  where
    prefix = "forward/replay equality: Record from ScalarLedgerEmpty -- "