Advanced

// ── file: SupplierFsm.fsx ──────────────────────────────────────────────────
// Supplier state DU: four states, one terminal (Blacklisted).
// Compiler rejects any SupplierState value outside this set.
type SupplierState =
    | Pending     // => Application received; vetting in progress
    | Approved    // => Cleared for new POs; appears in supplier selection
    | Suspended   // => Temporarily blocked; existing POs continue, no new POs
    | Blacklisted // => Permanently excluded — terminal state
 
// Supplier event DU: exhaustive alphabet of what can happen to a supplier.
type SupplierEvent =
    | Approve    // => Vetting passed; supplier cleared for purchasing
    | Suspend    // => Compliance issue detected; temporary hold
    | Reinstate  // => Issue resolved; supplier restored to Approved
    | Blacklist  // => Severe breach; permanent exclusion
 
// Supplier record — immutable; identity + current state.
type Supplier =
    { Id: string          // => Format: "sup_<id>"
      Name: string        // => Supplier legal name
      State: SupplierState }
 
// Transition table: (SupplierState * SupplierEvent) -> SupplierState option.
// Map.ofList builds an immutable lookup at startup.
let supplierTransitions : Map<SupplierState * SupplierEvent, SupplierState> =
    Map.ofList [
        (Pending,   Approve),   Approved    // => Vetting passed -> Approved
        (Pending,   Blacklist), Blacklisted // => Immediate exclusion from Pending
        (Approved,  Suspend),   Suspended   // => Compliance issue -> Suspended
        (Approved,  Blacklist), Blacklisted // => Severe breach from Approved
        (Suspended, Reinstate), Approved    // => Issue resolved -> back to Approved
        (Suspended, Blacklist), Blacklisted // => Escalation from Suspended
        // => Blacklisted: terminal — no outgoing transitions listed
    ]
 
// Pure transition function: lookup table, return Result.
let transitionSupplier (sup: Supplier) (event: SupplierEvent) : Result<Supplier, string> =
    match Map.tryFind (sup.State, event) supplierTransitions with
    | Some next -> Ok { sup with State = next }
    // => Valid transition: return supplier with updated state
    | None      -> Error $"{sup.State} --{event}--> (forbidden)"
    // => (state, event) not in table — invalid for this supplier
 
let sup = { Id = "sup_001"; Name = "Acme Supplies Ltd"; State = Approved }
// => Start in Approved state
 
let r1 = transitionSupplier sup Suspend
// => Ok { State = Suspended }
 
let r2 = r1 |> Result.bind (fun s -> transitionSupplier s Reinstate)
// => Ok { State = Approved }
 
let r3 = transitionSupplier sup Approve
// => Error "Approved --Approve--> (forbidden)" (already Approved)
 
printfn "%A" r1  // => Ok { Id = "sup_001"; State = Suspended }
printfn "%A" r2  // => Ok { Id = "sup_001"; State = Approved }
printfn "%A" r3  // => Error "Approved --Approve--> (forbidden)"

// ── file: SupplierFsm.fsx ──────────────────────────────────────────────────
// Guard: can a supplier receive a new PO?
// Pure predicate — depends only on the supplier's current state.
let supplierEligibleForPO (state: SupplierState) : bool =
    state = Approved
    // => Only Approved: Pending are unvetted, Suspended cannot receive new POs
 
// Guard: does blacklisting a supplier force its open POs to Disputed?
// Domain rule: any transition INTO Blacklisted triggers cascading disputes.
let blacklistingForcesDispute (oldState: SupplierState) (newState: SupplierState) : bool =
    newState = Blacklisted && oldState <> Blacklisted
    // => true only on the transition edge into Blacklisted
 
// Return type: the blacklisted supplier plus the PO IDs that must be disputed.
type BlacklistResult =
    { Supplier: Supplier
      AffectedPOIds: string list } // => PO ids to be force-disputed by the caller
 
// Blacklist function: pure; returns Result carrying the cascade information.
let blacklistSupplier (sup: Supplier) (openPOIds: string list) : Result<BlacklistResult, string> =
    if sup.State = Blacklisted then
        Error $"Supplier {sup.Id} is already blacklisted"
        // => Idempotent: no-op if already blacklisted
    else
        match transitionSupplier sup Blacklist with
        | Error msg -> Error msg
        // => Transition failed — propagate error (shouldn't happen given guard above)
        | Ok updated ->
            // => Determine cascade: which POs must be disputed?
            let affected =
                if blacklistingForcesDispute sup.State updated.State then openPOIds else []
            // => If transitioning INTO Blacklisted, all open POs are affected
            Ok { Supplier = updated; AffectedPOIds = affected }
 
// Tests
printfn "Eligible (Approved):    %b" (supplierEligibleForPO Approved)    // => true
printfn "Eligible (Suspended):   %b" (supplierEligibleForPO Suspended)   // => false
printfn "Eligible (Pending):     %b" (supplierEligibleForPO Pending)     // => false
 
let approvedSup = { Id = "sup_002"; Name = "Beta Corp"; State = Approved }
let bl = blacklistSupplier approvedSup ["po_101"; "po_102"; "po_103"]
// => Ok { Supplier = { State = Blacklisted }; AffectedPOIds = ["po_101";"po_102";"po_103"] }
 
printfn "%A" bl  // => Ok { Supplier = { State = Blacklisted }; AffectedPOIds = [3 PO ids] }

// ── file: SupplierFsm.fsx ──────────────────────────────────────────────────
// Supplier application: carries vetting data evaluated by the guard.
type SupplierApplication =
    { SupplierId: string
      RiskScore: float    // => 0.0 (high risk) to 1.0 (low risk)
      HasDocuments: bool } // => Required compliance documents submitted?
 
// Thresholds defined as a record — easier to test with different values.
type ApprovalThresholds =
    { MinRiskScore: float  // => Below this: too risky
      RequireDocuments: bool } // => Documents mandatory?
 
// Default thresholds used in production.
let defaultThresholds = { MinRiskScore = 0.6; RequireDocuments = true }
 
// Guard: accumulate all blocking reasons — same pattern as createValidatedPO.
let canApproveSupplier (app: SupplierApplication) (thresholds: ApprovalThresholds) : string list =
    [   // => List comprehension collects every failing check
        if app.RiskScore < thresholds.MinRiskScore then
            yield $"Risk score {app.RiskScore:F2} below minimum {thresholds.MinRiskScore:F2}"
            // => Risk too high; supplier not ready for approval
        if thresholds.RequireDocuments && not app.HasDocuments then
            yield "Required compliance documents not submitted"
            // => Missing documents; cannot approve without them
    ]   // => Empty list = guard passes; non-empty = blocked with reasons
 
// Guarded approve transition using the guard.
let approveSupplier
    (sup: Supplier)
    (app: SupplierApplication)
    (thresholds: ApprovalThresholds)
    : Result<Supplier, string> =
    if sup.State <> Pending then
        Error $"Supplier {sup.Id} is not in Pending state"
        // => FSM guard: approve only valid from Pending
    else
        let errors = canApproveSupplier app thresholds
        if not (List.isEmpty errors) then
            Error $"Approval blocked: {String.concat \"; \" errors}"
            // => Business guard: concatenate all blocking reasons
        else
            Ok { sup with State = Approved }
            // => All checks passed — advance to Approved
 
