feat(fsharp): m01-m06 util, model, rules, random, spawn, game, view with Expecto tests
Co-Authored-By: Claude Opus 5.5 <[email protected]>
This commit is contained in:
Lucas Winther
co-authored by
Claude Opus 5.5
Claude Opus 5.5
parent
183821737e
commit
9cbefeb2be
@@ -1,9 +1,11 @@
|
||||
/// Loads shared fixtures from ../../fixtures/<name>.json.
|
||||
/// Typed decoders (point, direction, status, action, state, opt) arrive with the model (Task 13).
|
||||
/// Loads shared fixtures from ../fixtures/<name>.json and decodes them into the course's types.
|
||||
module Snake.Tests.Fixtures
|
||||
|
||||
open System.IO
|
||||
open System.Text.Json
|
||||
open Expecto
|
||||
open Snake.Model
|
||||
open Snake.View
|
||||
|
||||
let private dir =
|
||||
Path.GetFullPath(Path.Combine(Directory.GetCurrentDirectory(), "..", "fixtures"))
|
||||
@@ -19,3 +21,68 @@ let cases (name: string) : JsonElement list =
|
||||
/// Decode a nullable JSON value into an Option.
|
||||
let opt (f: JsonElement -> 'a) (v: JsonElement) : 'a option =
|
||||
if v.ValueKind = JsonValueKind.Null then None else Some(f v)
|
||||
|
||||
let prop (key: string) (v: JsonElement) : JsonElement = v.GetProperty(key)
|
||||
let str (v: JsonElement) : string = v.GetString()
|
||||
let num (v: JsonElement) : int = v.GetInt32()
|
||||
let u32 (v: JsonElement) : uint32 = v.GetUInt32()
|
||||
let bool (v: JsonElement) : bool = v.GetBoolean()
|
||||
let list (f: JsonElement -> 'a) (v: JsonElement) : 'a list = v.EnumerateArray() |> Seq.map f |> List.ofSeq
|
||||
|
||||
/// The i-th argument of a case.
|
||||
let arg (i: int) (c: JsonElement) : JsonElement = (prop "args" c)[i]
|
||||
let expected (c: JsonElement) : JsonElement = prop "expected" c
|
||||
let name (c: JsonElement) : string = str (prop "name" c)
|
||||
|
||||
let point (v: JsonElement) : Point = { X = num (prop "x" v); Y = num (prop "y" v) }
|
||||
|
||||
let direction (v: JsonElement) : Direction =
|
||||
match str v with
|
||||
| "Up" -> Up
|
||||
| "Down" -> Down
|
||||
| "Left" -> Left
|
||||
| "Right" -> Right
|
||||
| other -> failwith $"unknown direction: {other}"
|
||||
|
||||
let status (v: JsonElement) : Status =
|
||||
match str v with
|
||||
| "Playing" -> Playing
|
||||
| "Paused" -> Paused
|
||||
| "GameOver" -> GameOver
|
||||
| "Won" -> Won
|
||||
| other -> failwith $"unknown status: {other}"
|
||||
|
||||
let action (v: JsonElement) : Action =
|
||||
match str (prop "tag" v) with
|
||||
| "Tick" -> Tick
|
||||
| "Turn" -> Turn(direction (prop "dir" v))
|
||||
| "TogglePause" -> TogglePause
|
||||
| "Restart" -> Restart
|
||||
| "Frame" -> Frame
|
||||
| other -> failwith $"unknown action tag: {other}"
|
||||
|
||||
/// JSON uses camelCase field names; the F# record uses PascalCase.
|
||||
let gameState (v: JsonElement) : GameState =
|
||||
{ Width = num (prop "width" v)
|
||||
Height = num (prop "height" v)
|
||||
Snake = list point (prop "snake" v)
|
||||
Dir = direction (prop "dir" v)
|
||||
NextDir = direction (prop "nextDir" v)
|
||||
Apple = opt point (prop "apple" v)
|
||||
Seed = u32 (prop "seed" v)
|
||||
Score = num (prop "score" v)
|
||||
Status = status (prop "status" v)
|
||||
Frame = num (prop "frame" v) }
|
||||
|
||||
let shape (v: JsonElement) : Shape =
|
||||
let n key = num (prop key v)
|
||||
let s key = str (prop key v)
|
||||
|
||||
match s "tag" with
|
||||
| "Rect" -> Rect(n "x", n "y", n "w", n "h", s "color")
|
||||
| "Text" -> Text(n "x", n "y", s "text", s "color", n "size", s "align")
|
||||
| other -> failwith $"unknown shape tag: {other}"
|
||||
|
||||
/// One test per case of a fixture, named "<label>: <case name>".
|
||||
let fixtureTests (fixture: string) (label: string) (body: JsonElement -> unit) : Test list =
|
||||
[ for c in cases fixture -> testCase $"{label}: {name c}" (fun () -> body c) ]
|
||||
|
||||
@@ -0,0 +1,34 @@
|
||||
module Snake.Tests.M01Util
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
|
||||
// The JavaScript m01 also has `pipe` and `compose`; in F# they are built in as `|>` and `>>`, so there is nothing to test.
|
||||
|
||||
let private sameParity a b = a % 2 = b % 2
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M01 Util" [
|
||||
testCase "range 0 is empty" (fun () -> Expect.equal (Util.range 0) [] "range 0")
|
||||
testCase "range 3 counts from zero up to n-1" (fun () -> Expect.equal (Util.range 3) [ 0; 1; 2 ] "range 3")
|
||||
|
||||
testCase "dropLast of an empty list is empty" (fun () ->
|
||||
Expect.equal (Util.dropLast ([]: int list)) [] "dropLast []")
|
||||
testCase "dropLast removes only the last element" (fun () ->
|
||||
Expect.equal (Util.dropLast [ 1; 2; 3 ]) [ 1; 2 ] "dropLast [1;2;3]")
|
||||
testCase "dropLast leaves its input untouched" (fun () ->
|
||||
let xs = [ 1; 2; 3 ]
|
||||
Expect.equal (Util.dropLast xs) [ 1; 2 ] "result"
|
||||
Expect.equal xs [ 1; 2; 3 ] "input")
|
||||
|
||||
testCase "contains finds an element using the supplied equality" (fun () ->
|
||||
Expect.isTrue (Util.contains [ 1; 2; 3 ] 5 sameParity) "5 has the parity of 1")
|
||||
testCase "contains is false when no element is equal" (fun () ->
|
||||
Expect.isFalse (Util.contains [ 2; 4 ] 3 sameParity) "no odd element")
|
||||
testCase "contains is false for an empty list" (fun () ->
|
||||
Expect.isFalse (Util.contains [] 1 (=)) "empty list")
|
||||
testCase "contains compares structurally when given a structural equality" (fun () ->
|
||||
Expect.isTrue (Util.contains [ { X = 1; Y = 2 } ] { X = 1; Y = 2 } (=)) "same point")
|
||||
]
|
||||
@@ -0,0 +1,42 @@
|
||||
module Snake.Tests.M02Model
|
||||
|
||||
open Expecto
|
||||
open Snake.Model
|
||||
open Snake.Tests.Fixtures
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M02 Model" [
|
||||
yield! fixtureTests "m02-delta" "delta" (fun c ->
|
||||
Expect.equal (delta (direction (arg 0 c))) (point (expected c)) "delta")
|
||||
|
||||
yield! fixtureTests "m02-opposite" "opposite" (fun c ->
|
||||
Expect.equal (opposite (direction (arg 0 c))) (direction (expected c)) "opposite")
|
||||
|
||||
// pointEquals has no F# function: records already compare structurally with `=`.
|
||||
// The shared fixture is kept so every track checks the same four situations.
|
||||
yield! fixtureTests "m02-point-equals" "pointEquals (record =)" (fun c ->
|
||||
Expect.equal (point (arg 0 c) = point (arg 1 c)) (bool (expected c)) "point equality")
|
||||
|
||||
yield! fixtureTests "m02-initial-state" "initialState" (fun c ->
|
||||
Expect.equal (initialState (u32 (arg 0 c))) (gameState (expected c)) "initialState")
|
||||
|
||||
testCase "Point holds its coordinates" (fun () ->
|
||||
let p = { X = 3; Y = 4 }
|
||||
Expect.equal (p.X, p.Y) (3, 4) "coordinates")
|
||||
|
||||
testCase "opposite is its own inverse" (fun () ->
|
||||
for d in [ Up; Down; Left; Right ] do
|
||||
Expect.equal (opposite (opposite d)) d $"{d}")
|
||||
|
||||
testCase "Action Turn carries the direction" (fun () ->
|
||||
Expect.equal (Turn Left) (Turn Left) "same direction"
|
||||
Expect.notEqual (Turn Left) (Turn Right) "different directions"
|
||||
|
||||
match Turn Left with
|
||||
| Turn d -> Expect.equal d Left "carried direction"
|
||||
| other -> failtest $"expected Turn, got {other}")
|
||||
|
||||
testCase "the other Actions are distinct constants" (fun () ->
|
||||
Expect.equal (List.length (List.distinct [ Tick; TogglePause; Restart; Frame ])) 4 "distinct")
|
||||
]
|
||||
@@ -0,0 +1,21 @@
|
||||
module Snake.Tests.M03Rules
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Tests.Fixtures
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M03 Rules" [
|
||||
yield! fixtureTests "m03-move" "move" (fun c ->
|
||||
Expect.equal (Rules.move (point (arg 0 c)) (direction (arg 1 c))) (point (expected c)) "move")
|
||||
|
||||
yield! fixtureTests "m03-in-bounds" "inBounds" (fun c ->
|
||||
Expect.equal (Rules.inBounds (gameState (arg 0 c)) (point (arg 1 c))) (bool (expected c)) "inBounds")
|
||||
|
||||
yield! fixtureTests "m03-turn" "turn" (fun c ->
|
||||
Expect.equal (Rules.turn (gameState (arg 0 c)) (direction (arg 1 c))) (gameState (expected c)) "turn")
|
||||
|
||||
yield! fixtureTests "m03-advance" "advance" (fun c ->
|
||||
Expect.equal (Rules.advance (gameState (arg 0 c))) (gameState (expected c)) "advance")
|
||||
]
|
||||
@@ -0,0 +1,73 @@
|
||||
module Snake.Tests.M04Random
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Tests.Fixtures
|
||||
|
||||
let private pair (f: System.Text.Json.JsonElement -> 'a) (v: System.Text.Json.JsonElement) : 'a * uint32 =
|
||||
(f (v.Item 0), u32 (v.Item 1))
|
||||
|
||||
// n draws of `intBelow n` in a row, each starting from the seed the previous one left behind.
|
||||
let rec private draws (n: int) (seed: uint32) (count: int) : int list =
|
||||
if count = 0 then
|
||||
[]
|
||||
else
|
||||
let v, s = Random.run seed (Random.intBelow n)
|
||||
v :: draws n s (count - 1)
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M04 Random" [
|
||||
// Same values as the JS and Scala tracks: if mulberry32 drifts (signed math, overflow), these fail.
|
||||
yield! fixtureTests "m04-random" "nextUint32" (fun c ->
|
||||
Expect.equal (Random.run (u32 (arg 0 c)) Random.nextUint32) (pair u32 (expected c)) "nextUint32")
|
||||
|
||||
yield! fixtureTests "m04-int-below" "intBelow" (fun c ->
|
||||
Expect.equal (Random.run (u32 (arg 1 c)) (Random.intBelow (num (arg 0 c)))) (pair num (expected c)) "intBelow")
|
||||
|
||||
testCase "the recorded steps chain: each step starts from the previous step's seed" (fun () ->
|
||||
let cs = cases "m04-random"
|
||||
|
||||
for i, c in List.indexed cs do
|
||||
if not ((name c).EndsWith("-step-1")) then
|
||||
let previous = expected cs[i - 1]
|
||||
Expect.equal (u32 (arg 0 c)) (u32 previous[1]) (name c))
|
||||
|
||||
testCase "pure returns its value and leaves the seed alone" (fun () ->
|
||||
Expect.equal (Random.run 99u (Random.pure "x")) ("x", 99u) "pure")
|
||||
|
||||
testCase "map applies f to the value and keeps the seed from the underlying step" (fun () ->
|
||||
let v, s = Random.run 5u Random.nextUint32
|
||||
Expect.equal (Random.run 5u (Random.map (fun x -> x + 1u) Random.nextUint32)) (v + 1u, s) "map")
|
||||
|
||||
testCase "map with the identity function changes nothing" (fun () ->
|
||||
Expect.equal (Random.run 5u (Random.map id Random.nextUint32)) (Random.run 5u Random.nextUint32) "map id")
|
||||
|
||||
testCase "bind threads the seed through both steps" (fun () ->
|
||||
let a, s1 = Random.run 5u Random.nextUint32
|
||||
let b, s2 = Random.run s1 Random.nextUint32
|
||||
|
||||
let both =
|
||||
Random.nextUint32 |> Random.bind (fun x -> Random.nextUint32 |> Random.map (fun y -> (x, y)))
|
||||
|
||||
Expect.equal (Random.run 5u both) ((a, b), s2) "bind")
|
||||
|
||||
testCase "bind with pure on the left or right changes nothing" (fun () ->
|
||||
Expect.equal
|
||||
(Random.run 5u (Random.pure 3u |> Random.bind (fun x -> Random.map (fun v -> v + x) Random.nextUint32)))
|
||||
(Random.run 5u (Random.map (fun v -> v + 3u) Random.nextUint32))
|
||||
"left identity"
|
||||
|
||||
Expect.equal
|
||||
(Random.run 5u (Random.bind Random.pure Random.nextUint32))
|
||||
(Random.run 5u Random.nextUint32)
|
||||
"right identity")
|
||||
|
||||
testCase "intBelow always lands in [0, n)" (fun () ->
|
||||
for n in [ 1; 2; 7; 400 ] do
|
||||
for v in draws n 123u 50 do
|
||||
Expect.isTrue (v >= 0 && v < n) $"{v} not in [0, {n})")
|
||||
|
||||
testCase "running a Random does not mutate anything: same seed, same answer" (fun () ->
|
||||
Expect.equal (Random.run 8u Random.nextUint32) (Random.run 8u Random.nextUint32) "same answer")
|
||||
]
|
||||
@@ -0,0 +1,55 @@
|
||||
module Snake.Tests.M04Spawn
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Model
|
||||
open Snake.Tests.Fixtures
|
||||
|
||||
// 3x2 board, one-cell snake, about to eat the apple at (1,0)
|
||||
let private eating: GameState =
|
||||
{ Width = 3
|
||||
Height = 2
|
||||
Snake = [ { X = 0; Y = 0 } ]
|
||||
Dir = Right
|
||||
NextDir = Right
|
||||
Apple = Some { X = 1; Y = 0 }
|
||||
Seed = 0u
|
||||
Score = 0
|
||||
Status = Playing
|
||||
Frame = 0 }
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M04 Spawn" [
|
||||
yield! fixtureTests "m04-free-cells" "freeCells" (fun c ->
|
||||
Expect.equal (Spawn.freeCells (gameState (arg 0 c))) (list point (expected c)) "freeCells")
|
||||
|
||||
yield! fixtureTests "m04-spawn" "spawnApple" (fun c ->
|
||||
Expect.equal (Spawn.spawnApple (gameState (arg 0 c))) (gameState (expected c)) "spawnApple")
|
||||
|
||||
yield! fixtureTests "m04-new-game" "newGame" (fun c ->
|
||||
Expect.equal (Spawn.newGame (u32 (arg 0 c))) (gameState (expected c)) "newGame")
|
||||
|
||||
yield! fixtureTests "m04-tick" "tick" (fun c ->
|
||||
Expect.equal (Spawn.tick (gameState (arg 0 c))) (gameState (expected c)) "tick")
|
||||
|
||||
testCase "tick: eating the apple spawns a new one in the same step" (fun () ->
|
||||
// snake becomes (1,0),(0,0); free cells are (2,0),(0,1),(1,1),(2,1); seed 0 draws 1144304738 % 4 = 2 -> (1,1)
|
||||
Expect.equal
|
||||
(Spawn.tick eating)
|
||||
{ eating with
|
||||
Snake = [ { X = 1; Y = 0 }; { X = 0; Y = 0 } ]
|
||||
Apple = Some { X = 1; Y = 1 }
|
||||
Score = 1
|
||||
Seed = 1831565813u }
|
||||
"tick")
|
||||
|
||||
testCase "tick is spawnApple after advance" (fun () ->
|
||||
Expect.equal (Spawn.tick eating) (Spawn.spawnApple (Rules.advance eating)) "tick")
|
||||
|
||||
testCase "tick leaves the seed alone when no apple needs spawning" (fun () ->
|
||||
Expect.equal (Spawn.tick { eating with Apple = Some { X = 2; Y = 1 } }).Seed 0u "seed")
|
||||
|
||||
testCase "newGame is reproducible: same seed, same game" (fun () ->
|
||||
Expect.equal (Spawn.newGame 42u) (Spawn.newGame 42u) "newGame 42")
|
||||
]
|
||||
@@ -0,0 +1,33 @@
|
||||
module Snake.Tests.M05Game
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Tests.Fixtures
|
||||
|
||||
let private replayCase () = List.head (cases "m05-replay")
|
||||
let private start () = gameState (arg 0 (replayCase ()))
|
||||
let private actions () = list action (arg 1 (replayCase ()))
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M05 Game" [
|
||||
yield! fixtureTests "m05-update" "update" (fun c ->
|
||||
Expect.equal (Game.update (gameState (arg 0 c)) (action (arg 1 c))) (gameState (expected c)) "update")
|
||||
|
||||
yield! fixtureTests "m05-replay" "replay" (fun c ->
|
||||
Expect.equal (Game.replay (gameState (arg 0 c)) (list action (arg 1 c))) (gameState (expected c)) "replay")
|
||||
|
||||
yield! fixtureTests "m05-history" "history" (fun c ->
|
||||
Expect.equal
|
||||
(Game.history (gameState (arg 0 c)) (list action (arg 1 c)))
|
||||
(list gameState (expected c))
|
||||
"history")
|
||||
|
||||
testCase "history has one more state than there are actions" (fun () ->
|
||||
Expect.equal (List.length (Game.history (start ()) (actions ()))) (List.length (actions ()) + 1) "length")
|
||||
|
||||
testCase "history starts at the start state and ends where replay ends" (fun () ->
|
||||
let states = Game.history (start ()) (actions ())
|
||||
Expect.equal (List.head states) (start ()) "first"
|
||||
Expect.equal (List.last states) (Game.replay (start ()) (actions ())) "last")
|
||||
]
|
||||
@@ -0,0 +1,14 @@
|
||||
module Snake.Tests.M06View
|
||||
|
||||
open Expecto
|
||||
open Snake
|
||||
open Snake.Tests.Fixtures
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "M06 View" [
|
||||
testCase "CELL is 20 pixels" (fun () -> Expect.equal View.CELL 20 "CELL")
|
||||
|
||||
yield! fixtureTests "m06-view" "view" (fun c ->
|
||||
Expect.equal (View.view (gameState (arg 0 c))) (list shape (expected c)) "view")
|
||||
]
|
||||
@@ -0,0 +1,54 @@
|
||||
module Snake.Tests.Purity
|
||||
|
||||
open System.IO
|
||||
open System.Text.RegularExpressions
|
||||
open Expecto
|
||||
|
||||
let private srcDir = Path.Combine(Directory.GetCurrentDirectory(), "src")
|
||||
|
||||
// The one file allowed to touch the outside world (the browser glue lives in web/, outside src/).
|
||||
let private excluded (file: string) = Path.GetFileName(file) = "Runtime.fs"
|
||||
|
||||
let private banned: (string * Regex * string) list =
|
||||
[ "mutable", Regex(@"\bmutable\b"), "let mutable n = 0"
|
||||
"<-", Regex(@"<-"), "n <- n + 1"
|
||||
"System.Random", Regex(@"\bSystem\.Random\b"), "let r = System.Random()"
|
||||
"DateTime", Regex(@"\bDateTime\b"), "let t = System.DateTime.Now"
|
||||
"printf", Regex(@"\bprintf"), "printfn \"hi\""
|
||||
"ref ", Regex(@"\bref "), "let cell = ref 0" ]
|
||||
|
||||
// Block comments `(* ... *)` and line comments (`//`, `///`) are removed before scanning.
|
||||
let private stripComments (code: string) =
|
||||
Regex.Replace(Regex.Replace(code, @"(?s)\(\*.*?\*\)", ""), @"(?m)//.*$", "")
|
||||
|
||||
let private violations (code: string) =
|
||||
let clean = stripComments code
|
||||
[ for name, re, _ in banned do
|
||||
if re.IsMatch clean then
|
||||
yield name ]
|
||||
|
||||
let private fsFiles () =
|
||||
if Directory.Exists srcDir then
|
||||
Directory.GetFiles(srcDir, "*.fs", SearchOption.AllDirectories) |> Array.sort |> List.ofArray
|
||||
else
|
||||
[]
|
||||
|
||||
[<Tests>]
|
||||
let tests =
|
||||
testList "Purity" [
|
||||
for name, _, sample in banned do
|
||||
yield testCase $"purity scanner flags a known-bad sample using {name}" (fun () ->
|
||||
Expect.contains (violations sample) name "flagged")
|
||||
|
||||
yield testCase "purity scanner ignores banned words inside comments" (fun () ->
|
||||
let code = "// let mutable x\n(* x <- 1; printfn \"hi\" *)\nlet a = 1 // System.Random DateTime ref x\n"
|
||||
Expect.equal (violations code) [] "no violations")
|
||||
|
||||
yield testCase "purity scanner accepts ordinary pure code" (fun () ->
|
||||
Expect.equal (violations "let f xs = List.map (fun x -> x + 1) xs") [] "no violations")
|
||||
|
||||
for f in fsFiles () do
|
||||
if not (excluded f) then
|
||||
yield testCase $"purity: {Path.GetRelativePath(srcDir, f)} has no banned constructs" (fun () ->
|
||||
Expect.equal (violations (File.ReadAllText f)) [] "violations")
|
||||
]
|
||||
@@ -2,10 +2,20 @@
|
||||
<PropertyGroup>
|
||||
<OutputType>Exe</OutputType>
|
||||
<TargetFramework>net10.0</TargetFramework>
|
||||
<!-- FS0046: `pure` is reserved for future use by F#; the course keeps the name used by every track. -->
|
||||
<NoWarn>$(NoWarn);FS0046</NoWarn>
|
||||
</PropertyGroup>
|
||||
<ItemGroup>
|
||||
<Compile Include="Fixtures.fs" />
|
||||
<Compile Include="M00Sanity.fs" />
|
||||
<Compile Include="M01Util.fs" />
|
||||
<Compile Include="M02Model.fs" />
|
||||
<Compile Include="M03Rules.fs" />
|
||||
<Compile Include="M04Random.fs" />
|
||||
<Compile Include="M04Spawn.fs" />
|
||||
<Compile Include="M05Game.fs" />
|
||||
<Compile Include="M06View.fs" />
|
||||
<Compile Include="Purity.fs" />
|
||||
<Compile Include="Main.fs" />
|
||||
</ItemGroup>
|
||||
<ItemGroup>
|
||||
|
||||
Reference in New Issue
Block a user