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
@@ -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>