// Tests
let pendingSup = { Id = "sup_003"; Name = "Gamma Ltd"; State = Pending }
let lowScoreApp  = { SupplierId = "sup_003"; RiskScore = 0.4; HasDocuments = false }
let goodApp      = { SupplierId = "sup_003"; RiskScore = 0.75; HasDocuments = true }
 
printfn "%A" (approveSupplier pendingSup lowScoreApp defaultThresholds)
// => Error "Approval blocked: Risk score 0.40 below minimum 0.60; Required compliance documents not submitted"
 
printfn "%A" (approveSupplier pendingSup goodApp defaultThresholds)
// => Ok { Id = "sup_003"; State = Approved }

// ── file: SupplierFsm.fsx ──────────────────────────────────────────────────
// Sub-state DU: only meaningful when parent is Approved.
// Using a separate DU avoids polluting the top-level SupplierState.
type ApprovedSubState =
    | ActiveContract     // => Contract valid; no action needed
    | ContractExpiring   // => Contract expires within 30 days; renewal reminder needed
 
// Extended supplier: top-level state + optional sub-state.
// SubState is None when State is not Approved.
type ExtendedSupplier =
    { Id: string
      State: SupplierState
      SubState: ApprovedSubState option } // => Some only when State = Approved
 
// Smart constructor: enforce sub-state/state invariant at creation time.
let createExtSupplier (id: string) (state: SupplierState) : ExtendedSupplier =
    let sub =
        match state with
        | Approved -> Some ActiveContract  // => Default sub-state on approval
        | _        -> None                 // => No sub-state outside Approved
    { Id = id; State = state; SubState = sub }
 
// Enter ContractExpiring sub-state: only valid when top-level is Approved.
let markContractExpiring (sup: ExtendedSupplier) : Result<ExtendedSupplier, string> =
    match sup.State, sup.SubState with
    | Approved, Some ActiveContract ->
        Ok { sup with SubState = Some ContractExpiring }
        // => Valid: active contract can transition to expiring
    | Approved, Some ContractExpiring ->
        Error "Contract already marked as expiring"
        // => Idempotent guard: already in ContractExpiring
    | other, _ ->
        Error $"Sub-state only applies to Approved suppliers; current state: {other}"
        // => Top-level not Approved — sub-state has no meaning
 
// Renew contract: reset to ActiveContract from ContractExpiring.
let renewContract (sup: ExtendedSupplier) : Result<ExtendedSupplier, string> =
    match sup.State, sup.SubState with
    | Approved, Some ContractExpiring ->
        Ok { sup with SubState = Some ActiveContract }
        // => Renewal resets the sub-state to active
    | Approved, Some ActiveContract ->
        Error "Contract is not expiring; nothing to renew"
    | other, _ ->
        Error $"Cannot renew contract for supplier in state {other}"
 
let sup = createExtSupplier "sup_004" Approved
// => { State = Approved; SubState = Some ActiveContract }
 
let expiring = markContractExpiring sup
// => Ok { State = Approved; SubState = Some ContractExpiring }
 
let renewed  = expiring |> Result.bind renewContract
// => Ok { State = Approved; SubState = Some ActiveContract }
 
printfn "%A" expiring  // => Ok { SubState = Some ContractExpiring }
printfn "%A" renewed   // => Ok { SubState = Some ActiveContract }

// ── file: SupplierFsm.fsx ──────────────────────────────────────────────────
// Supplier with history: remembers sub-state across suspension cycles.
type HistorySupplier =
    { Id: string
      State: SupplierState
      SubState: ApprovedSubState option      // => Current sub-state
      HistorySubState: ApprovedSubState option } // => Last sub-state before suspension
 
// Suspend with history: save sub-state before clearing it.
let suspendWithHistory (sup: HistorySupplier) : Result<HistorySupplier, string> =
    match sup.State with
    | Approved ->
        Ok { sup with
               State = Suspended
               HistorySubState = sup.SubState  // => Save current sub-state as history
               SubState = None }               // => No sub-state while Suspended
    | other ->
        Error $"Cannot suspend from state {other}"
        // => Only Approved suppliers can be suspended
 
// Reinstate with history: restore saved sub-state.
let reinstateWithHistory (sup: HistorySupplier) : Result<HistorySupplier, string> =
    match sup.State with
    | Suspended ->
        let restoredSub = sup.HistorySubState |> Option.defaultValue ActiveContract
        // => Restore saved sub-state, or ActiveContract if history is None
        Ok { sup with
               State = Approved
               SubState = Some restoredSub     // => Sub-state restored from history
               HistorySubState = None }        // => Clear history after use
    | other ->
        Error $"Cannot reinstate from state {other}"
        // => Only Suspended suppliers can be reinstated
 
// Simulate: start Approved+ContractExpiring, suspend, reinstate -> ContractExpiring restored
let initial =
    { Id = "sup_005"; State = Approved
      SubState = Some ContractExpiring; HistorySubState = None }
// => Contract was expiring before suspension
 
let suspended  = suspendWithHistory initial
// => Ok { State = Suspended; SubState = None; HistorySubState = Some ContractExpiring }
 
let reinstated = suspended |> Result.bind reinstateWithHistory
// => Ok { State = Approved; SubState = Some ContractExpiring; HistorySubState = None }
 
printfn "%A" suspended  // => Ok { State = Suspended; SubState = None; HistorySubState = Some ContractExpiring }
printfn "%A" reinstated // => Ok { State = Approved; SubState = Some ContractExpiring }

// ── file: SupplierFsm.fsx ──────────────────────────────────────────────────
// F# equivalent of a Python Enum-based supplier FSM.
// Uses the same Map approach — shows language-agnostic pattern.
 
// Equivalent Python pattern (shown as F# pseudocomment):
// class SupplierState(Enum): PENDING="Pending"; APPROVED="Approved"; etc.
// TRANSITIONS = {(SupplierState.PENDING, "approve"): SupplierState.APPROVED, ...}
 
// F# implementation uses the same data structure:
let pythonStyleTransitions : Map<string * string, string> =
    Map.ofList [
        ("Pending",   "approve"),   "Approved"
        // => Python: TRANSITIONS[(PENDING, "approve")] = APPROVED
        ("Pending",   "blacklist"), "Blacklisted"
        ("Approved",  "suspend"),   "Suspended"
        ("Approved",  "blacklist"), "Blacklisted"
        ("Suspended", "reinstate"), "Approved"
        ("Suspended", "blacklist"), "Blacklisted"
    ]
 
// Generic string-keyed transition: mirrors Python's dict-based approach.
let stringTransition (state: string) (event: string) : Result<string, string> =
    match Map.tryFind (state, event) pythonStyleTransitions with
    | Some next -> Ok next           // => Transition found
    | None      -> Error $"No transition: {state} + {event}"
    // => Invalid (state, event) pair
 
// Replay a string-keyed event log — same fold pattern as PO FSM.
let replayStringEvents (events: string list) : Result<string, string> =
    let rec go state remaining =
        match remaining with
        | []             -> Ok state
        | event :: rest  ->
            match stringTransition state event with
            | Ok next  -> go next rest
            | Error msg -> Error msg
    go "Pending" events
 
