From 55f8b0b30fa0a643112575dc60f0643085f74176 Mon Sep 17 00:00:00 2001 From: Lucas Winther Date: Thu, 29 Oct 2026 00:56:27 +0100 Subject: [PATCH] feat(fsharp): m09 input/app/runtime and m10 extensions with tests Co-Authored-By: Claude Opus 5.5 --- fsharp/solutions/App.fs | 28 ++++++++ fsharp/solutions/Input.fs | 15 +++++ fsharp/solutions/Runtime.fs | 46 +++++++++++++ fsharp/solutions/Snake.fsproj | 3 + fsharp/src/App.fs | 33 +++++++++ fsharp/src/Input.fs | 10 +++ fsharp/src/Runtime.fs | 32 +++++++++ fsharp/src/Snake.fsproj | 3 + fsharp/tests/M09App.fs | 63 +++++++++++++++++ fsharp/tests/M09Helpers.fs | 19 ++++++ fsharp/tests/M09Input.fs | 12 ++++ fsharp/tests/M09Runtime.fs | 115 ++++++++++++++++++++++++++++++++ fsharp/tests/M10Extensions.fs | 51 ++++++++++++++ fsharp/tests/Snake.Tests.fsproj | 5 ++ 14 files changed, 435 insertions(+) create mode 100644 fsharp/solutions/App.fs create mode 100644 fsharp/solutions/Input.fs create mode 100644 fsharp/solutions/Runtime.fs create mode 100644 fsharp/src/App.fs create mode 100644 fsharp/src/Input.fs create mode 100644 fsharp/src/Runtime.fs create mode 100644 fsharp/tests/M09App.fs create mode 100644 fsharp/tests/M09Helpers.fs create mode 100644 fsharp/tests/M09Input.fs create mode 100644 fsharp/tests/M09Runtime.fs create mode 100644 fsharp/tests/M10Extensions.fs diff --git a/fsharp/solutions/App.fs b/fsharp/solutions/App.fs new file mode 100644 index 0000000..00d9f62 --- /dev/null +++ b/fsharp/solutions/App.fs @@ -0,0 +1,28 @@ +/// m09 app: the whole game wired together as values: streams of actions in, a stream of drawings out. +module Snake.App + +open Snake.Model +open Snake.IO +open Snake.Stream + +let TICK_MS = 150L +let FRAME_MS = 25L + +// Everything that can happen to the game: a Tick every TICK_MS, and an action for each bound key. +let classicActions: Stream = + Stream.merge (Stream.interval TICK_MS |> Stream.map (fun _ -> Tick)) (Stream.keyDowns |> Stream.choose Input.keyToAction) + +// m10: a Frame every FRAME_MS instead of a Tick; the game itself decides (movesEvery) which frames take a step. +let speedActions: Stream = + Stream.merge (Stream.interval FRAME_MS |> Stream.map (fun _ -> Frame)) (Stream.keyDowns |> Stream.choose Input.keyToAction) + +// Actions folded into game states. startWith puts the initial state first so it is drawn right away. +let states (seed: uint32) (actions: Stream) : Stream = + actions |> Stream.scan Game.update (Spawn.newGame seed) |> Stream.startWith (Spawn.newGame seed) + +let render (state: GameState) : IO = 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. +// Nothing runs here; Runtime interprets it. +let main () : IO>> = + IO.randomSeed () |> IO.map (fun seed -> states seed speedActions |> Stream.map render) diff --git a/fsharp/solutions/Input.fs b/fsharp/solutions/Input.fs new file mode 100644 index 0000000..f1b4ef3 --- /dev/null +++ b/fsharp/solutions/Input.fs @@ -0,0 +1,15 @@ +/// m09 input: from keyboard keys to game actions. +module Snake.Input + +open Snake.Model + +// A match on string literals is the lookup table; `|` lists the alternatives. +let keyToAction (key: string) : Action option = + match key with + | "ArrowUp" | "w" | "W" -> Some(Turn Up) + | "ArrowDown" | "s" | "S" -> Some(Turn Down) + | "ArrowLeft" | "a" | "A" -> Some(Turn Left) + | "ArrowRight" | "d" | "D" -> Some(Turn Right) + | " " -> Some TogglePause // m10 + | "r" | "R" -> Some Restart // m10 + | _ -> None diff --git a/fsharp/solutions/Runtime.fs b/fsharp/solutions/Runtime.fs new file mode 100644 index 0000000..896b11e --- /dev/null +++ b/fsharp/solutions/Runtime.fs @@ -0,0 +1,46 @@ +/// m09 runtime: the single impure place in the course (with the web/ glue); everything else only builds values. +/// Here we interpret IO descriptions against a Platform and hold the one mutable variable, the current stream. +module Snake.Runtime + +open Snake.View +open Snake.IO +open Snake.Stream + +/// The outside world, as the runtime sees it. +type Platform = + { FillRect: int -> int -> int -> int -> string -> unit + FillText: int -> int -> string -> string -> int -> string -> unit + RandomSeed: unit -> uint32 + StartClock: (int64 -> unit) -> unit + OnKeyDown: (string -> unit) -> unit + OnKeyUp: (string -> 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()) + | Draw(Rect(x, y, w, h, color)) -> + p.FillRect x y w h color + Done + | Draw(Text(x, y, text, color, size, align)) -> + p.FillText x y text color size align + Done + +// Tail recursive, so it compiles to a loop: a scene is hundreds of ops and the stack must not grow with them. +let rec runIO (p: Platform) (io: IO<'a>) : 'a = + match io with + | Pure a -> a + | Effect(op, k) -> runIO p (k (perform p op)) + +let runApp (p: Platform) (main: IO>>) : unit = + // The one mutable variable. F# closures cannot capture a `let mutable`, so it is a ref cell. + let stream = ref (runIO p main) + + let feed (event: Event) = + let ios, next = Stream.step event stream.Value + stream.Value <- next + List.iter (runIO p) ios + + p.OnKeyDown(fun key -> feed (KeyDown key)) + p.OnKeyUp(fun key -> feed (KeyUp key)) + p.StartClock(fun t -> feed (Time t)) diff --git a/fsharp/solutions/Snake.fsproj b/fsharp/solutions/Snake.fsproj index f444693..33fdeee 100644 --- a/fsharp/solutions/Snake.fsproj +++ b/fsharp/solutions/Snake.fsproj @@ -15,5 +15,8 @@ + + + diff --git a/fsharp/src/App.fs b/fsharp/src/App.fs new file mode 100644 index 0000000..6311886 --- /dev/null +++ b/fsharp/src/App.fs @@ -0,0 +1,33 @@ +/// m09 app: the whole game wired together as values: streams of actions in, a stream of drawings out. +module Snake.App + +open Snake.Model +open Snake.IO +open Snake.Stream + +/// Milliseconds between game steps. +let TICK_MS = 150L + +/// Milliseconds between animation frames (m10). +let FRAME_MS = 25L + +/// 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.) +let classicActions: Stream = Stream(fun _ -> failwith "TODO m09") + +/// (m10) Like `classicActions`, but the clock emits `Frame` every FRAME_MS instead of `Tick` every TICK_MS; +/// key presses are translated by `Input.keyToAction` as before (now including pause and restart). +let speedActions: Stream = Stream(fun _ -> failwith "TODO m10") + +/// Fold a stream of actions into a stream of game states: start from `Spawn.newGame seed`, apply `Game.update` to +/// each action (scan), and emit the initial state first (startWith) so there is something to draw before anything happens. +let states (seed: uint32) (actions: Stream) : Stream = failwith "TODO m09" + +/// The drawing of one state, as an IO: `IO.drawScene (View.view state)`. +let render (state: GameState) : IO = failwith "TODO m09" + +/// 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`. +let main () : IO>> = failwith "TODO m09" diff --git a/fsharp/src/Input.fs b/fsharp/src/Input.fs new file mode 100644 index 0000000..81c4142 --- /dev/null +++ b/fsharp/src/Input.fs @@ -0,0 +1,10 @@ +/// m09 input: from keyboard keys to game actions. +module Snake.Input + +open Snake.Model + +/// Translate a keyboard key name (as in the browser's `KeyboardEvent.key`) into the action it triggers, if any. +/// m09: "ArrowUp"/"w"/"W" -> `Some (Turn Up)`, "ArrowDown"/"s"/"S" -> Down, "ArrowLeft"/"a"/"A" -> Left, +/// "ArrowRight"/"d"/"D" -> Right. Any other key -> `None`. +/// (m10) " " (Space) -> `Some TogglePause`, "r"/"R" -> `Some Restart`. +let keyToAction (key: string) : Action option = failwith "TODO m09" diff --git a/fsharp/src/Runtime.fs b/fsharp/src/Runtime.fs new file mode 100644 index 0000000..11cee9f --- /dev/null +++ b/fsharp/src/Runtime.fs @@ -0,0 +1,32 @@ +/// m09 runtime: the single impure place in the course (with the web/ glue); everything else only builds values. +/// Here one mutable variable is allowed. Keep it tiny. +module Snake.Runtime + +open Snake.View +open Snake.IO +open Snake.Stream + +/// The outside world, as the runtime sees it. The browser builds one from a canvas (web/BrowserPlatform.fs); +/// tests build a fake that records calls. +type Platform = + { FillRect: int -> int -> int -> int -> string -> unit + FillText: int -> int -> string -> string -> int -> string -> unit + /// A random unsigned 32-bit seed. + RandomSeed: unit -> uint32 + /// Call `onTime t` again and again, `t` = milliseconds since the clock started. + StartClock: (int64 -> unit) -> unit + OnKeyDown: (string -> unit) -> unit + OnKeyUp: (string -> 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`. +/// 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" + +/// Run the program: `runIO p main` gives the stream; keep the current stream in the one mutable variable +/// (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. +let runApp (p: Platform) (main: IO>>) : unit = failwith "TODO m09" diff --git a/fsharp/src/Snake.fsproj b/fsharp/src/Snake.fsproj index f444693..33fdeee 100644 --- a/fsharp/src/Snake.fsproj +++ b/fsharp/src/Snake.fsproj @@ -15,5 +15,8 @@ + + + diff --git a/fsharp/tests/M09App.fs b/fsharp/tests/M09App.fs new file mode 100644 index 0000000..462c65f --- /dev/null +++ b/fsharp/tests/M09App.fs @@ -0,0 +1,63 @@ +module Snake.Tests.M09App + +open Expecto +open Snake +open Snake.Model +open Snake.IO +open Snake.Stream +open Snake.Tests.M09Helpers + +[] +let tests = + testList "M09 App" [ + testCase "the game ticks every 150 ms" (fun () -> Expect.equal App.TICK_MS 150L "TICK_MS") + + testCase "classicActions turns the clock into Tick actions and keys into Turn actions" (fun () -> + Expect.equal + (Stream.run [ Time 150L; KeyDown "ArrowUp"; KeyDown "x"; Time 300L ] App.classicActions) + [ Tick; Turn Up; Tick ] + "actions") + + testCase "states starts with the new game, then yields one state per action" (fun () -> + let out = App.states 42u App.classicActions |> Stream.run [ Time 150L; KeyDown "ArrowUp"; Time 300L ] + Expect.equal (List.length out) 4 "length" + Expect.equal (List.head out) (Spawn.newGame 42u) "first state" + + Expect.equal + (out |> List.map (fun s -> List.head s.Snake)) + [ { X = 10; Y = 10 }; { X = 11; Y = 10 }; { X = 11; Y = 10 }; { X = 11; Y = 9 } ] + "heads" + + Expect.equal (out |> List.map (fun s -> s.NextDir)) [ Right; Right; Up; Up ] "nextDir" + Expect.equal (out |> List.map (fun s -> s.Dir)) [ Right; Right; Right; Up ] "dir") + + testCase "render draws the whole view of the state" (fun () -> + Expect.equal + (IO.trace 0u (App.render (Spawn.newGame 42u))).Ops + (View.view (Spawn.newGame 42u) |> List.map Draw) + "ops") + + 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" + 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") + + // `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 () -> + let stream = (IO.trace 42u (classicMain ())).Result + let first, next = Stream.step (Time 0L) stream + let second, _ = Stream.step (Time 150L) next + Expect.equal (drawn (List.head first)) (View.view (Spawn.newGame 42u)) "first drawing" + Expect.equal (List.length second) 1 "one more drawing" + Expect.notEqual (drawn (List.head second)) (drawn (List.head first)) "the game moved") + + // Holds before and after m10: whatever `main` ticks with, the clock must be wired in, so time passing produces more drawings. + testCase "main draws again once time has passed" (fun () -> + let stream = (IO.trace 42u (App.main ())).Result + let first, next = Stream.step (Time 0L) stream + let later, _ = Stream.step (Time 150L) next + Expect.equal (List.length first) 1 "one drawing" + Expect.isNonEmpty later "more drawings") + ] diff --git a/fsharp/tests/M09Helpers.fs b/fsharp/tests/M09Helpers.fs new file mode 100644 index 0000000..dd96444 --- /dev/null +++ b/fsharp/tests/M09Helpers.fs @@ -0,0 +1,19 @@ +/// Test helpers shared by the m09, m10 and m11 suites. +module Snake.Tests.M09Helpers + +open Snake +open Snake.View +open Snake.IO +open Snake.Stream + +/// The m09 program built from classicActions (ticks every 150 ms). The shipped `main` switches to speedActions in m10. +let classicMain () : IO>> = + IO.randomSeed () |> IO.map (fun seed -> App.states seed App.classicActions |> Stream.map App.render) + +/// The shapes an IO draws, in order (interpreted by `IO.trace`). +let drawn (io: IO) : Shape list = + (IO.trace 0u io).Ops + |> List.choose (fun op -> + match op with + | Draw shape -> Some shape + | RandomSeed -> None) diff --git a/fsharp/tests/M09Input.fs b/fsharp/tests/M09Input.fs new file mode 100644 index 0000000..be70070 --- /dev/null +++ b/fsharp/tests/M09Input.fs @@ -0,0 +1,12 @@ +module Snake.Tests.M09Input + +open Expecto +open Snake +open Snake.Tests.Fixtures + +[] +let tests = + testList "M09 Input" [ + yield! fixtureTests "m09-input" "keyToAction" (fun c -> + Expect.equal (Input.keyToAction (str (arg 0 c))) (opt action (expected c)) "keyToAction") + ] diff --git a/fsharp/tests/M09Runtime.fs b/fsharp/tests/M09Runtime.fs new file mode 100644 index 0000000..d7a7b76 --- /dev/null +++ b/fsharp/tests/M09Runtime.fs @@ -0,0 +1,115 @@ +module Snake.Tests.M09Runtime + +open Expecto +open Snake +open Snake.Model +open Snake.View +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) = + let calls = ResizeArray() + let mutable onTime: int64 -> unit = ignore + let mutable onDown: string -> unit = ignore + let mutable onUp: string -> unit = ignore + + 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 _.Platform: Platform = + { FillRect = fun x y w h color -> calls.Add [ box "fillRect"; box x; box y; box w; box h; box color ] + FillText = + fun x y text color size align -> + calls.Add [ box "fillText"; box x; box y; box text; box color; box size; box align ] + RandomSeed = + fun () -> + calls.Add [ box "randomSeed" ] + seed + StartClock = fun cb -> onTime <- cb + OnKeyDown = fun cb -> onDown <- cb + OnKeyUp = fun cb -> onUp <- cb } + +// What the platform should have been asked to draw for a scene. +let private expectedCalls (scene: Scene) : obj list list = + scene + |> List.map (fun shape -> + match shape with + | Rect(x, y, w, h, color) -> [ box "fillRect"; box x; box y; box w; box h; box color ] + | Text(x, y, text, color, size, align) -> [ box "fillText"; box x; box y; box text; box color; box size; box align ]) + +let private rect = Rect(1, 2, 3, 4, "#abcdef") +let private text = Text(5, 6, "hi", "#fff", 16, "center") + +[] +let tests = + testList "M09 Runtime" [ + testCase "runIO of a pure value returns it without touching the platform" (fun () -> + let p = FakePlatform 42u + Expect.equal (Runtime.runIO p.Platform (IO.pure 7)) 7 "result" + Expect.equal p.Calls [] "calls") + + testCase "runIO maps Draw Rect to FillRect x y w h color" (fun () -> + let p = FakePlatform 42u + Runtime.runIO p.Platform (IO.draw rect) + Expect.equal p.Calls [ [ box "fillRect"; box 1; box 2; box 3; box 4; box "#abcdef" ] ] "calls") + + testCase "runIO maps Draw Text to FillText x y text color size align" (fun () -> + let p = FakePlatform 42u + Runtime.runIO p.Platform (IO.draw text) + Expect.equal p.Calls [ [ box "fillText"; box 5; box 6; box "hi"; box "#fff"; box 16; box "center" ] ] "calls") + + testCase "runIO answers RandomSeed with platform.RandomSeed () and continues with it" (fun () -> + let p = FakePlatform 99u + Expect.equal (Runtime.runIO p.Platform (IO.randomSeed () |> IO.map (fun s -> s + 1u))) 100u "result" + Expect.equal p.Calls [ [ box "randomSeed" ] ] "calls") + + testCase "runIO performs effects in order" (fun () -> + let p = FakePlatform 42u + Runtime.runIO p.Platform (IO.sequence [ IO.draw rect; IO.draw text; IO.draw rect ]) + Expect.equal (p.Calls |> List.map List.head) [ box "fillRect"; box "fillText"; box "fillRect" ] "order") + + testCase "runIO handles 100000 effects without overflowing the stack" (fun () -> + let p = FakePlatform 42u + let n = 100000 + Runtime.runIO p.Platform (IO.sequence (List.replicate n (IO.draw rect))) + Expect.equal (List.length p.Calls) n "calls") + + testCase "runApp asks the platform for a seed once, at start, and draws nothing before the first event" (fun () -> + let p = FakePlatform 42u + Runtime.runApp p.Platform (classicMain ()) + Expect.equal p.Calls [ [ box "randomSeed" ] ] "calls") + + testCase "runApp draws the initial scene on the first clock tick, then the ticked scene after 150 ms" (fun () -> + let p = FakePlatform 42u + Runtime.runApp p.Platform (classicMain ()) + p.Clear() + p.FireTime 150L + + Expect.equal + p.Calls + (expectedCalls (View.view (Spawn.newGame 42u)) @ expectedCalls (View.view (Spawn.tick (Spawn.newGame 42u)))) + "calls") + + testCase "runApp feeds key presses to the game" (fun () -> + let p = FakePlatform 42u + Runtime.runApp p.Platform (classicMain ()) + p.FireTime 0L + p.Clear() + p.FireKey "ArrowUp" + p.FireTime 150L + let turned = { Spawn.newGame 42u with NextDir = Up } + Expect.equal p.Calls (expectedCalls (View.view turned) @ expectedCalls (View.view (Spawn.tick turned))) "calls") + + testCase "runApp ignores key releases and unmapped keys (no redraw)" (fun () -> + let p = FakePlatform 42u + Runtime.runApp p.Platform (classicMain ()) + p.FireTime 0L + p.Clear() + p.FireKeyUp "ArrowUp" + p.FireKey "x" + Expect.equal p.Calls [] "calls") + ] diff --git a/fsharp/tests/M10Extensions.fs b/fsharp/tests/M10Extensions.fs new file mode 100644 index 0000000..31d40fa --- /dev/null +++ b/fsharp/tests/M10Extensions.fs @@ -0,0 +1,51 @@ +module Snake.Tests.M10Extensions + +open Expecto +open Snake +open Snake.Model +open Snake.IO +open Snake.Stream +open Snake.Tests.Fixtures +open Snake.Tests.M09Helpers + +let private frameTimes = [ 25L; 50L; 75L; 100L; 125L; 150L; 175L; 200L ] + +[] +let tests = + testList "M10 Extensions" [ + yield! fixtureTests "m10-update" "update" (fun c -> + Expect.equal (Game.update (gameState (arg 0 c)) (action (arg 1 c))) (gameState (expected c)) "update") + + yield! fixtureTests "m10-moves-every" "movesEvery" (fun c -> + Expect.equal (Game.movesEvery (num (arg 0 c))) (num (expected c)) "movesEvery") + + yield! fixtureTests "m10-input" "keyToAction" (fun c -> + Expect.equal (Input.keyToAction (str (arg 0 c))) (opt action (expected c)) "keyToAction") + + 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 () -> + Expect.equal (Stream.run (List.map Time frameTimes) App.speedActions) (List.replicate 8 Frame) "actions") + + testCase "speedActions still turns keys into actions, including pause and restart" (fun () -> + Expect.equal + (Stream.run [ KeyDown " "; KeyDown "r"; KeyDown "ArrowUp" ] App.speedActions) + [ TogglePause; Restart; Turn Up ] + "actions") + + 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" + let first, afterFirst = Stream.step (Time 0L) traced.Result + Expect.equal (drawn (List.head first)) (View.view (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 + + let moved = + { start with + Snake = start.Snake |> List.map (fun p -> { p with X = p.X + 1 }) + Frame = 8 } + + Expect.equal (drawn drawings[7]) (View.view moved) "moved snake") + ] diff --git a/fsharp/tests/Snake.Tests.fsproj b/fsharp/tests/Snake.Tests.fsproj index 660976a..a1e85df 100644 --- a/fsharp/tests/Snake.Tests.fsproj +++ b/fsharp/tests/Snake.Tests.fsproj @@ -17,6 +17,11 @@ + + + + +