YOLO traverse - you only lift once

traverse.fs

//fsharp
type Result<'Ok, 'Error> =
    | Ok of 'Ok
    | Error of 'Error

//yolo
module Result =

    let bind f v = 
        match v with 
        | Ok x -> f x
        | Error e -> Error e 
        
    let map f : Result<'a, 'b> -> Result<'c, 'b> = function
        | Ok v -> Ok (f v)
        | Error v -> Error v
        
    let map2 f1 f2 : Result<'a, 'b> -> Result<'c, 'd> = function
        | Ok v -> Ok (f1 v)
        | Error v -> Error (f2 v)
        
    let fold f g =
        function
        | Ok x -> f x
        | Error y -> g y
        
    let apply f v =
        bind (fun f' ->
        bind (fun v' ->
        Ok (f' v')) v) f
        
    let lift2 f v1 v2 =
        apply (apply (Ok f) v1) v2

//yolo
module Async =
    
    let result = async.Return
    
    let map f value = async {
        let! v = value
        return f v
    }
    
    let bind f xAsync = async {
        let! x = xAsync
        return! f x
    }
    
    let withTimeout timeoutMillis operation = async {
        let! child = Async.StartChild(operation, timeoutMillis)
        try
            let! result = child
            return Some result
        with :? TimeoutException ->
            return None
    }
    
    let apply fAsync xAsync = async {
        // start the two asyncs in parallel
        let! fChild = Async.StartChild fAsync
        let! xChild = Async.StartChild xAsync
        
        // wait for the results
        let! f = fChild
        let! x = xChild
        
        // apply the function to the results
        return f x
    }
    
    let lift2 f x y =
        apply (apply (result f) x) y

//yolo
module List =

    let rec traverseResultA f list =
        let (<*>) = Result.apply
        let cons head tail = head :: tail
        let initState = Result.Ok []
        let folder head tail =
            Result.Ok cons <*> (f head) <*> tail    
        List.foldBack folder list initState
            
    let sequenceResultA x = traverseResultA id x
        
    let rec traverseAsyncA f list =
        let (<*>) = Async.apply
        let cons head tail = head :: tail
        let initState = Async.result []
        let folder head tail =
            Async.result cons <*> (f head) <*> tail
        List.foldBack folder list initState
        
    let sequenceAsyncA x = traverseAsyncA id x

// This is similar to List.sequenceResultA
let aggregateSuccess results =
    results
    |> Seq.fold ( fun acc v ->
        match acc, v with
        | Ok a, Ok v -> Ok <| v::a
        | Error e, _ -> Error e
        | _, Error e -> Error e
    ) (Ok [])
        
let private file _ =
    DirectoryInfo @"c:\windows"
    
let private loadCore (fi: FileInfo) = async {
    if not fi.Exists then
        return Ok None
    else
        try
            let text = System.IO.File.ReadAllText fi.FullName
            return text |> Some |> Ok
        with e -> 
            return e |> Error
    }

let filter = "*.ini"

let loadAll1 _ =
    let di = file Unchecked.defaultof<_>
    di.GetFiles filter
    |> Seq.map loadCore
    |> List.ofSeq
    |> List.sequenceAsyncA
    |> Async.map ( 
        List.sequenceResultA )

let loadAll2 _ =
    let di = file Unchecked.defaultof<_>
    di.GetFiles filter
    |> Seq.map loadCore
    |> List.ofSeq
    |> List.sequenceAsyncA
    |> Async.map ( 
        aggregateSuccess )

loadAll1 () |> Async.RunSynchronously |> Dump |> ignore
loadAll2 () |> Async.RunSynchronously |> Dump |> ignore