printfn "%A" (replayStringEvents ["approve"; "suspend"; "reinstate"])
// => Ok "Approved"
 
printfn "%A" (replayStringEvents ["approve"; "approve"])
// => Error "No transition: Approved + approve"

// ── file: SupplierFsm.fsx ──────────────────────────────────────────────────
// Cascade input: supplier + all open POs for that supplier.
type OpenPO =
    { POId: string
      SupplierId: string
      State: POState }   // => POState from the PO FSM
 
// Cascade result: updated supplier + list of (POId, new POState).
type CascadeResult =
    { UpdatedSupplier: Supplier
      POTransitions: (string * POState) list } // => (POId, target state)
 
// Pure cascade function: no I/O; returns the complete change set.
let computeBlacklistCascade
    (sup: Supplier)
    (openPOs: OpenPO list)
    : Result<CascadeResult, string> =
    if sup.State = Blacklisted then
        Error "Supplier is already blacklisted"
        // => Idempotent: skip if already blacklisted
    else
        match transitionSupplier sup Blacklist with
        | Error msg -> Error msg
        | Ok updated ->
            // => All open POs for this supplier must enter Disputed
            let transitions =
                openPOs
                |> List.filter (fun po -> po.SupplierId = sup.Id)
                // => Only POs belonging to the blacklisted supplier
                |> List.map (fun po -> (po.POId, Disputed))
                // => Each affected PO -> Disputed state
            Ok { UpdatedSupplier = updated; POTransitions = transitions }
 
// Tests
let sup     = { Id = "sup_006"; Name = "Delta Ltd"; State = Approved }
let openPOs =
    [ { POId = "po_201"; SupplierId = "sup_006"; State = Issued }
      { POId = "po_202"; SupplierId = "sup_006"; State = Approved }
      { POId = "po_301"; SupplierId = "sup_007"; State = Issued } ] // => Different supplier
// => po_301 belongs to sup_007 — should not be affected
 
let cascade = computeBlacklistCascade sup openPOs
// => Ok { UpdatedSupplier = { State = Blacklisted }; POTransitions = [("po_201", Disputed); ("po_202", Disputed)] }
 
printfn "%A" cascade
// => Ok { UpdatedSupplier = { State = Blacklisted }; POTransitions = 2 entries }

// ── file: PaymentFsm.fsx ──────────────────────────────────────────────────
// Payment state DU: six states, two terminal (Settled and Cancelled).
type PaymentState =
    | Pending    // => Payment created; awaiting authorisation
    | Authorised // => Bank authorised the amount; ready for processing
    | Processing // => Being processed by payment gateway
    | Settled    // => Money transferred — terminal state
    | Failed     // => Gateway failure; retry allowed up to limit
    | Cancelled  // => Abandoned before settlement — terminal state
 
// Payment event DU: exhaustive event alphabet for payments.
type PaymentEvent =
    | Authorise // => Bank authorises the amount
    | Process   // => Submit to payment gateway
    | Settle    // => Gateway confirms successful transfer
    | Fail      // => Gateway reports failure
    | Retry     // => Retry processing after failure
    | Cancel    // => Cancel before settlement
 
// Payment record with retry counter for the retry-limit guard.
type Payment =
    { Id: string
      Amount: decimal       // => Payment amount in base currency
      State: PaymentState
      RetryCount: int }     // => Number of times Retry has been applied
 
// Transition table: all valid (PaymentState, PaymentEvent) pairs.
let paymentTransitions : Map<PaymentState * PaymentEvent, PaymentState> =
    Map.ofList [
        (Pending,    Authorise), Authorised  // => Authorisation received
        (Authorised, Process),   Processing  // => Submitted to gateway
        (Processing, Settle),    Settled     // => Success — terminal
        (Processing, Fail),      Failed      // => Gateway failure
        (Failed,     Retry),     Processing  // => Re-submit to gateway
        (Pending,    Cancel),    Cancelled   // => Cancelled before auth
        (Authorised, Cancel),    Cancelled   // => Cancelled after auth, before process
    ]
 
// Pure transition function with retry counter increment on Retry.
let transitionPayment (payment: Payment) (event: PaymentEvent) : Result<Payment, string> =
    match Map.tryFind (payment.State, event) paymentTransitions with
    | None      -> Error $"No transition: {payment.State} + {event}"
    | Some next ->
        let retries =
            if event = Retry then payment.RetryCount + 1 else payment.RetryCount
        // => Increment retry counter only on Retry event
        Ok { payment with State = next; RetryCount = retries }
 
let pay = { Id = "pay_001"; Amount = 5000m; State = Pending; RetryCount = 0 }
let r   =
    pay
    |> fun p -> transitionPayment p Authorise   // => Authorised
    |> Result.bind (fun p -> transitionPayment p Process)  // => Processing
    |> Result.bind (fun p -> transitionPayment p Fail)     // => Failed
    |> Result.bind (fun p -> transitionPayment p Retry)    // => Processing again
 
printfn "%A" r
// => Ok { State = Processing; RetryCount = 1 }

// ── file: PaymentFsm.fsx ──────────────────────────────────────────────────
// Maximum retries before a payment must be manually reviewed.
let maxRetries = 3  // => After 3 failed retries, escalate to operations
 
// Guard: can this payment be retried?
// Pure predicate — depends only on record fields.
let canRetry (payment: Payment) : bool =
    payment.State = Failed && payment.RetryCount < maxRetries
    // => Must be in Failed state AND below the retry limit
 
// Guarded retry transition: combines FSM validity + business guard.
let retryPayment (payment: Payment) : Result<Payment, string> =
    if not (canRetry payment) then
        match payment.State with
        | Failed ->
            Error $"Retry limit reached ({payment.RetryCount}/{maxRetries}); escalate to ops"
            // => In Failed state but limit exhausted
        | other ->
            Error $"Cannot retry payment in state {other}"
            // => Not in Failed state — retry makes no sense
    else
        transitionPayment payment Retry
        // => Guard passed — apply the Retry transition
 
// Test: exhaust retries
let exhausted =
    { Id = "pay_002"; Amount = 1200m; State = Failed; RetryCount = 3 }
// => RetryCount already at maxRetries
 
printfn "%A" (retryPayment exhausted)
// => Error "Retry limit reached (3/3); escalate to ops"
 
// Test: retry allowed
let retryable =
    { Id = "pay_003"; Amount = 800m; State = Failed; RetryCount = 1 }
// => RetryCount below maxRetries
 
printfn "%A" (retryPayment retryable)
// => Ok { State = Processing; RetryCount = 2 }

// ── file: PaymentFsm.fsx ──────────────────────────────────────────────────
// Notification state DU: runs in parallel with Payment state.
type NotificationState =
    | Unsent     // => No notification dispatched yet
    | Sent       // => Notification dispatched to customer
    | Acknowledged // => Customer opened/acknowledged the notification
 
// Combined state: two orthogonal FSMs in one record.
type PaymentWithNotification =
    { Payment: Payment                  // => Payment FSM state
      Notification: NotificationState } // => Notification FSM state
 
