feat(course): audit fixes and twelve extensions (Modules 7b, 12, 13)

Audit pass:
- Frame rule counts frames since the last move, so every step lasts
  exactly movesEvery(score) frames, also right after a speed-up
- clampTime + MAX_GAP_MS: a hidden tab no longer replays the whole gap
- Pong Restart keeps held keys
- Fact corrections (mulberry32 output coverage, Haskell IO, uniform)
- New fixture cases from a mutation analysis

Extensions (all three tracks, shared fixtures, course text):
- Turn queue (Exercise 10.6), persisted high score (10.7),
  replay viewer (10.8), play() end-to-end helper (9.5)
- Optional State (4.7) and optional Module 7b, stack-safe IO
- Module 12, property-based testing with generators, shrinking,
  invariants and a model-based oracle
- Module 13, Conway's Life with a Click event
- JS type checking via jsconfig, JSDoc and types.d.ts
- Maintainer tools: scripts/mutate.mjs, scripts/typecheck-js.sh,
  Playwright end-to-end suite (e2e/, scripts/e2e.sh)

Docs: docs/contract.md is the canonical contract; specs and build log
under docs/superpowers.

Verified: JS 728, Scala 689, F# 691 unit tests; stubs and progression
M01-M13 and M07b; 176 end-to-end tests on Chromium and WebKit.

Co-Authored-By: Claude Fable 5.2 <noreply@anthropic.com>
This commit is contained in:
Lucas WintherandClaude Fable 5.2 committed 2026-11-11 12:05:29 +01:00
1 parent 876f5aabb1
commit edd57f0148
253 files changed
+21753 -503

No files matched your search

