Deferreds

type private Attempt =
    | Succeed of int
    | Fail of int
    | Die of int
    | Complete of int
    | Interrupt

let deferreds (round: Round) : Flow<Axial.ClockEnvironment, Never, Check list> =
    let awaiters = round.Size 40

    flow {
        // Deferred.make's flow fails with the deferred's own error type; creating one never actually fails.
        let! deferred = Deferred.make<Axial.ClockEnvironment, int, int> () |> Flow.fold Flow.ok (fun _ -> Flow.die (InvalidOperationException "unreachable"))
        let! early = [ 1..awaiters ] |> Flow.traverse (fun _ -> deferred |> Deferred.await |> Flow.fork)

        // Several completers race, each with a different kind of completion; exactly one may win.
        let attempts =
            [ for id in 1..10 ->
                  match round.Next 5 with
                  | 0 -> Succeed id
                  | 1 -> Fail id
                  | 2 -> Die id
                  | 3 -> Complete id
                  | _ -> Interrupt ]

        let attempt kind =
            if round.Chance 50 then
                let won =
                    match kind with
                    | Succeed id -> deferred |> Deferred.succeedNow id
                    | Fail id -> deferred |> Deferred.failNow id
                    | Die id -> deferred |> Deferred.dieNow (InvalidOperationException(string id))
                    | Complete id -> deferred |> Deferred.completeNow (Exit.Success(id * 100))
                    | Interrupt -> deferred |> Deferred.interruptNow

                Flow.ok won
            else
                match kind with
                | Succeed id -> deferred |> Deferred.succeed id
                | Fail id -> deferred |> Deferred.fail id
                | Die id -> deferred |> Deferred.die (InvalidOperationException(string id))
                | Complete id -> deferred |> Deferred.complete (Exit.Success(id * 100))
                | Interrupt -> deferred |> Deferred.interrupt

        // Interrupt a random half of the early awaiters while the completers race.
        let interrupter =
            early |> Flow.traverse (fun fiber -> if round.Chance 50 then Fiber.interrupt fiber else Fiber.await fiber)

        let! won, earlyExits = Flow.zipPar (attempts |> Flow.traversePar (Parallelism.bounded 10) attempt) interrupter
        let! late = deferred |> Deferred.await |> exitOf

        let winners = List.zip attempts won |> List.filter snd |> List.map fst

        let expected: Exit<int, int> option =
            match winners with
            | [ Succeed id ] -> Some(Exit.Success id)
            | [ Fail id ] -> Some(Exit.Failure(Cause.Fail id))
            | [ Complete id ] -> Some(Exit.Success(id * 100))
            | [ Interrupt ] -> Some(Exit.Failure Cause.Interrupt)
            | _ -> None

        let matches (exit: Exit<int, int>) =
            match winners, exit with
            | [ Die id ], Exit.Failure(Cause.Die error) -> error.Message = string id
            | _ -> Some exit = expected

        let observed = earlyExits |> List.filter (isInterrupted >> not)

        return
            [ check "exactly one completion won" (winners.Length = 1)
              check "every awaiter that was not interrupted saw the winning outcome" (observed |> List.forall matches)
              check "an awaiter arriving afterwards sees the same outcome" (matches late) ]
    }