Main.hs

{- | EP-3 runtime conformance: the scaffolded process @Process@ module's
deterministic wiring — the timer-request builder (a real
@Keiro.Timer.TimerRequest@ with a v5-derived @TimerId@) and the fire
disposition over @Keiro.Command.CommandError@ — compiled against the LIVE
keiro runtime (not just emitted as text). Running it checks the
@on-reject => Fired@ benign inversion lowered correctly. (The full
ProcessManager value with a filled @handle@ remains the agent-written hole.)
-}
module Main (main) where

import Control.Monad (unless)
import Data.Text (Text)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Generated.HospitalCapacity.HospitalSurge.Process (
    hospitalSurgeCategory,
    hospitalSurgeFireOutcome,
    hospitalSurgeProcessName,
    hospitalSurgeProcessWorkerOptions,
    hospitalSurgeTimerRequest,
 )
import Generated.HospitalCapacity.Surge.EventStream (SurgeEventStreamDef)
import Keiro.Command (CommandError (..))
import Keiro.Dsl.Validate (sagaCategoryError)
import Keiro.ProcessManager (PoisonPolicy (..), RejectedCommandPolicy (..), WorkerOptions (..))
import Keiro.Stream (CategoryError, Stream, StreamCategory, category, entityStream)
import Keiro.Timer (TimerRequest (..))
import System.Exit (exitFailure)

main :: IO ()
main = do
    let nameOk = hospitalSurgeProcessName == "hospital-surge"
        -- the builder compiles against Keiro.Timer and names the queue.
        reqOk = processManagerName (hospitalSurgeTimerRequest "hosp-1" (posixSecondsToUTCTime 0)) == "hospital-surge"
        -- the disposition lowered from the spec: on-ok Fired, on-reject Fired.
        okOk = hospitalSurgeFireOutcome (Right () :: Either CommandError ()) == Just ()
        rejectOk = hospitalSurgeFireOutcome (Left CommandRejected :: Either CommandError ()) == Just ()
        ambiguousOk = hospitalSurgeFireOutcome (Left (CommandAmbiguous [0, 1]) :: Either CommandError ()) == Nothing
        rejectedPolicyOk = rejectedCommandPolicy hospitalSurgeProcessWorkerOptions == RejectedHalt
        poisonPolicyOk = poisonIsHalt hospitalSurgeProcessWorkerOptions
        sagaStream = entityStream hospitalSurgeCategory "hosp-1" :: Stream SurgeEventStreamDef
        sagaCategoryTyped = sagaStream `seq` True
        categoryMirrorOk = all categoryAgreement ["hospitalSurge", "surge", "", "$all", "hospital-surge", "hospital surge", "bad\NULcategory"]
        colonReservedOk = sagaCategoryError "wf:surge" /= Nothing && not (runtimeRejectsCategory "wf:surge")
    putStrLn ("process name: " <> show nameOk)
    putStrLn ("timer request builds against Keiro.Timer: " <> show reqOk)
    putStrLn ("on-ok => Fired: " <> show okOk)
    putStrLn ("on-reject => Fired (benign inversion): " <> show rejectOk)
    putStrLn ("on-ambiguous => Retry: " <> show ambiguousOk)
    putStrLn ("rejected policy lowered: " <> show rejectedPolicyOk)
    putStrLn ("poison policy lowered: " <> show poisonPolicyOk)
    putStrLn ("saga category carries its event-stream phantom: " <> show sagaCategoryTyped)
    putStrLn ("DSL saga category mirror agrees with Keiro.Stream.category: " <> show categoryMirrorOk)
    putStrLn ("DSL additionally reserves ':' for workflow streams: " <> show colonReservedOk)
    unless (nameOk && reqOk && okOk && rejectOk && ambiguousOk && rejectedPolicyOk && poisonPolicyOk && sagaCategoryTyped && categoryMirrorOk && colonReservedOk) exitFailure

categoryAgreement :: Text -> Bool
categoryAgreement value = (sagaCategoryError value /= Nothing) == runtimeRejectsCategory value

runtimeRejectsCategory :: Text -> Bool
runtimeRejectsCategory value = case category value :: Either CategoryError (StreamCategory ()) of
    Left _ -> True
    Right _ -> False

poisonIsHalt :: WorkerOptions es msg -> Bool
poisonIsHalt options = case poisonPolicy options of
    PoisonHalt -> True
    _ -> False