F# IO monad
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()