feat(fsharp): m11 pong capstone (model, rules, view, app) with tests

Co-Authored-By: Claude Opus 5.5 <[email protected]>

fsharp/tests/M11Pong.fs

@@ -0,0 +1,148 @@
+module Snake.Tests.M11Pong
+
+open System.Text.Json
+open Expecto
+open Snake
+open Snake.Model
+open Snake.Stream
+open Snake.Pong.Model
+open Snake.Pong.Rules
+open Snake.Pong.View
+open Snake.Pong.App
+open Snake.Tests.Fixtures
+open Snake.Tests.M09Helpers
+
+let private pongStatus (v: JsonElement) : PongStatus =
+    match str v with
+    | "Playing" -> PongStatus.Playing
+    | "Over" -> PongStatus.Over
+    | other -> failwith $"unknown pong status: {other}"
+
+let private pongState (v: JsonElement) : PongState =
+    let vel = prop "vel" v
+    let held = prop "held" v
+    let score = prop "score" v
+
+    { Ball = point (prop "ball" v)
+      Vel = { Dx = num (prop "dx" vel); Dy = num (prop "dy" vel) }
+      Player = num (prop "player" v)
+      Cpu = num (prop "cpu" v)
+      Held = { Up = bool (prop "up" held); Down = bool (prop "down" held) }
+      Score = { Score.Player = num (prop "player" score); Cpu = num (prop "cpu" score) }
+      Status = pongStatus (prop "status" v)
+      Seed = u32 (prop "seed" v)
+      Frame = num (prop "frame" v) }
+
+// `Paddle` only has Up and Down, so a JSON key like "constructor" decodes to None instead of crashing.
+let private paddle (v: JsonElement) : Paddle option =
+    match str v with
+    | "Up" -> Some Paddle.Up
+    | "Down" -> Some Paddle.Down
+    | _ -> None
+
+/// Decode a PongAction; `None` when its key is not a `Paddle` (such an action cannot even be built in F#).
+let private pongAction (v: JsonElement) : PongAction option =
+    match str (prop "tag" v) with
+    | "Press" -> paddle (prop "key" v) |> Option.map PongAction.Press
+    | "Release" -> paddle (prop "key" v) |> Option.map PongAction.Release
+    | "Frame" -> Some PongAction.Frame
+    | "Restart" -> Some PongAction.Restart
+    | other -> failwith $"unknown pong action tag: {other}"
+
+let private undecodable (e: JsonElement) : PongAction = failwith $"undecodable expected action: {e}"
+
+[<Tests>]
+let tests =
+    testList "M11 Pong" [
+        yield! fixtureTests "m11-pong-update" "pongUpdate" (fun c ->
+            let state = pongState (arg 0 c)
+
+            match pongAction (arg 1 c) with
+            | Some action -> Expect.equal (pongUpdate state action) (pongState (expected c)) "pongUpdate"
+            // An unknown key is ruled out by the types: Paddle has no such case. What the fixture asks for
+            // (state unchanged) therefore holds by construction; check that it says so.
+            | None -> Expect.equal (pongState (expected c)) state "an unknown key changes nothing")
+
+        yield! fixtureTests "m11-pong-view" "pongView" (fun c ->
+            Expect.equal (pongView (pongState (arg 0 c))) (list shape (expected c)) "pongView")
+
+        yield! fixtureTests "m11-pong-key" "pongKey" (fun c ->
+            let expectedAction = opt (fun e -> pongAction e |> Option.defaultWith (fun () -> undecodable e)) (expected c)
+            Expect.equal (pongKey (bool (arg 0 c)) (str (arg 1 c))) expectedAction "pongKey")
+
+        testCase "the court is 80 by 50 cells of 8 pixels, with 8-cell paddles" (fun () ->
+            Expect.equal [ W; H; PCELL; PADDLE; PLAYER_X; CPU_X; WIN ] [ 80; 50; 8; 8; 2; 77; 5 ] "constants")
+
+        testCase "initialPong puts the ball in the middle, both paddles centred, and nobody ahead" (fun () ->
+            Expect.equal
+                (initialPong 5u)
+                { Ball = { X = 40; Y = 25 }
+                  Vel = { Dx = 1; Dy = 1 }
+                  Player = 21
+                  Cpu = 21
+                  Held = { Up = false; Down = false }
+                  Score = { Score.Player = 0; Cpu = 0 }
+                  Status = PongStatus.Playing
+                  Seed = 5u
+                  Frame = 0 }
+                "initialPong")
+
+        testCase "clamp keeps a number inside [lo, hi]" (fun () ->
+            Expect.equal [ clamp 0 42 -1; clamp 0 42 17; clamp 0 42 43 ] [ 0; 17; 42 ] "clamp")
+
+        testCase "pongUpdate does not modify the state it is given" (fun () ->
+            let s = initialPong 0u
+            pongUpdate s PongAction.Frame |> ignore
+            Expect.equal s (initialPong 0u) "unchanged")
+
+        // 3000 frames with no one touching the keys: the ball must always stay on the court and the match must end.
+        testCase "an idle match stays on the court and ends once someone reaches five" (fun () ->
+            let states = List.replicate 3000 PongAction.Frame |> List.scan pongUpdate (initialPong 3u)
+
+            Expect.all states (fun s -> s.Ball.Y >= 0 && s.Ball.Y < H && s.Ball.X >= 0 && s.Ball.X < W) "ball on court"
+
+            Expect.all
+                states
+                (fun s -> s.Player >= 0 && s.Player <= H - PADDLE && s.Cpu >= 0 && s.Cpu <= H - PADDLE)
+                "paddles on court"
+
+            let last = List.last states
+            Expect.equal last.Status PongStatus.Over "match over"
+            Expect.equal (max last.Score.Player last.Score.Cpu) WIN "winner has five")
+
+        testCase "the clock runs every 30 ms" (fun () -> Expect.equal FRAME_MS_PONG 30L "FRAME_MS_PONG")
+
+        testCase "pongActions turns the clock into Frames and keys into Press, Release and Restart" (fun () ->
+            Expect.equal
+                (Stream.run
+                    [ Time 30L; KeyDown "ArrowUp"; KeyUp "ArrowUp"; KeyDown "s"; KeyDown "r"; KeyUp "r"; KeyDown "x"; Time 90L ]
+                    pongActions)
+                [ PongAction.Frame
+                  PongAction.Press Paddle.Up
+                  PongAction.Release Paddle.Up
+                  PongAction.Press Paddle.Down
+                  PongAction.Restart
+                  PongAction.Frame
+                  PongAction.Frame ]
+                "actions")
+
+        testCase "pongStates starts with the new match, then yields one state per action" (fun () ->
+            let out = pongStates 42u pongActions |> Stream.run [ Time 30L; KeyDown "w"; Time 60L ]
+            Expect.equal (List.length out) 4 "length"
+            Expect.equal (List.head out) (initialPong 42u) "first state"
+            Expect.equal (out |> List.map (fun s -> s.Frame)) [ 0; 1; 1; 2 ] "frames"
+            Expect.equal (out |> List.map (fun s -> s.Held.Up)) [ false; false; true; true ] "held up"
+            Expect.equal out[3].Player 20 "player moved up")
+
+        testCase "pongMain asks for a seed, draws the new match first, and then the updated one" (fun () ->
+            let traced = IO.trace 42u (pongMain ())
+            Expect.equal traced.Ops [ IO.RandomSeed ] "ops"
+            let first, next = Stream.step (Time 0L) traced.Result
+            let second, _ = Stream.step (Time 30L) next
+            Expect.equal (drawn (List.head first)) (pongView (initialPong 42u)) "first drawing"
+
+            Expect.equal
+                (drawn (List.head second))
+                (pongView (pongUpdate (initialPong 42u) PongAction.Frame))
+                "second drawing")
+    ]