functional-programming-snake/fsharp/tests/M09Runtime.fs

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, 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 ]
          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
          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 =
    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")
    ]