+2 -1
View File
@@ -1,7 +1,8 @@
#!/usr/bin/env bash
# Usage: ./build-web.sh
# Compiles src/ + web/ to JavaScript with Fable (a local dotnet tool, see .config/dotnet-tools.json) into web/dist/.
# index.html loads the Snake entry module, pong.html the Pong one.
# index.html loads the Snake entry module (web/dist/SnakeMain.js), pong.html the Pong one (PongMain.js), replay.html the
# replay viewer (ReplayMain.js, m10) and life.html Conway's Life (LifeMain.js, m13).
# Then serve the repo root (node scripts/serve.mjs) and open http://localhost:8000/fsharp/index.html.
set -euo pipefail
cd "$(dirname "$0")"
+22
View File
@@ -0,0 +1,22 @@
<!doctype html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>Pure Life</title>
<link rel="icon" href="data:,">
<style>
body { margin: 0; min-height: 100vh; display: flex; flex-direction: column; align-items: center;
justify-content: center; gap: 12px; background: #1b1b1b; color: #ddd; font: 14px system-ui, sans-serif; }
h1 { margin: 0; font-size: 20px; }
canvas { background: #111111; border: 2px solid #333; cursor: crosshair; }
p { margin: 0; color: #999; }
</style>
</head>
<body>
<h1>Pure Life</h1>
<canvas id="game" width="640" height="504"></canvas>
<p>Click a cell to switch it on or off. Space runs and pauses, N steps one generation, R fills the board at random, C clears it.</p>
<script type="module" src="web/dist/LifeMain.js"></script>
</body>
</html>
+22
View File
@@ -0,0 +1,22 @@
<!doctype html>
<html lang="en">
<head>
<meta charset="utf-8">
<meta name="viewport" content="width=device-width, initial-scale=1">
<title>Pure Snake replay</title>
<link rel="icon" href="data:,">
<style>
body { margin: 0; min-height: 100vh; display: flex; flex-direction: column; align-items: center;
justify-content: center; gap: 12px; background: #1b1b1b; color: #ddd; font: 14px system-ui, sans-serif; }
h1 { margin: 0; font-size: 20px; }
canvas { background: #111111; border: 2px solid #333; }
p { margin: 0; color: #999; }
</style>
</head>
<body>
<h1>Pure Snake: replay</h1>
<canvas id="game" width="400" height="400"></canvas>
<p>Right / D next step, Left / A previous, Home / End first / last, Space plays (Module 10, Exercise 10.8).</p>
<script type="module" src="web/dist/ReplayMain.js"></script>
</body>
</html>
+45 -2
View File
@@ -2,11 +2,14 @@
module Snake.App
open Snake.Model
open Snake.View
open Snake.IO
open Snake.Stream
let TICK_MS = 150L
let FRAME_MS = 25L
// m10: the longest step of time the game accepts at once; a longer silence (a background tab) counts as this much.
let MAX_GAP_MS = 250L
// Everything that can happen to the game: a Tick every TICK_MS, and an action for each bound key.
let classicActions: Stream<Action> =
@@ -22,7 +25,47 @@ let states (seed: uint32) (actions: Stream<Action>) : Stream<GameState> =
let render (state: GameState) : IO<unit> = IO.drawScene (View.view state)
// The whole program as a value: get a seed, then turn the stream of states into a stream of drawings.
// m10: a session wraps the game with the best score so far. GameState, update and view do not know about it.
// `Improved` says whether the action that produced this session raised the best, which is when it must be saved.
type Session = { Game: GameState; Best: int; Improved: bool }
let sessionUpdate (session: Session) (action: Action) : Session =
let game = Game.update session.Game action
let best = max session.Best game.Score
{ Game = game; Best = best; Improved = best > session.Best }
// The same running fold as `states`, one level up.
let sessions (seed: uint32) (best: int) (actions: Stream<Action>) : Stream<Session> =
let s0 = { Game = Spawn.newGame seed; Best = best; Improved = false }
actions |> Stream.scan sessionUpdate s0 |> Stream.startWith s0
// The game's picture with the best score at the top right, level with the score on the left.
let sessionView (session: Session) : Scene =
View.view session.Game
@ [ Text(session.Game.Width * CELL - 6, 18, $"Best: {session.Best}", "#ffffff", 16, "right") ]
// Draw, and save the best only on the action that raised it.
let renderSession (session: Session) : IO<unit> =
if session.Improved then
IO.sequence [ IO.drawScene (sessionView session); IO.saveBest session.Best ]
else
IO.drawScene (sessionView session)
// The whole program as a value: get a seed, then the stored best, then turn the stream of sessions into a stream
// of drawings. clampTime wraps the whole stream, so everything inside it sees the clamped clock.
// Nothing runs here; Runtime interprets it.
let main () : IO<Stream<IO<unit>>> =
IO.randomSeed () |> IO.map (fun seed -> states seed speedActions |> Stream.map render)
IO.randomSeed ()
|> IO.bind (fun seed ->
IO.loadBest ()
|> IO.map (fun best -> sessions seed best speedActions |> Stream.map renderSession |> Stream.clampTime MAX_GAP_MS))
// m09: the whole program in one equality. For each drawing that `main` emits while fed `events`, the ops it
// performs, answered by the pure interpreter (`seed` for RandomSeed, and from m10 `best` for LoadBest).
let playWith (seed: uint32) (best: int) (events: Event list) (main: IO<Stream<IO<unit>>>) : Op list list =
(IO.traceWith seed best main).Result
|> Stream.run events
|> List.map (fun io -> (IO.traceWith seed best io).Ops)
// The Module 9 helper is the "no stored best" case.
let play (seed: uint32) (events: Event list) (main: IO<Stream<IO<unit>>>) : Op list list = playWith seed 0 events main
+170
View File
@@ -0,0 +1,170 @@
/// m12 check: property-based testing built from the course's own parts.
/// A generator of test data is nothing new: it is a `Random<'a>` from Random.fs (`seed -> (value, nextSeed)`).
module Snake.Check
open Snake.Model
open Snake.Random
/// What `forAll` reports: every value passed, or the first one that did not.
type CheckResult<'a> =
| Passed of runs: int
| Failed of run: int * seed: uint32 * value: 'a
/// One of the elements of the non-empty list `xs`: the one at index `intBelow (List.length xs)`.
let elementOf (xs: 'a list) : Random<'a> =
Random.intBelow (List.length xs) |> Random.map (fun i -> List.item i xs)
/// `n` values drawn from `gen`, one after another; the seed is threaded from each draw to the next.
let rec listOf (n: int) (gen: Random<'a>) : Random<'a list> =
if n <= 0 then
Random.pure []
else
gen |> Random.bind (fun a -> listOf (n - 1) gen |> Random.map (fun rest -> a :: rest))
// Ticks appear three times so that the snake moves more often than it turns.
let private actionPool: Action list =
[ Tick; Tick; Tick; Turn Up; Turn Down; Turn Left; Turn Right ]
/// A generator of `n` random actions (given).
let genActions (n: int) : Random<Action list> = listOf n (elementOf actionPool)
/// Check `prop` on `runs` values drawn from `gen`, starting from `seed`; stop at the first value that fails.
/// Recursion carries the seed: no counter, no loop variable. `go` calls itself last, so it runs in constant stack.
let forAll (runs: int) (seed: uint32) (prop: 'a -> bool) (gen: Random<'a>) : CheckResult<'a> =
let rec go (i: int) (s: uint32) : CheckResult<'a> =
if i >= runs then
Passed runs
else
let value, next = Random.run s gen
if prop value then go (i + 1) next else Failed(i, s, value)
go 0 seed
/// Every list that is `xs` with exactly one element removed, in the order of the removed index.
let removals (xs: 'a list) : 'a list list = xs |> List.mapi (fun i _ -> List.removeAt i xs)
/// Keep removing one element for as long as the list still fails; the result is 1-minimal.
let rec minimize (fails: 'a list -> bool) (xs: 'a list) : 'a list =
match List.tryFind fails (removals xs) with
| Some smaller -> minimize fails smaller
| None -> xs
let private neighbours (a: Point, b: Point) : bool = abs (a.X - b.X) + abs (a.Y - b.Y) = 1
let rec private allDifferent (ps: Point list) : bool =
match ps with
| [] -> true
| p :: rest -> not (Util.contains rest p (=)) && allDifferent rest
// Each invariant: its name, and a predicate that is true when the state is fine.
// `Option.forall` is true for `None`: no apple breaks nothing.
let private invariants: (string * (GameState -> bool)) list =
[ "snake-not-empty", (fun s -> not (List.isEmpty s.Snake))
"snake-in-bounds", (fun s -> s.Snake |> List.forall (Rules.inBounds s))
"snake-no-overlap", (fun s -> allDifferent s.Snake)
"snake-connected", (fun s -> s.Snake |> List.pairwise |> List.forall neighbours)
"apple-in-bounds", (fun s -> s.Apple |> Option.forall (Rules.inBounds s))
"apple-not-on-snake", (fun s -> s.Apple |> Option.forall (fun a -> not (Util.contains s.Snake a (=))))
"turn-not-reversed", (fun s -> s.NextDir <> opposite s.Dir)
"queued-not-reversed", (fun s -> s.Queued |> Option.forall (fun q -> q <> opposite s.NextDir)) ]
/// The names of the invariants that `state` breaks, in the order of the table above.
let violations (state: GameState) : string list =
invariants |> List.filter (fun (_, holds) -> not (holds state)) |> List.map fst
/// The numbers of states between consecutive moves of the snake's head.
let moveGaps (states: GameState list) : int list =
let moved =
states
|> List.pairwise
|> List.indexed
|> List.filter (fun (_, (before, after)) -> List.tryHead after.Snake <> List.tryHead before.Snake)
|> List.map (fun (i, _) -> i + 1)
moved |> List.pairwise |> List.map (fun (a, b) -> b - a)
// ---- random states (Exercise 12.6) and a second implementation of the step as an oracle (Exercise 12.7)
let private directions: Direction list = [ Up; Down; Left; Right ]
// The direction the head moved in to get from the second cell to the first (`Right` for a one-cell snake).
let private headingOf (snake: Point list) : Direction =
match snake with
| head :: second :: _ -> directions |> List.find (fun d -> Rules.move second d = head)
| _ -> Right
/// A random snake, head first: a random head, then a random walk that never leaves the board or crosses itself.
let genSnake (width: int) (height: int) (maxLen: int) : Random<Point list> =
// Extend `snake` at its tail by up to `left` more cells, each a random free in-bounds neighbour of the last cell.
let rec grow (snake: Point list) (left: int) : Random<Point list> =
if left <= 0 then
Random.pure snake
else
let last = List.last snake
let options =
directions
|> List.map (Rules.move last)
|> List.filter (fun p ->
p.X >= 0 && p.X < width && p.Y >= 0 && p.Y < height && not (Util.contains snake p (=)))
if List.isEmpty options then
Random.pure snake
else
elementOf options |> Random.bind (fun p -> grow (snake @ [ p ]) (left - 1))
Random.intBelow width
|> Random.bind (fun x -> Random.intBelow height |> Random.bind (fun y -> grow [ { X = x; Y = y } ] (maxLen - 1)))
/// A random sane Playing state on a `width` x `height` board (given).
let genState (width: int) (height: int) : Random<GameState> =
Random.intBelow (width * height)
|> Random.bind (fun n ->
genSnake width height (n + 1)
|> Random.bind (fun snake ->
let dir = headingOf snake
let state =
{ Width = width
Height = height
Snake = snake
Dir = dir
NextDir = dir
Apple = None
Seed = 0u
Score = 0
Status = Playing
Frame = 0
Queued = None }
let free = Spawn.freeCells state
elementOf (directions |> List.filter (fun d -> d <> opposite dir))
|> Random.bind (fun nextDir ->
Random.intBelow 2
|> Random.bind (fun coin ->
(if coin = 0 || List.isEmpty free then Random.pure None else elementOf free |> Random.map Some)
|> Random.map (fun apple -> { state with NextDir = nextDir; Apple = apple })))))
/// The step of m03, written from the rules instead of from `advance`: build the snake the step would give,
/// then ask `violations` whether that snake is on the board and does not overlap itself.
let advanceSpec (state: GameState) : GameState =
if state.Status <> Playing then
state
else
let head = Rules.move (List.head state.Snake) state.NextDir
let eating = state.Apple = Some head
let snake = head :: (if eating then state.Snake else Util.dropLast state.Snake)
let broken =
violations { state with Snake = snake }
|> List.exists (fun v -> v = "snake-in-bounds" || v = "snake-no-overlap")
if broken then
{ state with Dir = state.NextDir; Status = GameOver }
else
{ state with
Snake = snake
Dir = state.NextDir
Apple = if eating then None else state.Apple
Score = state.Score + (if eating then 1 else 0) }
+27 -6
View File
@@ -1,19 +1,40 @@
/// 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.
/// m10 adds pause, restart, a frame counter that makes the snake speed up as the score grows, and a turn queue.
module Snake.Game
open Snake.Model
/// What `update` does with `Turn dir` from m10 on. With no turn pending (`NextDir = Dir`) it is the m03 `Rules.turn`.
/// With a turn pending, a key that is neither `NextDir` nor its opposite is remembered in `Queued`
/// (replacing an earlier one) and taken on the step after; any other key changes nothing.
let steer (state: GameState) (dir: Direction) : GameState =
if state.Status <> Playing then state
elif state.NextDir = state.Dir then Rules.turn state dir
elif dir <> state.NextDir && dir <> opposite state.NextDir then { state with Queued = Some dir }
else state
// After a step: a game still in play takes the queued turn, if there is one. It is always a legal turn, because the
// step just made `Dir` equal to the old `NextDir`, and `Queued` is neither that nor its opposite.
let private takeQueued (state: GameState) : GameState =
match state.Queued with
| Some d when state.Status = Playing -> { state with NextDir = d; Queued = None }
| _ -> state
// One game step as `update` takes it: `Spawn.tick`, then the queued turn.
let private step (state: GameState) : GameState = takeQueued (Spawn.tick state)
/// 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.
// One animation frame. `Frame` counts the frames since the snake last moved; when it reaches
// `movesEvery Score` the count starts again and the game takes a step. Counting from the last move
// (not from the start of the game) keeps every step exactly `movesEvery` frames long, also right after a speed-up.
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
let n = state.Frame + 1
if n >= movesEvery state.Score then step { state with Frame = 0 } else { state with Frame = n }
// Pause and resume only make sense in those two statuses; a finished game stays finished.
let private togglePause (state: GameState) : GameState =
@@ -26,8 +47,8 @@ let private togglePause (state: GameState) : GameState =
// 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
| Tick -> step state
| Turn dir -> steer state dir
| TogglePause -> togglePause state
| Restart -> Spawn.newGame state.Seed
| Frame -> frame state
+25 -4
View File
@@ -9,11 +9,16 @@ open Snake.View
type Op =
| Draw of Shape
| RandomSeed
// m10: the stored best score, read and written.
| LoadBest
| SaveBest of int
/// What the outside world answers: `Done` for a `Draw`, `Seed value` for a `RandomSeed`.
/// What the outside world answers: `Done` for a `Draw` or a `SaveBest`, `Seed value` for a `RandomSeed`,
/// `Best value` for a `LoadBest`.
type OpResult =
| Done
| Seed of uint32
| Best of int
type IO<'a> =
| Pure of 'a
@@ -47,13 +52,24 @@ let randomSeed () : IO<uint32> =
|> map (fun result ->
match result with
| Seed value -> value
| Done -> failwith "RandomSeed must be answered with a Seed")
| _ -> failwith "RandomSeed must be answered with a Seed")
let drawScene (scene: Scene) : IO<unit> = sequence (List.map draw scene)
// m10: the stored best score. Reading it answers a number (built like randomSeed); saving answers Done, like a draw.
let loadBest () : IO<int> =
effect LoadBest
|> map (fun result ->
match result with
| Best value -> value
| _ -> failwith "LoadBest must be answered with a Best")
let saveBest (score: int) : IO<unit> = effect (SaveBest score) |> map ignore
// Answer each op with a canned result, collecting the ops as we go. Tail recursion: the compiler turns it
// into a loop, so long programs cannot overflow the stack, and still nothing is mutated.
let trace (seed: uint32) (io: IO<'a>) : Traced<'a> =
// `best` (m10) answers LoadBest, the way `seed` answers RandomSeed.
let traceWith (seed: uint32) (best: int) (io: IO<'a>) : Traced<'a> =
let rec go io performed =
match io with
| Pure a -> { Result = a; Ops = List.rev performed }
@@ -61,8 +77,13 @@ let trace (seed: uint32) (io: IO<'a>) : Traced<'a> =
let answer =
match op with
| RandomSeed -> Seed seed
| Draw _ -> Done
| LoadBest -> Best best
| Draw _
| SaveBest _ -> Done
go (k answer) (op :: performed)
go io []
// The Module 7 interpreter is the "no stored best" case.
let trace (seed: uint32) (io: IO<'a>) : Traced<'a> = traceWith seed 0 io
+44
View File
@@ -0,0 +1,44 @@
/// m13 life app: the same wiring as Snake and Pong, with a third kind of input, the mouse.
module Snake.Life.App
open Snake
open Snake.Model
open Snake.IO
open Snake.Stream
open Snake.Life.Model
open Snake.Life.Rules
open Snake.Life.View
let GEN_MS = 150L
let lifeKey (key: string) : LifeAction option =
match key with
| " " -> Some LifeAction.TogglePause
| "n" | "N" -> Some LifeAction.Step
| "c" | "C" -> Some LifeAction.Clear
| "r" | "R" -> Some LifeAction.Randomize
| _ -> None
// Integer division rounds towards zero (-1 / 16 = 0), so the pixel is checked before dividing.
let lifeClick (x: int) (y: int) : LifeAction option =
if x >= 0 && y >= 0 && x / LCELL < LW && y / LCELL < LH then
Some(LifeAction.Toggle { X = x / LCELL; Y = y / LCELL })
else
None
let lifeActions: Stream<LifeAction> =
Stream.merge
(Stream.merge
(Stream.interval GEN_MS |> Stream.map (fun _ -> LifeAction.Frame))
(Stream.keyDowns |> Stream.choose lifeKey))
(Stream.clicks |> Stream.choose (fun (x, y) -> lifeClick x y))
let lifeStates (seed: uint32) (actions: Stream<LifeAction>) : Stream<LifeState> =
actions |> Stream.scan lifeUpdate (initialLife seed) |> Stream.startWith (initialLife seed)
let lifeMain () : IO<Stream<IO<unit>>> =
IO.randomSeed ()
|> IO.map (fun seed ->
lifeStates seed lifeActions
|> Stream.map (fun state -> IO.drawScene (lifeView state))
|> Stream.clampTime App.MAX_GAP_MS)
+32
View File
@@ -0,0 +1,32 @@
/// m13 life model: the whole world is one value, like the snake and the match.
module Snake.Life.Model
open Snake.Model
/// `Cells` is canonical: sorted row-major (by `Y`, then `X`), no duplicates, all on the board.
type LifeState =
{ Cells: Point list
Running: bool
Seed: uint32
Generation: int }
[<RequireQualifiedAccess>]
type LifeAction =
| Frame
| Toggle of Point
| TogglePause
| Step
| Clear
| Randomize
// The board, in cells: LW columns, LH rows, LCELL pixels per cell. Below it the page shows a status strip.
let LW = 40
let LH = 30
let LCELL = 16
let STRIP = 24
let initialLife (seed: uint32) : LifeState =
{ Cells = []
Running = false
Seed = seed
Generation = 0 }
+71
View File
@@ -0,0 +1,71 @@
/// m13 life rules: the next generation is a function of the whole old board, and nothing else.
module Snake.Life.Rules
open Snake
open Snake.Model
open Snake.Life.Model
// Every cell of the board, row-major (y, then x). Filtering this list keeps any result in canonical order for free.
let private board: Point list =
[ for y in 0 .. LH - 1 do
for x in 0 .. LW - 1 -> { X = x; Y = y } ]
let private onBoard (p: Point) : bool = p.X >= 0 && p.X < LW && p.Y >= 0 && p.Y < LH
// A cell's position in row-major order: the order the canonical list is sorted by.
let private index (p: Point) : int = p.Y * LW + p.X
let private offsets = [ (-1, -1); (0, -1); (1, -1); (-1, 0); (1, 0); (-1, 1); (0, 1); (1, 1) ]
// The up to eight neighbours of `p` that are on the board (the edges are dead: nothing wraps around).
let private neighbours (p: Point) : Point list =
offsets |> List.map (fun (dx, dy) -> { X = p.X + dx; Y = p.Y + dy }) |> List.filter onBoard
// B3/S23, every cell judged on the *old* list only. A Set of the old cells makes "is this neighbour alive?" one
// lookup, so a generation is 1200 x 8 lookups however many cells live. The set is built once and only read.
let lifeStep (cells: Point list) : Point list =
let alive = Set.ofList cells
let count p = neighbours p |> List.filter alive.Contains |> List.length
board
|> List.filter (fun p ->
let n = count p
n = 3 || (n = 2 && alive.Contains p))
// Add a dead cell or remove a live one, keeping the list sorted row-major without duplicates. Off the board: unchanged.
let private toggle (cells: Point list) (p: Point) : Point list =
if not (onBoard p) then
cells
elif List.contains p cells then
List.filter (fun c -> c <> p) cells
else
List.filter (fun c -> index c < index p) cells
@ [ p ]
@ List.filter (fun c -> index c > index p) cells
// A random board: one `intBelow 4` per cell in row-major order, the cell alive when the draw is 0 (about one cell in
// four). mapFold threads the seed through the 1200 draws; the result is the cells and the seed after the last draw.
let private randomCells (seed: uint32) : Point list * uint32 =
let draws, next = List.mapFold (fun s _ -> Random.run s (Random.intBelow 4)) seed board
List.zip board draws |> List.filter (fun (_, d) -> d = 0) |> List.map fst, next
let private nextGeneration (state: LifeState) : LifeState =
{ state with
Cells = lifeStep state.Cells
Generation = state.Generation + 1 }
let lifeUpdate (state: LifeState) (action: LifeAction) : LifeState =
match action with
| LifeAction.Frame -> if state.Running then nextGeneration state else state
| LifeAction.Step -> if state.Running then state else nextGeneration state
| LifeAction.TogglePause -> { state with Running = not state.Running }
// Clicking edits the world whether it runs or not: the click is one action between two generations.
| LifeAction.Toggle p -> { state with Cells = toggle state.Cells p }
| LifeAction.Clear -> { state with Cells = []; Generation = 0 }
| LifeAction.Randomize ->
let cells, seed = randomCells state.Seed
{ state with
Cells = cells
Seed = seed
Generation = 0 }
+17
View File
@@ -0,0 +1,17 @@
/// m13 life view: live cells as squares, and a status strip under the board.
module Snake.Life.View
open Snake.View
open Snake.Life.Model
let private text x y str align = Text(x, y, str, "#ffffff", 14, align)
let private W = LW * LCELL
let private H = LH * LCELL
let lifeView (state: LifeState) : Scene =
[ Rect(0, 0, W, H, "#111111") ]
@ (state.Cells |> List.map (fun p -> Rect(p.X * LCELL + 1, p.Y * LCELL + 1, LCELL - 2, LCELL - 2, "#7cb342")))
@ [ Rect(0, H, W, STRIP, "#222222")
text 6 (H + 17) $"Generation {state.Generation}" "left"
text (W - 6) (H + 17) (if state.Running then "Running: Space pauses" else "Paused: Space runs, N steps") "right" ]
+5 -2
View File
@@ -25,6 +25,7 @@ type Action =
| Frame
/// The whole game. `Snake` is head first; `Seed` is the unsigned 32-bit random seed.
/// `Frame` and `Queued` stay unused until m10 (`Queued` holds a turn waiting for the next step).
type GameState =
{ Width: int
Height: int
@@ -35,7 +36,8 @@ type GameState =
Seed: uint32
Score: int
Status: Status
Frame: int }
Frame: int
Queued: Direction option }
let delta (dir: Direction) : Point =
match dir with
@@ -61,4 +63,5 @@ let initialState (seed: uint32) : GameState =
Seed = seed
Score = 0
Status = Playing
Frame = 0 }
Frame = 0
Queued = None }
+4 -1
View File
@@ -33,4 +33,7 @@ let pongStates (seed: uint32) (actions: Stream<PongAction>) : Stream<PongState>
let pongMain () : IO<Stream<IO<unit>>> =
IO.randomSeed ()
|> IO.map (fun seed -> pongStates seed pongActions |> Stream.map (fun state -> IO.drawScene (pongView state)))
|> IO.map (fun seed ->
pongStates seed pongActions
|> Stream.map (fun state -> IO.drawScene (pongView state))
|> Stream.clampTime App.MAX_GAP_MS)
+2 -1
View File
@@ -89,5 +89,6 @@ let pongUpdate (state: PongState) (action: PongAction) : PongState =
match action with
| PongAction.Press key -> setHeld state key true
| PongAction.Release key -> setHeld state key false
| PongAction.Restart -> initialPong state.Seed
// A new match, but the keys are still where the player's fingers are.
| PongAction.Restart -> { initialPong state.Seed with Held = state.Held }
| PongAction.Frame -> frame state
+96
View File
@@ -0,0 +1,96 @@
/// m10 replay viewer: a recorded game is a seed and a list of actions; watching it is a second, tiny program
/// whose state is only a position in the list of the game's states.
module Snake.Replay
open Snake.Model
open Snake.View
open Snake.IO
open Snake.Stream
type Recording = { Seed: uint32; Actions: Action list }
type Viewer = { Index: int; Last: int; Playing: bool }
[<RequireQualifiedAccess>]
type ViewerAction =
| Next
| Prev
| First
| Last
| TogglePlay
| Beat
let REPLAY_MS = 100L
// Every state of the recorded game, from the new game to the end: the recording replayed with `history`.
let frames (recording: Recording) : GameState list =
Game.history (Spawn.newGame recording.Seed) recording.Actions
let viewerStart (last: int) : Viewer = { Index = 0; Last = last; Playing = false }
// Where each action moves the viewer, and whether it plays afterwards (before the end-of-recording rule).
let private move (v: Viewer) (action: ViewerAction) : Viewer =
let clamp i = min v.Last (max 0 i)
match action with
| ViewerAction.Next -> { v with Index = clamp (v.Index + 1) }
| ViewerAction.Prev -> { v with Index = clamp (v.Index - 1) }
| ViewerAction.First -> { v with Index = 0 }
| ViewerAction.Last -> { v with Index = v.Last }
// Play from the end means: watch it again from the start.
| ViewerAction.TogglePlay ->
if v.Playing then
{ v with Playing = false }
else
{ v with
Index = (if v.Index = v.Last then 0 else v.Index)
Playing = true }
| ViewerAction.Beat -> if v.Playing then { v with Index = clamp (v.Index + 1) } else v
// The index never leaves [0, Last], and the viewer never plays on the last frame, so autoplay stops by itself.
let viewerUpdate (viewer: Viewer) (action: ViewerAction) : Viewer =
let next = move viewer action
{ next with Playing = next.Playing && next.Index < next.Last }
let viewerKey (key: string) : ViewerAction option =
match key with
| "ArrowRight" | "d" | "D" -> Some ViewerAction.Next
| "ArrowLeft" | "a" | "A" -> Some ViewerAction.Prev
| "Home" -> Some ViewerAction.First
| "End" -> Some ViewerAction.Last
| " " -> Some ViewerAction.TogglePlay
| _ -> None
// The game's own picture of the current frame, then the position at the top right and a hint at the bottom.
let viewerView (frames: GameState list) (viewer: Viewer) : Scene =
let game = List.item viewer.Index frames
let w = game.Width * CELL
let hint =
if viewer.Playing then
"Space: pause"
else
"Left/Right: step Home/End: jump Space: play"
View.view game
@ [ Text(w - 6, 18, $"step {viewer.Index} / {viewer.Last}", "#ffffff", 16, "right")
Text(w / 2, game.Height * CELL - 8, hint, "#aaaaaa", 12, "center") ]
let replayActions: Stream<ViewerAction> =
Stream.merge
(Stream.interval REPLAY_MS |> Stream.map (fun _ -> ViewerAction.Beat))
(Stream.keyDowns |> Stream.choose viewerKey)
let viewerStates (last: int) (actions: Stream<ViewerAction>) : Stream<Viewer> =
actions |> Stream.scan viewerUpdate (viewerStart last) |> Stream.startWith (viewerStart last)
// It needs no seed from the world (the recording has one), so it starts with `pure`.
// The frames are computed once, here, and every drawing picks one of them.
let replayMain (recording: Recording) : IO<Stream<IO<unit>>> =
let fs = frames recording
IO.pure (
viewerStates (List.length fs - 1) replayActions
|> Stream.map (fun v -> IO.drawScene (viewerView fs v))
|> Stream.clampTime App.MAX_GAP_MS
)
+12 -1
View File
@@ -11,14 +11,23 @@ type Platform =
{ FillRect: int -> int -> int -> int -> string -> unit
FillText: int -> int -> string -> string -> int -> string -> unit
RandomSeed: unit -> uint32
// m10: the stored best score; reading must never fail (anything unreadable is 0).
LoadBest: unit -> int
SaveBest: int -> unit
StartClock: (int64 -> unit) -> unit
OnKeyDown: (string -> unit) -> unit
OnKeyUp: (string -> unit) -> unit }
OnKeyUp: (string -> unit) -> unit
// m13: clicks on the canvas, in canvas pixels.
OnClick: (int -> int -> unit) -> unit }
// Perform one op on the platform and return its answer.
let private perform (p: Platform) (op: Op) : OpResult =
match op with
| RandomSeed -> Seed(p.RandomSeed())
| LoadBest -> Best(p.LoadBest())
| SaveBest score ->
p.SaveBest score
Done
| Draw(Rect(x, y, w, h, color)) ->
p.FillRect x y w h color
Done
@@ -43,4 +52,6 @@ let runApp (p: Platform) (main: IO<Stream<IO<unit>>>) : unit =
p.OnKeyDown(fun key -> feed (KeyDown key))
p.OnKeyUp(fun key -> feed (KeyUp key))
// m13: a fourth kind of event. Programs that do not listen for clicks simply ignore them.
p.OnClick(fun x y -> feed (Click(x, y)))
p.StartClock(fun t -> feed (Time t))
+65
View File
@@ -0,0 +1,65 @@
/// m07b safeio (optional): a stack-safe IO. Same idea as m07's IO, plus one more case, so that `bind` only builds
/// data and no program shape can overflow the stack, however deeply its `bind`s are nested.
/// - `Pure a` done, with a value
/// - `Effect (op, k)` perform `op`, then continue with `k result`
/// - `FlatMap (io, f)` run `io`, then continue with `f result`
/// The ops, their answers and the result of `trace` are m07's `IO.Op`, `IO.OpResult` and `IO.Traced`.
/// (Not `open Snake.IO`: its cases are also called Pure and Effect.)
module Snake.SafeIO
/// `FlatMap`'s inner program produces some type `X` that only its continuation knows. A union case cannot have a
/// type parameter of its own, so `X` is erased to `obj`; only `bind` builds a `FlatMap`, and it keeps the two in step.
type SafeIO<'a> =
| Pure of 'a
| Effect of IO.Op * (IO.OpResult -> SafeIO<'a>)
| FlatMap of SafeIO<obj> * (obj -> SafeIO<'a>)
// Given: the same program, seen as a SafeIO<obj>. Constant work: continuations are wrapped, not called.
let rec private erase (io: SafeIO<'a>) : SafeIO<obj> =
match io with
| Pure a -> Pure(box a)
| Effect(op, k) -> Effect(op, fun r -> erase (k r))
| FlatMap(m, g) -> FlatMap(m, fun x -> erase (g x))
let pure (a: 'a) : SafeIO<'a> = Pure a
let effect (op: IO.Op) : SafeIO<IO.OpResult> = Effect(op, pure)
// Only builds a node: never calls f, not even when io is Pure. The unbox cannot fail: x is the result of `io`.
let bind (f: 'a -> SafeIO<'b>) (io: SafeIO<'a>) : SafeIO<'b> = FlatMap(erase io, fun x -> f (unbox<'a> x))
let map (f: 'a -> 'b) (io: SafeIO<'a>) : SafeIO<'b> = io |> bind (fun a -> Pure(f a))
// A left fold on purpose: with SafeIO the nesting no longer matters.
let sequence (ios: SafeIO<unit> list) : SafeIO<unit> = List.fold (fun acc io -> acc |> bind (fun () -> io)) (pure ()) ios
// One rewrite towards a program whose top is a Pure or an Effect. Constant work, no recursion.
// FlatMap(Pure a, f) -> f a
// FlatMap(Effect(op, k), f) -> Effect(op, fun r -> FlatMap(k r, f))
// FlatMap(FlatMap(m, g), f) -> FlatMap(m, fun x -> FlatMap(g x, f)) (re-association)
// Pure and Effect are already in that shape and come back unchanged.
let step (io: SafeIO<'a>) : SafeIO<'a> =
match io with
| FlatMap(Pure x, f) -> f x
| FlatMap(Effect(op, k), f) -> Effect(op, fun r -> FlatMap(k r, f))
| FlatMap(FlatMap(m, g), f) -> FlatMap(m, fun x -> FlatMap(g x, f))
| other -> other
// Given: the canned answer of the pure interpreter, as in m07. SafeIO keeps Module 7's two operations; the stored
// best score of Module 10 is not part of it, so its operations are refused loudly rather than given a meaning here.
let private answer (seed: uint32) (op: IO.Op) : IO.OpResult =
match op with
| IO.RandomSeed -> IO.Seed seed
| IO.Draw _ -> IO.Done
| IO.LoadBest
| IO.SaveBest _ -> failwith "SafeIO.trace answers only Module 7's operations (Draw and RandomSeed)"
// `loop` calls itself only in tail position, so the compiler turns it into a loop: the stack stays flat.
let trace (seed: uint32) (io: SafeIO<'a>) : IO.Traced<'a> =
let rec loop (current: SafeIO<'a>) (performed: IO.Op list) : IO.Traced<'a> =
match current with
| Pure a -> { IO.Result = a; IO.Ops = List.rev performed }
| Effect(op, k) -> loop (k (answer seed op)) (op :: performed)
| FlatMap _ -> loop (step current) performed
loop io []
+8
View File
@@ -10,17 +10,25 @@
<Compile Include="Model.fs" />
<Compile Include="Rules.fs" />
<Compile Include="Random.fs" />
<Compile Include="State.fs" />
<Compile Include="Spawn.fs" />
<Compile Include="Game.fs" />
<Compile Include="View.fs" />
<Compile Include="IO.fs" />
<Compile Include="SafeIO.fs" />
<Compile Include="Stream.fs" />
<Compile Include="Input.fs" />
<Compile Include="App.fs" />
<Compile Include="Runtime.fs" />
<Compile Include="Replay.fs" />
<Compile Include="Pong/Model.fs" />
<Compile Include="Pong/Rules.fs" />
<Compile Include="Pong/View.fs" />
<Compile Include="Pong/App.fs" />
<Compile Include="Life/Model.fs" />
<Compile Include="Life/Rules.fs" />
<Compile Include="Life/View.fs" />
<Compile Include="Life/App.fs" />
<Compile Include="Check.fs" />
</ItemGroup>
</Project>
+27
View File
@@ -0,0 +1,27 @@
/// m04 state (optional, Exercise 4.7): the general pattern behind Random. A `State<'s, 'a>` wraps a function
/// `s -> (value, nextS)`: it reads a state, produces a value and hands on a new state. `Random<'a>` is
/// `State<uint32, 'a>`. Nothing in the game uses this file; it is here to show that Random was one example of a bigger idea.
module Snake.State
type State<'s, 'a> = State of ('s -> 'a * 's)
let run (s: 's) (State f: State<'s, 'a>) : 'a * 's = f s
let pure (a: 'a) : State<'s, 'a> = State(fun s -> (a, s))
let map (f: 'a -> 'b) (st: State<'s, 'a>) : State<'s, 'b> =
State(fun s ->
let a, next = run s st
(f a, next))
let bind (f: 'a -> State<'s, 'b>) (st: State<'s, 'a>) : State<'s, 'b> =
State(fun s ->
let a, next = run s st
run next (f a))
// A function of unit: a generic module-level value is not allowed in F#.
let get () : State<'s, 's> = State(fun s -> (s, s))
let put (s: 's) : State<'s, unit> = State(fun _ -> ((), s))
let modify (f: 's -> 's) : State<'s, unit> = State(fun s -> ((), f s))
+30 -1
View File
@@ -2,11 +2,13 @@
/// There is no hidden state: whatever a stream "remembers" lives in the next stream it returns.
module Snake.Stream
/// Something that happens to the program: time passing (ms since start) or a key going down or up.
/// Something that happens to the program: time passing (ms since start) or a key going down or up, and from
/// Module 13 a mouse click at `(x, y)` in canvas pixels. Every stream ignores the kinds of event it does not use.
type Event =
| Time of int64
| KeyDown of string
| KeyUp of string
| Click of int * int
type Stream<'a> = Stream of (Event -> 'a list * Stream<'a>)
@@ -31,6 +33,16 @@ let keyUps: Stream<string> =
source ()
// (m13, given in src/) The position of every Click event, in canvas pixels. Like the key sources it remembers nothing.
let clicks: Stream<int * int> =
let rec source () =
Stream(fun e ->
match e with
| Click(x, y) -> [ (x, y) ], source ()
| _ -> [], source ())
source ()
// `last` is the time of the previous Time event. Multiples of ms in (last, t] fire, ascending.
let rec private intervalFrom (ms: int64) (last: int64) : Stream<int64> =
Stream(fun e ->
@@ -76,6 +88,23 @@ let startWith (v: 'a) (s: Stream<'a>) : Stream<'a> =
let out, next = step e s
v :: out, next)
// (m10) `last` is the previous real time, `clock` the time the inner stream has been told. A long silence
// (a background tab) moves `clock` by at most `maxGap`, so the inner stream never has to catch up on minutes of beats.
let rec private clampFrom (maxGap: int64) (last: int64) (clock: int64) (s: Stream<'a>) : Stream<'a> =
Stream(fun e ->
match e with
| Time t ->
let now = clock + min (max (t - last) 0L) maxGap
let out, next = step (Time now) s
out, clampFrom maxGap t now next
| KeyDown _
| KeyUp _
| Click _ ->
let out, next = step e s
out, clampFrom maxGap last clock next)
let clampTime (maxGap: int64) (s: Stream<'a>) : Stream<'a> = clampFrom maxGap 0L 0L s
// mapFold threads the stream through the events like fold, and keeps each step's outputs.
let run (events: Event list) (s: Stream<'a>) : 'a list =
List.mapFold (fun stream e -> step e stream) s events |> fst |> List.concat
+39 -2
View File
@@ -2,6 +2,7 @@
module Snake.App
open Snake.Model
open Snake.View
open Snake.IO
open Snake.Stream
@@ -11,6 +12,9 @@ let TICK_MS = 150L
/// Milliseconds between animation frames (m10).
let FRAME_MS = 25L
/// (m10) The longest step of time the game accepts at once, in milliseconds (see `clampTime` in Stream.fs).
let MAX_GAP_MS = 250L
/// Stream of everything that can happen to the game: `Tick` every TICK_MS (from `Stream.interval`),
/// merged with the action for each key press that `Input.keyToAction` recognises (from `Stream.keyDowns`).
/// (The stub is wrapped in `Stream` so the TODO only fires when the stream is stepped.)
@@ -27,7 +31,40 @@ let states (seed: uint32) (actions: Stream<Action>) : Stream<GameState> = failwi
/// The drawing of one state, as an IO: `IO.drawScene (View.view state)`.
let render (state: GameState) : IO<unit> = failwith "TODO m09"
/// (m10) A session: the game, the best score so far, and whether the action that produced this session raised the best.
type Session = { Game: GameState; Best: int; Improved: bool }
/// (m10) One action: `game' = Game.update session.Game action`, `best' = max session.Best game'.Score`,
/// `improved = best' > session.Best` (strictly greater: equalling the record is not a new record).
let sessionUpdate (session: Session) (action: Action) : Session = failwith "TODO m10"
/// (m10) Like `states`, one level up: scan with `sessionUpdate` from `s0`, and emit `s0` first (startWith),
/// with `s0 = { Game = Spawn.newGame seed; Best = best; Improved = false }`.
let sessions (seed: uint32) (best: int) (actions: Stream<Action>) : Stream<Session> = failwith "TODO m10"
/// (m10) `View.view session.Game` followed by one more shape: the text `Best: <best>` at the top right,
/// `Text(game.Width * CELL - 6, 18, "Best: 3", "#ffffff", 16, "right")`.
let sessionView (session: Session) : Scene = failwith "TODO m10"
/// (m10) `IO.drawScene (sessionView session)`, followed by `IO.saveBest session.Best` when `session.Improved`
/// (and only then).
let renderSession (session: Session) : IO<unit> = failwith "TODO m10"
/// The whole program as a value: ask for a random seed, then turn the stream of states (built from `classicActions`
/// in m09, from `speedActions` after m10) into a stream of drawings (`render`). Nothing runs here.
/// A function of `unit`, like `IO.randomSeed`.
/// in m09, from `speedActions` after m10) into a stream of drawings (`render`).
/// (m10) The whole stream is wrapped in `Stream.clampTime MAX_GAP_MS`.
/// (m10, Exercise 10.7) After the seed, ask for the stored best (`IO.loadBest ()`), and draw the stream of
/// `sessions seed best speedActions` with `renderSession` instead of the states with `render`.
/// Nothing runs here. A function of `unit`, like `IO.randomSeed`.
let main () : IO<Stream<IO<unit>>> = failwith "TODO m09"
/// (m10) `play` that also passes `best` to both traces (`IO.traceWith seed best`), so that `LoadBest` is answered
/// with it.
let playWith (seed: uint32) (best: int) (events: Event list) (main: IO<Stream<IO<unit>>>) : Op list list =
failwith "TODO m10"
/// (m09) The whole program in one equality: for each drawing that `main` emits while it is fed `events` (a list of
/// inputs), the list of ops that drawing performs. Interpret `main` with `IO.trace seed`, `Stream.run` the stream it
/// produces on `events`, and trace each emitted IO with the same seed, keeping its `Ops`.
/// (m10) Once `playWith` (above) is written, `play` becomes its "no stored best" case: `playWith seed 0 events main`.
let play (seed: uint32) (events: Event list) (main: IO<Stream<IO<unit>>>) : Op list list = failwith "TODO m09"
+126
View File
@@ -0,0 +1,126 @@
/// m12 check: property-based testing, built from the course's own parts.
/// A generator of test data is nothing new: it is a `Random<'a>` from Random.fs (`seed -> (value, nextSeed)`).
module Snake.Check
open Snake.Model
open Snake.Random
/// What `forAll` reports: every value passed (`Passed runs`), or the first one that did not (`Failed`, see `forAll`).
type CheckResult<'a> =
| Passed of runs: int
| Failed of run: int * seed: uint32 * value: 'a
/// A Random that gives one of the elements of the non-empty list `xs`: the element at index `i`,
/// where `i` is drawn with `Random.intBelow (List.length xs)`.
let elementOf (xs: 'a list) : Random<'a> = failwith "TODO m12"
/// A Random that gives a list of `n` values drawn from `gen`, one after another: the first draw starts from the
/// incoming seed, each later draw from the seed the previous one left behind, and the last draw's seed is the result's.
/// `listOf 0 gen` gives `[]` and leaves the seed alone. No loop: recursion on `n`, with `Random.bind` and `Random.map`.
let listOf (n: int) (gen: Random<'a>) : Random<'a list> = failwith "TODO m12"
// Ticks appear three times so that the snake moves more often than it turns.
let private actionPool: Action list =
[ Tick; Tick; Tick; Turn Up; Turn Down; Turn Left; Turn Right ]
/// A generator of `n` random actions (given; it works once `elementOf` and `listOf` do).
let genActions (n: int) : Random<Action list> = listOf n (elementOf actionPool)
/// Check the property `prop` (a function value -> bool) on `runs` values drawn from `gen`.
/// The first value is drawn from `seed`, each later one from the seed the previous draw left behind.
/// Stop at the first value for which `prop` is false.
/// Result: `Passed runs` when every value passed, otherwise `Failed(run, seed, value)`, where `run` is the 0-based
/// number of the failing draw, `value` is the counterexample and `seed` is the seed that draw started from
/// (so `Random.run seed gen |> fst` gives `value` again).
/// Write it with a tail-recursive helper that carries the run number and the seed.
let forAll (runs: int) (seed: uint32) (prop: 'a -> bool) (gen: Random<'a>) : CheckResult<'a> = failwith "TODO m12"
/// Every list that is `xs` with exactly one element removed, in the order of the removed index:
/// `removals [ 1; 2; 3 ]` is `[ [ 2; 3 ]; [ 1; 3 ]; [ 1; 2 ] ]`; `removals []` is `[]`.
let removals (xs: 'a list) : 'a list list = failwith "TODO m12"
/// Shrink a failing list. `fails` is a function list -> bool and `fails xs` is true.
/// If some list in `removals xs` still fails, continue with the first one that does; when none fails, return `xs`.
/// The result is "1-minimal": it fails, and removing any single element makes it pass.
let minimize (fails: 'a list -> bool) (xs: 'a list) : 'a list = failwith "TODO m12"
/// The names of the invariants that `state` breaks, in this order (an empty list means the state is sane):
/// "snake-not-empty" the snake has at least one cell
/// "snake-in-bounds" every cell of the snake is on the board
/// "snake-no-overlap" no two cells of the snake are equal
/// "snake-connected" each cell of the snake is exactly one step (up, down, left or right) from the one before it
/// "apple-in-bounds" the apple, if there is one (`Some`), is on the board
/// "apple-not-on-snake" the apple, if there is one (`Some`), is not on a cell of the snake
/// "turn-not-reversed" `NextDir` is not the opposite of `Dir`
/// "queued-not-reversed" `Queued` is `None`, or is not the opposite of `NextDir`
/// No apple (`None`) breaks neither apple invariant.
let violations (state: GameState) : string list = failwith "TODO m12"
/// Given the states of a game in order, the snake "moves at index i" (i >= 1) when the head of `states[i]`
/// differs from the head of `states[i - 1]`. `moveGaps states` is the list of differences between consecutive
/// such indices: moves at 2, 5 and 12 give `[ 3; 7 ]`. Fewer than two moves give `[]`.
let moveGaps (states: GameState list) : int list = failwith "TODO m12"
// ---- random states (Exercise 12.6) and a second implementation of the step as an oracle (Exercise 12.7)
/// (Exercise 12.6) A Random that gives a snake, head first, on a `width` x `height` board, with at most `maxLen` cells
/// (`maxLen >= 1`). The draws, in this exact order (so that every track gets the same snake from the same seed):
/// 1. the head: `x` with `Random.intBelow width`, then `y` with `Random.intBelow height`;
/// 2. then, while the snake has fewer than `maxLen` cells: look at the neighbours of its *last* cell, in the order
/// Up, Down, Left, Right (`Rules.move last dir`), and keep those that are on the board and not yet in the snake.
/// If none is left, stop early (with `Random.pure`, no draw). Otherwise append the one picked with
/// `elementOf neighbours` and go on.
/// So the result is always on the board, connected and free of overlap. No loop: recursion, with `Random.bind`.
let genSnake (width: int) (height: int) (maxLen: int) : Random<Point list> = failwith "TODO m12"
let private directions: Direction list = [ Up; Down; Left; Right ]
// The direction the head moved in to get from the second cell to the first (`Right` for a one-cell snake).
let private headingOf (snake: Point list) : Direction =
match snake with
| head :: second :: _ -> directions |> List.find (fun d -> Rules.move second d = head)
| _ -> Right
/// A random sane Playing state on a `width` x `height` board (given; it works once `genSnake` does). Draws in order:
/// the snake's length limit `n + 1` with `n` from `Random.intBelow (width * height)`; the snake with `genSnake`;
/// `NextDir` with `elementOf` among Up, Down, Left, Right without the opposite of `Dir` (so: `Dir` or a perpendicular
/// direction); a coin `Random.intBelow 2`: 0 means no apple, 1 means an apple at `elementOf (Spawn.freeCells ...)`
/// (no apple if no cell is free). `Dir` is the direction from the snake's second cell to its head (`Right` for a
/// one-cell snake); seed, score and frame are 0, `Queued` is `None`.
let genState (width: int) (height: int) : Random<GameState> =
Random.intBelow (width * height)
|> Random.bind (fun n ->
genSnake width height (n + 1)
|> Random.bind (fun snake ->
let dir = headingOf snake
let state =
{ Width = width
Height = height
Snake = snake
Dir = dir
NextDir = dir
Apple = None
Seed = 0u
Score = 0
Status = Playing
Frame = 0
Queued = None }
let free = Spawn.freeCells state
elementOf (directions |> List.filter (fun d -> d <> opposite dir))
|> Random.bind (fun nextDir ->
Random.intBelow 2
|> Random.bind (fun coin ->
(if coin = 0 || List.isEmpty free then Random.pure None else elementOf free |> Random.map Some)
|> Random.map (fun apple -> { state with NextDir = nextDir; Apple = apple })))))
/// (Exercise 12.7) The step of m03, written straight from the rules, as a second opinion on `Rules.advance`.
/// Not Playing: the state unchanged. Otherwise build the snake the step would produce: the new head
/// (`Rules.move head NextDir`) in front, followed by the old snake, without its last cell unless the new head is on
/// the apple. Then ask `violations` about the state with that snake: if the list contains "snake-in-bounds" or
/// "snake-no-overlap", the result is m03's game over (`Dir = NextDir`, `Status = GameOver`, nothing else changed);
/// otherwise the state with the new snake, `Dir = NextDir`, and, when eating, `Apple = None` and the score one higher.
/// Do not call `Rules.advance`. On every sane state the result must equal `Rules.advance state`.
let advanceSpec (state: GameState) : GameState = failwith "TODO m12"
+14 -2
View File
@@ -3,6 +3,13 @@ module Snake.Game
open Snake.Model
/// (m10, Exercise 10.6) What `update` does with `Turn dir` from m10 on (the turn queue).
/// - not Playing: the state unchanged;
/// - no turn pending (`NextDir = Dir`): `Rules.turn state dir`, the m03 rule;
/// - a turn pending (`NextDir <> Dir`): if `dir` is neither `NextDir` nor `opposite NextDir`, the state with
/// `Queued = Some dir` (a later key replaces an earlier queued one); otherwise the state unchanged.
let steer (state: GameState) (dir: Direction) : GameState = failwith "TODO m10"
/// 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"
@@ -14,8 +21,13 @@ let movesEvery (score: int) : int = failwith "TODO m10"
///
/// (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.
/// (m10) `Frame` does nothing unless Playing. Otherwise it counts the frame: `n = Frame + 1`. While `n` is below
/// `movesEvery Score` the result is the state with `Frame = n`. When `n` reaches `movesEvery Score` (`n >= ...`),
/// the count starts again and the game takes a step: the result is `Spawn.tick` of the state with `Frame = 0`.
/// So `Frame` is the number of frames since the snake last moved.
/// (m10, Exercise 10.6) The turn queue: `Turn` uses `steer` instead of `Rules.turn`, and after every game step `update`
/// takes (the `Tick` case and the stepping branch of `Frame`), if the result is Playing and `Queued` is `Some d`,
/// the result gets `NextDir = d` and `Queued = None`. A result that is not Playing keeps `Queued` as it is.
/// 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"
+20 -1
View File
@@ -1,6 +1,8 @@
/// m07 io: effects as values. An `IO<'a>` is a description of a program that, when interpreted, produces an `'a`:
/// - `Pure a` finished, nothing left to do
/// - `Effect (op, k)` perform `op`, then continue with `k result` (which returns another IO)
/// (m10) Two more operations, for a best score that survives a reload: `LoadBest` (answered with `Best value`, the
/// stored best) and `SaveBest score` (answered with `Done`).
/// Building an IO never performs anything; only an interpreter (`trace` here, `Runtime.runIO` in m09) does.
module Snake.IO
@@ -10,11 +12,17 @@ open Snake.View
type Op =
| Draw of Shape
| RandomSeed
/// (m10) Read the stored best score.
| LoadBest
/// (m10) Store `score` as the new best.
| SaveBest of int
/// What the outside world answers: `Done` for a `Draw`, `Seed value` (an unsigned 32-bit number) for a `RandomSeed`.
/// What the outside world answers: `Done` for a `Draw`, `Seed value` (an unsigned 32-bit number) for a `RandomSeed`;
/// (m10) `Best value` for a `LoadBest`, `Done` for a `SaveBest`.
type OpResult =
| Done
| Seed of uint32
| Best of int
type IO<'a> =
| Pure of 'a
@@ -50,7 +58,18 @@ let randomSeed () : IO<uint32> = failwith "TODO m07"
/// Draw every shape of a scene in order: `sequence (List.map draw scene)`.
let drawScene (scene: Scene) : IO<unit> = failwith "TODO m07"
/// (m10) An IO that reads the stored best score and produces it (the `value` of the `Best` answer).
/// A function of `unit`, like `randomSeed ()`; an answer other than `Best` is a broken interpreter: fail loudly.
let loadBest () : IO<int> = failwith "TODO m10"
/// (m10) An IO that stores `score` as the new best and produces `()`: built like `draw`, from `SaveBest score`.
let saveBest (score: int) : IO<unit> = failwith "TODO m10"
/// (m10) `trace` that also answers every `LoadBest` with `Best best` and every `SaveBest` with `Done`.
let traceWith (seed: uint32) (best: int) (io: IO<'a>) : Traced<'a> = failwith "TODO m10"
/// A pure interpreter for tests. Answers every `RandomSeed` with `Seed seed` and every `Draw` with `Done`.
/// Returns the final value and the operations in the order they were executed.
/// Implemented by recursion, with no mutation.
/// (m10) Once `traceWith` (above) is written, `trace` becomes its "no stored best" case: `traceWith seed 0 io`.
let trace (seed: uint32) (io: IO<'a>) : Traced<'a> = failwith "TODO m07"
+34
View File
@@ -0,0 +1,34 @@
/// m13 life app: the same wiring as Snake and Pong, with a third kind of input, the mouse.
module Snake.Life.App
open Snake
open Snake.IO
open Snake.Stream
open Snake.Life.Model
open Snake.Life.Rules
open Snake.Life.View
/// Milliseconds between two generations while the world runs.
let GEN_MS = 150L
/// A key press to a `LifeAction`, if any: " " -> TogglePause, "n"/"N" -> Step, "c"/"C" -> Clear,
/// "r"/"R" -> Randomize. Any other key -> `None`.
let lifeKey (key: string) : LifeAction option = failwith "TODO m13"
/// A click at canvas pixel `(x, y)` to `Toggle` of the cell under it (`x / LCELL` and `y / LCELL`, rounded down),
/// or `None` when the pixel is not on the board (left of it, above it, right of it, or in the status strip below it).
/// Careful: F# integer division rounds towards zero, so `-1 / 16` is 0. Check the pixel before you divide.
let lifeClick (x: int) (y: int) : LifeAction option = failwith "TODO m13"
/// Everything that can happen to the world: `Frame` every GEN_MS (from `Stream.interval`), merged with `lifeKey` of
/// every key press, merged with `lifeClick` of every click (`Stream.clicks`), in that order.
/// (The stub is wrapped in `Stream` so the TODO only fires when the stream is stepped.)
let lifeActions: Stream<LifeAction> = Stream(fun _ -> failwith "TODO m13")
/// Fold the actions into a stream of states: start from `initialLife seed`, `lifeUpdate` for each action, emit the
/// initial state first.
let lifeStates (seed: uint32) (actions: Stream<LifeAction>) : Stream<LifeState> = failwith "TODO m13"
/// The whole program as a value, like `App.main`: ask for a seed, turn the stream of states into a stream of drawings
/// of `lifeView`, and wrap that stream in `Stream.clampTime App.MAX_GAP_MS`. A function of `unit`, like `App.main`.
let lifeMain () : IO<Stream<IO<unit>>> = failwith "TODO m13"
+38
View File
@@ -0,0 +1,38 @@
/// m13 life model: the whole world is one value, like the snake and the match.
module Snake.Life.Model
open Snake.Model
/// The whole world. `Cells` are the live cells, always canonical: sorted row-major (by `Y`, then by `X`), each cell
/// at most once, all on the board. `Running` says whether generations follow each other on their own; `Seed` is the
/// unsigned 32-bit random seed used by `Randomize`; `Generation` counts the generations since the last Clear or
/// Randomize.
type LifeState =
{ Cells: Point list
Running: bool
Seed: uint32
Generation: int }
/// Everything that can happen to the world, as data. `Toggle` carries the cell that was clicked.
/// (RequireQualifiedAccess: Snake's `Action` also has `Frame` and `TogglePause`.)
[<RequireQualifiedAccess>]
type LifeAction =
| Frame
| Toggle of Point
| TogglePause
| Step
| Clear
| Randomize
// The board, in cells: LW columns, LH rows. Below it the page shows a status strip.
let LW = 40
let LH = 30
/// Pixels per cell.
let LCELL = 16
/// Height of the status strip under the board, in pixels.
let STRIP = 24
/// A fresh world: no live cells (`Cells = []`), paused (`Running = false`), the given seed, generation 0.
let initialLife (seed: uint32) : LifeState = failwith "TODO m13"
+27
View File
@@ -0,0 +1,27 @@
/// m13 life rules: the next generation is a function of the whole old board, and nothing else.
module Snake.Life.Rules
open Snake
open Snake.Model
open Snake.Life.Model
/// One generation of Conway's Life on the LW x LH board (B3/S23), from a canonical list of live cells to a canonical
/// list (sorted row-major: by `Y`, then `X`; no duplicates).
/// - A live cell with 2 or 3 live neighbours stays alive; a dead cell with exactly 3 live neighbours is born;
/// every other cell is dead in the next generation.
/// - The neighbours of a cell are the up to 8 cells around it that are on the board: the edges are dead,
/// nothing wraps around.
/// - Every cell is judged by the *old* board only.
let lifeStep (cells: Point list) : Point list = failwith "TODO m13"
/// The one function that says how the world changes.
/// - `Frame`: when running, the next generation (`lifeStep`) and `Generation + 1`; when paused, unchanged.
/// - `Step`: when paused, the next generation and `Generation + 1`; when running, unchanged.
/// - `TogglePause`: `Running` flips.
/// - `Toggle cell`: a dead cell becomes alive, a live one dead, whether the world runs or not; `Cells` stays canonical
/// (insert the new cell at its row-major place). A cell off the board changes nothing. `Generation` is unchanged.
/// - `Clear`: no live cells, generation 0; `Running` and `Seed` are kept.
/// - `Randomize`: draw `Random.intBelow 4` (Module 4) once for every cell of the board, in row-major order
/// (y = 0..LH-1, and within a row x = 0..LW-1), threading the seed from `state.Seed`; a cell is alive when its draw
/// is 0. The state gets those cells, the seed after the last draw, and generation 0; `Running` is kept.
let lifeUpdate (state: LifeState) (action: LifeAction) : LifeState = failwith "TODO m13"
+11
View File
@@ -0,0 +1,11 @@
/// m13 life view: live cells as squares, and a status strip under the board.
module Snake.Life.View
open Snake.View
open Snake.Life.Model
/// Describe the world as shapes, drawn in order (all text "#ffffff", size 14):
/// the board `Rect(0, 0, 640, 480, "#111111")`; one `Rect(x*16+1, y*16+1, 14, 14, "#7cb342")` per live cell, in the
/// order of `Cells`; the status strip `Rect(0, 480, 640, 24, "#222222")`; `Text(6, 497, "Generation <n>", align "left")`;
/// `Text(634, 497, "Running: Space pauses"` when running, else `"Paused: Space runs, N steps", align "right")`.
let lifeView (state: LifeState) : Scene = failwith "TODO m13"
+4 -2
View File
@@ -25,6 +25,7 @@ type Action =
| Frame
/// The whole game. `Snake` is head first; `Seed` is the unsigned 32-bit random seed.
/// `Frame` and `Queued` stay unused until m10 (`Queued` holds a turn waiting for the next step).
type GameState =
{ Width: int
Height: int
@@ -35,7 +36,8 @@ type GameState =
Seed: uint32
Score: int
Status: Status
Frame: int }
Frame: int
Queued: Direction option }
/// 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"
@@ -44,5 +46,5 @@ let delta (dir: Direction) : Point = failwith "TODO m02"
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.
/// no apple, the given seed, score 0, status Playing, frame 0, nothing queued (`Queued = None`).
let initialState (seed: uint32) : GameState = failwith "TODO m02"
+1 -1
View File
@@ -25,5 +25,5 @@ let pongActions: Stream<PongAction> = Stream(fun _ -> failwith "TODO m11")
let pongStates (seed: uint32) (actions: Stream<PongAction>) : Stream<PongState> = failwith "TODO m11"
/// The whole program as a value, like `App.main`: ask for a seed, turn the stream of states into a stream of drawings
/// of `pongView`. A function of `unit`, like `App.main`.
/// of `pongView`, and wrap that stream in `Stream.clampTime App.MAX_GAP_MS`. A function of `unit`, like `App.main`.
let pongMain () : IO<Stream<IO<unit>>> = failwith "TODO m11"
+1 -1
View File
@@ -11,7 +11,7 @@ let clamp (lo: int) (hi: int) (x: int) : int = failwith "TODO m11"
/// The one function that says how a match changes: `state -> action -> state`.
///
/// - `Press key` / `Release key`: set `Held.Up` or `Held.Down` to true / false (even when the match is over).
/// - `Restart`: `initialPong state.Seed`.
/// - `Restart`: `initialPong state.Seed`, except that `Held` is kept (the player may still be holding a key).
/// - `Frame`: unchanged unless status is Playing. Otherwise, in this order:
/// 1. `Frame + 1`.
/// 2. The player moves one cell down for `Held.Down` and one up for `Held.Up` (both cancel out),
+66
View File
@@ -0,0 +1,66 @@
/// m10 replay viewer: a recorded game is a seed and a list of actions; watching it is a second, tiny program
/// whose state is only a position in the list of the game's states.
module Snake.Replay
open Snake.Model
open Snake.View
open Snake.IO
open Snake.Stream
/// A recorded game: the seed of the game and every action, in order (see `fixtures/replay-sample.json`).
type Recording = { Seed: uint32; Actions: Action list }
/// The viewer: which frame is shown (`Index`, 0 = the new game, k = after k actions), the index of the last frame
/// (`Last`, the number of actions), and whether autoplay is on (`Playing`).
type Viewer = { Index: int; Last: int; Playing: bool }
/// Everything the viewer can be asked to do, as data. `Beat` is one beat of the autoplay clock.
/// (RequireQualifiedAccess: `ViewerAction.Last` must never be confused with anything else in scope.)
[<RequireQualifiedAccess>]
type ViewerAction =
| Next
| Prev
| First
| Last
| TogglePlay
| Beat
/// Milliseconds between two frames of autoplay.
let REPLAY_MS = 100L
/// Every state of the recorded game: `Game.history (Spawn.newGame seed) actions`. Its length is the number of
/// actions + 1.
let frames (recording: Recording) : GameState list = failwith "TODO m10"
/// The viewer at the first frame, not playing: `{ Index = 0; Last = last; Playing = false }`.
let viewerStart (last: int) : Viewer = failwith "TODO m10"
/// One step of the viewer; total, for every action and every viewer.
/// - `Next` / `Prev`: one frame forward / back, never past `Last` or below 0.
/// - `First` / `Last`: frame 0 / frame `Last`.
/// - `TogglePlay`: playing -> not playing. Not playing -> playing; at the last frame it starts again from frame 0.
/// - `Beat`: when playing, one frame forward (never past `Last`); when not playing, unchanged.
/// - After every action: a viewer at the last frame is not playing (so autoplay stops at the end by itself).
let viewerUpdate (viewer: Viewer) (action: ViewerAction) : Viewer = failwith "TODO m10"
/// A key to a viewer action, or `None`: "ArrowRight"/"d"/"D" -> Next, "ArrowLeft"/"a"/"A" -> Prev, "Home" -> First,
/// "End" -> Last, " " -> TogglePlay. Any other key -> `None`.
let viewerKey (key: string) : ViewerAction option = failwith "TODO m10"
/// The picture: `View.view` of the frame at `Index`, followed by two texts. With `w = Width * CELL` of that frame:
/// `Text(w - 6, 18, "step <index> / <last>", "#ffffff", 16, "right")` and
/// `Text(w / 2, Height * CELL - 8, <hint>, "#aaaaaa", 12, "center")`, where the hint is "Space: pause" while playing
/// and "Left/Right: step Home/End: jump Space: play" (three spaces between the parts) otherwise.
let viewerView (frames: GameState list) (viewer: Viewer) : Scene = failwith "TODO m10"
/// `Beat` every REPLAY_MS (from `Stream.interval`), merged with `viewerKey` of every key press (the beats first).
/// (The stub is wrapped in `Stream` so the TODO only fires when the stream is stepped.)
let replayActions: Stream<ViewerAction> = Stream(fun _ -> failwith "TODO m10")
/// Fold the actions into viewers with `viewerUpdate`, starting from `viewerStart last`, which is emitted first.
let viewerStates (last: int) (actions: Stream<ViewerAction>) : Stream<Viewer> = failwith "TODO m10"
/// The whole viewer as a value: `IO.pure` of the stream of drawings of `viewerView (frames recording) viewer` over
/// `viewerStates <last index> replayActions`, wrapped in `Stream.clampTime App.MAX_GAP_MS`.
/// No seed is asked for: the recording carries its own. Compute the frames once, not for every drawing.
let replayMain (recording: Recording) : IO<Stream<IO<unit>>> = failwith "TODO m10"
+9 -1
View File
@@ -13,14 +13,21 @@ type Platform =
FillText: int -> int -> string -> string -> int -> string -> unit
/// A random unsigned 32-bit seed.
RandomSeed: unit -> uint32
/// (m10) The stored best score; 0 when there is none or it cannot be read. Never throws.
LoadBest: unit -> int
/// (m10) Store a new best score.
SaveBest: int -> unit
/// Call `onTime t` again and again, `t` = milliseconds since the clock started.
StartClock: (int64 -> unit) -> unit
OnKeyDown: (string -> unit) -> unit
OnKeyUp: (string -> unit) -> unit }
OnKeyUp: (string -> unit) -> unit
/// (m13, given) Call `cb x y` for every click on the canvas, `x` and `y` in canvas pixels.
OnClick: (int -> int -> unit) -> unit }
/// Interpret an IO against a platform and return its final value.
/// `Draw` of a Rect -> `p.FillRect x y w h color` and of a Text -> `p.FillText x y text color size align`,
/// both answered with `Done`; `RandomSeed` -> `Seed (p.RandomSeed ())`. Each answer is passed to `k`.
/// (m10) `LoadBest` -> `Best (p.LoadBest ())`; `SaveBest score` -> `p.SaveBest score`, answered with `Done`.
/// Must not grow the stack with the number of ops: a loop, or a tail-recursive `let rec` (which the compiler
/// turns into a loop).
let runIO (p: Platform) (io: IO<'a>) : 'a = failwith "TODO m09"
@@ -29,4 +36,5 @@ let runIO (p: Platform) (io: IO<'a>) : 'a = failwith "TODO m09"
/// (F# closures cannot capture a `let mutable`, so use a ref cell: `let stream = ref ...`, `stream.Value <- next`).
/// Register `p.OnKeyDown` / `p.OnKeyUp` / `p.StartClock` so that each event steps the stream with the matching
/// `Event` (`KeyDown key`, `KeyUp key`, `Time t`), stores the next stream, and runs every IO the step emitted, in order.
/// (m13) Also register `p.OnClick` so that each click steps the stream with `Click(x, y)`.
let runApp (p: Platform) (main: IO<Stream<IO<unit>>>) : unit = failwith "TODO m09"
+63
View File
@@ -0,0 +1,63 @@
/// m07b (optional): a stack-safe IO. The same idea as m07's IO, with one more case:
/// - `Pure a` finished, with a value
/// - `Effect (op, k)` perform `op`, then continue with `k result` (which returns another SafeIO)
/// - `FlatMap (io, f)` run `io`, then continue with `f result` (which returns another SafeIO)
/// The ops, their answers and the result of `trace` are m07's: write them `IO.Op`, `IO.OpResult`, `IO.Traced`
/// (do not `open Snake.IO`: its cases are also called Pure and Effect). This module does not use m07's `IO` type;
/// it is a second, independent IO. Building a SafeIO never performs anything and never calls a function given to
/// `map` or `bind`.
module Snake.SafeIO
/// `FlatMap`'s inner program produces some type `X` that only its continuation knows. A union case cannot have a
/// type parameter of its own, so `X` is erased to `obj`; only `bind` builds a `FlatMap`, and it keeps the two in step.
type SafeIO<'a> =
| Pure of 'a
| Effect of IO.Op * (IO.OpResult -> SafeIO<'a>)
| FlatMap of SafeIO<obj> * (obj -> SafeIO<'a>)
// Given: the same program, seen as a SafeIO<obj>. Constant work: continuations are wrapped, not called.
let rec private erase (io: SafeIO<'a>) : SafeIO<obj> =
match io with
| Pure a -> Pure(box a)
| Effect(op, k) -> Effect(op, fun r -> erase (k r))
| FlatMap(m, g) -> FlatMap(m, fun x -> erase (g x))
/// A SafeIO that does nothing and produces `a`: `Pure a`.
let pure (a: 'a) : SafeIO<'a> = failwith "TODO m07b"
/// A SafeIO that performs the single operation `op` and produces its answer: `Effect (op, pure)`.
let effect (op: IO.Op) : SafeIO<IO.OpResult> = failwith "TODO m07b"
/// "Run `io`, then continue with `f result`": only builds a node, `FlatMap (erase io, fun x -> f (unbox<'a> x))`.
/// Never calls `f`, and never looks inside `io`.
let bind (f: 'a -> SafeIO<'b>) (io: SafeIO<'a>) : SafeIO<'b> = failwith "TODO m07b"
/// Transform the result of `io` with `f`, built from `bind` and `pure`. Never calls `f` while building.
let map (f: 'a -> 'b) (io: SafeIO<'a>) : SafeIO<'b> = failwith "TODO m07b"
/// Run the SafeIOs one after another, left to right, producing `()`. Either fold is fine here.
let sequence (ios: SafeIO<unit> list) : SafeIO<unit> = failwith "TODO m07b"
/// One rewrite towards a program whose top is a `Pure` or an `Effect`, with a constant amount of work:
/// FlatMap(Pure a, f) becomes f a
/// FlatMap(Effect(op, k), f) becomes Effect(op, fun r -> FlatMap(k r, f))
/// FlatMap(FlatMap(m, g), f) becomes FlatMap(m, fun x -> FlatMap(g x, f)) (re-association)
/// A `Pure` or an `Effect` is returned unchanged. No recursion: `step` looks at most two levels deep and calls no
/// function except `f` in the first rule. (The inner parts already have the erased types, so no `erase` is needed.)
let step (io: SafeIO<'a>) : SafeIO<'a> = failwith "TODO m07b"
// Given: the canned answer of the pure interpreter, as in m07. SafeIO keeps Module 7's two operations; the stored
// best score of Module 10 is not part of it, so its operations are refused loudly rather than given a meaning here.
let private answer (seed: uint32) (op: IO.Op) : IO.OpResult =
match op with
| IO.RandomSeed -> IO.Seed seed
| IO.Draw _ -> IO.Done
| IO.LoadBest
| IO.SaveBest _ -> failwith "SafeIO.trace answers only Module 7's operations (Draw and RandomSeed)"
/// The pure interpreter for tests. Answers every `RandomSeed` with `IO.Seed seed` and every `Draw` with `IO.Done`
/// (`answer seed op`). Returns the final value and the operations in the order they were performed.
/// Write it with an inner `let rec` that calls itself only in tail position (so the stack stays flat), one case per
/// constructor: a `Pure` is finished; an `Effect` is answered and continues with `k answer`, recording its op; a
/// `FlatMap` is rewritten once with `step`. Collect the ops at the front of a list and reverse it once at the end.
let trace (seed: uint32) (io: SafeIO<'a>) : IO.Traced<'a> = failwith "TODO m07b"
+8
View File
@@ -10,17 +10,25 @@
<Compile Include="Model.fs" />
<Compile Include="Rules.fs" />
<Compile Include="Random.fs" />
<Compile Include="State.fs" />
<Compile Include="Spawn.fs" />
<Compile Include="Game.fs" />
<Compile Include="View.fs" />
<Compile Include="IO.fs" />
<Compile Include="SafeIO.fs" />
<Compile Include="Stream.fs" />
<Compile Include="Input.fs" />
<Compile Include="App.fs" />
<Compile Include="Runtime.fs" />
<Compile Include="Replay.fs" />
<Compile Include="Pong/Model.fs" />
<Compile Include="Pong/Rules.fs" />
<Compile Include="Pong/View.fs" />
<Compile Include="Pong/App.fs" />
<Compile Include="Life/Model.fs" />
<Compile Include="Life/Rules.fs" />
<Compile Include="Life/View.fs" />
<Compile Include="Life/App.fs" />
<Compile Include="Check.fs" />
</ItemGroup>
</Project>
+28
View File
@@ -0,0 +1,28 @@
/// m04 state (optional, Exercise 4.7). A `State<'s, 'a>` wraps a plain function from a state to a pair:
/// `s -> (value, nextS)`. It is `Random<'a>` with the seed replaced by any state type `'s`.
/// Nothing in the game uses this file.
module Snake.State
type State<'s, 'a> = State of ('s -> 'a * 's)
/// Run `st` from the initial state `s`: the value it produces and the final state.
let run (s: 's) (st: State<'s, 'a>) : 'a * 's = failwith "TODO m04"
/// A State that gives `a` and leaves the state untouched: `s -> (a, s)`.
let pure (a: 'a) : State<'s, 'a> = failwith "TODO m04"
/// Transform the value a State produces; the state threading is unchanged.
let map (f: 'a -> 'b) (st: State<'s, 'a>) : State<'s, 'b> = failwith "TODO m04"
/// Run `st`, feed its value to `f` to pick the next State, and run that with the state `st` left behind.
let bind (f: 'a -> State<'s, 'b>) (st: State<'s, 'a>) : State<'s, 'b> = failwith "TODO m04"
/// A State whose value is the current state, which it leaves untouched: `s -> (s, s)`.
/// A function of unit (use it as `get ()`), because F# does not allow a generic module-level value.
let get () : State<'s, 's> = failwith "TODO m04"
/// A State that replaces the state with `s` and gives `()`: whatever the old state, `((), s)`.
let put (s: 's) : State<'s, unit> = failwith "TODO m04"
/// A State that replaces the state `s` with `f s` and gives `()`.
let modify (f: 's -> 's) : State<'s, unit> = failwith "TODO m04"
+22 -1
View File
@@ -3,11 +3,13 @@
/// the next event. Nothing is mutated, so a stream value can be run any number of times with the same results.
module Snake.Stream
/// Something that happens to the program: time passing (ms since start) or a key going down or up.
/// Something that happens to the program: time passing (ms since start) or a key going down or up, and from
/// Module 13 a mouse click at `(x, y)` in canvas pixels. Every stream ignores the kinds of event it does not use.
type Event =
| Time of int64
| KeyDown of string
| KeyUp of string
| Click of int * int
type Stream<'a> = Stream of (Event -> 'a list * Stream<'a>)
@@ -21,6 +23,17 @@ let keyDowns: Stream<string> = Stream(fun _ -> failwith "TODO m08")
/// Emits the `key` of every KeyUp event; ignores everything else.
let keyUps: Stream<string> = Stream(fun _ -> failwith "TODO m08")
/// (m13) Emits the position `(x, y)` of every Click event; ignores everything else.
/// Given: nothing to write here. It is the third source, built exactly like your `keyDowns`.
let clicks: Stream<int * int> =
let rec source () =
Stream(fun e ->
match e with
| Click(x, y) -> [ (x, y) ], source ()
| _ -> [], source ())
source ()
/// On `Time t`, emits every multiple `k*ms` with `last < k*ms <= t`, ascending, where `last` starts at 0
/// and becomes `t` afterwards. A big time jump can emit several values. Ignores key events.
/// Hint: write a private helper that carries `last`.
@@ -45,5 +58,13 @@ let scan (f: 'b -> 'a -> 'b) (z: 'b) (s: Stream<'a>) : Stream<'b> = failwith "TO
/// Note: streams only act when an event arrives, so if no event ever arrives, `v` is never emitted.
let startWith (v: 'a) (s: Stream<'a>) : Stream<'a> = failwith "TODO m08"
/// (m10) Limit how far one Time event can move the clock that `s` sees, so a long silence (a background tab)
/// does not turn into hundreds of beats at once.
/// `s` gets a clock of its own, starting at 0. On `Time t` that clock advances by `t - last`, but by at most `maxGap`
/// and never by less than 0 (time does not run backwards), where `last` is the `t` of the previous Time event
/// (0 at the start). `s` is then stepped with `Time clock`. Key and click events are passed to `s` unchanged.
/// Hint: a private helper that carries `last` and `clock`, like the one for `interval`.
let clampTime (maxGap: int64) (s: Stream<'a>) : Stream<'a> = failwith "TODO m10"
/// Feed all events through the stream and collect every output, in order. A pure fold.
let run (events: Event list) (s: Stream<'a>) : 'a list = failwith "TODO m08"
+4 -2
View File
@@ -1,11 +1,13 @@
#!/usr/bin/env bash
# Usage: ./test.sh [MNN] (no arg = all tests)
# Usage: ./test.sh [MNN] (no arg = all tests; e.g. ./test.sh M04, ./test.sh M07b)
# Every test list is named "MNN Name" (tag, a space, a name). Expecto's --filter-test-list matches a substring, so the
# tag is passed with its trailing space: "M07 " selects "M07 IO" but not "M07b SafeIO".
set -euo pipefail
cd "$(dirname "$0")"
export PATH="$HOME/.dotnet:$PATH"
export DOTNET_NOLOGO=1 DOTNET_CLI_TELEMETRY_OPTOUT=1
if [ $# -ge 1 ]; then
exec dotnet run --project tests -- --filter-test-list "$1"
exec dotnet run --project tests -- --filter-test-list "$1 "
else
exec dotnet run --project tests
fi
+2 -1
View File
@@ -72,7 +72,8 @@ let gameState (v: JsonElement) : GameState =
Seed = u32 (prop "seed" v)
Score = num (prop "score" v)
Status = status (prop "status" v)
Frame = num (prop "frame" v) }
Frame = num (prop "frame" v)
Queued = opt direction (prop "queued" v) }
let shape (v: JsonElement) : Shape =
let n key = num (prop key v)
+2 -1
View File
@@ -16,7 +16,8 @@ let private eating: GameState =
Seed = 0u
Score = 0
Status = Playing
Frame = 0 }
Frame = 0
Queued = None }
[<Tests>]
let tests =
+83
View File
@@ -0,0 +1,83 @@
module Snake.Tests.M04State
open Expecto
open Snake
open Snake.State
// Small initial states for the "behaves like" checks: two States behave alike when they give the same pair from each.
let private starts = [ 0; 1; 7; 42 ]
let private sameOnAll (st1: State<int, 'a>) (st2: State<int, 'a>) : unit =
for s in starts do
Expect.equal (State.run s st1) (State.run s st2) $"from state {s}"
// A counter step: gives the current number times 10 and adds 1 to the state. A function of unit, so that a stub
// that throws fails each test on its own instead of the whole file at load time.
let private step () : State<int, int> =
State.get () |> State.bind (fun n -> State.put (n + 1) |> State.map (fun () -> n * 10))
let private f (a: int) : State<int, int> = State.modify (fun s -> s * 2) |> State.map (fun () -> a + 1)
let private g (b: int) : State<int, int * int> = State.get () |> State.bind (fun s -> State.pure (b, s))
[<Tests>]
let tests =
testList "M04 State" [
testCase "State pure gives its value and leaves the state alone" (fun () ->
Expect.equal (State.run 99 (State.pure "x")) ("x", 99) "pure")
testCase "State map applies f to the value and keeps the state from the underlying step" (fun () ->
Expect.equal (State.run 4 (State.map (fun v -> v + 1) (step ()))) (41, 5) "map")
testCase "State bind threads the state through both steps" (fun () ->
let both = step () |> State.bind (fun a -> step () |> State.map (fun b -> (a, b)))
Expect.equal (State.run 4 both) ((40, 50), 6) "bind")
testCase "State get gives the state as the value and leaves it alone" (fun () ->
Expect.equal (State.run "board" (State.get ())) ("board", "board") "get")
testCase "State put replaces the state and gives unit" (fun () ->
Expect.equal (State.run 99 (State.put 5)) ((), 5) "put")
testCase "State modify applies f to the state and gives unit" (fun () ->
Expect.equal (State.run 21 (State.modify (fun s -> s * 2))) ((), 42) "modify")
testCase "State law: left identity, bind f (pure a) behaves like f a" (fun () ->
sameOnAll (State.pure 3 |> State.bind f) (f 3))
testCase "State law: right identity, bind pure m behaves like m" (fun () ->
sameOnAll (step () |> State.bind State.pure) (step ()))
testCase "State law: associativity, the grouping of bind does not matter" (fun () ->
sameOnAll (step () |> State.bind f |> State.bind g) (step () |> State.bind (fun a -> f a |> State.bind g)))
testCase "State a counter hands out fresh labels in order" (fun () ->
let fresh = State.get () |> State.bind (fun n -> State.put (n + 1) |> State.map (fun () -> $"L{n}"))
let three =
fresh
|> State.bind (fun a -> fresh |> State.bind (fun b -> fresh |> State.map (fun c -> [ a; b; c ])))
Expect.equal (State.run 0 three) ([ "L0"; "L1"; "L2" ], 3) "from 0"
Expect.equal (State.run 7 three) ([ "L7"; "L8"; "L9" ], 10) "from 7")
testCase "State Random is State with the seed as S: the dice give the same values and seeds" (fun () ->
// One draw written only with State's get and put: read the seed, compute, store the next seed.
let draw: State<uint32, uint32> =
State.get ()
|> State.bind (fun seed ->
let v, next = Random.run seed Random.nextUint32
State.put next |> State.map (fun () -> v))
// The same draw, by turning a Random step into a State by hand.
let wrapped: State<uint32, uint32> = State(fun seed -> Random.run seed Random.nextUint32)
let d6State = draw |> State.map (fun v -> 1u + v % 6u)
let twoDiceState = d6State |> State.bind (fun a -> d6State |> State.map (fun b -> a + b))
let d6Random = Random.nextUint32 |> Random.map (fun v -> 1u + v % 6u)
let twoDiceRandom = d6Random |> Random.bind (fun a -> d6Random |> Random.map (fun b -> a + b))
for seed in [ 0u; 1u; 42u; 4294967295u ] do
Expect.equal (State.run seed draw) (Random.run seed Random.nextUint32) $"draw from {seed}"
Expect.equal (State.run seed wrapped) (Random.run seed Random.nextUint32) $"wrapped from {seed}"
Expect.equal (State.run seed d6State) (Random.run seed d6Random) $"d6 from {seed}"
Expect.equal (State.run seed twoDiceState) (Random.run seed twoDiceRandom) $"twoDice from {seed}")
]
+293
View File
@@ -0,0 +1,293 @@
module Snake.Tests.M07bSafeIO
// The JS tests check that a node holds the very same function; functions cannot be compared, so these tests check
// each node's shape (its case) and then observe the program through `trace`. `traceStep` and `drive` are JS-only.
open Expecto
open Snake
open Snake.View
open Snake.SafeIO
let private rectAt (x: int) : Shape = Rect(x, 0, 1, 1, "#000000")
let private r1 = rectAt 0
let private t1 = Text(1, 2, "hi", "#ffffff", 16, "left")
let private boom (_: 'a) : SafeIO<'b> = failwith "boom"
let private N = 100000
// The value of a RandomSeed answer (the same job as IO.randomSeed does for m07's IO).
let private seedValue (r: IO.OpResult) : uint32 =
match r with
| IO.Seed s -> s
| _ -> failwith "RandomSeed must be answered with a Seed"
// SafeIO versions of m07's `draw` and `randomSeed`, built the same way.
let private draw (shape: Shape) : SafeIO<unit> = SafeIO.effect (IO.Draw shape) |> SafeIO.map ignore
let private randomSeed () : SafeIO<uint32> = SafeIO.effect IO.RandomSeed |> SafeIO.map seedValue
let private leftDraws (n: int) : SafeIO<unit> =
List.fold (fun acc i -> acc |> SafeIO.bind (fun () -> draw (rectAt i))) (SafeIO.pure ()) [ 0 .. n - 1 ]
let private rightDraws (n: int) : SafeIO<unit> =
List.foldBack (fun i rest -> draw (rectAt i) |> SafeIO.bind (fun () -> rest)) [ 0 .. n - 1 ] (SafeIO.pure ())
let private firstAndLast (ops: IO.Op list) : IO.Op list = [ List.head ops; List.last ops ]
// ---- the monad laws, observed through trace
let private programs: (string * (unit -> SafeIO<uint32>)) list =
[ "a pure value", (fun () -> SafeIO.pure 4u)
"one effect", (fun () -> randomSeed ())
"a draw followed by reading the seed", (fun () -> draw r1 |> SafeIO.bind (fun () -> randomSeed ())) ]
let private f (n: uint32) : SafeIO<uint32> = draw (rectAt (int n)) |> SafeIO.bind (fun () -> SafeIO.pure (n * 2u))
let private g (n: uint32) : SafeIO<uint32> = randomSeed () |> SafeIO.map (fun s -> s + n)
// ---- the same programs under m07's IO. F# cannot pass "an IO module" as a parameter, so each program is written
// twice, line for line the same, once with each IO.
let private shared: (string * (unit -> IO.Traced<int>) * (unit -> IO.Traced<int>)) list =
[ "seed, then a draw that depends on it",
(fun () ->
randomSeed ()
|> SafeIO.bind (fun s -> draw (rectAt (int (s % 20u))) |> SafeIO.map (fun () -> int s))
|> SafeIO.trace 7u),
(fun () ->
IO.randomSeed ()
|> IO.bind (fun s -> IO.draw (rectAt (int (s % 20u))) |> IO.map (fun () -> int s))
|> IO.trace 7u)
"a sequence of three effects",
(fun () ->
SafeIO.sequence [ draw t1; randomSeed () |> SafeIO.map ignore; draw r1 ]
|> SafeIO.map (fun () -> 0)
|> SafeIO.trace 7u),
(fun () ->
IO.sequence [ IO.draw t1; IO.randomSeed () |> IO.map ignore; IO.draw r1 ]
|> IO.map (fun () -> 0)
|> IO.trace 7u)
"200 left-nested binds",
(fun () ->
List.fold
(fun acc i -> acc |> SafeIO.bind (fun n -> draw (rectAt i) |> SafeIO.map (fun () -> n + 1)))
(SafeIO.pure 0)
[ 0..199 ]
|> SafeIO.trace 7u),
(fun () ->
List.fold (fun acc i -> acc |> IO.bind (fun n -> IO.draw (rectAt i) |> IO.map (fun () -> n + 1))) (IO.pure 0) [ 0..199 ]
|> IO.trace 7u)
"nested on both sides",
(fun () ->
randomSeed ()
|> SafeIO.bind (fun s -> draw r1 |> SafeIO.bind (fun () -> SafeIO.pure (int s + 1)))
|> SafeIO.bind (fun n ->
SafeIO.sequence [ draw t1; randomSeed () |> SafeIO.map ignore ] |> SafeIO.map (fun () -> n * 3))
|> SafeIO.trace 7u),
(fun () ->
IO.randomSeed ()
|> IO.bind (fun s -> IO.draw r1 |> IO.bind (fun () -> IO.pure (int s + 1)))
|> IO.bind (fun n -> IO.sequence [ IO.draw t1; IO.randomSeed () |> IO.map ignore ] |> IO.map (fun () -> n * 3))
|> IO.trace 7u) ]
[<Tests>]
let tests =
testList "M07b SafeIO" [
// ---- building
testCase "pure builds a Pure" (fun () ->
match SafeIO.pure 3 with
| Pure 3 -> ()
| _ -> failtest "expected Pure 3")
testCase "effect op is an Effect whose continuation is pure" (fun () ->
match SafeIO.effect IO.RandomSeed with
| Effect(op, k) ->
Expect.equal op IO.RandomSeed "op"
match k (IO.Seed 5u) with
| Pure(IO.Seed 5u) -> ()
| _ -> failtest "expected the continuation to give Pure (Seed 5u)"
| _ -> failtest "expected an Effect")
testCase "bind only builds a FlatMap node" (fun () ->
match SafeIO.pure 1 |> SafeIO.bind (fun n -> SafeIO.pure (n + 1)) with
| FlatMap(inner, k) ->
match inner with
| Pure x -> Expect.equal (unbox<int> x) 1 "the inner program is the Pure 1 it was given"
| _ -> failtest "expected the inner program to be a Pure"
Expect.equal (SafeIO.trace 0u (k (box 1))).Result 2 "the continuation is f"
| _ -> failtest "expected a FlatMap")
testCase "building bind throwingF (pure 1) does not throw" (fun () ->
SafeIO.pure 1 |> SafeIO.bind boom |> ignore<SafeIO<int>>)
testCase "building map throwingF io does not throw" (fun () ->
SafeIO.effect IO.RandomSeed |> SafeIO.map (fun _ -> failwith "boom") |> ignore<SafeIO<int>>)
testCase "tracing map throwingF io runs f and throws" (fun () ->
Expect.throwsC
(fun () ->
SafeIO.effect IO.RandomSeed
|> SafeIO.map (fun _ -> failwith "boom")
|> SafeIO.trace 0u
|> ignore<IO.Traced<int>>)
(fun e -> Expect.equal e.Message "boom" "f runs when the program is traced"))
// ---- step: the three rewrite rules
testCase "step leaves a Pure unchanged" (fun () ->
match SafeIO.step (SafeIO.pure 1) with
| Pure 1 -> ()
| _ -> failtest "expected Pure 1")
testCase "step leaves an Effect unchanged" (fun () ->
match SafeIO.step (SafeIO.effect IO.RandomSeed) with
| Effect(IO.RandomSeed, k) ->
match k (IO.Seed 5u) with
| Pure(IO.Seed 5u) -> ()
| _ -> failtest "expected the same continuation (pure)"
| _ -> failtest "expected an Effect with the same op")
testCase "step of FlatMap(Pure a, f) is f a" (fun () ->
match SafeIO.step (SafeIO.pure 3 |> SafeIO.bind (fun n -> SafeIO.pure (n * 2))) with
| Pure 6 -> ()
| _ -> failtest "expected Pure 6")
testCase "step of FlatMap(Effect(op, k), f) is an Effect with the same op that continues with FlatMap(k r, f)" (fun () ->
let f (r: IO.OpResult) = SafeIO.pure (int (seedValue r) * 2)
match SafeIO.step (SafeIO.effect IO.RandomSeed |> SafeIO.bind f) with
| Effect(op, k) ->
Expect.equal op IO.RandomSeed "op"
match k (IO.Seed 5u) with
| FlatMap(Pure x, _) as next ->
Expect.equal (unbox<IO.OpResult> x) (IO.Seed 5u) "FlatMap(k r, _): k r is Pure (Seed 5u)"
Expect.equal (SafeIO.trace 0u next) { IO.Result = 10; IO.Ops = [] } "then f"
| _ -> failtest "expected the continuation to give FlatMap(Pure _, _)"
| _ -> failtest "expected an Effect")
testCase "step re-associates FlatMap(FlatMap(m, g), f) into FlatMap(m, fun x -> FlatMap(g x, f))" (fun () ->
let g (r: IO.OpResult) = SafeIO.pure (int (seedValue r) + 1)
let f (n: int) = SafeIO.pure (n * 2)
match SafeIO.step (SafeIO.effect IO.RandomSeed |> SafeIO.bind g |> SafeIO.bind f) with
| FlatMap(Effect(IO.RandomSeed, _), k) ->
match k (box (IO.Seed 4u)) with
| FlatMap(Pure x, _) as inner ->
Expect.equal (unbox<int> x) 5 "g x is Pure 5"
Expect.equal (SafeIO.trace 0u inner) { IO.Result = 10; IO.Ops = [] } "then f"
| _ -> failtest "expected the continuation to give FlatMap(g x, f)"
| _ -> failtest "expected FlatMap(m, _) with m the Effect")
testCase "step does not call the functions it re-associates" (fun () ->
SafeIO.effect IO.RandomSeed
|> SafeIO.bind boom
|> SafeIO.bind boom
|> SafeIO.step
|> ignore<SafeIO<int>>)
testCase "step of a left-nested chain is one rewrite, not a whole walk" (fun () ->
// After one step, the top is still a FlatMap: step did constant work, the rest is left for later steps.
let chain = List.fold (fun acc _ -> acc |> SafeIO.bind (fun n -> SafeIO.pure (n + 1))) (SafeIO.pure 0) [ 1..N ]
match SafeIO.step chain with
| FlatMap _ -> ()
| _ -> failtest "expected a FlatMap")
// ---- the interpreter
testCase "trace of pure 3 has result 3 and no ops" (fun () ->
Expect.equal (SafeIO.trace 0u (SafeIO.pure 3)) { IO.Result = 3; IO.Ops = [] } "trace")
testCase "trace answers RandomSeed with the seed and Draw with Done" (fun () ->
let program =
SafeIO.effect IO.RandomSeed
|> SafeIO.bind (fun s -> SafeIO.effect (IO.Draw r1) |> SafeIO.map (fun d -> (s, d)))
Expect.equal
(SafeIO.trace 9u program)
{ IO.Result = (IO.Seed 9u, IO.Done); IO.Ops = [ IO.RandomSeed; IO.Draw r1 ] }
"trace")
// The stub throws too, so the test also checks that the failure is not the stub's TODO.
testCase "trace refuses operations of later modules" (fun () ->
Expect.throwsC
(fun () -> SafeIO.trace 0u (SafeIO.effect IO.LoadBest) |> ignore)
(fun e -> Expect.isFalse (e.Message.Contains "TODO") $"refused by the interpreter, not the stub: {e.Message}"))
testCase "sequence of nothing has no ops" (fun () ->
Expect.equal (SafeIO.trace 0u (SafeIO.sequence [])) { IO.Result = (); IO.Ops = [] } "trace")
testCase "sequence runs effects left to right" (fun () ->
Expect.equal
(SafeIO.trace 0u (SafeIO.sequence [ randomSeed () |> SafeIO.map ignore; draw t1; draw r1 ])).Ops
[ IO.RandomSeed; IO.Draw t1; IO.Draw r1 ]
"ops")
// ---- stack safety
testCase "100 000 left-nested binds of draws run, in order" (fun () ->
let traced = SafeIO.trace 0u (leftDraws N)
Expect.equal traced.Result () "result"
Expect.equal (List.length traced.Ops) N "ops"
Expect.equal (firstAndLast traced.Ops) [ IO.Draw(rectAt 0); IO.Draw(rectAt (N - 1)) ] "order")
testCase "100 000 right-nested binds of draws run, in order" (fun () ->
let traced = SafeIO.trace 0u (rightDraws N)
Expect.equal (List.length traced.Ops) N "ops"
Expect.equal (firstAndLast traced.Ops) [ IO.Draw(rectAt 0); IO.Draw(rectAt (N - 1)) ] "order")
testCase "100 000 left-nested maps run without any op" (fun () ->
let program = List.fold (fun acc _ -> acc |> SafeIO.map (fun n -> n + 1)) (SafeIO.pure 0) [ 1..N ]
Expect.equal (SafeIO.trace 0u program) { IO.Result = N; IO.Ops = [] } "trace")
testCase "sequence of 100 000 draws runs" (fun () ->
let program = SafeIO.sequence [ for i in 0 .. N - 1 -> draw (rectAt i) ]
Expect.equal (List.length (SafeIO.trace 0u program).Ops) N "ops")
testCase "a while loop over step is a complete interpreter for 100 000 left-nested binds" (fun () ->
// What an impure runtime would do (a loop is allowed there): rewrite until the top is Pure or Effect, perform.
let mutable performed = 0
let mutable current = leftDraws N
let isPure p = match p with Pure _ -> true | _ -> false
while not (isPure current) do
current <- SafeIO.step current
match current with
| Effect(_, k) ->
performed <- performed + 1
current <- k IO.Done
| _ -> ()
Expect.equal performed N "performed")
// ---- the monad laws, observed through trace
yield!
[ for name, program in programs do
testCase $"left identity holds for {name}" (fun () ->
let a = (SafeIO.trace 5u (program ())).Result
Expect.equal (SafeIO.trace 5u (SafeIO.pure a |> SafeIO.bind f)) (SafeIO.trace 5u (f a)) "left identity")
testCase $"right identity holds for {name}" (fun () ->
Expect.equal
(SafeIO.trace 5u (program () |> SafeIO.bind SafeIO.pure))
(SafeIO.trace 5u (program ()))
"right identity")
testCase $"associativity holds for {name}" (fun () ->
Expect.equal
(SafeIO.trace 5u (program () |> SafeIO.bind f |> SafeIO.bind g))
(SafeIO.trace 5u (program () |> SafeIO.bind (fun x -> f x |> SafeIO.bind g)))
"associativity") ]
// ---- the same programs under Module 7's IO
yield!
[ for name, safe, simple in shared ->
testCase $"trace equals Module 7's trace for {name}" (fun () -> Expect.equal (safe ()) (simple ()) "trace") ]
]
+3
View File
@@ -24,6 +24,9 @@ let tests =
testCase "interval emits several multiples after one big time jump" (fun () ->
Expect.equal (Stream.run [ Time 35L ] (Stream.interval 10L)) [ 10L; 20L; 30L ] "ticks")
testCase "interval 1 emits every millisecond crossed" (fun () ->
Expect.equal (Stream.run [ Time 1L; Time 3L ] (Stream.interval 1L)) [ 1L; 2L; 3L ] "ticks")
testCase "interval ignores key events" (fun () ->
Expect.equal (Stream.run [ KeyDown "a"; KeyUp "a" ] (Stream.interval 10L)) [] "ticks")
+25 -2
View File
@@ -7,6 +7,9 @@ open Snake.IO
open Snake.Stream
open Snake.Tests.M09Helpers
// The ops of drawing one state's view.
let private drawOps (state: GameState) : Op list = View.view state |> List.map Draw
[<Tests>]
let tests =
testList "M09 App" [
@@ -37,12 +40,19 @@ let tests =
(View.view (Spawn.newGame 42u) |> List.map Draw)
"ops")
// Module 10 (Exercise 10.7) makes `main` also load the stored best and draw one more shape after the game's
// view, so this test accepts both versions; M10 pins the final one exactly.
testCase "main asks for a random seed, then builds the stream from it" (fun () ->
let traced = IO.trace 42u (App.main ())
Expect.equal traced.Ops [ RandomSeed ] "ops"
Expect.isTrue
(traced.Ops = [ RandomSeed ] || traced.Ops = [ RandomSeed; LoadBest ])
$"main may only ask for the seed (and, from m10 on, the stored best); it asked for %A{traced.Ops}"
let outs, _ = Stream.step (Time 0L) traced.Result
Expect.equal (List.length outs) 1 "one drawing"
Expect.equal (drawn (List.head outs)) (View.view (Spawn.newGame 42u)) "drawing")
let expected = View.view (Spawn.newGame 42u)
Expect.equal (drawn (List.head outs) |> List.truncate (List.length expected)) expected "drawing")
// `main` itself switches to speedActions in m10, so the 150 ms behaviour is checked on the same program built from classicActions.
testCase "the program built from classicActions draws the new game first, then the ticked game after 150 ms" (fun () ->
@@ -60,4 +70,17 @@ let tests =
let later, _ = Stream.step (Time 150L) next
Expect.equal (List.length first) 1 "one drawing"
Expect.isNonEmpty later "more drawings")
// ---- play: the whole program in one equality (Exercise 9.5)
testCase "play on the classic program equals the scenes of the expected states" (fun () ->
let events = [ Time 150L; KeyDown "ArrowUp"; KeyDown "x"; Time 300L; Time 310L ]
let expectedStates = Game.history (Spawn.newGame 42u) [ Tick; Turn Up; Tick ]
Expect.equal (App.play 42u events (classicMain ())) (List.map drawOps expectedStates) "drawings")
testCase "play with no events gives no drawings" (fun () ->
Expect.equal (App.play 42u [] (classicMain ())) [] "drawings")
testCase "play uses the seed for the program's RandomSeed" (fun () ->
Expect.equal (App.play 7u [ Time 0L ] (classicMain ())) [ drawOps (Spawn.newGame 7u) ] "drawings")
]
+1 -1
View File
@@ -16,4 +16,4 @@ let drawn (io: IO<unit>) : Shape list =
|> List.choose (fun op ->
match op with
| Draw shape -> Some shape
| RandomSeed -> None)
| _ -> None)
+30 -4
View File
@@ -8,17 +8,25 @@ open Snake.Runtime
open Snake.Tests.M09Helpers
/// A fake platform: records every call and lets the test fire events by hand. (Tests may mutate; src/ may not.)
type FakePlatform(seed: uint32) =
type FakePlatform(seed: uint32, best: int) =
let calls = ResizeArray<obj list>()
let mutable onTime: int64 -> unit = ignore
let mutable onDown: string -> unit = ignore
let mutable onUp: string -> unit = ignore
// m13: a runtime from Module 9 does not register this yet; nothing in m09 fires a click.
let mutable onClick: int -> int -> unit = fun _ _ -> ()
let registered = ResizeArray<string>()
new(seed: uint32) = FakePlatform(seed, 0)
member _.Calls: obj list list = List.ofSeq calls
member _.Clear() = calls.Clear()
member _.FireTime(t: int64) = onTime t
member _.FireKey(key: string) = onDown key
member _.FireKeyUp(key: string) = onUp key
member _.FireClick(x: int, y: int) = onClick x y
/// The names of the handlers the runtime registered ("click", "down", "time", "up"), sorted.
member _.Registered: string list = registered |> Seq.distinct |> Seq.sort |> List.ofSeq
member _.Platform: Platform =
{ FillRect = fun x y w h color -> calls.Add [ box "fillRect"; box x; box y; box w; box h; box color ]
@@ -29,9 +37,27 @@ type FakePlatform(seed: uint32) =
fun () ->
calls.Add [ box "randomSeed" ]
seed
StartClock = fun cb -> onTime <- cb
OnKeyDown = fun cb -> onDown <- cb
OnKeyUp = fun cb -> onUp <- cb }
LoadBest =
fun () ->
calls.Add [ box "loadBest" ]
best
SaveBest = fun n -> calls.Add [ box "saveBest"; box n ]
StartClock =
fun cb ->
registered.Add "time"
onTime <- cb
OnKeyDown =
fun cb ->
registered.Add "down"
onDown <- cb
OnKeyUp =
fun cb ->
registered.Add "up"
onUp <- cb
OnClick =
fun cb ->
registered.Add "click"
onClick <- cb }
// What the platform should have been asked to draw for a scene.
let private expectedCalls (scene: Scene) : obj list list =
+207 -4
View File
@@ -1,15 +1,47 @@
module Snake.Tests.M10Extensions
open System.Text.Json
open Expecto
open Snake
open Snake.Model
open Snake.View
open Snake.IO
open Snake.Stream
open Snake.App
open Snake.Tests.Fixtures
open Snake.Tests.M09Helpers
open Snake.Tests.M09Runtime
let private frameTimes = [ 25L; 50L; 75L; 100L; 125L; 150L; 175L; 200L ]
// Sessions in the fixtures use the keys game, best and improved.
let private session (v: JsonElement) : Session =
{ Game = gameState (prop "game" v); Best = num (prop "best" v); Improved = bool (prop "improved" v) }
// Events in the golden fixture: {tag:'Time', t} and {tag:'KeyDown', key}.
let private event (v: JsonElement) : Event =
match str (prop "tag" v) with
| "Time" -> Time((prop "t" v).GetInt64())
| "KeyDown" -> KeyDown(str (prop "key" v))
| "KeyUp" -> KeyUp(str (prop "key" v))
| other -> failwith $"unknown event tag: {other}"
// The drawings are compared by their first shapes, the game's view: Exercise 10.7 adds the best score after it.
let private startsWithView (io: IO<unit>) (state: GameState) (label: string) =
let expected = View.view state
Expect.equal (drawn io |> List.truncate (List.length expected)) expected label
let private newSession (game: GameState) (best: int) : Session = { Game = game; Best = best; Improved = false }
let private drawOps (scene: Scene) : Op list = List.map Draw scene
let private saves (ops: Op list) : int list =
ops
|> List.choose (fun op ->
match op with
| SaveBest n -> Some n
| _ -> None)
[<Tests>]
let tests =
testList "M10 Extensions" [
@@ -22,6 +54,31 @@ let tests =
yield! fixtureTests "m10-input" "keyToAction" (fun c ->
Expect.equal (Input.keyToAction (str (arg 0 c))) (opt action (expected c)) "keyToAction")
yield! fixtureTests "m10-session-update" "sessionUpdate" (fun c ->
Expect.equal (App.sessionUpdate (session (arg 0 c)) (action (arg 1 c))) (session (expected c)) "sessionUpdate")
yield! fixtureTests "m10-session-view" "sessionView" (fun c ->
Expect.equal (App.sessionView (session (arg 0 c))) (list shape (expected c)) "sessionView")
// ---- the turn queue (Exercise 10.6)
testCase "steer is what update does with a Turn" (fun () ->
for c in cases "m10-update" do
match action (arg 1 c) with
| Turn dir -> Expect.equal (Game.steer (gameState (arg 0 c)) dir) (gameState (expected c)) (name c)
| _ -> ())
testCase "Turn Up then Turn Left within one step: the snake goes Up on the next step and Left on the one after" (fun () ->
let start = Spawn.newGame 42u // heading Right from (10, 10); the apple is far away
let states = List.scan Game.update start [ Turn Up; Turn Left; Tick; Tick ]
Expect.equal
(states |> List.skip 2 |> List.map (fun s -> List.head s.Snake))
[ { X = 10; Y = 10 }; { X = 10; Y = 9 }; { X = 9; Y = 9 } ]
"head path"
Expect.equal (states |> List.map (fun s -> s.Queued)) [ None; None; Some Left; None; None ] "queued")
testCase "the animation clock runs every 25 ms" (fun () -> Expect.equal App.FRAME_MS 25L "FRAME_MS")
testCase "speedActions turns the clock into Frame actions every 25 ms" (fun () ->
@@ -35,9 +92,9 @@ let tests =
testCase "main (seed 42) draws a moved snake after eight 25 ms frames" (fun () ->
let traced = IO.trace 42u (App.main ())
Expect.equal traced.Ops [ RandomSeed ] "ops"
Expect.equal (List.head traced.Ops) RandomSeed "first op"
let first, afterFirst = Stream.step (Time 0L) traced.Result
Expect.equal (drawn (List.head first)) (View.view (Spawn.newGame 42u)) "first drawing"
startsWithView (List.head first) (Spawn.newGame 42u) "first drawing"
let drawings = Stream.run (List.map Time frameTimes) afterFirst
Expect.equal (List.length drawings) 8 "eight drawings"
let start = Spawn.newGame 42u
@@ -45,7 +102,153 @@ let tests =
let moved =
{ start with
Snake = start.Snake |> List.map (fun p -> { p with X = p.X + 1 })
Frame = 8 }
Frame = 0 }
Expect.equal (drawn drawings[7]) (View.view moved) "moved snake")
startsWithView drawings[7] moved "moved snake")
// ---- clampTime: a long silence from the clock (a background tab) must not turn into hundreds of frames
testCase "clampTime passes small steps of time through unchanged" (fun () ->
Expect.equal
(Stream.interval 10L |> Stream.clampTime 100L |> Stream.run (List.map Time [ 5L; 10L; 35L ]))
[ 10L; 20L; 30L ]
"outputs")
testCase "clampTime lets a long gap count as maxGap, and carries on from there" (fun () ->
Expect.equal
(Stream.interval 10L |> Stream.clampTime 25L |> Stream.run (List.map Time [ 10L; 5000L; 5010L ]))
[ 10L; 20L; 30L; 40L ]
"outputs")
testCase "clampTime clamps the very first step too (the clock starts at 0)" (fun () ->
Expect.equal (Stream.interval 10L |> Stream.clampTime 25L |> Stream.run [ Time 1000L ]) [ 10L; 20L ] "outputs")
testCase "clampTime never moves the clock backwards" (fun () ->
Expect.equal
(Stream.interval 10L |> Stream.clampTime 100L |> Stream.run (List.map Time [ 30L; 10L; 40L ]))
[ 10L; 20L; 30L; 40L; 50L; 60L ]
"outputs")
testCase "clampTime passes key events through, and they do not disturb the clock" (fun () ->
Expect.equal
(Stream.keyDowns |> Stream.clampTime 5L |> Stream.run [ KeyDown "a"; Time 50L; KeyDown "b" ])
[ "a"; "b" ]
"keys"
Expect.equal
(Stream.interval 10L |> Stream.clampTime 25L |> Stream.run [ Time 10L; KeyDown "a"; Time 20L ])
[ 10L; 20L ]
"clock")
testCase "clampTime tells the inner stream exactly the clamped time, and a repeated time adds nothing" (fun () ->
Expect.equal
(Stream.interval 1L |> Stream.clampTime 100L |> Stream.run [ Time 5L; Time 5L; Time 6L ])
[ 1L; 2L; 3L; 4L; 5L; 6L ]
"outputs")
testCase "running the same clamped stream twice gives the same outputs" (fun () ->
let s = Stream.interval 10L |> Stream.clampTime 25L
let events = List.map Time [ 10L; 5000L; 5010L ]
Expect.equal (Stream.run events s) (Stream.run events s) "same outputs")
testCase "the game accepts at most 250 ms of time at once" (fun () -> Expect.equal App.MAX_GAP_MS 250L "MAX_GAP_MS")
testCase "main: after ten seconds in a background tab the game advances by 250 ms, not by ten seconds" (fun () ->
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (App.main ())).Result
let drawings, next = Stream.step (Time 10000L) afterFirst
Expect.equal (List.length drawings) (int (App.MAX_GAP_MS / App.FRAME_MS)) "ten drawings"
Expect.equal (List.length (fst (Stream.step (Time 10025L) next))) 1 "one more drawing")
// ---- a high score that survives a reload (Exercise 10.7)
testCase "loadBest records a LoadBest op and is answered with the best given to traceWith" (fun () ->
Expect.equal (IO.traceWith 0u 17 (IO.loadBest ())) { Result = 17; Ops = [ LoadBest ] } "traceWith")
testCase "trace answers LoadBest with 0 (no best given)" (fun () ->
Expect.equal (IO.trace 9u (IO.loadBest ())).Result 0 "result")
testCase "saveBest records a SaveBest op with the score and produces ()" (fun () ->
Expect.equal (IO.trace 0u (IO.saveBest 7)) { Result = (); Ops = [ SaveBest 7 ] } "trace")
testCase "a program can load the best, then save a higher one" (fun () ->
Expect.equal
(IO.traceWith 0u 4 (IO.loadBest () |> IO.bind (fun b -> IO.saveBest (b + 1)))).Ops
[ LoadBest; SaveBest 5 ]
"ops")
testCase "sessions starts with the new game and the stored best, then yields one session per action" (fun () ->
let out = App.sessions 42u 3 App.speedActions |> Stream.run [ Time 25L; KeyDown " " ]
let s0 = newSession (Spawn.newGame 42u) 3
let s1 = App.sessionUpdate s0 Frame
Expect.equal out [ s0; s1; App.sessionUpdate s1 TogglePause ] "sessions")
testCase "renderSession draws the session view and saves nothing when the best did not improve" (fun () ->
let s = newSession (Spawn.newGame 42u) 5
Expect.equal (IO.trace 0u (App.renderSession s)).Ops (drawOps (App.sessionView s)) "ops")
testCase "renderSession draws the session view, then saves the best, when the best improved" (fun () ->
let s = { Game = { Spawn.newGame 42u with Score = 6 }; Best = 6; Improved = true }
Expect.equal (IO.trace 0u (App.renderSession s)).Ops (drawOps (App.sessionView s) @ [ SaveBest 6 ]) "ops")
testCase "main asks for the seed, then the stored best, and draws the first session" (fun () ->
let traced = IO.traceWith 42u 9 (App.main ())
Expect.equal traced.Ops [ RandomSeed; LoadBest ] "ops"
let first, _ = Stream.step (Time 0L) traced.Result
Expect.equal (drawn (List.head first)) (App.sessionView (newSession (Spawn.newGame 42u) 9)) "drawing")
testCase "playWith passes the best to the program: the first scene shows it" (fun () ->
Expect.equal
(App.playWith 42u 9 [ Time 0L ] (App.main ()))
[ drawOps (App.sessionView (newSession (Spawn.newGame 42u) 9)) ]
"drawings")
// The golden fixture: a seed, a scripted list of inputs, a stored best, and the scene of the last drawing.
yield!
[ for c in cases "m10-golden" do
let seed = u32 (arg 0 c)
let events = list event (arg 1 c)
let best = num (arg 2 c)
let expectedScene = list shape (expected c)
yield
testCase $"play(main): {name c}" (fun () ->
let lastScene = App.playWith seed best events (App.main ()) |> List.last
Expect.equal (lastScene |> List.choose (fun op -> match op with Draw s -> Some s | _ -> None)) expectedScene "last scene")
yield
testCase $"play(main) saves once per improvement: {name c}" (fun () ->
let saved = App.playWith seed best events (App.main ()) |> List.collect saves
let finalBest =
expectedScene
|> List.pick (fun s ->
match s with
| Text(_, _, text, _, _, _) when text.StartsWith "Best: " -> Some(int (text.Substring 6))
| _ -> None)
Expect.equal saved [ best + 1 .. finalBest ] "saves") ]
// ---- the runtime with a fake platform that records the two new calls
testCase "runIO answers LoadBest with platform.LoadBest () and continues with it" (fun () ->
let p = FakePlatform(42u, 11)
Expect.equal (Runtime.runIO p.Platform (IO.loadBest () |> IO.map (fun b -> b + 1))) 12 "result"
Expect.equal p.Calls [ [ box "loadBest" ] ] "calls")
testCase "runIO maps SaveBest to platform.SaveBest score" (fun () ->
let p = FakePlatform 42u
Expect.equal (Runtime.runIO p.Platform (IO.saveBest 8 |> IO.bind (fun () -> IO.pure "done"))) "done" "result"
Expect.equal p.Calls [ [ box "saveBest"; box 8 ] ] "calls")
testCase "runApp asks for the seed and loads the best once, at start, and draws nothing before the first event" (fun () ->
let p = FakePlatform(42u, 3)
Runtime.runApp p.Platform (App.main ())
Expect.equal p.Calls [ [ box "randomSeed" ]; [ box "loadBest" ] ] "calls at start"
p.FireTime 0L
p.FireTime 25L
Expect.equal (p.Calls |> List.filter (fun c -> List.head c = box "loadBest") |> List.length) 1 "one load"
Expect.isTrue
(p.Calls |> List.exists (fun c -> List.head c = box "fillText" && c[3] = box "Best: 3"))
"draws Best: 3")
]
+180
View File
@@ -0,0 +1,180 @@
module Snake.Tests.M10Replay
open System.Text.Json
open Expecto
open Snake
open Snake.Model
open Snake.View
open Snake.IO
open Snake.Stream
open Snake.Replay
open Snake.Tests.Fixtures
open Snake.Tests.M09Helpers
// Viewers in the fixtures use the keys index, last and playing.
let private viewer (v: JsonElement) : Viewer =
{ Index = num (prop "index" v); Last = num (prop "last" v); Playing = bool (prop "playing" v) }
let private viewerAction (v: JsonElement) : ViewerAction =
match str (prop "tag" v) with
| "Next" -> ViewerAction.Next
| "Prev" -> ViewerAction.Prev
| "First" -> ViewerAction.First
| "Last" -> ViewerAction.Last
| "TogglePlay" -> ViewerAction.TogglePlay
| "Beat" -> ViewerAction.Beat
| other -> failwith $"unknown viewer action tag: {other}"
// The sample recording, as the page loads it. Not a fixture of cases: a recording {seed, actions}.
let private sample: Recording =
let v = load "replay-sample"
{ Seed = u32 (prop "seed" v); Actions = list action (prop "actions" v) }
[<Tests>]
let tests =
testList "M10 Replay" [
yield! fixtureTests "m10-viewer-update" "viewerUpdate" (fun c ->
Expect.equal (viewerUpdate (viewer (arg 0 c)) (viewerAction (arg 1 c))) (viewer (expected c)) "viewerUpdate")
yield! fixtureTests "m10-viewer-key" "viewerKey" (fun c ->
Expect.equal (viewerKey (str (arg 0 c))) (opt viewerAction (expected c)) "viewerKey")
yield! fixtureTests "m10-viewer-view" "viewerView" (fun c ->
Expect.equal (viewerView (list gameState (arg 0 c)) (viewer (arg 1 c))) (list shape (expected c)) "viewerView")
yield!
[ testCase
"the sample recording is worth watching: Tick and Turn only, under 400 actions, at least five apples, then game over"
(fun () ->
Expect.all
sample.Actions
(fun a ->
match a with
| Tick
| Turn _ -> true
| _ -> false)
"Tick and Turn only"
let n = List.length sample.Actions
Expect.isTrue (n >= 150 && n <= 400) $"{n} actions"
let fs = Game.history (Spawn.newGame sample.Seed) sample.Actions
let last = List.last fs
Expect.isGreaterThanOrEqual last.Score 5 "score"
Expect.equal last.Status GameOver "last frame"
Expect.equal (List.item (List.length fs - 2) fs).Status Playing "frame before the last")
testCase "frames replays the recording with history, from the new game of its seed" (fun () ->
let recording = { Seed = 42u; Actions = [ Tick; Turn Up; Tick ] }
Expect.equal (frames recording) (Game.history (Spawn.newGame 42u) recording.Actions) "frames"
Expect.equal (List.length (frames sample)) (List.length sample.Actions + 1) "length")
testCase "viewerStart is the first frame, not playing" (fun () ->
Expect.equal (viewerStart 12) { Index = 0; Last = 12; Playing = false } "viewerStart")
testCase "viewerUpdate keeps the index in [0, last] whatever the actions" (fun () ->
let actions =
[ ViewerAction.Prev
ViewerAction.Next
ViewerAction.Last
ViewerAction.Next
ViewerAction.TogglePlay
ViewerAction.Beat
ViewerAction.Beat
ViewerAction.First
ViewerAction.Prev
ViewerAction.Beat ]
let viewers = List.scan viewerUpdate (viewerStart 3) actions
Expect.all
viewers
(fun v -> v.Index >= 0 && v.Index <= 3 && not (v.Playing && v.Index = 3))
"in range, never playing at the end")
testCase "the autoplay clock beats every 100 ms" (fun () -> Expect.equal REPLAY_MS 100L "REPLAY_MS")
testCase "replayActions turns the clock into Beats and keys into viewer actions" (fun () ->
Expect.equal
(run [ Time 100L; KeyDown "ArrowRight"; KeyDown "x"; KeyDown " "; Time 300L ] replayActions)
[ ViewerAction.Beat
ViewerAction.Next
ViewerAction.TogglePlay
ViewerAction.Beat
ViewerAction.Beat ]
"actions")
testCase "autoplay: Space, then the clock steps one frame per 100 ms and stops at the end" (fun () ->
let out =
viewerStates 3 replayActions
|> run [ Time 0L; KeyDown " "; Time 100L; Time 200L; Time 300L; Time 400L; Time 500L ]
Expect.equal (out |> List.map (fun v -> v.Index)) [ 0; 0; 1; 2; 3; 3; 3 ] "indices"
Expect.equal
(out |> List.map (fun v -> v.Playing))
[ false; true; true; true; false; false; false ]
"playing")
testCase "without Space nothing plays: the clock alone never moves the viewer" (fun () ->
Expect.all
(viewerStates 3 replayActions |> run [ Time 0L; Time 1000L; Time 2000L ])
(fun v -> v.Index = 0)
"index 0")
testCase "replayMain asks for nothing and draws the first frame of the recording first" (fun () ->
let traced = IO.trace 0u (replayMain sample)
Expect.equal traced.Ops [] "ops"
let drawings, _ = Stream.step (Time 0L) traced.Result
Expect.equal (List.length drawings) 1 "one drawing"
Expect.equal
(drawn (List.head drawings))
(viewerView (frames sample) (viewerStart (List.length sample.Actions)))
"first scene"
let start = View.view (Spawn.newGame sample.Seed)
Expect.equal
(drawn (List.head drawings) |> List.truncate (List.length start))
start
"the game's own view first")
testCase "replayMain: End shows the last frame of the game, the game over" (fun () ->
let out = (IO.trace 0u (replayMain sample)).Result |> run [ Time 0L; KeyDown "End" ]
let fs = frames sample
let last = List.length fs - 1
let scene = drawn (List.last out)
Expect.equal scene (viewerView fs { Index = last; Last = last; Playing = false }) "last scene"
Expect.exists
scene
(fun s ->
match s with
| Text(_, _, "Game Over", _, _, _) -> true
| _ -> false)
"Game Over")
testCase "stepping back shows exactly the earlier scene" (fun () ->
let out =
(IO.trace 0u (replayMain sample)).Result
|> run
[ Time 0L
KeyDown "ArrowRight"
KeyDown "ArrowRight"
KeyDown "ArrowRight"
KeyDown "ArrowLeft"
KeyDown "d"
KeyDown "a"
KeyDown "a" ]
let scenes = List.map drawn out
Expect.equal scenes[4] scenes[2] "back one"
Expect.equal scenes[6] scenes[4] "forward and back"
Expect.equal scenes[7] scenes[1] "back to frame 1"
Expect.notEqual scenes[3] scenes[2] "frames differ")
testCase "replayMain: after ten seconds in a background tab autoplay moves 2 frames (250 ms), not 100" (fun () ->
let _, afterPlay = Stream.step (KeyDown " ") (IO.trace 0u (replayMain sample)).Result
let _, afterFirst = Stream.step (Time 0L) afterPlay
Expect.equal (List.length (fst (Stream.step (Time 10000L) afterFirst))) 2 "two drawings") ]
]
+4
View File
@@ -134,6 +134,10 @@ let tests =
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: after ten seconds in a background tab the match advances by 250 ms, not by ten seconds" (fun () ->
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (pongMain ())).Result
Expect.equal (List.length (fst (Stream.step (Time 10000L) afterFirst))) 8 "eight drawings")
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"
+442
View File
@@ -0,0 +1,442 @@
module Snake.Tests.M12Check
open Expecto
open Snake
open Snake.Model
open Snake.Check
open Snake.Tests.Fixtures
// ---- helpers for moveGaps: a state whose snake has its head at (x, y); nothing else matters there
let private at (x: int) (y: int) : GameState =
{ Width = 20
Height = 20
Snake = [ { X = x; Y = y }; { X = x - 1; Y = y } ]
Dir = Right
NextDir = Right
Apple = None
Seed = 0u
Score = 0
Status = Playing
Frame = 0
Queued = None }
// ---- the payoff: properties of the game, and deliberately broken games ("mutants") that they must catch
// Every state of the game played with `upd` from `start`. (For the real `Game.update` this is `Game.history`.)
let private statesWith (upd: GameState -> Action -> GameState) (start: GameState) (actions: Action list) : GameState list =
List.scan upd start actions
let private sane (upd: GameState -> Action -> GameState) (actions: Action list) : bool =
statesWith upd (Spawn.newGame 1u) actions |> List.forall (fun s -> List.isEmpty (violations s))
// Mutant 1: `turn` checks against NextDir instead of Dir (version A of Puzzle 2 in Module 3).
let private turnAgainstNextDir (state: GameState) (action: Action) : GameState =
match action with
| Turn dir -> if state.Status = Playing && dir <> opposite state.NextDir then { state with NextDir = dir } else state
| _ -> Game.update state action
// Mutant 2: `advance` forgets to check the walls.
let private advanceWithoutWalls (state: GameState) : GameState =
if state.Status <> Playing then
state
else
let head = Rules.move (List.head state.Snake) state.NextDir
let eating = state.Apple = Some head
let body = if eating then state.Snake else Util.dropLast state.Snake
if Util.contains body head (=) then
{ state with Dir = state.NextDir; Status = GameOver }
else
{ state with
Snake = head :: body
Dir = state.NextDir
Apple = if eating then None else state.Apple
Score = state.Score + (if eating then 1 else 0) }
// What `update` does after a step since Exercise 10.6: take the queued turn. The mutants below that replace `Tick`
// do the same, so that each one differs from the real game in exactly one thing.
let private takeQueued (s: GameState) : GameState =
match s.Queued with
| Some d when s.Status = Playing -> { s with NextDir = d; Queued = None }
| _ -> s
let private noWalls (state: GameState) (action: Action) : GameState =
match action with
| Tick -> takeQueued (Spawn.spawnApple (advanceWithoutWalls state))
| _ -> Game.update state action
// Mutant 4: a `Tick` that forgets the turn queue of Exercise 10.6 (the `Frame` step still takes it).
let private tickForgetsQueue (state: GameState) (action: Action) : GameState =
match action with
| Tick -> Spawn.tick state
| _ -> Game.update state action
// Mutant 5: the queue accepts any key that differs from the pending turn, even the one straight back from it.
let private queueAnyKey (state: GameState) (action: Action) : GameState =
match action with
| Turn dir when state.Status = Playing && state.NextDir <> state.Dir && dir <> state.NextDir ->
{ state with Queued = Some dir }
| _ -> Game.update state action
// Mutant 3: the frame rule this course used at first: step whenever the *total* frame count is a multiple of movesEvery.
let private totalFrameCount (state: GameState) (action: Action) : GameState =
match action with
| Frame ->
if state.Status <> Playing then
state
else
let counted = { state with Frame = state.Frame + 1 }
if counted.Frame % Game.movesEvery counted.Score = 0 then Spawn.tick counted else counted
| _ -> Game.update state action
// A long corridor: the snake is one step from its third apple (score 2 -> 3, so the speed changes), `frame` frames into the game.
let private corridor (frame: int) : GameState =
{ Width = 60
Height = 1
Snake = [ { X = 1; Y = 0 }; { X = 0; Y = 0 } ]
Dir = Right
NextDir = Right
Apple = Some { X = 2; Y = 0 }
Seed = 0u
Score = 2
Status = Playing
Frame = frame
Queued = None }
let private frames = List.replicate 40 Frame
// Every gap between two moves is exactly `movesEvery` of the score the snake had after the first of the two.
let private steady (upd: GameState -> Action -> GameState) (frame: int) : bool =
let states = statesWith upd (corridor frame) frames
let scoreAtMove =
states
|> List.pairwise
|> List.filter (fun (before, after) -> List.head after.Snake <> List.head before.Snake)
|> List.map (fun (_, after) -> after.Score)
let gaps = moveGaps states
List.forall2 (fun gap score -> gap = Game.movesEvery score) gaps (List.truncate (List.length gaps) scoreAtMove)
// ---- random states and the oracle
let private connected (snake: Point list) : bool =
snake |> List.pairwise |> List.forall (fun (a, b) -> abs (a.X - b.X) + abs (a.Y - b.Y) = 1)
let private board (width: int) (height: int) : GameState = { at 0 0 with Width = width; Height = height }
// Mutant 6: Puzzle 1 of Module 3, "the new head must not be on the old snake" (it forgets that the tail moves away).
let private advanceOldSnakeCheck (state: GameState) : GameState =
if state.Status <> Playing then
state
else
let head = Rules.move (List.head state.Snake) state.NextDir
let eating = state.Apple = Some head
let body = if eating then state.Snake else Util.dropLast state.Snake
if not (Rules.inBounds state head) || Util.contains state.Snake head (=) then
{ state with Dir = state.NextDir; Status = GameOver }
else
{ state with
Snake = head :: body
Dir = state.NextDir
Apple = if eating then None else state.Apple
Score = state.Score + (if eating then 1 else 0) }
let private pt (x: int) (y: int) : Point = { X = x; Y = y }
[<Tests>]
let tests =
testList "M12 Check" [
// ---- generators
testCase "elementOf picks the element at the index drawn by intBelow" (fun () ->
let xs = [ "a"; "b"; "c"; "d"; "e" ]
let i, seed = Random.run 0u (Random.intBelow 5)
Expect.equal (Random.run 0u (elementOf xs)) (xs[i], seed) "elementOf")
testCase "elementOf of a one-element list always gives that element, and still uses up a draw" (fun () ->
Expect.equal (Random.run 0u (elementOf [ "only" ])) ("only", 1831565813u) "elementOf")
testCase "listOf 0 gen is the empty list and leaves the seed alone" (fun () ->
Expect.equal (Random.run 99u (listOf 0 Random.nextUint32)) ([], 99u) "listOf 0")
testCase "listOf threads the seed from each draw to the next" (fun () ->
Expect.equal
(Random.run 0u (listOf 3 Random.nextUint32))
([ 1144304738u; 1416247u; 958946056u ], 1199730143u)
"listOf 3")
testCase "listOf of a constant generator repeats the value and leaves the seed alone" (fun () ->
Expect.equal (Random.run 7u (listOf 4 (Random.pure "x"))) ([ "x"; "x"; "x"; "x" ], 7u) "listOf pure")
testCase "genActions n gives n actions, the same ones for the same seed" (fun () ->
let actions, _ = Random.run 5u (genActions 30)
Expect.equal (List.length actions) 30 "length"
Expect.all
actions
(fun a ->
match a with
| Tick
| Turn _ -> true
| TogglePause
| Restart
| Frame -> false)
"only Tick and Turn"
Expect.equal (Random.run 5u (genActions 30)) (Random.run 5u (genActions 30)) "same seed, same actions")
// ---- forAll
testCase "forAll reports success with the number of runs" (fun () ->
Expect.equal (forAll 200 1u (fun x -> x >= 0 && x < 10) (Random.intBelow 10)) (Passed 200) "forAll")
testCase "forAll with zero runs succeeds without drawing anything" (fun () ->
Expect.equal (forAll 0 1u (fun _ -> false) Random.nextUint32) (Passed 0) "forAll")
testCase "forAll reports the first failing draw, its value and the seed it started from" (fun () ->
let gen = Random.intBelow 10
let prop x = x <> 7
let draws, _ = Random.run 3u (listOf 200 gen)
let first = draws |> List.findIndex (fun x -> not (prop x))
Expect.isGreaterThan first 0 "the test needs a failure that is not the very first draw"
match forAll 200 3u prop gen with
| Failed(run, seed, value) ->
Expect.equal (run, value) (first, 7) "run and value"
Expect.equal (fst (Random.run seed gen)) 7 "the reported seed gives the value again"
| Passed runs -> failtest $"expected a failure, got Passed {runs}")
testCase "forAll stops at the first failure: the property is not asked about later values" (fun () ->
let gen = Random.intBelow 10
let draws, _ = Random.run 3u (listOf 200 gen)
let first = draws |> List.findIndex (fun x -> x = 7)
let mutable calls = 0 // test code may count; the code under test may not
let result =
forAll
200
3u
(fun x ->
calls <- calls + 1
x <> 7)
gen
match result with
| Failed(run, _, _) -> Expect.equal run first "run"
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
Expect.equal calls (first + 1) "calls")
testCase "forAll is reproducible: same generator, property, runs and seed give the same report" (fun () ->
let check () = forAll 500 11u (fun x -> x % 97 <> 0) (Random.intBelow 1000)
Expect.equal (check ()) (check ()) "same report")
testCase "forAll runs in constant stack: a million runs do not overflow it" (fun () ->
Expect.equal (forAll 1000000 1u (fun x -> x < 10) (Random.intBelow 10)) (Passed 1000000) "forAll")
// ---- shrinking
testCase "removals lists every way to drop one element, in order" (fun () ->
Expect.equal (removals [ 1; 2; 3 ]) [ [ 2; 3 ]; [ 1; 3 ]; [ 1; 2 ] ] "removals")
testCase "removals of an empty list is empty, and of a single element is one empty list" (fun () ->
Expect.equal (removals ([]: int list)) [] "empty"
Expect.equal (removals [ "a" ]) [ [] ] "single")
testCase "minimize keeps exactly the elements the failure needs" (fun () ->
Expect.equal
(minimize (fun xs -> List.contains 3 xs && List.contains 7 xs) [ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ])
[ 3; 7 ]
"minimize")
testCase "minimize keeps the order and the duplicates the failure needs" (fun () ->
Expect.equal
(minimize
(fun xs -> (xs |> List.filter (fun x -> x = "a") |> List.length) >= 2 && List.contains "c" xs)
[ "b"; "a"; "c"; "a"; "d"; "a" ])
[ "c"; "a"; "a" ]
"minimize")
testCase "minimize of a list that fails whatever you remove is the empty list" (fun () ->
Expect.equal (minimize (fun _ -> true) [ 1; 2; 3 ]) [] "minimize")
testCase "minimize returns a list that still fails and has no failing removal (1-minimal)" (fun () ->
let fails (xs: int list) = List.sum xs >= 10
let small = minimize fails [ 5; 1; 4; 2; 6; 3 ]
Expect.isTrue (fails small) "still fails"
Expect.all (removals small) (fun ys -> not (fails ys)) "no failing removal")
// ---- invariants
yield! fixtureTests "m12-violations" "violations" (fun c ->
Expect.equal (violations (gameState (arg 0 c))) (list str (expected c)) "violations")
// ---- moveGaps
testCase "moveGaps measures the distance between consecutive moves of the head" (fun () ->
Expect.equal
(moveGaps [ at 1 0; at 1 0; at 2 0; at 2 0; at 2 0; at 3 0; at 3 1 ])
[ 3; 1 ]
"moveGaps")
testCase "moveGaps of fewer than two moves is empty" (fun () ->
Expect.equal (moveGaps []) [] "no states"
Expect.equal (moveGaps [ at 1 0 ]) [] "one state"
Expect.equal (moveGaps [ at 1 0; at 1 0; at 2 0; at 2 0 ]) [] "one move")
testCase "moveGaps counts a move at index 1" (fun () ->
Expect.equal (moveGaps [ at 1 0; at 2 0; at 2 0; at 3 0 ]) [ 2 ] "moveGaps")
testCase "moveGaps treats an empty snake as a head of its own" (fun () ->
let snake (cells: Point list) = { at 1 0 with Snake = cells }
Expect.equal
(moveGaps [ snake []; snake []; snake [ { X = 1; Y = 0 } ]; snake [ { X = 1; Y = 0 } ]; snake [ { X = 2; Y = 0 } ] ])
[ 2 ]
"moveGaps")
// ---- properties of the game, and the mutants
testCase "statesWith Game.update in these tests is the history of Module 5" (fun () ->
let actions, _ = Random.run 9u (genActions 25)
Expect.equal (statesWith Game.update (Spawn.newGame 1u) actions) (Game.history (Spawn.newGame 1u) actions) "history")
testCase "the real game keeps every invariant on 300 random games of 40 actions" (fun () ->
Expect.equal (forAll 300 2024u (sane Game.update) (genActions 40)) (Passed 300) "forAll")
testCase "the quick double turn bug is found and shrunk to its two key presses" (fun () ->
let prop = sane turnAgainstNextDir
match forAll 300 2024u prop (genActions 40) with
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
| Failed(_, _, value) ->
match minimize (fun actions -> not (prop actions)) value with
| [ Turn first; Turn second ] ->
Expect.contains [ Up; Down ] first "first turn"
Expect.equal second Left "second turn"
| small -> failtest $"expected two turns, got %A{small}")
testCase "a game without walls is found and shrunk to the shortest way off the board: ten ticks" (fun () ->
let prop = sane noWalls
match forAll 300 2024u prop (genActions 40) with
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
| Failed(_, _, value) ->
Expect.equal (minimize (fun actions -> not (prop actions)) value) (List.replicate 10 Tick) "ten ticks")
testCase "a Tick that forgets the queued turn is caught by queued-not-reversed and shrunk to four actions" (fun () ->
let prop = sane tickForgetsQueue
match forAll 300 2024u prop (genActions 40) with
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
| Failed(_, _, value) ->
Expect.equal
(minimize (fun actions -> not (prop actions)) value)
[ Turn Up; Turn Right; Tick; Turn Left ]
"four actions")
testCase "a queue that accepts a reversal is found and shrunk to its two key presses" (fun () ->
let prop = sane queueAnyKey
match forAll 300 2024u prop (genActions 40) with
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
| Failed(_, _, value) ->
Expect.equal (minimize (fun actions -> not (prop actions)) value) [ Turn Up; Turn Down ] "two key presses")
testCase "the real game moves exactly every movesEvery score frames, also across a speed-up" (fun () ->
Expect.equal (forAll 100 7u (steady Game.update) (Random.intBelow 8)) (Passed 100) "forAll")
testCase "counting frames from the start of the game makes some steps too short, and the property finds one" (fun () ->
match forAll 100 7u (steady totalFrameCount) (Random.intBelow 56) with
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
| Failed(_, _, value) -> Expect.isFalse (steady totalFrameCount value) "the counterexample fails")
// ---- random states (Exercise 12.6)
testCase "genSnake draws the head first, then walks from the tail (seed 0, 5x5, at most 6 cells)" (fun () ->
Expect.equal
(Random.run 0u (genSnake 5 5 6))
([ pt 3 2; pt 3 1; pt 3 0; pt 2 0; pt 1 0; pt 0 0 ], 4231026099u)
"genSnake")
testCase "genSnake is pinned for a few more seeds" (fun () ->
Expect.equal
(fst (Random.run 1u (genSnake 5 5 6)))
[ pt 2 3; pt 3 3; pt 4 3; pt 4 4; pt 3 4; pt 2 4 ]
"seed 1"
Expect.equal
(fst (Random.run 42u (genSnake 5 5 6)))
[ pt 1 0; pt 1 1; pt 2 1; pt 2 0; pt 3 0; pt 3 1 ]
"seed 42")
testCase "genSnake with maxLen 1 is just the head, drawn with two draws" (fun () ->
let x, s1 = Random.run 0u (Random.intBelow 5)
let y, s2 = Random.run s1 (Random.intBelow 5)
Expect.equal (Random.run 0u (genSnake 5 5 1)) ([ pt x y ], s2) "genSnake")
testCase "genSnake stops early when the walk is stuck: a 1x1 board holds one cell" (fun () ->
Expect.equal (fst (Random.run 3u (genSnake 1 1 5))) [ pt 0 0 ] "genSnake")
testCase "genSnake always gives a snake on the board, connected, without overlap, at most maxLen long" (fun () ->
let ok (snake: Point list) =
List.length snake >= 1
&& List.length snake <= 8
&& connected snake
&& List.forall (Rules.inBounds (board 4 3)) snake
&& List.length (List.distinct snake) = List.length snake
Expect.equal (forAll 300 5u ok (genSnake 4 3 8)) (Passed 300) "forAll")
testCase "every generated state is sane: 500 states of a 5x5 board have no violations" (fun () ->
Expect.equal (forAll 500 2024u (fun s -> List.isEmpty (violations s)) (genState 5 5)) (Passed 500) "forAll")
testCase "generated states are Playing, have nothing queued, and vary in length and apple" (fun () ->
let states, _ = Random.run 2024u (listOf 500 (genState 5 5))
Expect.all states (fun s -> s.Status = Playing && s.Queued = None && s.Width = 5 && s.Height = 5) "shape"
Expect.all
states
(fun s ->
match s.Snake with
| [ _ ] -> s.Dir = Right
| head :: second :: _ -> Rules.move second s.Dir = head
| [] -> false)
"dir"
Expect.exists states (fun s -> List.length s.Snake = 1) "a one-cell snake"
Expect.exists states (fun s -> List.length s.Snake >= 10) "a long snake"
Expect.exists states (fun s -> s.Apple = None) "no apple"
Expect.exists states (fun s -> s.Apple <> None) "an apple"
Expect.exists states (fun s -> s.NextDir <> s.Dir) "a pending turn")
testCase "generated states start with seed 0, score 0 and frame 0" (fun () ->
let states, _ = Random.run 2024u (listOf 50 (genState 5 5))
Expect.all states (fun s -> s.Seed = 0u && s.Score = 0 && s.Frame = 0) "seed, score and frame")
// ---- a second implementation as an oracle (Exercise 12.7)
yield! fixtureTests "m03-advance" "advanceSpec agrees with Module 3's advance fixture" (fun c ->
Expect.equal (advanceSpec (gameState (arg 0 c))) (gameState (expected c)) "advanceSpec")
testCase "advance and advanceSpec agree on 500 generated states of a 5x5 board" (fun () ->
Expect.equal (forAll 500 2024u (fun s -> Rules.advance s = advanceSpec s) (genState 5 5)) (Passed 500) "forAll")
testCase "no invariant sees the wrong collision check of Puzzle 1: every state it produces is sane" (fun () ->
Expect.equal
(forAll 500 2024u (fun s -> List.isEmpty (violations (advanceOldSnakeCheck s))) (genState 5 5))
(Passed 500)
"forAll")
testCase "comparing with advanceSpec catches the wrong collision check: the head was moving onto the tail" (fun () ->
match forAll 500 2024u (fun s -> advanceOldSnakeCheck s = advanceSpec s) (genState 5 5) with
| Passed runs -> failtest $"expected a failure, got Passed {runs}"
| Failed(run, _, s) ->
Expect.equal run 21 "run"
Expect.equal (Rules.move (List.head s.Snake) s.NextDir) (List.last s.Snake) "onto the tail"
Expect.equal (advanceOldSnakeCheck s).Status GameOver "the mutant ends the game"
Expect.equal (advanceSpec s).Status Playing "the rules do not")
]
+268
View File
@@ -0,0 +1,268 @@
module Snake.Tests.M13Life
open System.Diagnostics
open System.Text.Json
open Expecto
open Snake
open Snake.Model
open Snake.Stream
open Snake.Life.Model
open Snake.Life.Rules
open Snake.Life.View
open Snake.Life.App
open Snake.Tests.Fixtures
open Snake.Tests.M09Helpers
open Snake.Tests.M09Runtime
let private lifeState (v: JsonElement) : LifeState =
{ Cells = list point (prop "cells" v)
Running = bool (prop "running" v)
Seed = u32 (prop "seed" v)
Generation = num (prop "generation" v) }
let private lifeAction (v: JsonElement) : LifeAction =
match str (prop "tag" v) with
| "Frame" -> LifeAction.Frame
| "Toggle" -> LifeAction.Toggle(point (prop "cell" v))
| "TogglePause" -> LifeAction.TogglePause
| "Step" -> LifeAction.Step
| "Clear" -> LifeAction.Clear
| "Randomize" -> LifeAction.Randomize
| other -> failwith $"unknown life action tag: {other}"
let private cell (x: int) (y: int) : Point = { X = x; Y = y }
let private rowMajor (cells: Point list) : bool =
cells |> List.pairwise |> List.forall (fun (a, b) -> a.Y < b.Y || (a.Y = b.Y && a.X < b.X))
// n generations after `cells`, the start included: n + 1 boards.
let private generations (n: int) (cells: Point list) : Point list list =
List.scan (fun cs _ -> lifeStep cs) cells [ 1..n ]
[<Tests>]
let tests =
testList "M13 Life" [
yield! fixtureTests "m13-life-step" "lifeStep" (fun c ->
Expect.equal (lifeStep (list point (arg 0 c))) (list point (expected c)) "lifeStep")
yield! fixtureTests "m13-life-update" "lifeUpdate" (fun c ->
Expect.equal (lifeUpdate (lifeState (arg 0 c)) (lifeAction (arg 1 c))) (lifeState (expected c)) "lifeUpdate")
yield! fixtureTests "m13-life-view" "lifeView" (fun c ->
Expect.equal (lifeView (lifeState (arg 0 c))) (list shape (expected c)) "lifeView")
yield! fixtureTests "m13-life-key" "lifeKey" (fun c ->
Expect.equal (lifeKey (str (arg 0 c))) (opt lifeAction (expected c)) "lifeKey")
yield! fixtureTests "m13-life-click" "lifeClick" (fun c ->
Expect.equal (lifeClick (num (arg 0 c)) (num (arg 1 c))) (opt lifeAction (expected c)) "lifeClick")
yield!
[ // ---- the model and the rules
testCase "the board is 40 by 30 cells of 16 pixels, with a 24-pixel status strip below" (fun () ->
Expect.equal [ LW; LH; LCELL; STRIP ] [ 40; 30; 16; 24 ] "constants")
testCase "initialLife is an empty, paused world at generation 0 with the given seed" (fun () ->
Expect.equal
(initialLife 9u)
{ Cells = []
Running = false
Seed = 9u
Generation = 0 }
"initialLife")
testCase "lifeUpdate does not modify the state it is given" (fun () ->
let make () =
{ Cells = [ cell 4 5; cell 5 5; cell 6 5 ]
Running = true
Seed = 3u
Generation = 0 }
let s = make ()
[ LifeAction.Frame
LifeAction.Toggle(cell 0 0)
LifeAction.Toggle(cell 5 5)
LifeAction.Randomize
LifeAction.Clear ]
|> List.iter (fun a -> lifeUpdate s a |> ignore)
Expect.equal s (make ()) "unchanged")
testCase "a glider moves one cell diagonally every four generations" (fun () ->
let glider = [ cell 1 0; cell 2 1; cell 0 2; cell 1 2; cell 2 2 ]
Expect.equal
(List.last (generations 4 glider))
[ cell 2 1; cell 3 2; cell 1 3; cell 2 3; cell 3 3 ]
"after four generations")
testCase "the next generation is computed from the whole old board: a blinker blinks forever" (fun () ->
let horizontal = [ cell 9 10; cell 10 10; cell 11 10 ]
let gens = generations 6 horizontal
Expect.equal gens[2] horizontal "two generations"
Expect.equal gens[6] horizontal "six generations"
Expect.equal gens[1] [ cell 10 9; cell 10 10; cell 10 11 ] "vertical in between")
testCase "Randomize draws one intBelow 4 per cell in row-major order, alive when the draw is 0" (fun () ->
let seed = 2024u
// The same draws, written the long way round with the Module 4 generator.
let draws, next =
List.fold
(fun (ds, s) _ ->
let d, s2 = Random.run s (Random.intBelow 4)
ds @ [ d ], s2)
([], seed)
[ 1 .. LW * LH ]
let expectedCells =
draws
|> List.indexed
|> List.choose (fun (i, d) -> if d = 0 then Some(cell (i % LW) (i / LW)) else None)
let result = lifeUpdate (initialLife seed) LifeAction.Randomize
Expect.equal result.Cells expectedCells "cells"
Expect.equal result.Seed next "seed"
let n = List.length result.Cells
Expect.isTrue (n > 200 && n < 400) $"{n} live cells")
testCase "every generation of a random board stays sorted row-major, on the board and without duplicates" (fun () ->
let start = (lifeUpdate (initialLife 5u) LifeAction.Randomize).Cells
generations 20 start
|> List.iter (fun cells ->
Expect.isTrue (rowMajor cells) "sorted row-major, no duplicates"
Expect.all cells (fun c -> c.X >= 0 && c.X < LW && c.Y >= 0 && c.Y < LH) "on the board"))
// Generous on purpose (and more so than in JS, for an unoptimised Debug build): a straightforward
// lifeStep takes a few milliseconds per generation. This only catches a generation that is far slower
// than the 150 ms between two of them.
testCase "lifeStep keeps up: 50 generations of a quarter-full board take well under 50 x 150 ms" (fun () ->
let start = (lifeUpdate (initialLife 11u) LifeAction.Randomize).Cells
let watch = Stopwatch.StartNew()
generations 50 start |> ignore
let ms = watch.ElapsedMilliseconds
Expect.isLessThan ms 5000L $"{ms} ms")
// ---- the fourth kind of event
testCase "clicks emits the position of every Click event and ignores everything else" (fun () ->
Expect.equal
(Stream.clicks |> Stream.run [ Time 10L; Click(3, 4); KeyDown "a"; Click(0, 479); KeyUp "a" ])
[ (3, 4); (0, 479) ]
"positions")
testCase "the other sources ignore clicks" (fun () ->
let events = [ Click(5, 5); Time 100L; Click(6, 6) ]
Expect.equal (Stream.run events Stream.keyDowns) [] "keyDowns"
Expect.equal (Stream.run events Stream.keyUps) [] "keyUps"
Expect.equal (Stream.run events (Stream.interval 50L)) [ 50L; 100L ] "interval"
Expect.equal
(Stream.run events (Stream.clampTime 250L Stream.clicks))
[ (5, 5); (6, 6) ]
"clampTime passes clicks through")
testCase "a generation every 150 ms" (fun () -> Expect.equal GEN_MS 150L "GEN_MS")
testCase "lifeActions turns the clock into Frames, keys into actions and clicks on the board into Toggles" (fun () ->
Expect.equal
(lifeActions
|> Stream.run
[ Time 150L; KeyDown " "; Click(20, 40); KeyDown "x"; Click(700, 10); KeyDown "n"; Time 450L ])
[ LifeAction.Frame
LifeAction.TogglePause
LifeAction.Toggle(cell 1 2)
LifeAction.Step
LifeAction.Frame
LifeAction.Frame ]
"actions")
testCase "lifeStates starts with the new world, then yields one state per action" (fun () ->
let out =
lifeStates 7u lifeActions
|> Stream.run [ Time 0L; Click(16, 16); Click(32, 16); Click(48, 16); KeyDown " "; Time 150L ]
Expect.equal (List.head out) (initialLife 7u) "first state"
Expect.equal (out |> List.map (fun s -> List.length s.Cells)) [ 0; 1; 2; 3; 3; 3 ] "live cells"
Expect.equal
(List.last out)
{ Cells = [ cell 2 0; cell 2 1; cell 2 2 ]
Running = true
Seed = 7u
Generation = 1 }
"last state")
testCase "lifeMain asks for a seed, draws the empty world first, and then a click as a live cell" (fun () ->
let traced = IO.trace 42u (lifeMain ())
Expect.equal traced.Ops [ IO.RandomSeed ] "ops"
let first, next = Stream.step (Time 0L) traced.Result
let second, _ = Stream.step (Click(17, 33)) next
Expect.equal (drawn (List.head first)) (lifeView (initialLife 42u)) "first drawing"
Expect.equal
(drawn (List.head second))
(lifeView { initialLife 42u with Cells = [ cell 1 2 ] })
"second drawing")
testCase "lifeMain: after ten seconds in a background tab the world advances by 250 ms, not by ten seconds" (fun () ->
let _, afterFirst = Stream.step (Time 0L) (IO.trace 42u (lifeMain ())).Result
Expect.equal (List.length (fst (Stream.step (Time 10000L) afterFirst))) 1 "one drawing")
// ---- the runtime (step 7 of the module); the browser glue in web/ is given
testCase "runApp registers a click handler with the platform" (fun () ->
let p = FakePlatform 42u
Runtime.runApp p.Platform (IO.pure (Stream.clicks |> Stream.map (fun _ -> IO.pure ())))
Expect.equal p.Registered [ "click"; "down"; "time"; "up" ] "registered")
testCase "runApp feeds clicks to the stream" (fun () ->
let p = FakePlatform 42u
let program =
IO.pure (Stream.clicks |> Stream.map (fun (x, y) -> IO.draw (View.Rect(x, y, 1, 1, "#ffffff"))))
Runtime.runApp p.Platform program
p.FireClick(33, 47)
p.FireClick(0, 2)
Expect.equal
p.Calls
[ [ box "fillRect"; box 33; box 47; box 1; box 1; box "#ffffff" ]
[ box "fillRect"; box 0; box 2; box 1; box 1; box "#ffffff" ] ]
"calls")
testCase "runApp runs Life: a click on the canvas draws the world with that cell alive" (fun () ->
let p = FakePlatform 42u
Runtime.runApp p.Platform (lifeMain ())
p.FireTime 0L
p.Clear()
p.FireClick(100, 250)
Expect.contains
p.Calls
[ box "fillRect"; box (6 * 16 + 1); box (15 * 16 + 1); box 14; box 14; box "#7cb342" ]
"the live cell")
testCase "Snake and Pong ignore clicks: their actions and drawings are the same with and without them" (fun () ->
let withClicks = [ Time 0L; Click(5, 5); Time 25L; KeyDown "ArrowUp"; Click(300, 300); Time 200L ]
let without =
withClicks
|> List.filter (fun e ->
match e with
| Click _ -> false
| _ -> true)
Expect.equal (Stream.run withClicks App.speedActions) (Stream.run without App.speedActions) "speedActions"
Expect.equal
(Stream.run withClicks Pong.App.pongActions)
(Stream.run without Pong.App.pongActions)
"pongActions"
Expect.equal (App.play 42u withClicks (App.main ())) (App.play 42u without (App.main ())) "play main") ]
]
+5
View File
@@ -13,16 +13,21 @@
<Compile Include="M03Rules.fs" />
<Compile Include="M04Random.fs" />
<Compile Include="M04Spawn.fs" />
<Compile Include="M04State.fs" />
<Compile Include="M05Game.fs" />
<Compile Include="M06View.fs" />
<Compile Include="M07IO.fs" />
<Compile Include="M07bSafeIO.fs" />
<Compile Include="M08Stream.fs" />
<Compile Include="M09Helpers.fs" />
<Compile Include="M09Input.fs" />
<Compile Include="M09App.fs" />
<Compile Include="M09Runtime.fs" />
<Compile Include="M10Extensions.fs" />
<Compile Include="M10Replay.fs" />
<Compile Include="M11Pong.fs" />
<Compile Include="M12Check.fs" />
<Compile Include="M13Life.fs" />
<Compile Include="Purity.fs" />
<Compile Include="Main.fs" />
</ItemGroup>
+46 -2
View File
@@ -41,7 +41,48 @@ let private randomSeed () : uint32 =
crypto?getRandomValues (buf)
buf[0]
/// A Platform drawing on `canvas` (an HTML canvas element) and listening to the window's keys and frames.
// m10: where the best score survives a reload.
let private bestKey = "pure-snake-best"
// Storage can be missing, blocked (privacy settings; some browsers throw as soon as localStorage is touched) or hold
// anything: all of that reads as 0, and nothing throws. Only a non-negative whole number counts.
let private loadBest () : int =
try
let raw: string = window?localStorage?getItem (bestKey)
if isNull raw then
0
else
// Only what saveBest writes counts: decimal digits, at most 2147483647 (so all three tracks read alike).
let digits = raw.Length >= 1 && raw.Length <= 10 && Seq.forall (fun c -> c >= '0' && c <= '9') raw
if digits && float raw <= 2147483647.0 then int (float raw) else 0
with _ ->
0
// A record that cannot be stored is lost; the game goes on.
let private saveBest (score: int) : unit =
try
window?localStorage?setItem (bestKey, string score)
with _ ->
()
// m13: a click on the canvas, in canvas pixels. The page may show the canvas larger or smaller than its width and
// height (CSS, zoom) and draws a border round it, so the window coordinates of the mouse are made relative to the
// drawing area (inside the border) and then scaled. The listener is added when the runtime asks, not before.
let private onClick (canvas: obj) (cb: int -> int -> unit) : unit =
canvas?addEventListener ("click",
fun (e: obj) ->
let r = canvas?getBoundingClientRect ()
let scale (client: float) (start: float) (border: float) (size: float) (shown: float) =
int (System.Math.Floor((client - start - border) * size / shown))
cb
(scale e?clientX r?left canvas?clientLeft canvas?width canvas?clientWidth)
(scale e?clientY r?top canvas?clientTop canvas?height canvas?clientHeight))
/// A Platform drawing on `canvas` (an HTML canvas element) and listening to the window's keys and frames, and from
/// m13 to clicks on the canvas.
let create (canvas: obj) : Platform =
let ctx = canvas?getContext ("2d")
@@ -56,9 +97,12 @@ let create (canvas: obj) : Platform =
ctx?textAlign <- align
ctx?fillText (text, x, y)
RandomSeed = randomSeed
LoadBest = loadBest
SaveBest = saveBest
StartClock = startClock
OnKeyDown = listen "keydown"
OnKeyUp = listen "keyup" }
OnKeyUp = listen "keyup"
OnClick = onClick canvas }
/// The page's `<canvas id="game">`.
let gameCanvas () : obj = window?document?getElementById ("game")
+7
View File
@@ -0,0 +1,7 @@
/// fsharp/life.html loads this module (web/dist/LifeMain.js): one call runs Conway's Life (m13).
module Snake.Web.LifeMain
open Snake
// The same Platform as Snake's; Life listens to its clicks, and never asks for LoadBest or SaveBest.
Runtime.runApp (BrowserPlatform.create (BrowserPlatform.gameCanvas ())) (Life.App.lifeMain ())
+1
View File
@@ -3,4 +3,5 @@ module Snake.Web.PongMain
open Snake
// The same Platform as Snake's; pongMain () never asks for LoadBest or SaveBest, so the stored best is untouched.
Runtime.runApp (BrowserPlatform.create (BrowserPlatform.gameCanvas ())) (Pong.App.pongMain ())
+39
View File
@@ -0,0 +1,39 @@
/// fsharp/replay.html loads this module (web/dist/ReplayMain.js): the replay viewer of m10.
/// The recording is plain JSON next to the test fixtures; the page is served from the repository root by
/// scripts/serve.mjs, so it can be fetched (relative to the page, fsharp/replay.html). It is decoded with plain
/// JavaScript interop, without a JSON library, and the viewer starts once it has arrived.
module Snake.Web.ReplayMain
open Fable.Core
open Fable.Core.JsInterop
open Snake
open Snake.Model
open Snake.Replay
[<Global>]
let private window: obj = jsNative
let private direction (dir: string) : Direction =
match dir with
| "Up" -> Up
| "Down" -> Down
| "Left" -> Left
| "Right" -> Right
| other -> failwith $"unknown direction in the recording: {other}"
// A recording holds only Tick and Turn: {"tag":"Tick"} or {"tag":"Turn","dir":"Up"}.
let private action (a: obj) : Action =
match (a?tag: string) with
| "Tick" -> Tick
| "Turn" -> Turn(direction a?dir)
| other -> failwith $"unknown action in the recording: {other}"
let private recording (data: obj) : Recording =
{ Seed = uint32 (data?seed: float)
Actions = (data?actions: obj[]) |> Array.map action |> List.ofArray }
let private start (data: obj) : unit =
Runtime.runApp (BrowserPlatform.create (BrowserPlatform.gameCanvas ())) (replayMain (recording data))
window?fetch("../fixtures/replay-sample.json")?``then``(fun (response: obj) -> response?json ())?``then``(start)
|> ignore
+7
View File
@@ -19,13 +19,20 @@
<Compile Include="../src/Input.fs" />
<Compile Include="../src/App.fs" />
<Compile Include="../src/Runtime.fs" />
<Compile Include="../src/Replay.fs" />
<Compile Include="../src/Pong/Model.fs" />
<Compile Include="../src/Pong/Rules.fs" />
<Compile Include="../src/Pong/View.fs" />
<Compile Include="../src/Pong/App.fs" />
<Compile Include="../src/Life/Model.fs" />
<Compile Include="../src/Life/Rules.fs" />
<Compile Include="../src/Life/View.fs" />
<Compile Include="../src/Life/App.fs" />
<Compile Include="BrowserPlatform.fs" />
<Compile Include="SnakeMain.fs" />
<Compile Include="PongMain.fs" />
<Compile Include="ReplayMain.fs" />
<Compile Include="LifeMain.fs" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="Fable.Core" Version="5.6.0" />