Lucas WintherandClaude Fable 5.2
edd57f0148
Audit pass: - Frame rule counts frames since the last move, so every step lasts exactly movesEvery(score) frames, also right after a speed-up - clampTime + MAX_GAP_MS: a hidden tab no longer replays the whole gap - Pong Restart keeps held keys - Fact corrections (mulberry32 output coverage, Haskell IO, uniform) - New fixture cases from a mutation analysis Extensions (all three tracks, shared fixtures, course text): - Turn queue (Exercise 10.6), persisted high score (10.7), replay viewer (10.8), play() end-to-end helper (9.5) - Optional State (4.7) and optional Module 7b, stack-safe IO - Module 12, property-based testing with generators, shrinking, invariants and a model-based oracle - Module 13, Conway's Life with a Click event - JS type checking via jsconfig, JSDoc and types.d.ts - Maintainer tools: scripts/mutate.mjs, scripts/typecheck-js.sh, Playwright end-to-end suite (e2e/, scripts/e2e.sh) Docs: docs/contract.md is the canonical contract; specs and build log under docs/superpowers. Verified: JS 728, Scala 689, F# 691 unit tests; stubs and progression M01-M13 and M07b; 176 end-to-end tests on Chromium and WebKit. Co-Authored-By: Claude Fable 5.2 <noreply@anthropic.com>
294 lines
14 KiB
FSharp
294 lines
14 KiB
FSharp
module Snake.Tests.M07bSafeIO
|
|
|
|
// The JS tests check that a node holds the very same function; functions cannot be compared, so these tests check
|
|
// each node's shape (its case) and then observe the program through `trace`. `traceStep` and `drive` are JS-only.
|
|
|
|
open Expecto
|
|
open Snake
|
|
open Snake.View
|
|
open Snake.SafeIO
|
|
|
|
let private rectAt (x: int) : Shape = Rect(x, 0, 1, 1, "#000000")
|
|
let private r1 = rectAt 0
|
|
let private t1 = Text(1, 2, "hi", "#ffffff", 16, "left")
|
|
let private boom (_: 'a) : SafeIO<'b> = failwith "boom"
|
|
let private N = 100000
|
|
|
|
// The value of a RandomSeed answer (the same job as IO.randomSeed does for m07's IO).
|
|
let private seedValue (r: IO.OpResult) : uint32 =
|
|
match r with
|
|
| IO.Seed s -> s
|
|
| _ -> failwith "RandomSeed must be answered with a Seed"
|
|
|
|
// SafeIO versions of m07's `draw` and `randomSeed`, built the same way.
|
|
let private draw (shape: Shape) : SafeIO<unit> = SafeIO.effect (IO.Draw shape) |> SafeIO.map ignore
|
|
let private randomSeed () : SafeIO<uint32> = SafeIO.effect IO.RandomSeed |> SafeIO.map seedValue
|
|
|
|
let private leftDraws (n: int) : SafeIO<unit> =
|
|
List.fold (fun acc i -> acc |> SafeIO.bind (fun () -> draw (rectAt i))) (SafeIO.pure ()) [ 0 .. n - 1 ]
|
|
|
|
let private rightDraws (n: int) : SafeIO<unit> =
|
|
List.foldBack (fun i rest -> draw (rectAt i) |> SafeIO.bind (fun () -> rest)) [ 0 .. n - 1 ] (SafeIO.pure ())
|
|
|
|
let private firstAndLast (ops: IO.Op list) : IO.Op list = [ List.head ops; List.last ops ]
|
|
|
|
// ---- the monad laws, observed through trace
|
|
|
|
let private programs: (string * (unit -> SafeIO<uint32>)) list =
|
|
[ "a pure value", (fun () -> SafeIO.pure 4u)
|
|
"one effect", (fun () -> randomSeed ())
|
|
"a draw followed by reading the seed", (fun () -> draw r1 |> SafeIO.bind (fun () -> randomSeed ())) ]
|
|
|
|
let private f (n: uint32) : SafeIO<uint32> = draw (rectAt (int n)) |> SafeIO.bind (fun () -> SafeIO.pure (n * 2u))
|
|
let private g (n: uint32) : SafeIO<uint32> = randomSeed () |> SafeIO.map (fun s -> s + n)
|
|
|
|
// ---- the same programs under m07's IO. F# cannot pass "an IO module" as a parameter, so each program is written
|
|
// twice, line for line the same, once with each IO.
|
|
|
|
let private shared: (string * (unit -> IO.Traced<int>) * (unit -> IO.Traced<int>)) list =
|
|
[ "seed, then a draw that depends on it",
|
|
(fun () ->
|
|
randomSeed ()
|
|
|> SafeIO.bind (fun s -> draw (rectAt (int (s % 20u))) |> SafeIO.map (fun () -> int s))
|
|
|> SafeIO.trace 7u),
|
|
(fun () ->
|
|
IO.randomSeed ()
|
|
|> IO.bind (fun s -> IO.draw (rectAt (int (s % 20u))) |> IO.map (fun () -> int s))
|
|
|> IO.trace 7u)
|
|
|
|
"a sequence of three effects",
|
|
(fun () ->
|
|
SafeIO.sequence [ draw t1; randomSeed () |> SafeIO.map ignore; draw r1 ]
|
|
|> SafeIO.map (fun () -> 0)
|
|
|> SafeIO.trace 7u),
|
|
(fun () ->
|
|
IO.sequence [ IO.draw t1; IO.randomSeed () |> IO.map ignore; IO.draw r1 ]
|
|
|> IO.map (fun () -> 0)
|
|
|> IO.trace 7u)
|
|
|
|
"200 left-nested binds",
|
|
(fun () ->
|
|
List.fold
|
|
(fun acc i -> acc |> SafeIO.bind (fun n -> draw (rectAt i) |> SafeIO.map (fun () -> n + 1)))
|
|
(SafeIO.pure 0)
|
|
[ 0..199 ]
|
|
|> SafeIO.trace 7u),
|
|
(fun () ->
|
|
List.fold (fun acc i -> acc |> IO.bind (fun n -> IO.draw (rectAt i) |> IO.map (fun () -> n + 1))) (IO.pure 0) [ 0..199 ]
|
|
|> IO.trace 7u)
|
|
|
|
"nested on both sides",
|
|
(fun () ->
|
|
randomSeed ()
|
|
|> SafeIO.bind (fun s -> draw r1 |> SafeIO.bind (fun () -> SafeIO.pure (int s + 1)))
|
|
|> SafeIO.bind (fun n ->
|
|
SafeIO.sequence [ draw t1; randomSeed () |> SafeIO.map ignore ] |> SafeIO.map (fun () -> n * 3))
|
|
|> SafeIO.trace 7u),
|
|
(fun () ->
|
|
IO.randomSeed ()
|
|
|> IO.bind (fun s -> IO.draw r1 |> IO.bind (fun () -> IO.pure (int s + 1)))
|
|
|> IO.bind (fun n -> IO.sequence [ IO.draw t1; IO.randomSeed () |> IO.map ignore ] |> IO.map (fun () -> n * 3))
|
|
|> IO.trace 7u) ]
|
|
|
|
[<Tests>]
|
|
let tests =
|
|
testList "M07b SafeIO" [
|
|
// ---- building
|
|
|
|
testCase "pure builds a Pure" (fun () ->
|
|
match SafeIO.pure 3 with
|
|
| Pure 3 -> ()
|
|
| _ -> failtest "expected Pure 3")
|
|
|
|
testCase "effect op is an Effect whose continuation is pure" (fun () ->
|
|
match SafeIO.effect IO.RandomSeed with
|
|
| Effect(op, k) ->
|
|
Expect.equal op IO.RandomSeed "op"
|
|
|
|
match k (IO.Seed 5u) with
|
|
| Pure(IO.Seed 5u) -> ()
|
|
| _ -> failtest "expected the continuation to give Pure (Seed 5u)"
|
|
| _ -> failtest "expected an Effect")
|
|
|
|
testCase "bind only builds a FlatMap node" (fun () ->
|
|
match SafeIO.pure 1 |> SafeIO.bind (fun n -> SafeIO.pure (n + 1)) with
|
|
| FlatMap(inner, k) ->
|
|
match inner with
|
|
| Pure x -> Expect.equal (unbox<int> x) 1 "the inner program is the Pure 1 it was given"
|
|
| _ -> failtest "expected the inner program to be a Pure"
|
|
|
|
Expect.equal (SafeIO.trace 0u (k (box 1))).Result 2 "the continuation is f"
|
|
| _ -> failtest "expected a FlatMap")
|
|
|
|
testCase "building bind throwingF (pure 1) does not throw" (fun () ->
|
|
SafeIO.pure 1 |> SafeIO.bind boom |> ignore<SafeIO<int>>)
|
|
|
|
testCase "building map throwingF io does not throw" (fun () ->
|
|
SafeIO.effect IO.RandomSeed |> SafeIO.map (fun _ -> failwith "boom") |> ignore<SafeIO<int>>)
|
|
|
|
testCase "tracing map throwingF io runs f and throws" (fun () ->
|
|
Expect.throwsC
|
|
(fun () ->
|
|
SafeIO.effect IO.RandomSeed
|
|
|> SafeIO.map (fun _ -> failwith "boom")
|
|
|> SafeIO.trace 0u
|
|
|> ignore<IO.Traced<int>>)
|
|
(fun e -> Expect.equal e.Message "boom" "f runs when the program is traced"))
|
|
|
|
// ---- step: the three rewrite rules
|
|
|
|
testCase "step leaves a Pure unchanged" (fun () ->
|
|
match SafeIO.step (SafeIO.pure 1) with
|
|
| Pure 1 -> ()
|
|
| _ -> failtest "expected Pure 1")
|
|
|
|
testCase "step leaves an Effect unchanged" (fun () ->
|
|
match SafeIO.step (SafeIO.effect IO.RandomSeed) with
|
|
| Effect(IO.RandomSeed, k) ->
|
|
match k (IO.Seed 5u) with
|
|
| Pure(IO.Seed 5u) -> ()
|
|
| _ -> failtest "expected the same continuation (pure)"
|
|
| _ -> failtest "expected an Effect with the same op")
|
|
|
|
testCase "step of FlatMap(Pure a, f) is f a" (fun () ->
|
|
match SafeIO.step (SafeIO.pure 3 |> SafeIO.bind (fun n -> SafeIO.pure (n * 2))) with
|
|
| Pure 6 -> ()
|
|
| _ -> failtest "expected Pure 6")
|
|
|
|
testCase "step of FlatMap(Effect(op, k), f) is an Effect with the same op that continues with FlatMap(k r, f)" (fun () ->
|
|
let f (r: IO.OpResult) = SafeIO.pure (int (seedValue r) * 2)
|
|
|
|
match SafeIO.step (SafeIO.effect IO.RandomSeed |> SafeIO.bind f) with
|
|
| Effect(op, k) ->
|
|
Expect.equal op IO.RandomSeed "op"
|
|
|
|
match k (IO.Seed 5u) with
|
|
| FlatMap(Pure x, _) as next ->
|
|
Expect.equal (unbox<IO.OpResult> x) (IO.Seed 5u) "FlatMap(k r, _): k r is Pure (Seed 5u)"
|
|
Expect.equal (SafeIO.trace 0u next) { IO.Result = 10; IO.Ops = [] } "then f"
|
|
| _ -> failtest "expected the continuation to give FlatMap(Pure _, _)"
|
|
| _ -> failtest "expected an Effect")
|
|
|
|
testCase "step re-associates FlatMap(FlatMap(m, g), f) into FlatMap(m, fun x -> FlatMap(g x, f))" (fun () ->
|
|
let g (r: IO.OpResult) = SafeIO.pure (int (seedValue r) + 1)
|
|
let f (n: int) = SafeIO.pure (n * 2)
|
|
|
|
match SafeIO.step (SafeIO.effect IO.RandomSeed |> SafeIO.bind g |> SafeIO.bind f) with
|
|
| FlatMap(Effect(IO.RandomSeed, _), k) ->
|
|
match k (box (IO.Seed 4u)) with
|
|
| FlatMap(Pure x, _) as inner ->
|
|
Expect.equal (unbox<int> x) 5 "g x is Pure 5"
|
|
Expect.equal (SafeIO.trace 0u inner) { IO.Result = 10; IO.Ops = [] } "then f"
|
|
| _ -> failtest "expected the continuation to give FlatMap(g x, f)"
|
|
| _ -> failtest "expected FlatMap(m, _) with m the Effect")
|
|
|
|
testCase "step does not call the functions it re-associates" (fun () ->
|
|
SafeIO.effect IO.RandomSeed
|
|
|> SafeIO.bind boom
|
|
|> SafeIO.bind boom
|
|
|> SafeIO.step
|
|
|> ignore<SafeIO<int>>)
|
|
|
|
testCase "step of a left-nested chain is one rewrite, not a whole walk" (fun () ->
|
|
// After one step, the top is still a FlatMap: step did constant work, the rest is left for later steps.
|
|
let chain = List.fold (fun acc _ -> acc |> SafeIO.bind (fun n -> SafeIO.pure (n + 1))) (SafeIO.pure 0) [ 1..N ]
|
|
|
|
match SafeIO.step chain with
|
|
| FlatMap _ -> ()
|
|
| _ -> failtest "expected a FlatMap")
|
|
|
|
// ---- the interpreter
|
|
|
|
testCase "trace of pure 3 has result 3 and no ops" (fun () ->
|
|
Expect.equal (SafeIO.trace 0u (SafeIO.pure 3)) { IO.Result = 3; IO.Ops = [] } "trace")
|
|
|
|
testCase "trace answers RandomSeed with the seed and Draw with Done" (fun () ->
|
|
let program =
|
|
SafeIO.effect IO.RandomSeed
|
|
|> SafeIO.bind (fun s -> SafeIO.effect (IO.Draw r1) |> SafeIO.map (fun d -> (s, d)))
|
|
|
|
Expect.equal
|
|
(SafeIO.trace 9u program)
|
|
{ IO.Result = (IO.Seed 9u, IO.Done); IO.Ops = [ IO.RandomSeed; IO.Draw r1 ] }
|
|
"trace")
|
|
|
|
// The stub throws too, so the test also checks that the failure is not the stub's TODO.
|
|
testCase "trace refuses operations of later modules" (fun () ->
|
|
Expect.throwsC
|
|
(fun () -> SafeIO.trace 0u (SafeIO.effect IO.LoadBest) |> ignore)
|
|
(fun e -> Expect.isFalse (e.Message.Contains "TODO") $"refused by the interpreter, not the stub: {e.Message}"))
|
|
|
|
testCase "sequence of nothing has no ops" (fun () ->
|
|
Expect.equal (SafeIO.trace 0u (SafeIO.sequence [])) { IO.Result = (); IO.Ops = [] } "trace")
|
|
|
|
testCase "sequence runs effects left to right" (fun () ->
|
|
Expect.equal
|
|
(SafeIO.trace 0u (SafeIO.sequence [ randomSeed () |> SafeIO.map ignore; draw t1; draw r1 ])).Ops
|
|
[ IO.RandomSeed; IO.Draw t1; IO.Draw r1 ]
|
|
"ops")
|
|
|
|
// ---- stack safety
|
|
|
|
testCase "100 000 left-nested binds of draws run, in order" (fun () ->
|
|
let traced = SafeIO.trace 0u (leftDraws N)
|
|
Expect.equal traced.Result () "result"
|
|
Expect.equal (List.length traced.Ops) N "ops"
|
|
Expect.equal (firstAndLast traced.Ops) [ IO.Draw(rectAt 0); IO.Draw(rectAt (N - 1)) ] "order")
|
|
|
|
testCase "100 000 right-nested binds of draws run, in order" (fun () ->
|
|
let traced = SafeIO.trace 0u (rightDraws N)
|
|
Expect.equal (List.length traced.Ops) N "ops"
|
|
Expect.equal (firstAndLast traced.Ops) [ IO.Draw(rectAt 0); IO.Draw(rectAt (N - 1)) ] "order")
|
|
|
|
testCase "100 000 left-nested maps run without any op" (fun () ->
|
|
let program = List.fold (fun acc _ -> acc |> SafeIO.map (fun n -> n + 1)) (SafeIO.pure 0) [ 1..N ]
|
|
Expect.equal (SafeIO.trace 0u program) { IO.Result = N; IO.Ops = [] } "trace")
|
|
|
|
testCase "sequence of 100 000 draws runs" (fun () ->
|
|
let program = SafeIO.sequence [ for i in 0 .. N - 1 -> draw (rectAt i) ]
|
|
Expect.equal (List.length (SafeIO.trace 0u program).Ops) N "ops")
|
|
|
|
testCase "a while loop over step is a complete interpreter for 100 000 left-nested binds" (fun () ->
|
|
// What an impure runtime would do (a loop is allowed there): rewrite until the top is Pure or Effect, perform.
|
|
let mutable performed = 0
|
|
let mutable current = leftDraws N
|
|
let isPure p = match p with Pure _ -> true | _ -> false
|
|
|
|
while not (isPure current) do
|
|
current <- SafeIO.step current
|
|
|
|
match current with
|
|
| Effect(_, k) ->
|
|
performed <- performed + 1
|
|
current <- k IO.Done
|
|
| _ -> ()
|
|
|
|
Expect.equal performed N "performed")
|
|
|
|
// ---- the monad laws, observed through trace
|
|
|
|
yield!
|
|
[ for name, program in programs do
|
|
testCase $"left identity holds for {name}" (fun () ->
|
|
let a = (SafeIO.trace 5u (program ())).Result
|
|
Expect.equal (SafeIO.trace 5u (SafeIO.pure a |> SafeIO.bind f)) (SafeIO.trace 5u (f a)) "left identity")
|
|
|
|
testCase $"right identity holds for {name}" (fun () ->
|
|
Expect.equal
|
|
(SafeIO.trace 5u (program () |> SafeIO.bind SafeIO.pure))
|
|
(SafeIO.trace 5u (program ()))
|
|
"right identity")
|
|
|
|
testCase $"associativity holds for {name}" (fun () ->
|
|
Expect.equal
|
|
(SafeIO.trace 5u (program () |> SafeIO.bind f |> SafeIO.bind g))
|
|
(SafeIO.trace 5u (program () |> SafeIO.bind (fun x -> f x |> SafeIO.bind g)))
|
|
"associativity") ]
|
|
|
|
// ---- the same programs under Module 7's IO
|
|
|
|
yield!
|
|
[ for name, safe, simple in shared ->
|
|
testCase $"trace equals Module 7's trace for {name}" (fun () -> Expect.equal (safe ()) (simple ()) "trace") ]
|
|
]
|