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