(co)monoidal resource management in fsharp

resources.fs

module FileTest =
    open System.IO
    type Resource = Dispose of (unit -> unit) 

    let mzero = Dispose(id)
    let mappend (Dispose(a)) (Dispose(b)) = Dispose(a >> b)
    let destroy (Dispose(r)) = r()

    let rec pair (Dispose(d)) =  
        let lockObj = new obj()
        let synchronized f () = lock lockObj f
        let f = ref false
        let destructor () = 
            if !f then d()
            else f := true

        let destructor = synchronized destructor
        Dispose(destructor),Dispose(destructor)

    let createWriter (path:string) =
                  printfn "Created writer %s" path
                  let w = new StreamWriter(path, true)
                  w, Dispose(fun () -> printfn "disposed writer %s" path
                                       w.Dispose())
    
    let createReader (path:string) =
                  printfn "Created reader %s" path
                  let r = new StreamReader(path, true)
                  r, Dispose(fun () -> printfn "disposed reader %s" path
                                       r.Dispose())

    type Managed<'r> = Resource -> 'r * Resource

    type ResourceBuilder() = 
          member inline x.Return(v) : Managed<'r> = fun r -> destroy r
                                                             v, mzero
          member inline x.ReturnFrom(v) : Managed<'T> = v

          member inline x.Bind(rm1:Managed<'T>, f:'T -> Managed<'T2>) : Managed<'T2> =  
                fun r -> let r,r2 = pair r
                         let v, r = rm1 r
                         f v (mappend r r2)


    let resource = ResourceBuilder()

    let destroySnd t = destroy <| snd t
                       fst t

    let run (tr:Managed<'r>) = mzero |> tr |> destroySnd

    let liftCtor c a: Managed<_>  = fun r -> destroy r
                                             c a

    let createWriterM = liftCtor createWriter
    let createReaderM = liftCtor createReader

    let subProgram () = resource{
        let! r = createReaderM "D:\\install.ini"
        printfn "sub program: reading line"
        let line = r.ReadLine()
        return line
    }

    let subProgram2 () = resource{
        printfn "creating reader in subProgram2"
        let r = createReaderM "D:\\install.ini"
        printfn "creating unused writer in subProgram2"
        let! w = createWriterM <| Path.GetTempFileName()
        return! r
    }

    let asyncWriteLine (line:string) (w:StreamWriter)  = async{
        printfn "async sleeping"
        do! Async.Sleep(1000)
        printfn "async writing line"
        w.WriteLine(line)
    }

    let startAsync a r = 
            let task = async{
                            do! a
                            destroy r
                            return ()
                        } |> Async.StartChild
            task, mzero

    let program = resource{
        printfn "executing sub program"
        let! line = subProgram()
        printfn "finished executing sub program result is: %s" line
        printfn "creating writer"
        let! w = createWriterM <| Path.GetTempFileName()
        printfn "executing subProgram2"
        let! r = subProgram2()
        printfn "finished executing sub program2"
        printfn "executing async write line"
        let! a = startAsync (asyncWriteLine "async line" w)//captured both reader and writer
        printfn "finished executing async write line"
        printfn "reading line"
        let line = r.ReadLine()
        printfn "writing line"
        w.WriteLine(line)
        return a, line
    }

    let a, line = run program 
    printfn "result line %A" line
    Async.RunSynchronously a
    Async.RunSynchronously <| Async.Sleep 2000

strings.fs

module StringTest=
    open System.IO
    //monoid
    let mzero () = ""
    let mappend (s:string) (s2:string) = s + s2

    let ctorCompose f1 f2 () = mappend (f1()) (f2())
    let (|>>) a b = ctorCompose a b
    let toCtor f = f >> mzero
    
    let ctor1 () = printfn "Please enter string" 
                   System.Console.ReadLine()
    let ctor2 () = "aaa"
    let printSmth () = printfn "smth" 
    let ctor3 = toCtor printSmth


    let comboCtor = ctor1 |>> ctor2 |>> ctor3

    //comonoid

    let pair (s:string) = s,s
    let destroy (s:string) = () 
    let dectorCompose f1 f2 a = let a,a2 = pair a
                                f1(a)
                                f2(a2)
                                ()

    let toDestructor (fn: unit -> unit) = destroy >> fn
    let (>>>) a b = dectorCompose a b


    let destructor = printfn "%s"
    let destructor2 (s:string) = ()
    let createlogFileDestructor path =
        fun (s:string) -> use wr = new StreamWriter(path, true)
                          wr.WriteLine(s)

    let logFileStringDestructor = createlogFileDestructor <| Path.GetTempFileName()



    let composedDestructor = destructor >>> destructor2 >>> logFileStringDestructor >>> (toDestructor printSmth)

    let res = comboCtor()
    printfn "result of combo constructor %s" res
    composedDestructor res