feat(fsharp): m01-m06 util, model, rules, random, spawn, game, view with Expecto tests

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
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"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net10.0</TargetFramework> <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> <TreatWarningsAsErrors>false</TreatWarningsAsErrors>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Util.fs" /> <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> </ItemGroup>
</Project> </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 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"> <Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net10.0</TargetFramework> <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> <TreatWarningsAsErrors>false</TreatWarningsAsErrors>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Util.fs" /> <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> </ItemGroup>
</Project> </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 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. /// Loads shared fixtures from ../fixtures/<name>.json and decodes them into the course's types.
/// Typed decoders (point, direction, status, action, state, opt) arrive with the model (Task 13).
module Snake.Tests.Fixtures module Snake.Tests.Fixtures
open System.IO open System.IO
open System.Text.Json open System.Text.Json
open Expecto
open Snake.Model
open Snake.View
let private dir = let private dir =
Path.GetFullPath(Path.Combine(Directory.GetCurrentDirectory(), "..", "fixtures")) 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. /// Decode a nullable JSON value into an Option.
let opt (f: JsonElement -> 'a) (v: JsonElement) : 'a option = let opt (f: JsonElement -> 'a) (v: JsonElement) : 'a option =
if v.ValueKind = JsonValueKind.Null then None else Some(f v) 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> <PropertyGroup>
<OutputType>Exe</OutputType> <OutputType>Exe</OutputType>
<TargetFramework>net10.0</TargetFramework> <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> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Fixtures.fs" /> <Compile Include="Fixtures.fs" />
<Compile Include="M00Sanity.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" /> <Compile Include="Main.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
+11 -2
View File
@@ -10,7 +10,6 @@ repo="$(cd "$(dirname "$0")/.." && pwd)"
export PATH="$HOME/.dotnet:$HOME/.local/bin:$PATH" export PATH="$HOME/.dotnet:$HOME/.local/bin:$PATH"
# Module -> files (relative to src/ and solutions/) that the module introduces. A directory entry copies it whole. # Module -> files (relative to src/ and solutions/) that the module introduces. A directory entry copies it whole.
# Later tasks: extend the F# table.
files_for() { files_for() {
case "$track:$1" in case "$track:$1" in
js:01) echo "util.js todo.js" ;; js:01) echo "util.js todo.js" ;;
@@ -35,7 +34,17 @@ files_for() {
scala:09) echo "Input.scala App.scala Runtime.scala" ;; scala:09) echo "Input.scala App.scala Runtime.scala" ;;
scala:10) echo "" ;; scala:10) echo "" ;;
scala:11) echo "pong" ;; scala:11) echo "pong" ;;
fsharp:*) echo "" ;; # added by the F# tasks fsharp:01) echo "Util.fs" ;; # Snake.fsproj lists every file from the start and is identical in both trees
fsharp:02) echo "Model.fs" ;;
fsharp:03) echo "Rules.fs" ;;
fsharp:04) echo "Random.fs Spawn.fs" ;;
fsharp:05) echo "Game.fs" ;;
fsharp:06) echo "View.fs" ;;
fsharp:07) echo "IO.fs" ;;
fsharp:08) echo "Stream.fs" ;;
fsharp:09) echo "Input.fs App.fs Runtime.fs" ;;
fsharp:10) echo "" ;;
fsharp:11) echo "Pong" ;;
*) echo "" ;; *) echo "" ;;
esac esac
} }