FreeMonad.fs

open System

type TurtleProgram<'a> =
    | Stop     of 'a
    | PenUp    of TurtleProgram<'a>
    | PenDown  of TurtleProgram<'a>

let returnT x =
    Stop x

let rec bindT f inst  =
    match inst with
    | Stop x ->
        f x
    | PenUp(next) ->
        PenUp(bindT f next)
    | PenDown(next) ->
        PenDown(bindT f next)

type TurtleProgramBuilder() =
    member this.Return(x) = returnT x
    member this.Bind(x,f) = bindT f x
    member this.Zero(x) = returnT ()

let turtleProgram = TurtleProgramBuilder ()

let rec interpretAsDistance program =
    let recurse = interpretAsDistance
    
    let log = printfn "%s"

    match program with
    | Stop a ->
        log "stop"
        0
    | PenUp next ->
        log "pen up"
        let nextProgram = next
        recurse nextProgram
    | PenDown next ->
        log "pen down"
        let nextProgram = next
        recurse nextProgram

let penup = (PenUp (Stop ()))
let pendown = (PenDown (Stop ()))

let pp = turtleProgram {
    do! penup
    do! pendown
}

[<EntryPoint>]
let main argv =
    interpretAsDistance pp
    0 // return an integer exit code