// free monad for memory operations.
// Read: int -> float
// Write: int * float -> unit

(*
STEP 1:
Create types for input and output for each of the operations.
*)

type MemReadIn = int
type MemReadOut = float

type MemWriteIn = int * float
type MemWriteOut = unit

(*
STEP 2:
Create a functor for the instructions
*)

type MemInstruction<'a> =
    | MemRead of (MemReadIn * (MemReadOut -> 'a))
    | MemWrite of (MemWriteIn * (MemWriteOut -> 'a))

// (a -> b) -> Ma -> Mb
let mapI f = function
    | MemRead (args, next) -> MemRead(args, next >> f)
    | MemWrite (args, next) -> MemWrite(args, next >> f)

(*
STEP 3:
Create a free monad for the program
*)

type MemProgram<'a> =
    | Free of MemInstruction<MemProgram<'a>>
    | Pure of 'a

// (a -> Mb) -> Ma -> Mb
let rec bind f = function
    | Free x -> x |> mapI (bind f) |> Free
    | Pure x -> f x

(*
STEP 4:
Create the computation expression builder
*)

type MemBuilder () =
    member __.Bind (x, f) = bind f x
    member __.Return (x) = Pure x
    member __.ReturnFrom m = m
    member __.Zero () = Pure ()

let mem = new MemBuilder ()
let memread args = Free (MemRead (args, Pure))
let memwrite args = Free (MemWrite (args, Pure))

(*
STEP 5:
Interpreter:
*)
let mutable x = 0.

let read (args:MemReadIn) : MemReadOut =
    printfn "Read args: %O" args
    x

let write (args:MemWriteIn) : MemWriteOut =
    printfn "Write args: %O" args
    let (i, v) = args
    x <- v
    ()

let rec interpret = function
    | Pure x -> x
    | Free (MemRead (x, next)) -> x |> read |> next |> interpret
    | Free (MemWrite (x, next)) -> x |> write |> next |> interpret

(*
TESTS
*)

let workflow = mem {
        do! memwrite (1, 10.)
        let! x = memread (1)
        return x
    }

workflow |> interpret |> printfn "Res: %O"