feat(fsharp): m09 input/app/runtime and m10 extensions with tests

Co-Authored-By: Claude Opus 5.5 <[email protected]>

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<Action> =
+    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<Action> =
+    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<Action>) : Stream<GameState> =
+    actions |> Stream.scan Game.update (Spawn.newGame seed) |> Stream.startWith (Spawn.newGame seed)
+
+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.
+// Nothing runs here; Runtime interprets it.
+let main () : IO<Stream<IO<unit>>> =
+    IO.randomSeed () |> IO.map (fun seed -> states seed speedActions |> Stream.map render)

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

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<Stream<IO<unit>>>) : 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))

fsharp/solutions/Snake.fsproj

@@ -15,5 +15,8 @@
     <Compile Include="View.fs" />
     <Compile Include="IO.fs" />
     <Compile Include="Stream.fs" />
+    <Compile Include="Input.fs" />
+    <Compile Include="App.fs" />
+    <Compile Include="Runtime.fs" />
   </ItemGroup>
 </Project>

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<Action> = 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<Action> = 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<Action>) : Stream<GameState> = failwith "TODO m09"
+
+/// The drawing of one state, as an IO: `IO.drawScene (View.view state)`.
+let render (state: GameState) : IO<unit> = 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<Stream<IO<unit>>> = failwith "TODO m09"

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"

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<Stream<IO<unit>>>) : unit = failwith "TODO m09"

fsharp/src/Snake.fsproj

@@ -15,5 +15,8 @@
     <Compile Include="View.fs" />
     <Compile Include="IO.fs" />
     <Compile Include="Stream.fs" />
+    <Compile Include="Input.fs" />
+    <Compile Include="App.fs" />
+    <Compile Include="Runtime.fs" />
   </ItemGroup>
 </Project>

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
+
+[<Tests>]
+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")
+    ]

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<Stream<IO<unit>>> =
+    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<unit>) : Shape list =
+    (IO.trace 0u io).Ops
+    |> List.choose (fun op ->
+        match op with
+        | Draw shape -> Some shape
+        | RandomSeed -> None)

fsharp/tests/M09Input.fs

@@ -0,0 +1,12 @@
+module Snake.Tests.M09Input
+
+open Expecto
+open Snake
+open Snake.Tests.Fixtures
+
+[<Tests>]
+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")
+    ]

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<obj list>()
+    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")
+
+[<Tests>]
+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")
+    ]

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 ]
+
+[<Tests>]
+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")
+    ]

fsharp/tests/Snake.Tests.fsproj

@@ -17,6 +17,11 @@
     <Compile Include="M06View.fs" />
     <Compile Include="M07IO.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="Purity.fs" />
     <Compile Include="Main.fs" />
   </ItemGroup>