98 lines
4.4 KiB
FSharp
98 lines
4.4 KiB
FSharp
module Snake.Tests.M07IO
|
|
|
|
open Expecto
|
|
open Snake
|
|
open Snake.View
|
|
open Snake.IO
|
|
|
|
let private rectAt (x: uint32) : Shape = Rect(int x, 0, 1, 1, "#000000")
|
|
let private r1 = rectAt 0u
|
|
let private t1 = Text(1, 2, "hi", "#ffffff", 16, "left")
|
|
|
|
// Monad laws, checked by interpreting both sides and comparing { Result; Ops }.
|
|
let private programs: (string * (unit -> IO<uint32>)) list =
|
|
[ "a pure value", (fun () -> IO.pure 4u)
|
|
"randomSeed", (fun () -> IO.randomSeed ())
|
|
"a draw followed by reading the seed", (fun () -> IO.draw r1 |> IO.bind (fun () -> IO.randomSeed ())) ]
|
|
|
|
let private f (n: uint32) : IO<uint32> = IO.draw (rectAt n) |> IO.bind (fun () -> IO.pure (n * 2u))
|
|
let private g (n: uint32) : IO<uint32> = IO.randomSeed () |> IO.map (fun s -> s + n)
|
|
|
|
[<Tests>]
|
|
let tests =
|
|
testList "M07 IO" [
|
|
yield testCase "trace of pure 3 has result 3 and no ops" (fun () ->
|
|
Expect.equal (IO.trace 0u (IO.pure 3)) { Result = 3; Ops = [] } "trace")
|
|
|
|
yield testCase "randomSeed is answered with the seed given to trace" (fun () ->
|
|
Expect.equal (IO.trace 9u (IO.randomSeed ())).Result 9u "result")
|
|
|
|
yield testCase "randomSeed records a RandomSeed op" (fun () ->
|
|
Expect.equal (IO.trace 9u (IO.randomSeed ())).Ops [ RandomSeed ] "ops")
|
|
|
|
yield testCase "effect op is an Effect whose continuation is pure" (fun () ->
|
|
match IO.effect RandomSeed with
|
|
| Effect(op, k) ->
|
|
Expect.equal op RandomSeed "op"
|
|
|
|
match k (Seed 5u) with
|
|
| Pure(Seed 5u) -> ()
|
|
| other -> failtest $"expected Pure (Seed 5u), got %A{other}"
|
|
| other -> failtest $"expected an Effect, got %A{other}")
|
|
|
|
yield testCase "draw records a Draw op and produces ()" (fun () ->
|
|
Expect.equal (IO.trace 0u (IO.draw r1)) { Result = (); Ops = [ Draw r1 ] } "trace")
|
|
|
|
yield testCase "drawScene draws the shapes in order" (fun () ->
|
|
Expect.equal (IO.trace 0u (IO.drawScene [ r1; t1 ])).Ops [ Draw r1; Draw t1 ] "ops")
|
|
|
|
yield testCase "drawScene of an empty scene has no ops" (fun () ->
|
|
Expect.equal (IO.trace 0u (IO.drawScene [])).Ops [] "ops")
|
|
|
|
yield testCase "sequence of nothing has no ops" (fun () ->
|
|
Expect.equal (IO.trace 0u (IO.sequence [])) { Result = (); Ops = [] } "trace")
|
|
|
|
yield testCase "sequence runs effects left to right" (fun () ->
|
|
Expect.equal
|
|
(IO.trace 0u (IO.sequence [ IO.randomSeed () |> IO.map ignore; IO.draw t1; IO.draw r1 ])).Ops
|
|
[ RandomSeed; Draw t1; Draw r1 ]
|
|
"ops")
|
|
|
|
yield testCase "map transforms the result without adding ops" (fun () ->
|
|
Expect.equal
|
|
(IO.trace 41u (IO.randomSeed () |> IO.map (fun s -> s + 1u)))
|
|
{ Result = 42u; Ops = [ RandomSeed ] }
|
|
"trace")
|
|
|
|
yield testCase "bind passes the result of the first IO to the second" (fun () ->
|
|
Expect.equal
|
|
(IO.trace 7u (IO.randomSeed () |> IO.bind (fun s -> IO.draw (rectAt s)))).Ops
|
|
[ RandomSeed; Draw(rectAt 7u) ]
|
|
"ops")
|
|
|
|
yield testCase "building IO.map throwingF io does not throw" (fun () ->
|
|
let boom (_: uint32) : uint32 = failwith "boom"
|
|
IO.randomSeed () |> IO.map boom |> ignore) // only builds a description
|
|
|
|
yield testCase "tracing IO.map throwingF io runs f and throws" (fun () ->
|
|
let boom (_: uint32) : uint32 = failwith "boom"
|
|
|
|
Expect.throwsC
|
|
(fun () -> IO.randomSeed () |> IO.map boom |> IO.trace 0u |> ignore)
|
|
(fun e -> Expect.equal e.Message "boom" "exception message"))
|
|
|
|
for name, program in programs do
|
|
yield testCase $"left identity holds for {name}" (fun () ->
|
|
let a = (IO.trace 5u (program ())).Result
|
|
Expect.equal (IO.trace 5u (IO.pure a |> IO.bind f)) (IO.trace 5u (f a)) "left identity")
|
|
|
|
yield testCase $"right identity holds for {name}" (fun () ->
|
|
Expect.equal (IO.trace 5u (program () |> IO.bind IO.pure)) (IO.trace 5u (program ())) "right identity")
|
|
|
|
yield testCase $"associativity holds for {name}" (fun () ->
|
|
Expect.equal
|
|
(IO.trace 5u (program () |> IO.bind f |> IO.bind g))
|
|
(IO.trace 5u (program () |> IO.bind (fun x -> f x |> IO.bind g)))
|
|
"associativity")
|
|
]
|