// Parallel transition: advance both FSMs based on a single payment event.
let transitionParallel
    (combined: PaymentWithNotification)
    (event: PaymentEvent)
    : Result<PaymentWithNotification, string> =
    // => Step 1: advance the payment FSM
    match transitionPayment combined.Payment event with
    | Error msg -> Error msg
    | Ok updatedPayment ->
        // => Step 2: derive the notification transition from the payment event
        let updatedNotification =
            match event with
            | Authorise -> Sent        // => Notify customer on authorisation
            | Fail      -> Sent        // => Notify customer of failure
            | Settle    -> Sent        // => Notify customer of settlement
            | _         -> combined.Notification  // => No notification change
        // => Both FSMs advanced in one atomic step
        Ok { Payment = updatedPayment; Notification = updatedNotification }
 
// Test: authorise triggers both state changes
let initial =
    { Payment = { Id = "pay_004"; Amount = 3000m; State = Pending; RetryCount = 0 }
      Notification = Unsent }
// => Both regions start in their initial states
 
let afterAuth = transitionParallel initial Authorise
// => Payment: Pending -> Authorised; Notification: Unsent -> Sent
 
printfn "%A" afterAuth
// => Ok { Payment = { State = Authorised }; Notification = Sent }

// ── file: PaymentFsm.fsx ──────────────────────────────────────────────────
// Persistence record: flat JSON-friendly representation of Payment.
// DU values are stored as strings to survive schema evolution.
type PaymentSnapshot =
    { Id: string
      Amount: decimal
      State: string      // => DU case name as string; e.g. "Processing"
      RetryCount: int }  // => Counter persisted alongside state
 
// Serialise: Payment -> snapshot (pure function, no I/O).
let toSnapshot (payment: Payment) : PaymentSnapshot =
    { Id         = payment.Id
      Amount     = payment.Amount
      State      = sprintf "%A" payment.State  // => F# %A formats DU case name
      RetryCount = payment.RetryCount }
// => sprintf "%A" Processing = "Processing"
 
// Deserialise: snapshot -> Payment (returns Result to handle unknown strings).
let fromSnapshot (snap: PaymentSnapshot) : Result<Payment, string> =
    let state =
        match snap.State with
        | "Pending"    -> Ok Pending
        | "Authorised" -> Ok Authorised
        | "Processing" -> Ok Processing
        | "Settled"    -> Ok Settled
        | "Failed"     -> Ok Failed
        | "Cancelled"  -> Ok Cancelled
        | unknown      -> Error $"Unknown PaymentState: {unknown}"
        // => Handles unknown strings from future schema versions gracefully
    state |> Result.map (fun s ->
        { Id = snap.Id; Amount = snap.Amount; State = s; RetryCount = snap.RetryCount })
 
// Round-trip test
let payment   = { Id = "pay_005"; Amount = 2500m; State = Processing; RetryCount = 2 }
let snapshot  = toSnapshot payment
// => { Id = "pay_005"; Amount = 2500; State = "Processing"; RetryCount = 2 }
 
let restored  = fromSnapshot snapshot
// => Ok { Id = "pay_005"; Amount = 2500; State = Processing; RetryCount = 2 }
 
printfn "Snapshot: %A"  snapshot  // => { State = "Processing"; RetryCount = 2 }
printfn "Restored: %A"  restored  // => Ok { State = Processing; RetryCount = 2 }

// ── file: PaymentFsm.fsx ──────────────────────────────────────────────────
// Stored event: one entry per event applied to the payment.
type PaymentEventRecord =
    { EventId: string        // => Unique event identifier (UUID)
      PaymentId: string      // => Which payment this event belongs to
      Event: PaymentEvent    // => The event applied
      OccurredAt: int64 }    // => Unix timestamp (milliseconds)
 
// Replay: fold a list of stored events onto the initial Payment record.
// Returns Result to surface the first invalid transition in the log.
let replayPaymentEvents
    (paymentId: string)
    (initialAmount: decimal)
    (events: PaymentEventRecord list)
    : Result<Payment, string> =
    // => Build initial state: Pending payment with zero retries
    let initial = { Id = paymentId; Amount = initialAmount; State = Pending; RetryCount = 0 }
    // => Fold over events; stop on first error (strict replay)
    let rec go (current: Payment) (remaining: PaymentEventRecord list) =
        match remaining with
        | [] -> Ok current
        // => All events consumed — return final state
        | record :: rest ->
            match transitionPayment current record.Event with
            | Ok next  -> go next rest  // => Valid — advance and continue
            | Error msg -> Error $"Event {record.EventId}: {msg}"
            // => Invalid event in log — surface with event id for debugging
    go initial events
 
// Simulate a stored event log
let eventLog =
    [ { EventId = "evt_001"; PaymentId = "pay_006"; Event = Authorise; OccurredAt = 1000L }
      { EventId = "evt_002"; PaymentId = "pay_006"; Event = Process;   OccurredAt = 2000L }
      { EventId = "evt_003"; PaymentId = "pay_006"; Event = Fail;      OccurredAt = 3000L }
      { EventId = "evt_004"; PaymentId = "pay_006"; Event = Retry;     OccurredAt = 4000L }
      { EventId = "evt_005"; PaymentId = "pay_006"; Event = Settle;    OccurredAt = 5000L } ]
// => Full lifecycle: Pending -> Authorised -> Processing -> Failed -> Processing -> Settled
 
let finalState = replayPaymentEvents "pay_006" 7500m eventLog
// => Ok { State = Settled; RetryCount = 1 }
 
printfn "%A" finalState  // => Ok { Id = "pay_006"; Amount = 7500M; State = Settled; RetryCount = 1 }

// ── file: PaymentFsm.fsx ──────────────────────────────────────────────────
// Payment sub-states: only meaningful when Payment is in Processing.
type ProcessingSubState =
    | AwaitingGateway    // => Request sent; waiting for gateway response
    | GatewayResponded   // => Response received; finalising
 
// Full payment: combines main FSM + parallel notification + hierarchical sub-state + history.
type FullPayment =
    { Id: string
      Amount: decimal
      State: PaymentState
      RetryCount: int
      SubState: ProcessingSubState option         // => Some only when Processing
      HistorySubState: ProcessingSubState option  // => Saved on exit from Processing
      Notification: NotificationState }           // => Parallel notification region
 
// Enter Processing from Authorised: set initial sub-state.
let enterProcessing (fp: FullPayment) : Result<FullPayment, string> =
    match fp.State with
    | Authorised ->
        Ok { fp with
               State = Processing
               SubState = Some AwaitingGateway  // => Start in AwaitingGateway sub-state
               Notification = Sent }            // => Parallel: notify on processing start
    | other ->
        Error $"Cannot enter Processing from {other}"
 
// Settle from Processing: save history, clear sub-state, advance notification.
let settlePayment (fp: FullPayment) : Result<FullPayment, string> =
    match fp.State with
    | Processing ->
        Ok { fp with
               State = Settled
               HistorySubState = fp.SubState  // => Save sub-state to history
               SubState = None                // => No sub-state when Settled
               Notification = Sent }          // => Parallel: notify on settlement
    | other ->
        Error $"Cannot settle payment in state {other}"
 
// Test: compose the transitions
let initial =
    { Id = "pay_007"; Amount = 4000m; State = Authorised; RetryCount = 0
      SubState = None; HistorySubState = None; Notification = Unsent }
 
