F# IO monad

guessing_game.fs

open System
open System.Runtime.CompilerServices
#nowarn "46"  // no warning for using reserved word "pure"

type IOError<'T> = Result<'T, exn>
type IO<'T> = unit -> IOError<'T>
  
exception UnwrapError of obj
  
type Option<'a> with
  member inline my.isNone() :bool = my |> Option.isNone
  member inline my.unwrap() :'a =
    match my with
    | Some v -> v
    | None -> raise <| UnwrapError(exn $"Unwrap None value of type {typeof<'a>} option")
 
type Result<'a, 'err> with
  member inline my.map(f: 'a -> 'b) :Result<'b, 'err> = my |> Result.map f
  member inline my.bind(f: 'a -> Result<'b,'err>) :Result<'b, 'err> = my |> Result.bind f
  
  member my.unwrap() :'a =
    match my with
    | Ok v -> v
    | Error e -> raise <| UnwrapError(e)
    
module IO =
  let inline pure (x: 'a) :IO<'a> = fun () -> Ok x
  let inline map (f: 'a -> 'b) (x: IO<'a>) = fun() -> x().map(f)
  let run (x: IO<'a>) :IOError<'a> =
    try
      x()
    with
    | e -> Error e
 
  let join = run
  let bind (f: 'a -> IO<'b>) (m: IO<'a>) :IO<'b> =
    printfn $"bind %A{m} with %A{f}"
    fun() -> m().bind(fun x -> (f x)())
 
  type IOBuilder() =
    member inline _.Return(x: 'a) :IO<'a> = fun() -> Ok x
    member inline _.Bind(m: IO<'a>, f: 'a -> IO<'b>) :IO<'b> =  m |> bind f
    member inline _.Yield(r: IOError<'a>) :IO<'a> = fun() -> r
    member inline _.Zero() :IO<unit> = pure ()
 
let io = IO.IOBuilder()

[<Extension>]
type IOExtension() =
  [<Extension>] static member inline map(my,f) = my |> IO.map f
  [<Extension>] static member inline run(my) = IO.run my

let get_random(max: int) :IO<int> = fun () ->
  let randomizer = Random()
  Ok(randomizer.Next max)
  
let read_line() :IO<string> = Ok << Console.ReadLine
let write_text(text: string) :IO<unit> = fun() -> Ok(printf $"%s{text}")
let writeln_text(text: string) :IO<unit> = fun() -> Ok(printfn $"%s{text}")
let retry(ma: IO<'a>) :IO<'a> =
  fun() -> let mutable result = None
           while result.isNone() do
             let r = ma()
             match r with
             | Ok _ -> result <- Some r
             | Error _ -> ()
           result.unwrap()
           
let print_result(target: int, guess: int) :IO<unit> =
  if guess < target then writeln_text("Too small")
  elif guess > target then writeln_text("Too big")
  else writeln_text($"Congrat, it's %d{guess}")
  
let get_guess_result(target: int, guess: int) :IO<unit> = fun() ->
  if guess = target then Ok() else Error(exn "Guess incorrect")
  
let play(target: int) :IO<unit> =
  let _1 = write_text("Guess: ")
  let guess = _1 |> IO.bind (fun() -> read_line().map(Int32.Parse))
  let guessing = guess |> IO.bind(fun guess ->
    let print_text = print_result(target, guess)
    print_text |> IO.bind(fun() -> get_guess_result(target, guess))
  )
  retry guessing
  
let program =
    let target = get_random 100
    target |> IO.bind play
  
program.run().unwrap()