ComMonad.fs

module ComMonad

//type ComOp<'T> = (unit -> 'T)
let private runCom t = t()
type Com =
    static member Run t = runCom t

let private result t = (fun () -> t)

let private delay (f:unit->unit->'a) = (fun() -> f()())
let private letBind f v :unit->'a= 
    let c = box v
    if c=null |> not && System.Runtime.InteropServices.Marshal.IsComObject(c) then
        try
            f v
        finally
            System.Runtime.InteropServices.Marshal.ReleaseComObject c |> ignore
    else
        f v
let private bind f v = try letBind f (v()) with | e -> raise e

type OkOrException<'T> =
    | Ok of 'T
    | Exception of System.Exception

let catch work = result  (try Ok(work()) with | e -> Exception e)

let tryFinally e compensation =
    catch (e)
    |> bind (fun res -> compensation();
                        match res with
                        | Ok v -> result v
                        | Exception e -> raise e)

let tryWith e handler =
    catch e
    |> bind (function Ok v -> result v | Exception e -> handler e)

let rec whileLoop gd body =
    if gd() then body |> bind (fun v -> whileLoop gd body)
    else result ()

let combine e1 e2 =
    e1 |> bind (fun () -> e2)

let using (resource: #System.IDisposable) f =
    tryFinally (f resource) (fun () -> resource.Dispose())

let forLoop (e:seq<_>) f =
    let ie = e.GetEnumerator()
    tryFinally (whileLoop (fun () -> ie.MoveNext())
                            (delay (fun () -> let v = ie.Current in f v)))
                    (fun () -> ie.Dispose())

type ComBuilder() =
    member x.Bind(e,k) = bind k e
    member x.Return(v) = result v
    member x.ReturnFrom(v) = v
    member x.Combine(e1,e2) = combine e1 e2
    member x.Delay(f) = delay f
    member x.Zero() = result ()
    member x.TryWith(e,handler) = tryWith e handler
    member x.TryFinally(e,compensation) = tryFinally e compensation
    member x.For(e:seq<_>,f) = forLoop e f
    member x.Using(resource,e) = using resource e
    member x.Yield(a) = a
    member x.YieldFrom(b) = b
let com = ComBuilder()