let processing = enterProcessing initial
// => Ok { State = Processing; SubState = Some AwaitingGateway; Notification = Sent }
 
let settled = processing |> Result.bind settlePayment
// => Ok { State = Settled; HistorySubState = Some AwaitingGateway; Notification = Sent }
 
printfn "%A" settled
// => Ok { State = Settled; SubState = None; HistorySubState = Some AwaitingGateway; Notification = Sent }

// ── file: IntegrationCheck.fsx ────────────────────────────────────────────
// Verify all four FSMs process their happy paths without error.
// Uses tableTransition (PO), invoiceTransition (Invoice),
// transitionSupplier, and transitionPayment from previous examples.
 
// Helper: fold an event list with a transition function; return final state or error.
let foldEvents
    (transition: 'S -> 'E -> Result<'S, string>)
    (initial: 'S)
    (events: 'E list)
    : Result<'S, string> =
    // => Generic fold: works for any (state, event) -> Result<state, string> function
    List.fold
        (fun acc event ->
            acc |> Result.bind (fun s -> transition s event))
        (Ok initial)
        events
// => Short-circuits on first Error; returns Ok final-state on success
 
// PO happy path: Draft -> AwaitingApproval -> Approved -> Issued -> Acknowledged -> Closed
let poResult =
    foldEvents tableTransition Draft
        [ Submit; Approve; Issue; Acknowledge; Close ]
// => Ok Closed
 
// Supplier happy path: Pending -> Approved -> Suspended -> Approved
let supplierFn (s: SupplierState) (e: SupplierEvent) =
    Map.tryFind (s, e) supplierTransitions
    |> Option.map Ok
    |> Option.defaultValue (Error $"No transition: {s} + {e}")
let supResult =
    foldEvents supplierFn Pending [ Approve; Suspend; Reinstate ]
// => Ok Approved
 
// Payment happy path: Pending -> Authorised -> Processing -> Settled
let payResult =
    foldEvents
        (fun s e -> transitionPayment { Id = ""; Amount = 0m; State = s; RetryCount = 0 } e
                    |> Result.map (fun p -> p.State))
        Pending
        [ Authorise; Process; Settle ]
// => Ok Settled
 
printfn "PO final state:       %A" poResult   // => Ok Closed
printfn "Supplier final state: %A" supResult  // => Ok Approved
printfn "Payment final state:  %A" payResult  // => Ok Settled

// ── file: MurabahFsm.fsx ──────────────────────────────────────────────────
// MurabahaContract state DU: offer -> acceptance -> repayment lifecycle.
// [Clojure: keyword values in a map — open; no compile-time exhaustiveness check]
type MurabahaState =
    | OfferPending   // => Bank has presented the cost+profit offer; awaiting customer decision
    | OfferAccepted  // => Customer accepted the offer; contract activation pending
    | OfferRejected  // => Customer rejected the offer — terminal state
    | Active         // => Contract active; first payment not yet made
    | Repaying       // => Customer is making instalment payments
    | Defaulted      // => Customer missed a payment; remediation required
    | Settled        // => Full repayment complete — terminal state
 
// MurabahaContract event DU: exhaustive alphabet of events that drive the lifecycle.
// [Clojure: keywords; no declaration required; dispatch is table-driven]
type MurabahaEvent =
    | Accept         // => Customer accepts the cost+profit offer
    | Reject         // => Customer rejects the offer
    | Activate       // => Bank activates the contract after acceptance
    | FirstPayment   // => Customer makes the first instalment
    | FullRepayment  // => Customer completes all instalments
    | MissPayment    // => Customer misses a scheduled payment
    | Remediate      // => Customer catches up on missed payments
 
// Transition table for the MurabahaContract FSM.
// Map.ofList builds an immutable lookup at startup — O(log n) per query.
let murabahaTransitions : Map<MurabahaState * MurabahaEvent, MurabahaState> =
    Map.ofList [
        (OfferPending,  Accept),       OfferAccepted  // => Customer accepts
        (OfferPending,  Reject),       OfferRejected  // => Customer rejects — terminal
        (OfferAccepted, Activate),     Active          // => Bank activates contract
        (Active,        FirstPayment), Repaying        // => Repayment started
        (Repaying,      FullRepayment),Settled         // => All paid — terminal
        (Repaying,      MissPayment),  Defaulted       // => Missed payment
        (Defaulted,     Remediate),    Repaying        // => Caught up — resume repaying
        // => OfferRejected and Settled: terminal — no outgoing transitions listed
    ]
 
// Pure transition function: lookup (state, event) pair; return Result.
let transitionMurabaha (state: MurabahaState) (event: MurabahaEvent) : Result<MurabahaState, string> =
    match Map.tryFind (state, event) murabahaTransitions with
    | Some next -> Ok next
    // => Valid transition found — return new state wrapped in Ok
    | None      -> Error $"Invalid transition: {state} + {event}"
    // => (state, event) pair not in table — invalid for this contract
 
// Happy path: offer -> accept -> activate -> firstPayment -> fullRepayment
let happyPath = [ Accept; Activate; FirstPayment; FullRepayment ]
let result =
    List.fold
        (fun acc e -> acc |> Result.bind (fun s -> transitionMurabaha s e))
        (Ok OfferPending)
        happyPath
// => List.fold threads state through each event, short-circuiting on Error
// => Ok Settled
 
printfn "%A" result  // => Ok Settled

// ── file: MurabahFsm.fsx ──────────────────────────────────────────────────
// Murabaha contract record with instalment tracking.
// [Clojure: plain map {:id ... :state :repaying :total-instalments 3 :paid-instalments 0}]
type MurabahaContract =
    { Id: string
      State: MurabahaState
      TotalInstalments: int   // => Total number of scheduled instalments
      PaidInstalments: int    // => Number of instalments paid so far
      ProfitMargin: decimal } // => Fixed profit percentage set at offer time
 
// Guard: can the customer make a FullRepayment?
// True only when all instalments have been paid.
let canFullyRepay (contract: MurabahaContract) : bool =
    contract.PaidInstalments >= contract.TotalInstalments
    // => >= handles edge case of over-payment without erroring
    // => pure predicate — depends only on the record fields
 
// Process a single instalment payment — self-loop on Repaying.
// [Clojure: (assoc contract :paid-instalments (inc paid)) — same immutable update]
let makeInstalment (contract: MurabahaContract) : Result<MurabahaContract, string> =
    match contract.State with
    | Repaying ->
        // => Increment paid counter; state stays Repaying until all paid
        let updated = { contract with PaidInstalments = contract.PaidInstalments + 1 }
        Ok updated
        // => Self-loop: Repaying -> Repaying with updated counter
    | other ->
        Error $"Cannot make instalment in state {other}"
        // => Not in Repaying state — instalment makes no sense
 
// Complete repayment: guard checks counter then fires FullRepayment.
// Guard must pass before the FSM transition is attempted.
let completeRepayment (contract: MurabahaContract) : Result<MurabahaContract, string> =
    if not (canFullyRepay contract) then
        let remaining = contract.TotalInstalments - contract.PaidInstalments
        Error $"{remaining} instalments still outstanding"
        // => Guard fails: not all instalments paid; surface the remaining count
    else
        match transitionMurabaha contract.State FullRepayment with
        | Ok next  -> Ok { contract with State = next }
        // => Guard passed; FSM advances to Settled
        | Error msg -> Error msg
        // => Transition rejected (shouldn't happen given guard above)
 
// Test: 3-instalment contract
let contract =
    { Id = "mur_001"; State = Repaying; TotalInstalments = 3; PaidInstalments = 0; ProfitMargin = 0.08m }
 
let afterInstalment1 = makeInstalment contract
// => Ok { PaidInstalments = 1; State = Repaying }
 
let afterInstalment2 = afterInstalment1 |> Result.bind makeInstalment
// => Ok { PaidInstalments = 2; State = Repaying }
 
let afterInstalment3 = afterInstalment2 |> Result.bind makeInstalment
// => Ok { PaidInstalments = 3; State = Repaying }
 
let settled = afterInstalment3 |> Result.bind completeRepayment
// => Ok { PaidInstalments = 3; State = Settled }
 
printfn "%A" settled
// => Ok { Id = "mur_001"; State = Settled; PaidInstalments = 3 }

// ── file: MurabahFsm.fsx ──────────────────────────────────────────────────
// Link record: connects a MurabahaContract to its originating PurchaseOrder.
// [Clojure: plain map {:contract {...} :linked-po {...}} — same structure, no type]
type MurabahaPOLink =
    { Contract: MurabahaContract
      LinkedPO: PurchaseOrder }  // => PurchaseOrder type from PO FSM
 
// Activate the contract and simultaneously issue the linked PO.
// Returns the updated contract and PO as a pair — no I/O.
// [Clojure: sequential if-let chain on {:ok ...} maps — same two-step logic]
let activateContractAndIssuePO
    (link: MurabahaPOLink)
    : Result<MurabahaPOLink, string> =
    // => Step 1: transition the contract from OfferAccepted to Active
    match transitionMurabaha link.Contract.State Activate with
    | Error msg -> Error $"Contract activation failed: {msg}"
    // => Contract not in OfferAccepted state — activation invalid
    | Ok activeState ->
        let updatedContract = { link.Contract with State = activeState }
        // => Contract is now Active; preserve all other fields
        // => Step 2: issue the linked PO (must be in Approved state)
        match tableTransition link.LinkedPO.State Issue with
        | Error msg -> Error $"PO issuance failed: {msg}"
        // => PO not in Approved state — cannot issue without approval
        | Ok issuedState ->
            let updatedPO = { link.LinkedPO with State = issuedState }
            // => PO is now Issued
            Ok { Contract = updatedContract; LinkedPO = updatedPO }
            // => Both machines advanced in one pure step — caller commits atomically
 
// Tests
let contractInAccepted =
    { Id = "mur_002"; State = OfferAccepted; TotalInstalments = 12
      PaidInstalments = 0; ProfitMargin = 0.07m }
// => Contract must be in OfferAccepted state for Activate to succeed
 
let poInApproved = { Id = "PO-100"; State = Approved }
// => PO must be in Approved state for Issue to succeed
 
let link = { Contract = contractInAccepted; LinkedPO = poInApproved }
 
printfn "%A" (activateContractAndIssuePO link)
// => Ok { Contract = { State = Active }; LinkedPO = { State = Issued } }
 
let linkBadPO = { link with LinkedPO = { Id = "PO-101"; State = Draft } }
printfn "%A" (activateContractAndIssuePO linkBadPO)
// => Error "PO issuance failed: No transition: Draft + Issue"

// ── file: PaymentActor.fsx ────────────────────────────────────────────────
// Actor message: carry the event and a reply channel.
// [Clojure: core.async channel — go block reads messages; no discriminated union needed]
type PaymentActorMsg =
    | Apply of PaymentEvent * AsyncReplyChannel<Result<Payment, string>>
    // => Apply an event; reply with new state or error
    | GetState of AsyncReplyChannel<Payment>
    // => Query current state without changing it
 
// Create a payment actor wrapping the payment FSM.
// MailboxProcessor processes messages sequentially — no race conditions.
// [Clojure: atom + core.async agent — different concurrency model; see Clojure tab]
let createPaymentActor (initial: Payment) : MailboxProcessor<PaymentActorMsg> =
    MailboxProcessor.Start(fun inbox ->
        // => Recursive loop: hold current state in tail-recursive parameter
        let rec loop (current: Payment) = async {
            let! msg = inbox.Receive()  // => Await next message; suspends without blocking thread
            match msg with
            | Apply(event, reply) ->
                let result = transitionPayment current event
                // => Apply event to current state — pure function; no mutation
                match result with
                | Ok next ->
                    reply.Reply(Ok next)  // => Send updated payment to caller
                    return! loop next     // => Recurse with new state; tail-recursive
                | Error msg ->
                    reply.Reply(Error msg)  // => Send error to caller
                    return! loop current   // => State unchanged on error; keep current
            | GetState reply ->
                reply.Reply current  // => Return current state without transition
                return! loop current // => State unchanged on query; continue loop
        }
        loop initial)  // => Start with initial payment state
 
// Usage: create actor and send events
let actor =
    createPaymentActor { Id = "pay_008"; Amount = 6000m; State = Pending; RetryCount = 0 }
// => Actor starts with Pending payment; MailboxProcessor ready to receive
 
let r1 = actor.PostAndReply(fun ch -> Apply(Authorise, ch))
// => Ok { State = Authorised }
 
let r2 = actor.PostAndReply(fun ch -> Apply(Process, ch))
// => Ok { State = Processing }
 
let current = actor.PostAndReply GetState
// => { State = Processing; RetryCount = 0 }
 
printfn "After Authorise: %A" r1      // => Ok { State = Authorised }
printfn "After Process:   %A" r2      // => Ok { State = Processing }
printfn "Current state:   %A" current // => { State = Processing }

// ── file: PaymentFsm.fsx ──────────────────────────────────────────────────
// Versioned payment: version increments on every successful transition.
// [Clojure: plain map with :version key — same field; no type declaration]
type VersionedPayment =
    { Id: string
      Amount: decimal
      State: PaymentState
      RetryCount: int
      Version: int64 }  // => Monotonically increasing version counter
 
// Versioned transition: caller must supply the expected current version.
// [Clojure: compare-and-swap check on :version before applying transition]
let transitionVersioned
    (payment: VersionedPayment)
    (event: PaymentEvent)
    (expectedVersion: int64)
    : Result<VersionedPayment, string> =
    if payment.Version <> expectedVersion then
        Error $"Version conflict: expected {expectedVersion}, found {payment.Version}"
        // => Another writer modified this payment since we read it
    else
        match Map.tryFind (payment.State, event) paymentTransitions with
        | None -> Error $"No transition: {payment.State} + {event}"
        // => FSM rejects the event in the current state
        | Some next ->
            let retries = if event = Retry then payment.RetryCount + 1 else payment.RetryCount
            // => Increment retry counter only on Retry events
            Ok { payment with
                   State = next
                   RetryCount = retries
                   Version = payment.Version + 1L }
                // => Version increments atomically with the state change
 
// Test: version conflict detection
let vp = { Id = "pay_009"; Amount = 3500m; State = Pending; RetryCount = 0; Version = 1L }
// => Version 1 is the current persisted version
 
let ok = transitionVersioned vp Authorise 1L
// => Caller supplies correct expected version; transition succeeds
// => Ok { State = Authorised; Version = 2L }
 
let conflict = transitionVersioned vp Authorise 0L
// => Caller supplies stale expected version 0; conflict detected
// => Error "Version conflict: expected 0, found 1"
 
printfn "%A" ok       // => Ok { State = Authorised; Version = 2L }
printfn "%A" conflict // => Error "Version conflict: expected 0, found 1"

// ── file: SagaFsm.fsx ─────────────────────────────────────────────────────
// Saga state: one field per participating machine.
// [Clojure: plain map {:saga-id "..." :po-state :approved :invoice-state "Received" :payment-state :processing}]
type P2PSaga =
    { SagaId: string
      POState: POState         // => PurchaseOrder FSM state
      InvoiceState: string     // => Invoice FSM state (string for brevity)
      PaymentState: PaymentState } // => Payment FSM state
 
// Saga step result: updated saga or compensating error.
// [Clojure: {:ok saga-map} or {:error msg} — same tagged-map convention]
type SagaStep = Result<P2PSaga, string>
 
// Advance the PO to Issued; prerequisite for invoice approval.
let sagaIssuePO (saga: P2PSaga) : SagaStep =
    match tableTransition saga.POState Issue with
    | Ok next -> Ok { saga with POState = next }
    // => PO transitions from Approved -> Issued
    | Error msg -> Error $"Saga PO issue failed: {msg}"
    // => PO not in Approved state — cannot issue before approval
 
// Advance the invoice to Approved; only after PO is Issued.
// [Clojure: if guard on (:po-state saga) — same cross-machine dependency check]
let sagaApproveInvoice (saga: P2PSaga) : SagaStep =
    if saga.POState <> Issued then
        Error "Invoice cannot be approved before PO is Issued"
        // => Saga coordination guard: cross-machine dependency enforced here
    else
        Ok { saga with InvoiceState = "Approved" }
        // => Invoice advances to Approved; no FSM table needed for string state
 
// Settle the payment; only after Invoice is Approved.
// [Clojure: sequential let chain checking :invoice-state then :payment state]
let sagaSettlePayment (saga: P2PSaga) (payment: Payment) : Result<P2PSaga * Payment, string> =
    if saga.InvoiceState <> "Approved" then
        Error "Payment cannot settle before Invoice is Approved"
        // => Cross-machine dependency: invoice approval gates payment settlement
    else
        match transitionPayment payment Settle with
        | Error msg -> Error $"Payment settle failed: {msg}"
        | Ok settled -> Ok ({ saga with PaymentState = settled.State }, settled)
        // => Both saga record and payment record returned as a pair
 
// Run the P2P saga
let saga =
    { SagaId = "saga_001"; POState = Approved
      InvoiceState = "Received"; PaymentState = Processing }
// => Starting state: PO approved, invoice received, payment processing
 
let result =
    Ok saga
    |> Result.bind sagaIssuePO           // => PO: Approved -> Issued
    |> Result.bind sagaApproveInvoice    // => Invoice: Received -> Approved
// => Ok { POState = Issued; InvoiceState = "Approved"; PaymentState = Processing }
 
printfn "%A" result
// => Ok { POState = Issued; InvoiceState = "Approved"; PaymentState = Processing }

// ── file: PaymentFsm.fsx ──────────────────────────────────────────────────
// Snapshot: point-in-time capture of payment FSM state.
// [Clojure: plain map with string :state — (name keyword) serialises :processing -> "processing"]
type PaymentSnapshot2 =
    { SnapshotId: string    // => Unique snapshot identifier
      PaymentId: string
      State: string         // => DU case name as string — survives schema evolution
      RetryCount: int
      Version: int64
      SnapshotAt: int64 }   // => Unix timestamp when snapshot was taken
 
// Create a snapshot from a VersionedPayment.
// [Clojure: to-snapshot converts :state keyword to string via (name kw)]
let takeSnapshot (payment: VersionedPayment) (now: int64) : PaymentSnapshot2 =
    { SnapshotId = System.Guid.NewGuid().ToString()
      // => Fresh ID guarantees snapshot uniqueness even for the same payment version
      PaymentId   = payment.Id
      State       = sprintf "%A" payment.State  // => F# %A formats DU case as "Processing"
      RetryCount  = payment.RetryCount
      Version     = payment.Version
      SnapshotAt  = now }
// => Pure function: Guid.NewGuid is the only non-deterministic call
 
// Restore a VersionedPayment from a snapshot.
// Explicit match surfaces unknown state strings as typed errors.
let restoreFromSnapshot (snap: PaymentSnapshot2) : Result<VersionedPayment, string> =
    let state =
        match snap.State with
        | "Pending"    -> Ok Pending
        | "Authorised" -> Ok Authorised
        | "Processing" -> Ok Processing
        | "Settled"    -> Ok Settled
        | "Failed"     -> Ok Failed
        | "Cancelled"  -> Ok Cancelled
        | unknown      -> Error $"Unknown state in snapshot: {unknown}"
        // => Unknown string from future schema version — return typed error
    state |> Result.map (fun s ->
        { Id = snap.PaymentId; Amount = 0m; State = s
          RetryCount = snap.RetryCount; Version = snap.Version })
    // => Amount not stored in snapshot — caller restores from separate payment record
 
// Test snapshot round-trip
let vp2  = { Id = "pay_010"; Amount = 9000m; State = Processing; RetryCount = 2; Version = 5L }
let snap = takeSnapshot vp2 1716000000000L
// => { SnapshotId = "<uuid>"; State = "Processing"; RetryCount = 2; Version = 5L }
 
let restored = restoreFromSnapshot snap
// => Ok { State = Processing; RetryCount = 2; Version = 5L }
 
printfn "Snapshot state: %s"   snap.State   // => Processing
printfn "Restored:       %A"   restored      // => Ok { State = Processing; RetryCount = 2; Version = 5 }

// ── file: Visualisation.fsx ───────────────────────────────────────────────
// Generate a Mermaid stateDiagram-v2 from any Map<(state * event), state>.
// Uses sprintf to format DU cases as readable strings.
let generateMermaid
    (title: string)
    (table: Map<'S * 'E, 'S>)
    : string =
    // => Collect one transition line per entry in the table
    let transitions =
        table
        |> Map.toList  // => [(('S, 'E), 'S)]
        |> List.map (fun ((fromState, event), toState) ->
            $"    {fromState} --> {toState}: {event}")
            // => Mermaid arrow syntax: From --> To : Label
    let header   = $"---\ntitle: {title}\n---\nstateDiagram-v2"
    // => Mermaid frontmatter + diagram type declaration
    let body     = transitions |> String.concat "\n"
    // => Join all transition lines
    header + "\n" + body
// => Returns complete Mermaid string, ready to embed in markdown
 
// Generate Mermaid for the Payment FSM
let paymentMermaid = generateMermaid "Payment FSM" paymentTransitions
 
printfn "%s" paymentMermaid
// => ---
// => title: Payment FSM
// => ---
// => stateDiagram-v2
// =>     Pending --> Authorised: Authorise
// =>     Pending --> Cancelled: Cancel
// =>     Authorised --> Processing: Process
// =>     Authorised --> Cancelled: Cancel
// =>     Processing --> Settled: Settle
// =>     Processing --> Failed: Fail
// =>     Failed --> Processing: Retry
 
// Generate for Supplier FSM
let supplierMermaid = generateMermaid "Supplier FSM" supplierTransitions
printfn "%s" supplierMermaid
// => stateDiagram-v2
// =>     Pending --> Approved: Approve
// =>     Pending --> Blacklisted: Blacklist
// =>     ... (one line per transition)

// ── file: ApiCodes.fsx ────────────────────────────────────────────────────
// HTTP status code mapping: (PaymentState, operation string) -> (int, string)
// Pure function — same inputs always produce same outputs.
let paymentStatusCode (state: PaymentState) (operation: string) : int * string =
    match state, operation with
    | Pending,    "view"    -> 200, "Payment pending authorisation"
    | Pending,    "pay"     -> 409, "Payment not yet authorised"
    // => 409 Conflict: action not valid for current state
    | Authorised, "view"    -> 200, "Payment authorised"
    | Authorised, "pay"     -> 409, "Payment not yet processed"
    | Processing, "view"    -> 200, "Payment processing"
    | Processing, "pay"     -> 409, "Payment already in processing"
    | Failed,     "view"    -> 200, "Payment failed"
    | Failed,     "retry"   -> 200, "Retry accepted"
    | Failed,     "pay"     -> 409, "Payment failed; retry or cancel"
    | Settled,    "view"    -> 200, "Payment settled"
    | Settled,    "pay"     -> 409, "Payment already settled"
    | Cancelled,  "view"    -> 200, "Payment cancelled"
    | Cancelled,  "pay"     -> 410, "Payment cancelled; cannot process"
    // => 410 Gone: resource permanently gone
    | _, _                  -> 422, $"Operation '{operation}' not supported in state {state}"
    // => 422 Unprocessable Entity: unrecognised combination
 
// Test across several state/operation pairs
let cases = [
    (Pending,    "pay"),    (409, "Payment not yet authorised")
    (Failed,     "retry"),  (200, "Retry accepted")
    (Settled,    "pay"),    (409, "Payment already settled")
    (Cancelled,  "pay"),    (410, "Payment cancelled; cannot process")
]
 
cases |> List.iter (fun ((state, op), (expectedCode, _)) ->
    let (code, msg) = paymentStatusCode state op
    printfn "%A + %s -> %d: %s" state op code msg)
// => Pending + pay -> 409: Payment not yet authorised
// => Failed + retry -> 200: Retry accepted
// => Settled + pay -> 409: Payment already settled
// => Cancelled + pay -> 410: Payment cancelled; cannot process

// ── file: IntegrationTest.fsx ─────────────────────────────────────────────
// Full P2P scenario: create PO, approve supplier, process invoice, settle payment.
// Each assertion is a pure structural equality check — no mocks, no setup.
 
// Step 1: Create and issue a PurchaseOrder
let po0 = createPO "PO-INTEG-001"
// => { State = Draft }
let po1 =
    [Submit; Approve; Issue]
    |> List.fold
        (fun acc e ->
            acc |> Result.bind (fun s -> tableTransition s e |> Result.map id))
        (Ok po0.State)
// => Ok Issued
 
// Step 2: Approve a Supplier
let sup0 = { Id = "sup_INTEG"; Name = "Integration Supplier"; State = Pending }
let sup1 = transitionSupplier sup0 Approve
// => Ok { State = Approved }
 
// Step 3: Process a Payment through full lifecycle
let pay0 = { Id = "pay_INTEG"; Amount = 10_000m; State = Pending; RetryCount = 0 }
let pay1 =
    [Authorise; Process; Settle]
    |> List.fold
        (fun acc e -> acc |> Result.bind (fun p -> transitionPayment p e))
        (Ok pay0)
// => Ok { State = Settled }
 
// Step 4: Assert all machines reached their expected final states
let assertOk label expected actual =
    match actual with
    | Ok value when sprintf "%A" value = sprintf "%A" expected ->
        printfn "PASS: %s -> %A" label value
        // => Test passed: actual matches expected
    | Ok value ->
        printfn "FAIL: %s expected %A got %A" label expected value
        // => Wrong value returned
    | Error msg ->
        printfn "FAIL: %s errored: %s" label msg
        // => Unexpected error
 
assertOk "PO final state"       (Ok Issued)   po1
// => PASS: PO final state -> Ok Issued
assertOk "Supplier final state" (Ok Approved) (sup1 |> Result.map (fun s -> s.State))
// => PASS: Supplier final state -> Ok Approved
assertOk "Payment final state"  (Ok Settled)  (pay1 |> Result.map (fun p -> p.State))
// => PASS: Payment final state -> Ok Settled

// ── file: StatechartSummary.fsx ───────────────────────────────────────────
// Summary: all four P2P FSMs as a combined Mermaid diagram.
// Each machine is shown as a Mermaid stateDiagram-v2 sub-diagram.
// This is the "living documentation" generated from transition tables.
 
// Generate summaries for all machines
let poSummary       = generateMermaid "PurchaseOrder FSM" fullTransitionTable
let supplierSummary = generateMermaid "Supplier FSM"      supplierTransitions
let paymentSummary  = generateMermaid "Payment FSM"       paymentTransitions
let murabahSummary  = generateMermaid "Murabaha FSM"      murabahaTransitions
 
// Count transitions across all machines
let totalTransitions =
    [ fullTransitionTable; supplierTransitions; paymentTransitions; murabahaTransitions ]
    |> List.sumBy Map.count
// => Total valid (state, event) pairs across all four machines
 
printfn "=== P2P Statechart Summary ==="
printfn "Total valid transitions: %d" totalTransitions
// => Exact number depends on transition tables defined above
 
// Print each machine's transition count
let machines =
    [ "PurchaseOrder", fullTransitionTable
      "Supplier",      supplierTransitions
      "Payment",       paymentTransitions
      "Murabaha",      murabahaTransitions ]
 
machines |> List.iter (fun (name, table) ->
    printfn "%s: %d transitions" name (Map.count table))
// => PurchaseOrder: 11 transitions
// => Supplier: 6 transitions
// => Payment: 7 transitions
// => Murabaha: 7 transitions
 
// Verify all machines have at least one terminal state
let hasTerminalState (table: Map<'S * 'E, 'S>) : bool =
    let reachableStates = table |> Map.toList |> List.map snd |> Set.ofList
    // => All states that are reachable as a destination
    let outboundStates  = table |> Map.toList |> List.map (fst >> fst) |> Set.ofList
    // => All states that have at least one outgoing transition
    not (Set.isEmpty (Set.difference reachableStates outboundStates))
    // => If a reachable state has no outgoing transitions, it is terminal
 
printfn "PurchaseOrder has terminal: %b" (hasTerminalState fullTransitionTable)  // => true
printfn "Supplier has terminal:      %b" (hasTerminalState supplierTransitions)  // => true
printfn "Payment has terminal:       %b" (hasTerminalState paymentTransitions)   // => true
printfn "Murabaha has terminal:      %b" (hasTerminalState murabahaTransitions)  // => true