Files
functional-programming-snake/fsharp/tests/M10Extensions.fs
T
Lucas WintherandClaude Fable 5.2 edd57f0148 feat(course): audit fixes and twelve extensions (Modules 7b, 12, 13)
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>
2026-11-11 12:05:29 +01:00

255 lines
13 KiB
FSharp

module Snake.Tests.M10Extensions
open System.Text.Json
open Expecto
open Snake
open Snake.Model
open Snake.View
open Snake.IO
open Snake.Stream
open Snake.App
open Snake.Tests.Fixtures
open Snake.Tests.M09Helpers
open Snake.Tests.M09Runtime
let private frameTimes = [ 25L; 50L; 75L; 100L; 125L; 150L; 175L; 200L ]
// Sessions in the fixtures use the keys game, best and improved.
let private session (v: JsonElement) : Session =
{ Game = gameState (prop "game" v); Best = num (prop "best" v); Improved = bool (prop "improved" v) }
// Events in the golden fixture: {tag:'Time', t} and {tag:'KeyDown', key}.
let private event (v: JsonElement) : Event =
match str (prop "tag" v) with
| "Time" -> Time((prop "t" v).GetInt64())
| "KeyDown" -> KeyDown(str (prop "key" v))
| "KeyUp" -> KeyUp(str (prop "key" v))
| other -> failwith $"unknown event tag: {other}"
// The drawings are compared by their first shapes, the game's view: Exercise 10.7 adds the best score after it.
let private startsWithView (io: IO<unit>) (state: GameState) (label: string) =
let expected = View.view state
Expect.equal (drawn io |> List.truncate (List.length expected)) expected label
let private newSession (game: GameState) (best: int) : Session = { Game = game; Best = best; Improved = false }
let private drawOps (scene: Scene) : Op list = List.map Draw scene
let private saves (ops: Op list) : int list =
ops
|> List.choose (fun op ->
match op with
| SaveBest n -> Some n
| _ -> None)
[<Tests>]
let tests =
testList "M10 Extensions" [
yield! fixtureTests "m10-update" "update" (fun c ->
Expect.equal (Game.update (gameState (arg 0 c)) (action (arg 1 c))) (gameState (expected c)) "update")
yield! fixtureTests "m10-moves-every" "movesEvery" (fun c ->
Expect.equal (Game.movesEvery (num (arg 0 c))) (num (expected c)) "movesEvery")
yield! fixtureTests "m10-input" "keyToAction" (fun c ->
Expect.equal (Input.keyToAction (str (arg 0 c))) (opt action (expected c)) "keyToAction")
yield! fixtureTests "m10-session-update" "sessionUpdate" (fun c ->
Expect.equal (App.sessionUpdate (session (arg 0 c)) (action (arg 1 c))) (session (expected c)) "sessionUpdate")
yield! fixtureTests "m10-session-view" "sessionView" (fun c ->
Expect.equal (App.sessionView (session (arg 0 c))) (list shape (expected c)) "sessionView")
// ---- the turn queue (Exercise 10.6)
testCase "steer is what update does with a Turn" (fun () ->
for c in cases "m10-update" do
match action (arg 1 c) with
| Turn dir -> Expect.equal (Game.steer (gameState (arg 0 c)) dir) (gameState (expected c)) (name c)
| _ -> ())
testCase "Turn Up then Turn Left within one step: the snake goes Up on the next step and Left on the one after" (fun () ->
let start = Spawn.newGame 42u // heading Right from (10, 10); the apple is far away
let states = List.scan Game.update start [ Turn Up; Turn Left; Tick; Tick ]
Expect.equal
(states |> List.skip 2 |> List.map (fun s -> List.head s.Snake))
[ { X = 10; Y = 10 }; { X = 10; Y = 9 }; { X = 9; Y = 9 } ]
"head path"
Expect.equal (states |> List.map (fun s -> s.Queued)) [ None; None; Some Left; None; None ] "queued")
testCase "the animation clock runs every 25 ms" (fun () -> Expect.equal App.FRAME_MS 25L "FRAME_MS")
testCase "speedActions turns the clock into Frame actions every 25 ms" (fun () ->
Expect.equal (Stream.run (List.map Time frameTimes) App.speedActions) (List.replicate 8 Frame) "actions")
testCase "speedActions still turns keys into actions, including pause and restart" (fun () ->
Expect.equal
(Stream.run [ KeyDown " "; KeyDown "r"; KeyDown "ArrowUp" ] App.speedActions)
[ TogglePause; Restart; Turn Up ]
"actions")
testCase "main (seed 42) draws a moved snake after eight 25 ms frames" (fun () ->
let traced = IO.trace 42u (App.main ())
Expect.equal (List.head traced.Ops) RandomSeed "first op"
let first, afterFirst = Stream.step (Time 0L) traced.Result
startsWithView (List.head first) (Spawn.newGame 42u) "first drawing"
let drawings = Stream.run (List.map Time frameTimes) afterFirst
Expect.equal (List.length drawings) 8 "eight drawings"
let start = Spawn.newGame 42u
let moved =
{ start with
Snake = start.Snake |> List.map (fun p -> { p with X = p.X + 1 })
Frame = 0 }
startsWithView drawings[7] moved "moved snake")
// ---- clampTime: a long silence from the clock (a background tab) must not turn into hundreds of frames
testCase "clampTime passes small steps of time through unchanged" (fun () ->
Expect.equal
(Stream.interval 10L |> Stream.clampTime 100L |> Stream.run (List.map Time [ 5L; 10L; 35L ]))
[ 10L; 20L; 30L ]
"outputs")
testCase "clampTime lets a long gap count as maxGap, and carries on from there" (fun () ->
Expect.equal
(Stream.interval 10L |> Stream.clampTime 25L |> Stream.run (List.map Time [ 10L; 5000L; 5010L ]))
[ 10L; 20L; 30L; 40L ]
"outputs")
testCase "clampTime clamps the very first step too (the clock starts at 0)" (fun () ->
Expect.equal (Stream.interval 10L |> Stream.clampTime 25L |> Stream.run [ Time 1000L ]) [ 10L; 20L ] "outputs")
testCase "clampTime never moves the clock backwards" (fun () ->
Expect.equal
(Stream.interval 10L |> Stream.clampTime 100L |> Stream.run (List.map Time [ 30L; 10L; 40L ]))
[ 10L; 20L; 30L; 40L; 50L; 60L ]
"outputs")
testCase "clampTime passes key events through, and they do not disturb the clock" (fun () ->
Expect.equal
(Stream.keyDowns |> Stream.clampTime 5L |> Stream.run [ KeyDown "a"; Time 50L; KeyDown "b" ])
[ "a"; "b" ]
"keys"
Expect.equal
(Stream.interval 10L |> Stream.clampTime 25L |> Stream.run [ Time 10L; KeyDown "a"; Time 20L ])
[ 10L; 20L ]
"clock")
testCase "clampTime tells the inner stream exactly the clamped time, and a repeated time adds nothing" (fun () ->
Expect.equal
(Stream.interval 1L |> Stream.clampTime 100L |> Stream.run [ Time 5L; Time 5L; Time 6L ])
[ 1L; 2L; 3L; 4L; 5L; 6L ]
"outputs")
testCase "running the same clamped stream twice gives the same outputs" (fun () ->
let s = Stream.interval 10L |> Stream.clampTime 25L
let events = List.map Time [ 10L; 5000L; 5010L ]
Expect.equal (Stream.run events s) (Stream.run events s) "same outputs")
testCase "the game accepts at most 250 ms of time at once" (fun () -> Expect.equal App.MAX_GAP_MS 250L "MAX_GAP_MS")
testCase "main: after ten seconds in a background tab the game advances by 250 ms, not by ten seconds" (fun () ->
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (App.main ())).Result
let drawings, next = Stream.step (Time 10000L) afterFirst
Expect.equal (List.length drawings) (int (App.MAX_GAP_MS / App.FRAME_MS)) "ten drawings"
Expect.equal (List.length (fst (Stream.step (Time 10025L) next))) 1 "one more drawing")
// ---- a high score that survives a reload (Exercise 10.7)
testCase "loadBest records a LoadBest op and is answered with the best given to traceWith" (fun () ->
Expect.equal (IO.traceWith 0u 17 (IO.loadBest ())) { Result = 17; Ops = [ LoadBest ] } "traceWith")
testCase "trace answers LoadBest with 0 (no best given)" (fun () ->
Expect.equal (IO.trace 9u (IO.loadBest ())).Result 0 "result")
testCase "saveBest records a SaveBest op with the score and produces ()" (fun () ->
Expect.equal (IO.trace 0u (IO.saveBest 7)) { Result = (); Ops = [ SaveBest 7 ] } "trace")
testCase "a program can load the best, then save a higher one" (fun () ->
Expect.equal
(IO.traceWith 0u 4 (IO.loadBest () |> IO.bind (fun b -> IO.saveBest (b + 1)))).Ops
[ LoadBest; SaveBest 5 ]
"ops")
testCase "sessions starts with the new game and the stored best, then yields one session per action" (fun () ->
let out = App.sessions 42u 3 App.speedActions |> Stream.run [ Time 25L; KeyDown " " ]
let s0 = newSession (Spawn.newGame 42u) 3
let s1 = App.sessionUpdate s0 Frame
Expect.equal out [ s0; s1; App.sessionUpdate s1 TogglePause ] "sessions")
testCase "renderSession draws the session view and saves nothing when the best did not improve" (fun () ->
let s = newSession (Spawn.newGame 42u) 5
Expect.equal (IO.trace 0u (App.renderSession s)).Ops (drawOps (App.sessionView s)) "ops")
testCase "renderSession draws the session view, then saves the best, when the best improved" (fun () ->
let s = { Game = { Spawn.newGame 42u with Score = 6 }; Best = 6; Improved = true }
Expect.equal (IO.trace 0u (App.renderSession s)).Ops (drawOps (App.sessionView s) @ [ SaveBest 6 ]) "ops")
testCase "main asks for the seed, then the stored best, and draws the first session" (fun () ->
let traced = IO.traceWith 42u 9 (App.main ())
Expect.equal traced.Ops [ RandomSeed; LoadBest ] "ops"
let first, _ = Stream.step (Time 0L) traced.Result
Expect.equal (drawn (List.head first)) (App.sessionView (newSession (Spawn.newGame 42u) 9)) "drawing")
testCase "playWith passes the best to the program: the first scene shows it" (fun () ->
Expect.equal
(App.playWith 42u 9 [ Time 0L ] (App.main ()))
[ drawOps (App.sessionView (newSession (Spawn.newGame 42u) 9)) ]
"drawings")
// The golden fixture: a seed, a scripted list of inputs, a stored best, and the scene of the last drawing.
yield!
[ for c in cases "m10-golden" do
let seed = u32 (arg 0 c)
let events = list event (arg 1 c)
let best = num (arg 2 c)
let expectedScene = list shape (expected c)
yield
testCase $"play(main): {name c}" (fun () ->
let lastScene = App.playWith seed best events (App.main ()) |> List.last
Expect.equal (lastScene |> List.choose (fun op -> match op with Draw s -> Some s | _ -> None)) expectedScene "last scene")
yield
testCase $"play(main) saves once per improvement: {name c}" (fun () ->
let saved = App.playWith seed best events (App.main ()) |> List.collect saves
let finalBest =
expectedScene
|> List.pick (fun s ->
match s with
| Text(_, _, text, _, _, _) when text.StartsWith "Best: " -> Some(int (text.Substring 6))
| _ -> None)
Expect.equal saved [ best + 1 .. finalBest ] "saves") ]
// ---- the runtime with a fake platform that records the two new calls
testCase "runIO answers LoadBest with platform.LoadBest () and continues with it" (fun () ->
let p = FakePlatform(42u, 11)
Expect.equal (Runtime.runIO p.Platform (IO.loadBest () |> IO.map (fun b -> b + 1))) 12 "result"
Expect.equal p.Calls [ [ box "loadBest" ] ] "calls")
testCase "runIO maps SaveBest to platform.SaveBest score" (fun () ->
let p = FakePlatform 42u
Expect.equal (Runtime.runIO p.Platform (IO.saveBest 8 |> IO.bind (fun () -> IO.pure "done"))) "done" "result"
Expect.equal p.Calls [ [ box "saveBest"; box 8 ] ] "calls")
testCase "runApp asks for the seed and loads the best once, at start, and draws nothing before the first event" (fun () ->
let p = FakePlatform(42u, 3)
Runtime.runApp p.Platform (App.main ())
Expect.equal p.Calls [ [ box "randomSeed" ]; [ box "loadBest" ] ] "calls at start"
p.FireTime 0L
p.FireTime 25L
Expect.equal (p.Calls |> List.filter (fun c -> List.head c = box "loadBest") |> List.length) 1 "one load"
Expect.isTrue
(p.Calls |> List.exists (fun c -> List.head c = box "fillText" && c[3] = box "Best: 3"))
"draws Best: 3")
]