/// m07 io: effects as values. An IO is a plain-data description of a program; nothing runs until interpreted.
///   - `Pure a`          done, with a value
///   - `Effect (op, k)`  perform `op`, then continue with `k result`
module Snake.IO

open Snake.View

/// An operation an IO program can ask the outside world to perform.
type Op =
    | Draw of Shape
    | RandomSeed

/// What the outside world answers: `Done` for a `Draw`, `Seed value` for a `RandomSeed`.
type OpResult =
    | Done
    | Seed of uint32

type IO<'a> =
    | Pure of 'a
    | Effect of Op * (OpResult -> IO<'a>)

/// The result of `trace`: the final value and the operations performed, in execution order.
type Traced<'a> = { Result: 'a; Ops: Op list }

let pure (a: 'a) : IO<'a> = Pure a

let effect (op: Op) : IO<OpResult> = Effect(op, pure)

// Pure: apply f now. Effect: keep the op, and extend the continuation so f runs after k.
// Nothing is performed here, we only build a bigger description.
let rec bind (f: 'a -> IO<'b>) (io: IO<'a>) : IO<'b> =
    match io with
    | Pure a -> f a
    | Effect(op, k) -> Effect(op, fun result -> bind f (k result))

let map (f: 'a -> 'b) (io: IO<'a>) : IO<'b> = bind (fun a -> Pure(f a)) io

let sequence (ios: IO<unit> list) : IO<unit> =
    List.foldBack (fun io rest -> bind (fun () -> rest) io) ios (pure ())

let draw (shape: Shape) : IO<unit> = effect (Draw shape) |> map ignore

// A function of unit: F# evaluates module-level values as soon as the module is used, and a description
// is cheap to rebuild. An interpreter that answers a RandomSeed with anything but a Seed is broken; say so loudly.
let randomSeed () : IO<uint32> =
    effect RandomSeed
    |> map (fun result ->
        match result with
        | Seed value -> value
        | Done -> failwith "RandomSeed must be answered with a Seed")

let drawScene (scene: Scene) : IO<unit> = sequence (List.map draw scene)

// Answer each op with a canned result, collecting the ops as we go. Tail recursion: the compiler turns it
// into a loop, so long programs cannot overflow the stack, and still nothing is mutated.
let trace (seed: uint32) (io: IO<'a>) : Traced<'a> =
    let rec go io performed =
        match io with
        | Pure a -> { Result = a; Ops = List.rev performed }
        | Effect(op, k) ->
            let answer =
                match op with
                | RandomSeed -> Seed seed
                | Draw _ -> Done

            go (k answer) (op :: performed)

    go io []