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

module Snake.Tests.M11Pong

open System.Text.Json
open Expecto
open Snake
open Snake.Model
open Snake.Stream
open Snake.Pong.Model
open Snake.Pong.Rules
open Snake.Pong.View
open Snake.Pong.App
open Snake.Tests.Fixtures
open Snake.Tests.M09Helpers

let private pongStatus (v: JsonElement) : PongStatus =
    match str v with
    | "Playing" -> PongStatus.Playing
    | "Over" -> PongStatus.Over
    | other -> failwith $"unknown pong status: {other}"

let private pongState (v: JsonElement) : PongState =
    let vel = prop "vel" v
    let held = prop "held" v
    let score = prop "score" v

    { Ball = point (prop "ball" v)
      Vel = { Dx = num (prop "dx" vel); Dy = num (prop "dy" vel) }
      Player = num (prop "player" v)
      Cpu = num (prop "cpu" v)
      Held = { Up = bool (prop "up" held); Down = bool (prop "down" held) }
      Score = { Score.Player = num (prop "player" score); Cpu = num (prop "cpu" score) }
      Status = pongStatus (prop "status" v)
      Seed = u32 (prop "seed" v)
      Frame = num (prop "frame" v) }

// `Paddle` only has Up and Down, so a JSON key like "constructor" decodes to None instead of crashing.
let private paddle (v: JsonElement) : Paddle option =
    match str v with
    | "Up" -> Some Paddle.Up
    | "Down" -> Some Paddle.Down
    | _ -> None

/// Decode a PongAction; `None` when its key is not a `Paddle` (such an action cannot even be built in F#).
let private pongAction (v: JsonElement) : PongAction option =
    match str (prop "tag" v) with
    | "Press" -> paddle (prop "key" v) |> Option.map PongAction.Press
    | "Release" -> paddle (prop "key" v) |> Option.map PongAction.Release
    | "Frame" -> Some PongAction.Frame
    | "Restart" -> Some PongAction.Restart
    | other -> failwith $"unknown pong action tag: {other}"

let private undecodable (e: JsonElement) : PongAction = failwith $"undecodable expected action: {e}"

[<Tests>]
let tests =
    testList "M11 Pong" [
        yield! fixtureTests "m11-pong-update" "pongUpdate" (fun c ->
            let state = pongState (arg 0 c)

            match pongAction (arg 1 c) with
            | Some action -> Expect.equal (pongUpdate state action) (pongState (expected c)) "pongUpdate"
            // An unknown key is ruled out by the types: Paddle has no such case. What the fixture asks for
            // (state unchanged) therefore holds by construction; check that it says so.
            | None -> Expect.equal (pongState (expected c)) state "an unknown key changes nothing")

        yield! fixtureTests "m11-pong-view" "pongView" (fun c ->
            Expect.equal (pongView (pongState (arg 0 c))) (list shape (expected c)) "pongView")

        yield! fixtureTests "m11-pong-key" "pongKey" (fun c ->
            let expectedAction = opt (fun e -> pongAction e |> Option.defaultWith (fun () -> undecodable e)) (expected c)
            Expect.equal (pongKey (bool (arg 0 c)) (str (arg 1 c))) expectedAction "pongKey")

        testCase "the court is 80 by 50 cells of 8 pixels, with 8-cell paddles" (fun () ->
            Expect.equal [ W; H; PCELL; PADDLE; PLAYER_X; CPU_X; WIN ] [ 80; 50; 8; 8; 2; 77; 5 ] "constants")

        testCase "initialPong puts the ball in the middle, both paddles centred, and nobody ahead" (fun () ->
            Expect.equal
                (initialPong 5u)
                { Ball = { X = 40; Y = 25 }
                  Vel = { Dx = 1; Dy = 1 }
                  Player = 21
                  Cpu = 21
                  Held = { Up = false; Down = false }
                  Score = { Score.Player = 0; Cpu = 0 }
                  Status = PongStatus.Playing
                  Seed = 5u
                  Frame = 0 }
                "initialPong")

        testCase "clamp keeps a number inside [lo, hi]" (fun () ->
            Expect.equal [ clamp 0 42 -1; clamp 0 42 17; clamp 0 42 43 ] [ 0; 17; 42 ] "clamp")

        testCase "pongUpdate does not modify the state it is given" (fun () ->
            let s = initialPong 0u
            pongUpdate s PongAction.Frame |> ignore
            Expect.equal s (initialPong 0u) "unchanged")

        // 3000 frames with no one touching the keys: the ball must always stay on the court and the match must end.
        testCase "an idle match stays on the court and ends once someone reaches five" (fun () ->
            let states = List.replicate 3000 PongAction.Frame |> List.scan pongUpdate (initialPong 3u)

            Expect.all states (fun s -> s.Ball.Y >= 0 && s.Ball.Y < H && s.Ball.X >= 0 && s.Ball.X < W) "ball on court"

            Expect.all
                states
                (fun s -> s.Player >= 0 && s.Player <= H - PADDLE && s.Cpu >= 0 && s.Cpu <= H - PADDLE)
                "paddles on court"

            let last = List.last states
            Expect.equal last.Status PongStatus.Over "match over"
            Expect.equal (max last.Score.Player last.Score.Cpu) WIN "winner has five")

        testCase "the clock runs every 30 ms" (fun () -> Expect.equal FRAME_MS_PONG 30L "FRAME_MS_PONG")

        testCase "pongActions turns the clock into Frames and keys into Press, Release and Restart" (fun () ->
            Expect.equal
                (Stream.run
                    [ Time 30L; KeyDown "ArrowUp"; KeyUp "ArrowUp"; KeyDown "s"; KeyDown "r"; KeyUp "r"; KeyDown "x"; Time 90L ]
                    pongActions)
                [ PongAction.Frame
                  PongAction.Press Paddle.Up
                  PongAction.Release Paddle.Up
                  PongAction.Press Paddle.Down
                  PongAction.Restart
                  PongAction.Frame
                  PongAction.Frame ]
                "actions")

        testCase "pongStates starts with the new match, then yields one state per action" (fun () ->
            let out = pongStates 42u pongActions |> Stream.run [ Time 30L; KeyDown "w"; Time 60L ]
            Expect.equal (List.length out) 4 "length"
            Expect.equal (List.head out) (initialPong 42u) "first state"
            Expect.equal (out |> List.map (fun s -> s.Frame)) [ 0; 1; 1; 2 ] "frames"
            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"
            let first, next = Stream.step (Time 0L) traced.Result
            let second, _ = Stream.step (Time 30L) next
            Expect.equal (drawn (List.head first)) (pongView (initialPong 42u)) "first drawing"

            Expect.equal
                (drawn (List.head second))
                (pongView (pongUpdate (initialPong 42u) PongAction.Frame))
                "second drawing")
    ]