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
2026-10-29 00:49:42 +01:00
co-authored by Claude Opus 5.5
parent 183821737e
commit 9cbefeb2be
27 changed files with 851 additions and 6 deletions
+38
View File
@@ -0,0 +1,38 @@
/// m05 game: one `update` turns every action into a new state; replaying a game is a fold over its actions.
/// m10 adds pause, restart and a frame clock that speeds up as the score grows.
module Snake.Game
open Snake.Model
/// How many frames pass between game steps: 8 at first, one fewer every 3 points, never fewer than 2.
let movesEvery (score: int) : int = max 2 (8 - score / 3)
// One animation frame: count it, and every `movesEvery score`-th frame run a game step.
let private frame (state: GameState) : GameState =
if state.Status <> Playing then
state
else
let counted = { state with Frame = state.Frame + 1 }
if counted.Frame % movesEvery counted.Score = 0 then Spawn.tick counted else counted
// Pause and resume only make sense in those two statuses; a finished game stays finished.
let private togglePause (state: GameState) : GameState =
match state.Status with
| Playing -> { state with Status = Paused }
| Paused -> { state with Status = Playing }
| GameOver
| Won -> state
// Every case is listed (no `| _ ->`): adding an Action later makes the compiler point here.
let update (state: GameState) (action: Action) : GameState =
match action with
| Tick -> Spawn.tick state
| Turn dir -> Rules.turn state dir
| TogglePause -> togglePause state
| Restart -> Spawn.newGame state.Seed
| Frame -> frame state
let replay (state: GameState) (actions: Action list) : GameState = List.fold update state actions
// List.scan is List.fold that keeps every intermediate result (the start state included).
let history (state: GameState) (actions: Action list) : GameState list = List.scan update state actions
+64
View File
@@ -0,0 +1,64 @@
/// m02 model: the data the whole game is built from. Records and unions are immutable.
module Snake.Model
/// A grid cell. Records compare structurally: two points with the same X and Y are `=`.
type Point = { X: int; Y: int }
type Direction =
| Up
| Down
| Left
| Right
type Status =
| Playing
| Paused
| GameOver
| Won
/// Everything that can happen to the game, as data.
type Action =
| Tick
| Turn of Direction
| TogglePause
| Restart
| Frame
/// The whole game. `Snake` is head first; `Seed` is the unsigned 32-bit random seed.
type GameState =
{ Width: int
Height: int
Snake: Point list
Dir: Direction
NextDir: Direction
Apple: Point option
Seed: uint32
Score: int
Status: Status
Frame: int }
let delta (dir: Direction) : Point =
match dir with
| Up -> { X = 0; Y = -1 }
| Down -> { X = 0; Y = 1 }
| Left -> { X = -1; Y = 0 }
| Right -> { X = 1; Y = 0 }
let opposite (dir: Direction) : Direction =
match dir with
| Up -> Down
| Down -> Up
| Left -> Right
| Right -> Left
let initialState (seed: uint32) : GameState =
{ Width = 20
Height = 20
Snake = [ { X = 10; Y = 10 }; { X = 9; Y = 10 }; { X = 8; Y = 10 } ]
Dir = Right
NextDir = Right
Apple = None
Seed = seed
Score = 0
Status = Playing
Frame = 0 }
+31
View File
@@ -0,0 +1,31 @@
/// m04 random: a tiny "state monad" for randomness. A Random<'a> wraps a function seed -> (value, nextSeed),
/// so every draw is a pure function and the seed is passed along explicitly instead of hidden.
/// Seeds and values are unsigned 32-bit numbers (uint32).
module Snake.Random
type Random<'a> = Random of (uint32 -> 'a * uint32)
let run (seed: uint32) (Random f: Random<'a>) : 'a * uint32 = f seed
let pure (a: 'a) : Random<'a> = Random(fun seed -> (a, seed))
let map (f: 'a -> 'b) (r: Random<'a>) : Random<'b> =
Random(fun seed ->
let a, next = run seed r
(f a, next))
let bind (f: 'a -> Random<'b>) (r: Random<'a>) : Random<'b> =
Random(fun seed ->
let a, next = run seed r
run next (f a))
// mulberry32. uint32 arithmetic wraps around at 2^32 (F# operators are unchecked) and `>>>` on uint32 is an
// unsigned shift, so the formula can be written down as it is.
let nextUint32: Random<uint32> =
Random(fun seed ->
let s = seed + 0x6D2B79F5u
let t1 = (s ^^^ (s >>> 15)) * (s ||| 1u)
let t2 = t1 ^^^ (t1 + (t1 ^^^ (t1 >>> 7)) * (t1 ||| 61u))
(t2 ^^^ (t2 >>> 14), s))
let intBelow (n: int) : Random<int> = map (fun v -> int (v % uint32 n)) nextUint32
+34
View File
@@ -0,0 +1,34 @@
/// m03 rules: the pure game rules. Each function takes a state and returns a new one.
module Snake.Rules
open Snake.Model
let move (p: Point) (dir: Direction) : Point =
let d = delta dir
{ X = p.X + d.X; Y = p.Y + d.Y }
let inBounds (state: GameState) (p: Point) : bool =
p.X >= 0 && p.X < state.Width && p.Y >= 0 && p.Y < state.Height
// Validate against `Dir` (last moved), not `NextDir`: Up then Left within one tick must not fold the snake back on itself.
let turn (state: GameState) (dir: Direction) : GameState =
if state.Status = Playing && dir <> opposite state.Dir then { state with NextDir = dir } else state
let advance (state: GameState) : GameState =
if state.Status <> Playing then
state
else
let d = state.NextDir
let head = move (List.head state.Snake) d
let eating = state.Apple = Some head
// When not eating, the tail leaves its cell this step, so the head may move into it.
let body = if eating then state.Snake else Util.dropLast state.Snake
if not (inBounds state head) || Util.contains body head (=) then
{ state with Dir = d; Status = GameOver }
else
{ state with
Snake = head :: body
Dir = d
Apple = if eating then None else state.Apple
Score = state.Score + (if eating then 1 else 0) }
+8
View File
@@ -1,9 +1,17 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<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>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
</PropertyGroup>
<ItemGroup>
<Compile Include="Util.fs" />
<Compile Include="Model.fs" />
<Compile Include="Rules.fs" />
<Compile Include="Random.fs" />
<Compile Include="Spawn.fs" />
<Compile Include="Game.fs" />
<Compile Include="View.fs" />
</ItemGroup>
</Project>
+25
View File
@@ -0,0 +1,25 @@
/// m04 spawn: placing apples with the Random from Random.fs.
module Snake.Spawn
open Snake.Model
let freeCells (state: GameState) : Point list =
[ for y in Util.range state.Height do
for x in Util.range state.Width do
let p = { X = x; Y = y }
if not (Util.contains state.Snake p (=)) then
yield p ]
let spawnApple (state: GameState) : GameState =
if state.Apple.IsSome || state.Status <> Playing then
state
else
match freeCells state with
| [] -> { state with Status = Won }
| cells ->
let i, seed = Random.run state.Seed (Random.intBelow (List.length cells))
{ state with Apple = Some(List.item i cells); Seed = seed }
let tick (state: GameState) : GameState = spawnApple (Rules.advance state)
let newGame (seed: uint32) : GameState = spawnApple (initialState seed)
+11 -1
View File
@@ -1,2 +1,12 @@
/// Placeholder; replaced by the m01 utilities.
/// m01 util: small helpers used by every later module.
/// (The JavaScript track also writes `pipe` and `compose` here; F# has them built in as `|>` and `>>`.)
module Snake.Util
let range (n: int) : int list = [ 0 .. n - 1 ]
let dropLast (xs: 'a list) : 'a list =
match xs with
| [] -> []
| _ -> List.take (List.length xs - 1) xs
let contains (xs: 'a list) (p: 'a) (eq: 'a -> 'a -> bool) : bool = List.exists (fun x -> eq x p) xs
+38
View File
@@ -0,0 +1,38 @@
/// m06 view: the picture is plain data (a list of shapes); drawing it is somebody else's job (m07).
module Snake.View
open Snake.Model
/// A thing to draw.
type Shape =
| Rect of x: int * y: int * w: int * h: int * color: string
| Text of x: int * y: int * text: string * color: string * size: int * align: string
/// A picture: shapes drawn in order.
type Scene = Shape list
let CELL = 20
let private text x y str size align = Text(x, y, str, "#ffffff", size, align)
// One cell, inset by 1px so neighbouring segments show a gap.
let private cell (p: Point) color =
Rect(p.X * CELL + 1, p.Y * CELL + 1, CELL - 2, CELL - 2, color)
let private overlay (state: GameState) : Scene =
let cx = state.Width * CELL / 2
let cy = state.Height * CELL / 2
let banner title hint = [ text cx cy title 32 "center"; text cx (cy + 30) hint 16 "center" ]
match state.Status with
| Paused -> banner "Paused" "Press Space to resume"
| GameOver -> banner "Game Over" "Press R to restart"
| Won -> banner "You Win!" "Press R to restart"
| Playing -> []
let view (state: GameState) : Scene =
[ Rect(0, 0, state.Width * CELL, state.Height * CELL, "#111111") ]
@ (state.Apple |> Option.map (fun a -> cell a "#e53935") |> Option.toList)
@ (state.Snake |> List.mapi (fun i p -> cell p (if i = 0 then "#7cb342" else "#43a047")))
@ [ text 6 18 $"Score: {state.Score}" 16 "left" ]
@ overlay state
+26
View File
@@ -0,0 +1,26 @@
/// m05 game: one `update` turns every action into a new state; replaying a game is a fold over its actions.
module Snake.Game
open Snake.Model
/// How many frames pass between game steps (m10): `max 2 (8 - score / 3)` (integer division).
/// Score 0-2 -> 8, 3-5 -> 7, ..., 18 and up -> 2.
let movesEvery (score: int) : int = failwith "TODO m10"
/// The one function that says how the game changes: `state -> action -> state`.
///
/// m05: `Tick` runs a game step (`Spawn.tick`), `Turn` asks to change direction (`Rules.turn`);
/// every other action returns the state unchanged.
///
/// (m10) `TogglePause` switches Playing <-> Paused and does nothing in any other status.
/// (m10) `Restart` gives `Spawn.newGame state.Seed`, whatever the status.
/// (m10) `Frame` does nothing unless Playing; otherwise it adds 1 to `Frame`, and when the new `Frame` is a multiple of
/// `movesEvery Score` it also runs a game step (`Spawn.tick`) on that incremented state.
/// In m10, match every case of `Action` explicitly (no `| _ ->`), so the compiler tells you if one is forgotten.
let update (state: GameState) (action: Action) : GameState = failwith "TODO m05"
/// Apply all actions in order, starting from `state`, and return the final state.
let replay (state: GameState) (actions: Action list) : GameState = failwith "TODO m05"
/// Like `replay`, but keep every state: `[state; afterFirst; afterSecond; ...]`, so its length is `List.length actions + 1`.
let history (state: GameState) (actions: Action list) : GameState list = failwith "TODO m05"
+48
View File
@@ -0,0 +1,48 @@
/// m02 model: the data the game is built from, plus two tiny functions over directions.
module Snake.Model
/// A grid cell. Records compare structurally: two points with the same X and Y are `=`.
type Point = { X: int; Y: int }
type Direction =
| Up
| Down
| Left
| Right
type Status =
| Playing
| Paused
| GameOver
| Won
/// Everything that can happen to the game, as data.
type Action =
| Tick
| Turn of Direction
| TogglePause
| Restart
| Frame
/// The whole game. `Snake` is head first; `Seed` is the unsigned 32-bit random seed.
type GameState =
{ Width: int
Height: int
Snake: Point list
Dir: Direction
NextDir: Direction
Apple: Point option
Seed: uint32
Score: int
Status: Status
Frame: int }
/// The unit step for a direction: Up (0,-1), Down (0,1), Left (-1,0), Right (1,0). Y grows downward.
let delta (dir: Direction) : Point = failwith "TODO m02"
/// The direction pointing the other way.
let opposite (dir: Direction) : Direction = failwith "TODO m02"
/// A fresh game: 20x20, snake (10,10),(9,10),(8,10) heading Right (`Dir` and `NextDir`),
/// no apple, the given seed, score 0, status Playing, frame 0.
let initialState (seed: uint32) : GameState = failwith "TODO m02"
+30
View File
@@ -0,0 +1,30 @@
/// m04 random. A `Random<'a>` wraps a plain function from a seed to a pair: `seed -> (value, nextSeed)`.
/// Seeds and values are unsigned 32-bit integers (`uint32`).
/// Nothing is hidden or mutated: the caller carries the seed.
module Snake.Random
type Random<'a> = Random of (uint32 -> 'a * uint32)
/// Run `r` from `seed`: the value it produces and the seed it leaves behind.
let run (seed: uint32) (r: Random<'a>) : 'a * uint32 = failwith "TODO m04"
/// A Random that always gives `a` and leaves the seed untouched.
let pure (a: 'a) : Random<'a> = failwith "TODO m04"
/// Transform the value `r` produces; the seed threading is unchanged.
let map (f: 'a -> 'b) (r: Random<'a>) : Random<'b> = failwith "TODO m04"
/// Run `r`, feed its value to `f` to pick the next Random, and run that with the seed `r` left behind.
let bind (f: 'a -> Random<'b>) (r: Random<'a>) : Random<'b> = failwith "TODO m04"
/// The generator (mulberry32). uint32 arithmetic already wraps around at 2^32 and `>>>` on a uint32 is an
/// unsigned shift. With `s = seed + 0x6D2B79F5u`:
/// t = (s ^^^ (s >>> 15)) * (s ||| 1u)
/// t = t ^^^ (t + (t ^^^ (t >>> 7)) * (t ||| 61u))
/// value = t ^^^ (t >>> 14)
/// It returns `value` and the new seed `s`.
/// (The stub is wrapped in `Random` so the TODO only fires when the generator is run.)
let nextUint32: Random<uint32> = Random(fun _ -> failwith "TODO m04")
/// A Random giving a number in `[0, n)`: the `nextUint32` value modulo `n`.
let intBelow (n: int) : Random<int> = failwith "TODO m04"
+22
View File
@@ -0,0 +1,22 @@
/// m03 rules: the pure game rules. Each function takes a state and returns a new one.
module Snake.Rules
open Snake.Model
/// The cell one step from `p` in direction `dir`. No wrapping: it may land outside the board.
let move (p: Point) (dir: Direction) : Point = failwith "TODO m03"
/// True if `p` lies on the board: `0 <= X < Width` and `0 <= Y < Height`.
let inBounds (state: GameState) (p: Point) : bool = failwith "TODO m03"
/// Ask to turn the snake. Returns `state` unchanged unless the game is Playing and
/// `dir` is not the opposite of `state.Dir` (the direction the snake last *moved*, not `NextDir`).
/// Otherwise sets `NextDir = dir`. Several turns in one tick: the last allowed one wins.
let turn (state: GameState) (dir: Direction) : GameState = failwith "TODO m03"
/// One step of the game. Returns `state` unchanged unless Playing. Otherwise the head moves in `NextDir`
/// (which becomes `Dir`):
/// - head lands on the apple: the snake grows (tail kept), score + 1, apple becomes None;
/// - otherwise the tail cell is vacated, so the head may enter the cell the tail is leaving;
/// - head off the board, or onto a remaining body cell: status GameOver, snake unchanged (but `Dir` updated).
let advance (state: GameState) : GameState = failwith "TODO m03"
+8
View File
@@ -1,9 +1,17 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<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>
<TreatWarningsAsErrors>false</TreatWarningsAsErrors>
</PropertyGroup>
<ItemGroup>
<Compile Include="Util.fs" />
<Compile Include="Model.fs" />
<Compile Include="Rules.fs" />
<Compile Include="Random.fs" />
<Compile Include="Spawn.fs" />
<Compile Include="Game.fs" />
<Compile Include="View.fs" />
</ItemGroup>
</Project>
+18
View File
@@ -0,0 +1,18 @@
/// m04 spawn: placing apples with the Random from Random.fs.
module Snake.Spawn
open Snake.Model
/// Every board cell not covered by the snake, row-major (y outer loop, x inner loop). The apple does not count as occupied.
let freeCells (state: GameState) : Point list = failwith "TODO m04"
/// Put an apple on a random free cell, drawing from `state.Seed` (use `Random.intBelow` and store the new seed).
/// Unchanged if there already is an apple or the status is not Playing.
/// If no cell is free the board is full: status becomes Won (seed unchanged, no apple).
let spawnApple (state: GameState) : GameState = failwith "TODO m04"
/// One game step: `Rules.advance`, then make sure there is an apple.
let tick (state: GameState) : GameState = failwith "TODO m04"
/// A fresh game (`initialState`) with its first apple already placed.
let newGame (seed: uint32) : GameState = failwith "TODO m04"
+11 -1
View File
@@ -1,2 +1,12 @@
/// Placeholder; replaced by the m01 utilities.
/// m01 util: small helpers used by every later module.
/// (The JavaScript track also writes `pipe` and `compose` here; F# has them built in as `|>` and `>>`.)
module Snake.Util
/// `range n` is `[0; 1; ...; n-1]`; `range 0` is `[]`.
let range (n: int) : int list = failwith "TODO m01"
/// `xs` without its last element; an empty list stays empty.
let dropLast (xs: 'a list) : 'a list = failwith "TODO m01"
/// True if some element `x` of `xs` satisfies `eq x p`. `eq` lets callers choose how elements are compared.
let contains (xs: 'a list) (p: 'a) (eq: 'a -> 'a -> bool) : bool = failwith "TODO m01"
+23
View File
@@ -0,0 +1,23 @@
/// m06 view: from game state to a Scene. The picture is plain data; drawing it is somebody else's job (m07).
module Snake.View
open Snake.Model
/// A thing to draw.
type Shape =
| Rect of x: int * y: int * w: int * h: int * color: string
| Text of x: int * y: int * text: string * color: string * size: int * align: string
/// A picture: shapes drawn in order.
type Scene = Shape list
/// Pixels per board cell.
let CELL = 20
/// Describe the picture as data, in this order: background `Rect(0, 0, Width*CELL, Height*CELL, "#111111")`;
/// the apple (if any) as `Rect(ax*CELL+1, ay*CELL+1, CELL-2, CELL-2, "#e53935")`; each snake segment in list order,
/// same size, head "#7cb342" and body "#43a047"; `Text(6, 18, "Score: <n>", "#ffffff", 16, "left")`;
/// then an overlay centred at (Width*CELL/2, Height*CELL/2), all "#ffffff", align "center":
/// Paused: "Paused" (size 32) and, 30px lower, "Press Space to resume" (size 16);
/// GameOver: "Game Over" + "Press R to restart"; Won: "You Win!" + "Press R to restart"; Playing: none.
let view (state: GameState) : Scene = failwith "TODO m06"
+69 -2
View File
@@ -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) ]
+34
View File
@@ -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")
]
+42
View File
@@ -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")
]
+21
View File
@@ -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")
]
+73
View File
@@ -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")
]
+55
View File
@@ -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")
]
+33
View File
@@ -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")
]
+14
View File
@@ -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")
]
+54
View File
@@ -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")
]
+10
View File
@@ -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>