From c57ac440234f4da16f720bcc9d44ee62e34a239a Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 17 May 2026 10:29:27 -0400 Subject: [PATCH 1/8] Optimize task applicative helpers --- src/FsToolkit.ErrorHandling/Task.fs | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/Task.fs b/src/FsToolkit.ErrorHandling/Task.fs index 4aa0091a..54098c63 100644 --- a/src/FsToolkit.ErrorHandling/Task.fs +++ b/src/FsToolkit.ErrorHandling/Task.fs @@ -23,7 +23,11 @@ module Task = } let inline apply f x = - bind (fun f' -> bind (fun x' -> singleton (f' x')) x) f + task { + let! f' = f + let! x' = x + return f' x' + } let inline map ([] f) x = x @@ -39,9 +43,20 @@ module Task = >> singleton ) - let inline map2 ([] f) x y = (apply (apply (singleton f) x) y) + let inline map2 ([] f) x y = + task { + let! x' = x + let! y' = y + return f x' y' + } - let inline map3 ([] f) x y z = apply (map2 f x y) z + let inline map3 ([] f) x y z = + task { + let! x' = x + let! y' = y + let! z' = z + return f x' y' z' + } /// Allows us to call `do!` syntax inside a computation expression let inline ignore<'a> (x: Task<'a>) = From 8151f3d6e94f7ae69507c2ada1e541ddf5b6595d Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 17 May 2026 10:29:39 -0400 Subject: [PATCH 2/8] Optimize array traversal helpers --- src/FsToolkit.ErrorHandling/Array.fs | 331 +++++++++++++-------------- 1 file changed, 156 insertions(+), 175 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/Array.fs b/src/FsToolkit.ErrorHandling/Array.fs index 546f92a6..50fcc5fc 100644 --- a/src/FsToolkit.ErrorHandling/Array.fs +++ b/src/FsToolkit.ErrorHandling/Array.fs @@ -2,173 +2,122 @@ namespace FsToolkit.ErrorHandling [] module Array = - let rec private traverseResultM' (state: Result<_, _>) (f: _ -> Result<_, _>) xs = - match xs with - | [||] -> - state - |> Result.map Array.rev - | arr -> - let x = Array.head arr - let xs = Array.skip 1 arr - - let res = - result { - let! y = f x - let! ys = state - return Array.append [| y |] ys - } - - match res with - | Ok _ -> traverseResultM' res f xs - | Error _ -> res - - let rec private traverseAsyncResultM' - (state: Async>) - (f: _ -> Async>) - xs + let inline traverseResultM + ([] f: 'okInput -> Result<'okOutput, 'error>) + (xs: 'okInput[]) = - match xs with - | [||] -> - state - |> AsyncResult.map Array.rev - | arr -> - let x = Array.head arr - let xs = Array.skip 1 arr - - async { - let! r = - asyncResult { - let! ys = state - let! y = f x - return Array.append [| y |] ys - } - - match r with - | Ok _ -> return! traverseAsyncResultM' (Async.singleton r) f xs - | Error _ -> return r - } - - let traverseResultM f xs = traverseResultM' (Ok [||]) f xs + let results = ResizeArray<'okOutput>(xs.Length) + let mutable index = 0 + let mutable error = Unchecked.defaultof<'error> + let mutable ok = true + + while ok + && index < xs.Length do + match f xs[index] with + | Ok value -> + results.Add value + index <- index + 1 + | Error e -> + error <- e + ok <- false + + if ok then Ok(results.ToArray()) else Error error let sequenceResultM xs = traverseResultM id xs - let traverseAsyncResultM f xs = - traverseAsyncResultM' (AsyncResult.ok [||]) f xs + let traverseAsyncResultM f (xs: _[]) = + async { + let results = ResizeArray(xs.Length) + let mutable index = 0 + let mutable error = Unchecked.defaultof<_> + let mutable ok = true + + while ok + && index < xs.Length do + let! result = f xs[index] + + match result with + | Ok value -> + results.Add value + index <- index + 1 + | Error e -> + error <- e + ok <- false + + return + if ok then + Ok(results.ToArray()) + else + Error error + } let sequenceAsyncResultM xs = traverseAsyncResultM id xs - let rec private traverseResultA' state f xs = - match xs with - | [||] -> - state - |> Result.eitherMap Array.rev Array.rev - | arr -> - let x = Array.head arr - let xs = Array.skip 1 arr - - match state, f x with - | Ok ys, Ok y -> traverseResultA' (Ok(Array.append [| y |] ys)) f xs - | Error errs, Error e -> traverseResultA' (Error(Array.append [| e |] errs)) f xs - | Ok _, Error e -> traverseResultA' (Error [| e |]) f xs - | Error e, Ok _ -> traverseResultA' (Error e) f xs - - let rec private traverseAsyncResultA' state f xs = - match xs with - | [||] -> - state - |> AsyncResult.eitherMap Array.rev Array.rev - - | arr -> - let x = Array.head arr - let xs = Array.skip 1 arr - - async { - let! s = state - let! fR = f x - - match s, fR with - | Ok ys, Ok y -> - return! traverseAsyncResultA' (AsyncResult.ok (Array.append [| y |] ys)) f xs - | Error errs, Error e -> - return! - traverseAsyncResultA' (AsyncResult.error (Array.append [| e |] errs)) f xs - | Ok _, Error e -> return! traverseAsyncResultA' (AsyncResult.error [| e |]) f xs - | Error e, Ok _ -> return! traverseAsyncResultA' (AsyncResult.error e) f xs - } - - let traverseResultA f xs = traverseResultA' (Ok [||]) f xs + let inline traverseResultA + ([] f: 'okInput -> Result<'okOutput, 'error>) + (xs: 'okInput[]) + = + let oks = ResizeArray<'okOutput>(xs.Length) + let errors = ResizeArray<'error>() + let mutable ok = true + + for x in xs do + match f x with + | Ok value when ok -> oks.Add value + | Ok _ -> () + | Error e -> + errors.Add e + ok <- false + + if ok then Ok(oks.ToArray()) else Error(errors.ToArray()) let sequenceResultA xs = traverseResultA id xs - let rec private traverseValidationA' state f xs = - match xs with - | [||] -> - state - |> Result.eitherMap Array.rev Array.rev - | arr -> - let x = Array.head arr - let xs = Array.skip 1 arr - let fR = f x - - match state, fR with - | Ok ys, Ok y -> traverseValidationA' (Ok(Array.append [| y |] ys)) f xs - | Error errs1, Error errs2 -> - let errs = Array.append errs2 errs1 - traverseValidationA' (Error errs) f xs - | Ok _, Error errs - | Error errs, Ok _ -> traverseValidationA' (Error errs) f xs - - let traverseValidationA f xs = traverseValidationA' (Ok [||]) f xs + let inline traverseValidationA + ([] f: 'okInput -> Result<'okOutput, 'error[]>) + (xs: 'okInput[]) + = + let oks = ResizeArray<'okOutput>(xs.Length) + let errors = ResizeArray<'error>() + let mutable ok = true + + for x in xs do + match f x with + | Ok value when ok -> oks.Add value + | Ok _ -> () + | Error errs -> + errors.AddRange errs + ok <- false + + if ok then Ok(oks.ToArray()) else Error(errors.ToArray()) let sequenceValidationA xs = traverseValidationA id xs - let traverseAsyncResultA f xs = - traverseAsyncResultA' (AsyncResult.ok [||]) f xs + let traverseAsyncResultA f (xs: _[]) = + async { + let oks = ResizeArray(xs.Length) + let errors = ResizeArray() + let mutable ok = true + + for x in xs do + let! result = f x + + match result with + | Ok value when ok -> oks.Add value + | Ok _ -> () + | Error e -> + errors.Add e + ok <- false + + return + if ok then + Ok(oks.ToArray()) + else + Error(errors.ToArray()) + } let sequenceAsyncResultA xs = traverseAsyncResultA id xs - let rec private traverseOptionM' (state: _ option) (f: _ -> _ option) xs = - match xs with - | [||] -> - state - |> Option.map Array.rev - | arr -> - let x = Array.head arr - let xs = Array.skip 1 arr - - let r = - option { - let! y = f x - let! ys = state - return Array.append [| y |] ys - } - - match r with - | Some _ -> traverseOptionM' r f xs - | None -> r - - let rec private traverseAsyncOptionM' (state: Async<_ option>) (f: _ -> Async<_ option>) xs = - match xs with - | [||] -> - state - |> AsyncOption.map Array.rev - | arr -> - let x = Array.head arr - let xs = Array.skip 1 arr - - async { - let! o = - asyncOption { - let! y = f x - let! ys = state - return Array.append [| y |] ys - } - - match o with - | Some _ -> return! traverseAsyncOptionM' (Async.singleton o) f xs - | None -> return o - } - /// /// Applies the given function to each element in the input list , /// and returns an option containing a list of the results. If any of the function applications return None, @@ -178,7 +127,23 @@ module Array = /// The input list. /// An option containing a list of the results of applying the function to each element in the input list, /// or None if any of the function applications return None. - let traverseOptionM f xs = traverseOptionM' (Some [||]) f xs + let inline traverseOptionM + ([] f: 'okInput -> 'okOutput option) + (xs: 'okInput[]) + = + let results = ResizeArray<'okOutput>(xs.Length) + let mutable index = 0 + let mutable ok = true + + while ok + && index < xs.Length do + match f xs[index] with + | Some value -> + results.Add value + index <- index + 1 + | None -> ok <- false + + if ok then Some(results.ToArray()) else None /// /// Applies the monadic function to each element in the input list , @@ -188,32 +153,32 @@ module Array = /// An option containing the result of applying to each element in . let sequenceOptionM xs = traverseOptionM id xs - let traverseAsyncOptionM f xs = - traverseAsyncOptionM' (AsyncOption.some [||]) f xs + let traverseAsyncOptionM f (xs: _[]) = + async { + let results = ResizeArray(xs.Length) + let mutable index = 0 + let mutable ok = true + + while ok + && index < xs.Length do + let! result = f xs[index] + + match result with + | Some value -> + results.Add value + index <- index + 1 + | None -> ok <- false + + return + if ok then + Some(results.ToArray()) + else + None + } let sequenceAsyncOptionM xs = traverseAsyncOptionM id xs #if !FABLE_COMPILER - let rec private traverseVOptionM' (state: voption<_>) (f: _ -> voption<_>) xs = - match xs with - | [||] -> - state - |> ValueOption.map Array.rev - | arr -> - let x = Array.head arr - let xs = Array.skip 1 arr - - let r = - voption { - let! y = f x - let! ys = state - return Array.append [| y |] ys - } - - match r with - | ValueSome _ -> traverseVOptionM' r f xs - | ValueNone -> r - /// /// Applies the given function to each element in the input list , /// and returns an option containing a list of the results. If any of the function applications return ValueNone, @@ -222,7 +187,23 @@ module Array = /// The function to apply to each element in the input list. /// The input list /// An Option monad containing the collected results. - let traverseVOptionM f xs = traverseVOptionM' (ValueSome [||]) f xs + let inline traverseVOptionM + ([] f: 'okInput -> 'okOutput voption) + (xs: 'okInput[]) + = + let results = ResizeArray<'okOutput>(xs.Length) + let mutable index = 0 + let mutable ok = true + + while ok + && index < xs.Length do + match f xs[index] with + | ValueSome value -> + results.Add value + index <- index + 1 + | ValueNone -> ok <- false + + if ok then ValueSome(results.ToArray()) else ValueNone /// /// Applies the function to each element in the input list , From 298a0a9441a34e35a9d22345b4b3c9a030cc27c2 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 17 May 2026 10:29:53 -0400 Subject: [PATCH 3/8] Use singleton fast paths for option workflows --- src/FsToolkit.ErrorHandling.JobResult/JobOption.fs | 4 ++-- src/FsToolkit.ErrorHandling/TaskOption.fs | 4 ++-- src/FsToolkit.ErrorHandling/TaskValueOption.fs | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/FsToolkit.ErrorHandling.JobResult/JobOption.fs b/src/FsToolkit.ErrorHandling.JobResult/JobOption.fs index 4abc9747..5bcc5602 100644 --- a/src/FsToolkit.ErrorHandling.JobResult/JobOption.fs +++ b/src/FsToolkit.ErrorHandling.JobResult/JobOption.fs @@ -15,12 +15,12 @@ module JobOption = let t = match opt with | Some x -> f x - | None -> job { return None } + | None -> Job.result None return! t } - let inline singleton x = job { return Some x } + let inline singleton x = Job.result (Some x) let inline apply f x = bind (fun f' -> bind (fun x' -> singleton (f' x')) x) f diff --git a/src/FsToolkit.ErrorHandling/TaskOption.fs b/src/FsToolkit.ErrorHandling/TaskOption.fs index 914ba271..13078fb1 100644 --- a/src/FsToolkit.ErrorHandling/TaskOption.fs +++ b/src/FsToolkit.ErrorHandling/TaskOption.fs @@ -15,12 +15,12 @@ module TaskOption = let t = match opt with | Some x -> f x - | None -> task { return None } + | None -> Task.singleton None return! t } - let inline some x = task { return Some x } + let inline some x = Task.singleton (Some x) let inline apply f x = bind (fun f' -> bind (fun x' -> some (f' x')) x) f diff --git a/src/FsToolkit.ErrorHandling/TaskValueOption.fs b/src/FsToolkit.ErrorHandling/TaskValueOption.fs index e7ecdf1a..cf18c8b1 100644 --- a/src/FsToolkit.ErrorHandling/TaskValueOption.fs +++ b/src/FsToolkit.ErrorHandling/TaskValueOption.fs @@ -15,12 +15,12 @@ module TaskValueOption = let t = match opt with | ValueSome x -> f x - | ValueNone -> task { return ValueNone } + | ValueNone -> Task.singleton ValueNone return! t } - let inline valueSome x = task { return ValueSome x } + let inline valueSome x = Task.singleton (ValueSome x) let inline apply f x = bind (fun f' -> bind (fun x' -> valueSome (f' x')) x) f From 7af8d514d07604d0a7fb200207e1aa576b5be03d Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 17 May 2026 10:30:07 -0400 Subject: [PATCH 4/8] Avoid array conversion in list task traversal --- src/FsToolkit.ErrorHandling/List.fs | 35 +++++++++++++---------------- 1 file changed, 16 insertions(+), 19 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs index 545ad17a..b9a4e035 100644 --- a/src/FsToolkit.ErrorHandling/List.fs +++ b/src/FsToolkit.ErrorHandling/List.fs @@ -219,27 +219,24 @@ module List = let private traverseTaskResultM' (f: 'c -> Task>) (xs: 'c list) = let mutable state = Ok [] - let mutable index = 0 - - let xs = - xs - |> List.toArray + let mutable remaining = xs + let mutable hasMore = true task { - while state - |> Result.isOk - && index < xs.Length do - let! r = - xs - |> Array.item index - |> f - - index <- index + 1 - - match (r, state) with - | Ok y, Ok ys -> state <- Ok(y :: ys) - | Error e, _ -> state <- Error e - | _, _ -> () + while hasMore + && state + |> Result.isOk do + match remaining with + | x :: xs -> + remaining <- xs + + let! r = f x + + match (r, state) with + | Ok y, Ok ys -> state <- Ok(y :: ys) + | Error e, _ -> state <- Error e + | _, _ -> () + | [] -> hasMore <- false return state From b457a8b9bf96d61f799d1ffd804fb664267762e1 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 17 May 2026 10:30:25 -0400 Subject: [PATCH 5/8] Add benchmarks for traversal optimizations --- benchmarks/Benchmarks.fs | 762 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 762 insertions(+) diff --git a/benchmarks/Benchmarks.fs b/benchmarks/Benchmarks.fs index 4ea1a175..f80441c1 100644 --- a/benchmarks/Benchmarks.fs +++ b/benchmarks/Benchmarks.fs @@ -3,6 +3,9 @@ open System open BenchmarkDotNet open BenchmarkDotNet.Attributes +open System.Threading.Tasks +open FsToolkit.ErrorHandling +open Hopac // open FsToolkit.ErrorHandling let okF x = x + 2 @@ -513,3 +516,762 @@ type Map2Benchmarks() = [] member this.Result_Alt_InlinedLambda_Map2() = Result.Alt.InlinedLambda.map2 add (Ok 1) (Ok 2): Result + +module TaskCandidates = + + let inline directMap2 ([] f) (x: Task<_>) (y: Task<_>) = + task { + let! x' = x + let! y' = y + return f x' y' + } + + let inline directMap3 ([] f) (x: Task<_>) (y: Task<_>) (z: Task<_>) = + task { + let! x' = x + let! y' = y + let! z' = z + return f x' y' z' + } + +[] +type TaskMap2Benchmarks() = + let x = Task.FromResult 1 + let y = Task.FromResult 2 + + [] + member _.Task_Current_Map2() = + FsToolkit.ErrorHandling.Task.map2 (fun x y -> x + y) x y + + [] + member _.Task_Direct_Map2() = + TaskCandidates.directMap2 (fun x y -> x + y) x y + +[] +type TaskMap3Benchmarks() = + let x = Task.FromResult 1 + let y = Task.FromResult 2 + let z = Task.FromResult 3 + + [] + member _.Task_Current_Map3() = + FsToolkit.ErrorHandling.Task.map3 (fun x y z -> x + y + z) x y z + + [] + member _.Task_Direct_Map3() = + TaskCandidates.directMap3 (fun x y z -> x + y + z) x y z + +module ArrayCandidates = + + let inline traverseResultM ([] f: 'a -> Result<'b, 'e>) (xs: 'a[]) = + let results = ResizeArray<'b>(xs.Length) + let mutable index = 0 + let mutable error = Unchecked.defaultof<'e> + let mutable ok = true + + while ok + && index < xs.Length do + match f xs[index] with + | Ok value -> + results.Add value + index <- index + 1 + | Error e -> + error <- e + ok <- false + + if ok then Ok(results.ToArray()) else Error error + + let inline traverseResultA ([] f: 'a -> Result<'b, 'e>) (xs: 'a[]) = + let results = ResizeArray<'b>(xs.Length) + let errors = ResizeArray<'e>() + let mutable ok = true + + for x in xs do + match f x with + | Ok value when ok -> results.Add value + | Ok _ -> () + | Error e -> + errors.Add e + ok <- false + + if ok then Ok(results.ToArray()) else Error(errors.ToArray()) + + let inline traverseOptionM ([] f: 'a -> 'b option) (xs: 'a[]) = + let results = ResizeArray<'b>(xs.Length) + let mutable index = 0 + let mutable ok = true + + while ok + && index < xs.Length do + match f xs[index] with + | Some value -> + results.Add value + index <- index + 1 + | None -> ok <- false + + if ok then Some(results.ToArray()) else None + + let inline traverseValidationA ([] f: 'a -> Result<'b, 'e[]>) (xs: 'a[]) = + let results = ResizeArray<'b>(xs.Length) + let errors = ResizeArray<'e>() + let mutable ok = true + + for x in xs do + match f x with + | Ok value when ok -> results.Add value + | Ok _ -> () + | Error errs -> + errors.AddRange errs + ok <- false + + if ok then Ok(results.ToArray()) else Error(errors.ToArray()) + + let inline traverseVOptionM ([] f: 'a -> 'b voption) (xs: 'a[]) = + let results = ResizeArray<'b>(xs.Length) + let mutable index = 0 + let mutable ok = true + + while ok + && index < xs.Length do + match f xs[index] with + | ValueSome value -> + results.Add value + index <- index + 1 + | ValueNone -> ok <- false + + if ok then ValueSome(results.ToArray()) else ValueNone + +module ArrayOriginal = + + let rec private traverseResultM' (state: Result<_, _>) (f: _ -> Result<_, _>) xs = + match xs with + | [||] -> state |> Result.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + let res = + result { + let! y = f x + let! ys = state + return Array.append [| y |] ys + } + + match res with + | Ok _ -> traverseResultM' res f xs + | Error _ -> res + + let traverseResultM f xs = traverseResultM' (Ok [||]) f xs + + let rec private traverseResultA' state f xs = + match xs with + | [||] -> state |> Result.eitherMap Array.rev Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + match state, f x with + | Ok ys, Ok y -> traverseResultA' (Ok(Array.append [| y |] ys)) f xs + | Error errs, Error e -> traverseResultA' (Error(Array.append [| e |] errs)) f xs + | Ok _, Error e -> traverseResultA' (Error [| e |]) f xs + | Error e, Ok _ -> traverseResultA' (Error e) f xs + + let traverseResultA f xs = traverseResultA' (Ok [||]) f xs + + let rec private traverseOptionM' (state: _ option) (f: _ -> _ option) xs = + match xs with + | [||] -> state |> Option.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + let r = + option { + let! y = f x + let! ys = state + return Array.append [| y |] ys + } + + match r with + | Some _ -> traverseOptionM' r f xs + | None -> r + + let traverseOptionM f xs = traverseOptionM' (Some [||]) f xs + + let rec private traverseValidationA' state f xs = + match xs with + | [||] -> state |> Result.eitherMap Array.rev Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + let fR = f x + + match state, fR with + | Ok ys, Ok y -> traverseValidationA' (Ok(Array.append [| y |] ys)) f xs + | Error errs1, Error errs2 -> + let errs = Array.append errs2 errs1 + traverseValidationA' (Error errs) f xs + | Ok _, Error errs + | Error errs, Ok _ -> traverseValidationA' (Error errs) f xs + + let traverseValidationA f xs = traverseValidationA' (Ok [||]) f xs + + let rec private traverseVOptionM' (state: voption<_>) (f: _ -> voption<_>) xs = + match xs with + | [||] -> state |> ValueOption.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + let r = + voption { + let! y = f x + let! ys = state + return Array.append [| y |] ys + } + + match r with + | ValueSome _ -> traverseVOptionM' r f xs + | ValueNone -> r + + let traverseVOptionM f xs = traverseVOptionM' (ValueSome [||]) f xs + + let rec private traverseAsyncResultM' + (state: Async>) + (f: _ -> Async>) + xs + = + match xs with + | [||] -> state |> AsyncResult.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + async { + let! r = + asyncResult { + let! ys = state + let! y = f x + return Array.append [| y |] ys + } + + match r with + | Ok _ -> return! traverseAsyncResultM' (Async.singleton r) f xs + | Error _ -> return r + } + + let traverseAsyncResultM f xs = + traverseAsyncResultM' (AsyncResult.ok [||]) f xs + + let rec private traverseAsyncResultA' state f xs = + match xs with + | [||] -> state |> AsyncResult.eitherMap Array.rev Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + async { + let! s = state + let! fR = f x + + match s, fR with + | Ok ys, Ok y -> return! traverseAsyncResultA' (AsyncResult.ok (Array.append [| y |] ys)) f xs + | Error errs, Error e -> + return! traverseAsyncResultA' (AsyncResult.error (Array.append [| e |] errs)) f xs + | Ok _, Error e -> return! traverseAsyncResultA' (AsyncResult.error [| e |]) f xs + | Error e, Ok _ -> return! traverseAsyncResultA' (AsyncResult.error e) f xs + } + + let traverseAsyncResultA f xs = + traverseAsyncResultA' (AsyncResult.ok [||]) f xs + + let rec private traverseAsyncOptionM' (state: Async<_ option>) (f: _ -> Async<_ option>) xs = + match xs with + | [||] -> state |> AsyncOption.map Array.rev + | arr -> + let x = Array.head arr + let xs = Array.skip 1 arr + + async { + let! o = + asyncOption { + let! y = f x + let! ys = state + return Array.append [| y |] ys + } + + match o with + | Some _ -> return! traverseAsyncOptionM' (Async.singleton o) f xs + | None -> return o + } + + let traverseAsyncOptionM f xs = + traverseAsyncOptionM' (AsyncOption.some [||]) f xs + +[] +type ArrayTraverseBenchmarks() = + let allOk = Array.init 1000 id + + let halfError = + Array.init 1000 (fun i -> if i = 500 then -1 else i) + + let toResult x = if x < 0 then Error x else Ok(x + 1) + let toOption x = if x < 0 then None else Some(x + 1) + let toValidation x = if x < 0 then Error [| x |] else Ok(x + 1) + + [] + member _.Array_Original_ResultM_AllOk() = + ArrayOriginal.traverseResultM toResult allOk + + [] + member _.Array_Current_ResultM_AllOk() = + FsToolkit.ErrorHandling.Array.traverseResultM toResult allOk + + [] + member _.Array_Candidate_ResultM_AllOk() = + ArrayCandidates.traverseResultM toResult allOk + + [] + member _.Array_Original_ResultM_EarlyError() = + ArrayOriginal.traverseResultM toResult halfError + + [] + member _.Array_Current_ResultM_EarlyError() = + FsToolkit.ErrorHandling.Array.traverseResultM toResult halfError + + [] + member _.Array_Candidate_ResultM_EarlyError() = + ArrayCandidates.traverseResultM toResult halfError + + [] + member _.Array_Original_ResultA_AllOk() = + ArrayOriginal.traverseResultA toResult allOk + + [] + member _.Array_Current_ResultA_AllOk() = + FsToolkit.ErrorHandling.Array.traverseResultA toResult allOk + + [] + member _.Array_Candidate_ResultA_AllOk() = + ArrayCandidates.traverseResultA toResult allOk + + [] + member _.Array_Original_ResultA_Errors() = + ArrayOriginal.traverseResultA toResult halfError + + [] + member _.Array_Current_ResultA_Errors() = + FsToolkit.ErrorHandling.Array.traverseResultA toResult halfError + + [] + member _.Array_Candidate_ResultA_Errors() = + ArrayCandidates.traverseResultA toResult halfError + + [] + member _.Array_Original_OptionM_AllSome() = + ArrayOriginal.traverseOptionM toOption allOk + + [] + member _.Array_Current_OptionM_AllSome() = + FsToolkit.ErrorHandling.Array.traverseOptionM toOption allOk + + [] + member _.Array_Candidate_OptionM_AllSome() = + ArrayCandidates.traverseOptionM toOption allOk + + [] + member _.Array_Original_ValidationA_Errors() = + ArrayOriginal.traverseValidationA toValidation halfError + + [] + member _.Array_Current_ValidationA_Errors() = + FsToolkit.ErrorHandling.Array.traverseValidationA toValidation halfError + + [] + member _.Array_Candidate_ValidationA_Errors() = + ArrayCandidates.traverseValidationA toValidation halfError + +[] +type ArrayVOptionTraverseBenchmarks() = + let allSome = Array.init 1000 id + + let halfNone = + Array.init 1000 (fun i -> if i = 500 then -1 else i) + + let toVOption x = if x < 0 then ValueNone else ValueSome(x + 1) + + [] + member _.Array_Original_VOptionM_AllSome() = + ArrayOriginal.traverseVOptionM toVOption allSome + + [] + member _.Array_Current_VOptionM_AllSome() = + FsToolkit.ErrorHandling.Array.traverseVOptionM toVOption allSome + + [] + member _.Array_Candidate_VOptionM_AllSome() = + ArrayCandidates.traverseVOptionM toVOption allSome + + [] + member _.Array_Original_VOptionM_EarlyNone() = + ArrayOriginal.traverseVOptionM toVOption halfNone + + [] + member _.Array_Current_VOptionM_EarlyNone() = + FsToolkit.ErrorHandling.Array.traverseVOptionM toVOption halfNone + + [] + member _.Array_Candidate_VOptionM_EarlyNone() = + ArrayCandidates.traverseVOptionM toVOption halfNone + +[] +type ArrayAsyncTraverseBenchmarks() = + let allOk = Array.init 1000 id + + let halfError = + Array.init 1000 (fun i -> if i = 500 then -1 else i) + + let toAsyncResult x = + async { return if x < 0 then Error x else Ok(x + 1) } + + let toAsyncOption x = + async { return if x < 0 then None else Some(x + 1) } + + [] + member _.Array_Original_AsyncResultM_AllOk() = + ArrayOriginal.traverseAsyncResultM toAsyncResult allOk + |> Async.RunSynchronously + + [] + member _.Array_Current_AsyncResultM_AllOk() = + FsToolkit.ErrorHandling.Array.traverseAsyncResultM toAsyncResult allOk + |> Async.RunSynchronously + + [] + member _.Array_Original_AsyncResultM_EarlyError() = + ArrayOriginal.traverseAsyncResultM toAsyncResult halfError + |> Async.RunSynchronously + + [] + member _.Array_Current_AsyncResultM_EarlyError() = + FsToolkit.ErrorHandling.Array.traverseAsyncResultM toAsyncResult halfError + |> Async.RunSynchronously + + [] + member _.Array_Original_AsyncResultA_AllOk() = + ArrayOriginal.traverseAsyncResultA toAsyncResult allOk + |> Async.RunSynchronously + + [] + member _.Array_Current_AsyncResultA_AllOk() = + FsToolkit.ErrorHandling.Array.traverseAsyncResultA toAsyncResult allOk + |> Async.RunSynchronously + + [] + member _.Array_Original_AsyncResultA_Errors() = + ArrayOriginal.traverseAsyncResultA toAsyncResult halfError + |> Async.RunSynchronously + + [] + member _.Array_Current_AsyncResultA_Errors() = + FsToolkit.ErrorHandling.Array.traverseAsyncResultA toAsyncResult halfError + |> Async.RunSynchronously + + [] + member _.Array_Original_AsyncOptionM_AllSome() = + ArrayOriginal.traverseAsyncOptionM toAsyncOption allOk + |> Async.RunSynchronously + + [] + member _.Array_Current_AsyncOptionM_AllSome() = + FsToolkit.ErrorHandling.Array.traverseAsyncOptionM toAsyncOption allOk + |> Async.RunSynchronously + +module TaskOptionOriginal = + + let inline bind ([] f) (ar: Task<_>) = + task { + let! opt = ar + + let t = + match opt with + | Some x -> f x + | None -> task { return None } + + return! t + } + + let inline some x = task { return Some x } + + let inline apply f x = + bind (fun f' -> bind (fun x' -> some (f' x')) x) f + +module TaskValueOptionOriginal = + + let inline bind ([] f) (ar: Task<_>) = + task { + let! opt = ar + + let t = + match opt with + | ValueSome x -> f x + | ValueNone -> task { return ValueNone } + + return! t + } + + let inline valueSome x = task { return ValueSome x } + + let inline apply f x = + bind (fun f' -> bind (fun x' -> valueSome (f' x')) x) f + +[] +type TaskOptionApplyBenchmarks() = + let someF = Task.FromResult(Some(fun x -> x + 1)) + let someX = Task.FromResult(Some 1) + let noneF: Task<(int -> int) option> = Task.FromResult None + let noneX: Task = Task.FromResult None + + [] + member _.TaskOption_Original_Apply_SomeSome() = + TaskOptionOriginal.apply someF someX + + [] + member _.TaskOption_Current_Apply_SomeSome() = + FsToolkit.ErrorHandling.TaskOption.apply someF someX + + [] + member _.TaskOption_Original_Apply_NoneFunction() = + TaskOptionOriginal.apply noneF someX + + [] + member _.TaskOption_Current_Apply_NoneFunction() = + FsToolkit.ErrorHandling.TaskOption.apply noneF someX + + [] + member _.TaskOption_Original_Apply_NoneValue() = + TaskOptionOriginal.apply someF noneX + + [] + member _.TaskOption_Current_Apply_NoneValue() = + FsToolkit.ErrorHandling.TaskOption.apply someF noneX + + [] + member _.TaskOption_Original_Some() = + TaskOptionOriginal.some 1 + + [] + member _.TaskOption_Current_Some() = + FsToolkit.ErrorHandling.TaskOption.some 1 + + [] + member _.TaskOption_Original_Bind_Some() = + TaskOptionOriginal.bind (fun x -> Task.FromResult(Some(x + 1))) someX + + [] + member _.TaskOption_Current_Bind_Some() = + FsToolkit.ErrorHandling.TaskOption.bind (fun x -> Task.FromResult(Some(x + 1))) someX + + [] + member _.TaskOption_Original_Bind_None() = + TaskOptionOriginal.bind (fun x -> Task.FromResult(Some(x + 1))) noneX + + [] + member _.TaskOption_Current_Bind_None() = + FsToolkit.ErrorHandling.TaskOption.bind (fun x -> Task.FromResult(Some(x + 1))) noneX + +[] +type TaskValueOptionApplyBenchmarks() = + let someF = Task.FromResult(ValueSome(fun x -> x + 1)) + let someX = Task.FromResult(ValueSome 1) + let noneF: Task<(int -> int) voption> = Task.FromResult ValueNone + let noneX: Task = Task.FromResult ValueNone + + [] + member _.TaskValueOption_Original_Apply_ValueSomeValueSome() = + TaskValueOptionOriginal.apply someF someX + + [] + member _.TaskValueOption_Current_Apply_ValueSomeValueSome() = + FsToolkit.ErrorHandling.TaskValueOption.apply someF someX + + [] + member _.TaskValueOption_Original_Apply_ValueNoneFunction() = + TaskValueOptionOriginal.apply noneF someX + + [] + member _.TaskValueOption_Current_Apply_ValueNoneFunction() = + FsToolkit.ErrorHandling.TaskValueOption.apply noneF someX + + [] + member _.TaskValueOption_Original_Apply_ValueNoneValue() = + TaskValueOptionOriginal.apply someF noneX + + [] + member _.TaskValueOption_Current_Apply_ValueNoneValue() = + FsToolkit.ErrorHandling.TaskValueOption.apply someF noneX + + [] + member _.TaskValueOption_Original_ValueSome() = + TaskValueOptionOriginal.valueSome 1 + + [] + member _.TaskValueOption_Current_ValueSome() = + FsToolkit.ErrorHandling.TaskValueOption.valueSome 1 + + [] + member _.TaskValueOption_Original_Bind_ValueSome() = + TaskValueOptionOriginal.bind (fun x -> Task.FromResult(ValueSome(x + 1))) someX + + [] + member _.TaskValueOption_Current_Bind_ValueSome() = + FsToolkit.ErrorHandling.TaskValueOption.bind (fun x -> Task.FromResult(ValueSome(x + 1))) someX + + [] + member _.TaskValueOption_Original_Bind_ValueNone() = + TaskValueOptionOriginal.bind (fun x -> Task.FromResult(ValueSome(x + 1))) noneX + + [] + member _.TaskValueOption_Current_Bind_ValueNone() = + FsToolkit.ErrorHandling.TaskValueOption.bind (fun x -> Task.FromResult(ValueSome(x + 1))) noneX + +module JobOptionOriginal = + + let inline bind ([] f) (ar: Job<_>) = + job { + let! opt = ar + + let t = + match opt with + | Some x -> f x + | None -> job { return None } + + return! t + } + + let inline singleton x = job { return Some x } + + let inline apply f x = + bind (fun f' -> bind (fun x' -> singleton (f' x')) x) f + +[] +type JobOptionApplyBenchmarks() = + let someF = Job.result (Some(fun x -> x + 1)) + let someX = Job.result (Some 1) + let noneF: Job<(int -> int) option> = Job.result None + let noneX: Job = Job.result None + + [] + member _.JobOption_Original_Apply_SomeSome() = + JobOptionOriginal.apply someF someX + |> Hopac.run + + [] + member _.JobOption_Current_Apply_SomeSome() = + FsToolkit.ErrorHandling.JobOption.apply someF someX + |> Hopac.run + + [] + member _.JobOption_Original_Apply_NoneFunction() = + JobOptionOriginal.apply noneF someX + |> Hopac.run + + [] + member _.JobOption_Current_Apply_NoneFunction() = + FsToolkit.ErrorHandling.JobOption.apply noneF someX + |> Hopac.run + + [] + member _.JobOption_Original_Apply_NoneValue() = + JobOptionOriginal.apply someF noneX + |> Hopac.run + + [] + member _.JobOption_Current_Apply_NoneValue() = + FsToolkit.ErrorHandling.JobOption.apply someF noneX + |> Hopac.run + + [] + member _.JobOption_Original_Singleton() = + JobOptionOriginal.singleton 1 + |> Hopac.run + + [] + member _.JobOption_Current_Singleton() = + FsToolkit.ErrorHandling.JobOption.singleton 1 + |> Hopac.run + + [] + member _.JobOption_Original_Bind_Some() = + JobOptionOriginal.bind (fun x -> Job.result (Some(x + 1))) someX + |> Hopac.run + + [] + member _.JobOption_Current_Bind_Some() = + FsToolkit.ErrorHandling.JobOption.bind (fun x -> Job.result (Some(x + 1))) someX + |> Hopac.run + + [] + member _.JobOption_Original_Bind_None() = + JobOptionOriginal.bind (fun x -> Job.result (Some(x + 1))) noneX + |> Hopac.run + + [] + member _.JobOption_Current_Bind_None() = + FsToolkit.ErrorHandling.JobOption.bind (fun x -> Job.result (Some(x + 1))) noneX + |> Hopac.run + +module ListOriginal = + + let private traverseTaskResultM' (f: 'c -> Task>) (xs: 'c list) = + let mutable state = Ok [] + let mutable index = 0 + + let xs = + xs + |> List.toArray + + task { + while state + |> Result.isOk + && index < xs.Length do + let! r = + xs + |> Array.item index + |> f + + index <- index + 1 + + match (r, state) with + | Ok y, Ok ys -> state <- Ok(y :: ys) + | Error e, _ -> state <- Error e + | _, _ -> () + + return + state + |> Result.map List.rev + } + + let traverseTaskResultM f xs = traverseTaskResultM' f xs + +[] +type ListTaskResultTraverseBenchmarks() = + let allOk = List.init 1000 id + let halfError = List.init 1000 (fun i -> if i = 500 then -1 else i) + let toTaskResult x = Task.FromResult(if x < 0 then Error x else Ok(x + 1)) + + [] + member _.List_Original_TaskResultM_AllOk() = + ListOriginal.traverseTaskResultM toTaskResult allOk + + [] + member _.List_Current_TaskResultM_AllOk() = + FsToolkit.ErrorHandling.List.traverseTaskResultM toTaskResult allOk + + [] + member _.List_Original_TaskResultM_EarlyError() = + ListOriginal.traverseTaskResultM toTaskResult halfError + + [] + member _.List_Current_TaskResultM_EarlyError() = + FsToolkit.ErrorHandling.List.traverseTaskResultM toTaskResult halfError From 3a32898e778c865fad3eb23a346fbe2039afd895 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 17 May 2026 11:25:12 -0400 Subject: [PATCH 6/8] formatting --- benchmarks/Benchmarks.fs | 91 ++++++++++++++++++---------- src/FsToolkit.ErrorHandling/Array.fs | 18 +----- 2 files changed, 61 insertions(+), 48 deletions(-) diff --git a/benchmarks/Benchmarks.fs b/benchmarks/Benchmarks.fs index f80441c1..657181c7 100644 --- a/benchmarks/Benchmarks.fs +++ b/benchmarks/Benchmarks.fs @@ -594,7 +594,10 @@ module ArrayCandidates = errors.Add e ok <- false - if ok then Ok(results.ToArray()) else Error(errors.ToArray()) + if ok then + Ok(results.ToArray()) + else + Error(errors.ToArray()) let inline traverseOptionM ([] f: 'a -> 'b option) (xs: 'a[]) = let results = ResizeArray<'b>(xs.Length) @@ -624,7 +627,10 @@ module ArrayCandidates = errors.AddRange errs ok <- false - if ok then Ok(results.ToArray()) else Error(errors.ToArray()) + if ok then + Ok(results.ToArray()) + else + Error(errors.ToArray()) let inline traverseVOptionM ([] f: 'a -> 'b voption) (xs: 'a[]) = let results = ResizeArray<'b>(xs.Length) @@ -645,7 +651,9 @@ module ArrayOriginal = let rec private traverseResultM' (state: Result<_, _>) (f: _ -> Result<_, _>) xs = match xs with - | [||] -> state |> Result.map Array.rev + | [||] -> + state + |> Result.map Array.rev | arr -> let x = Array.head arr let xs = Array.skip 1 arr @@ -665,7 +673,9 @@ module ArrayOriginal = let rec private traverseResultA' state f xs = match xs with - | [||] -> state |> Result.eitherMap Array.rev Array.rev + | [||] -> + state + |> Result.eitherMap Array.rev Array.rev | arr -> let x = Array.head arr let xs = Array.skip 1 arr @@ -680,7 +690,9 @@ module ArrayOriginal = let rec private traverseOptionM' (state: _ option) (f: _ -> _ option) xs = match xs with - | [||] -> state |> Option.map Array.rev + | [||] -> + state + |> Option.map Array.rev | arr -> let x = Array.head arr let xs = Array.skip 1 arr @@ -700,7 +712,9 @@ module ArrayOriginal = let rec private traverseValidationA' state f xs = match xs with - | [||] -> state |> Result.eitherMap Array.rev Array.rev + | [||] -> + state + |> Result.eitherMap Array.rev Array.rev | arr -> let x = Array.head arr let xs = Array.skip 1 arr @@ -718,7 +732,9 @@ module ArrayOriginal = let rec private traverseVOptionM' (state: voption<_>) (f: _ -> voption<_>) xs = match xs with - | [||] -> state |> ValueOption.map Array.rev + | [||] -> + state + |> ValueOption.map Array.rev | arr -> let x = Array.head arr let xs = Array.skip 1 arr @@ -742,7 +758,9 @@ module ArrayOriginal = xs = match xs with - | [||] -> state |> AsyncResult.map Array.rev + | [||] -> + state + |> AsyncResult.map Array.rev | arr -> let x = Array.head arr let xs = Array.skip 1 arr @@ -765,7 +783,9 @@ module ArrayOriginal = let rec private traverseAsyncResultA' state f xs = match xs with - | [||] -> state |> AsyncResult.eitherMap Array.rev Array.rev + | [||] -> + state + |> AsyncResult.eitherMap Array.rev Array.rev | arr -> let x = Array.head arr let xs = Array.skip 1 arr @@ -775,9 +795,11 @@ module ArrayOriginal = let! fR = f x match s, fR with - | Ok ys, Ok y -> return! traverseAsyncResultA' (AsyncResult.ok (Array.append [| y |] ys)) f xs + | Ok ys, Ok y -> + return! traverseAsyncResultA' (AsyncResult.ok (Array.append [| y |] ys)) f xs | Error errs, Error e -> - return! traverseAsyncResultA' (AsyncResult.error (Array.append [| e |] errs)) f xs + return! + traverseAsyncResultA' (AsyncResult.error (Array.append [| e |] errs)) f xs | Ok _, Error e -> return! traverseAsyncResultA' (AsyncResult.error [| e |]) f xs | Error e, Ok _ -> return! traverseAsyncResultA' (AsyncResult.error e) f xs } @@ -787,7 +809,9 @@ module ArrayOriginal = let rec private traverseAsyncOptionM' (state: Async<_ option>) (f: _ -> Async<_ option>) xs = match xs with - | [||] -> state |> AsyncOption.map Array.rev + | [||] -> + state + |> AsyncOption.map Array.rev | arr -> let x = Array.head arr let xs = Array.skip 1 arr @@ -812,12 +836,13 @@ module ArrayOriginal = type ArrayTraverseBenchmarks() = let allOk = Array.init 1000 id - let halfError = - Array.init 1000 (fun i -> if i = 500 then -1 else i) + let halfError = Array.init 1000 (fun i -> if i = 500 then -1 else i) let toResult x = if x < 0 then Error x else Ok(x + 1) let toOption x = if x < 0 then None else Some(x + 1) - let toValidation x = if x < 0 then Error [| x |] else Ok(x + 1) + + let toValidation x = + if x < 0 then Error [| x |] else Ok(x + 1) [] member _.Array_Original_ResultM_AllOk() = @@ -895,10 +920,10 @@ type ArrayTraverseBenchmarks() = type ArrayVOptionTraverseBenchmarks() = let allSome = Array.init 1000 id - let halfNone = - Array.init 1000 (fun i -> if i = 500 then -1 else i) + let halfNone = Array.init 1000 (fun i -> if i = 500 then -1 else i) - let toVOption x = if x < 0 then ValueNone else ValueSome(x + 1) + let toVOption x = + if x < 0 then ValueNone else ValueSome(x + 1) [] member _.Array_Original_VOptionM_AllSome() = @@ -928,8 +953,7 @@ type ArrayVOptionTraverseBenchmarks() = type ArrayAsyncTraverseBenchmarks() = let allOk = Array.init 1000 id - let halfError = - Array.init 1000 (fun i -> if i = 500 then -1 else i) + let halfError = Array.init 1000 (fun i -> if i = 500 then -1 else i) let toAsyncResult x = async { return if x < 0 then Error x else Ok(x + 1) } @@ -1033,32 +1057,28 @@ type TaskOptionApplyBenchmarks() = let noneX: Task = Task.FromResult None [] - member _.TaskOption_Original_Apply_SomeSome() = - TaskOptionOriginal.apply someF someX + member _.TaskOption_Original_Apply_SomeSome() = TaskOptionOriginal.apply someF someX [] member _.TaskOption_Current_Apply_SomeSome() = FsToolkit.ErrorHandling.TaskOption.apply someF someX [] - member _.TaskOption_Original_Apply_NoneFunction() = - TaskOptionOriginal.apply noneF someX + member _.TaskOption_Original_Apply_NoneFunction() = TaskOptionOriginal.apply noneF someX [] member _.TaskOption_Current_Apply_NoneFunction() = FsToolkit.ErrorHandling.TaskOption.apply noneF someX [] - member _.TaskOption_Original_Apply_NoneValue() = - TaskOptionOriginal.apply someF noneX + member _.TaskOption_Original_Apply_NoneValue() = TaskOptionOriginal.apply someF noneX [] member _.TaskOption_Current_Apply_NoneValue() = FsToolkit.ErrorHandling.TaskOption.apply someF noneX [] - member _.TaskOption_Original_Some() = - TaskOptionOriginal.some 1 + member _.TaskOption_Original_Some() = TaskOptionOriginal.some 1 [] member _.TaskOption_Current_Some() = @@ -1112,8 +1132,7 @@ type TaskValueOptionApplyBenchmarks() = FsToolkit.ErrorHandling.TaskValueOption.apply someF noneX [] - member _.TaskValueOption_Original_ValueSome() = - TaskValueOptionOriginal.valueSome 1 + member _.TaskValueOption_Original_ValueSome() = TaskValueOptionOriginal.valueSome 1 [] member _.TaskValueOption_Current_ValueSome() = @@ -1125,7 +1144,9 @@ type TaskValueOptionApplyBenchmarks() = [] member _.TaskValueOption_Current_Bind_ValueSome() = - FsToolkit.ErrorHandling.TaskValueOption.bind (fun x -> Task.FromResult(ValueSome(x + 1))) someX + FsToolkit.ErrorHandling.TaskValueOption.bind + (fun x -> Task.FromResult(ValueSome(x + 1))) + someX [] member _.TaskValueOption_Original_Bind_ValueNone() = @@ -1133,7 +1154,9 @@ type TaskValueOptionApplyBenchmarks() = [] member _.TaskValueOption_Current_Bind_ValueNone() = - FsToolkit.ErrorHandling.TaskValueOption.bind (fun x -> Task.FromResult(ValueSome(x + 1))) noneX + FsToolkit.ErrorHandling.TaskValueOption.bind + (fun x -> Task.FromResult(ValueSome(x + 1))) + noneX module JobOptionOriginal = @@ -1258,7 +1281,9 @@ module ListOriginal = type ListTaskResultTraverseBenchmarks() = let allOk = List.init 1000 id let halfError = List.init 1000 (fun i -> if i = 500 then -1 else i) - let toTaskResult x = Task.FromResult(if x < 0 then Error x else Ok(x + 1)) + + let toTaskResult x = + Task.FromResult(if x < 0 then Error x else Ok(x + 1)) [] member _.List_Original_TaskResultM_AllOk() = diff --git a/src/FsToolkit.ErrorHandling/Array.fs b/src/FsToolkit.ErrorHandling/Array.fs index 50fcc5fc..13fb7762 100644 --- a/src/FsToolkit.ErrorHandling/Array.fs +++ b/src/FsToolkit.ErrorHandling/Array.fs @@ -44,11 +44,7 @@ module Array = error <- e ok <- false - return - if ok then - Ok(results.ToArray()) - else - Error error + return if ok then Ok(results.ToArray()) else Error error } let sequenceAsyncResultM xs = traverseAsyncResultM id xs @@ -109,11 +105,7 @@ module Array = errors.Add e ok <- false - return - if ok then - Ok(oks.ToArray()) - else - Error(errors.ToArray()) + return if ok then Ok(oks.ToArray()) else Error(errors.ToArray()) } let sequenceAsyncResultA xs = traverseAsyncResultA id xs @@ -169,11 +161,7 @@ module Array = index <- index + 1 | None -> ok <- false - return - if ok then - Some(results.ToArray()) - else - None + return if ok then Some(results.ToArray()) else None } let sequenceAsyncOptionM xs = traverseAsyncOptionM id xs From 5fefbe122b53a71052205c521d61b290ed5c724f Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 17 May 2026 11:46:45 -0400 Subject: [PATCH 7/8] Address Copilot PR review feedback --- src/FsToolkit.ErrorHandling/Array.fs | 88 ++++++++++++++++++++-------- src/FsToolkit.ErrorHandling/List.fs | 9 ++- 2 files changed, 68 insertions(+), 29 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/Array.fs b/src/FsToolkit.ErrorHandling/Array.fs index 13fb7762..7233f19d 100644 --- a/src/FsToolkit.ErrorHandling/Array.fs +++ b/src/FsToolkit.ErrorHandling/Array.fs @@ -54,7 +54,7 @@ module Array = (xs: 'okInput[]) = let oks = ResizeArray<'okOutput>(xs.Length) - let errors = ResizeArray<'error>() + let mutable errors: ResizeArray<'error> option = None let mutable ok = true for x in xs do @@ -62,10 +62,23 @@ module Array = | Ok value when ok -> oks.Add value | Ok _ -> () | Error e -> - errors.Add e + let errorBuffer = + match errors with + | Some errors -> errors + | None -> + let buffer = ResizeArray<'error>() + errors <- Some buffer + buffer + + errorBuffer.Add e ok <- false - if ok then Ok(oks.ToArray()) else Error(errors.ToArray()) + if ok then + Ok(oks.ToArray()) + else + match errors with + | Some errors -> Error(errors.ToArray()) + | None -> Error [||] let sequenceResultA xs = traverseResultA id xs @@ -74,7 +87,7 @@ module Array = (xs: 'okInput[]) = let oks = ResizeArray<'okOutput>(xs.Length) - let errors = ResizeArray<'error>() + let mutable errors: ResizeArray<'error> option = None let mutable ok = true for x in xs do @@ -82,17 +95,30 @@ module Array = | Ok value when ok -> oks.Add value | Ok _ -> () | Error errs -> - errors.AddRange errs + let errorBuffer = + match errors with + | Some errors -> errors + | None -> + let buffer = ResizeArray<'error>() + errors <- Some buffer + buffer + + errorBuffer.AddRange errs ok <- false - if ok then Ok(oks.ToArray()) else Error(errors.ToArray()) + if ok then + Ok(oks.ToArray()) + else + match errors with + | Some errors -> Error(errors.ToArray()) + | None -> Error [||] let sequenceValidationA xs = traverseValidationA id xs - let traverseAsyncResultA f (xs: _[]) = + let traverseAsyncResultA (f: 'okInput -> Async>) (xs: 'okInput[]) = async { - let oks = ResizeArray(xs.Length) - let errors = ResizeArray() + let oks = ResizeArray<'okOutput>(xs.Length) + let mutable errors: ResizeArray<'error> option = None let mutable ok = true for x in xs do @@ -102,22 +128,36 @@ module Array = | Ok value when ok -> oks.Add value | Ok _ -> () | Error e -> - errors.Add e + let errorBuffer = + match errors with + | Some errors -> errors + | None -> + let buffer = ResizeArray<'error>() + errors <- Some buffer + buffer + + errorBuffer.Add e ok <- false - return if ok then Ok(oks.ToArray()) else Error(errors.ToArray()) + return + if ok then + Ok(oks.ToArray()) + else + match errors with + | Some errors -> Error(errors.ToArray()) + | None -> Error [||] } let sequenceAsyncResultA xs = traverseAsyncResultA id xs /// - /// Applies the given function to each element in the input list , - /// and returns an option containing a list of the results. If any of the function applications return None, + /// Applies the given function to each element in the input array , + /// and returns an option containing an array of the results. If any of the function applications return None, /// the entire result will be None. /// - /// The function to apply to each element in the input list. - /// The input list. - /// An option containing a list of the results of applying the function to each element in the input list, + /// The function to apply to each element in the input array. + /// The input array. + /// An option containing an array of the results of applying the function to each element in the input array, /// or None if any of the function applications return None. let inline traverseOptionM ([] f: 'okInput -> 'okOutput option) @@ -138,10 +178,10 @@ module Array = if ok then Some(results.ToArray()) else None /// - /// Applies the monadic function to each element in the input list , + /// Applies the monadic function to each element in the input array , /// and returns the result as an option. If any element in the list is None, the entire result will be None. /// - /// The input list. + /// The input array. /// An option containing the result of applying to each element in . let sequenceOptionM xs = traverseOptionM id xs @@ -168,12 +208,12 @@ module Array = #if !FABLE_COMPILER /// - /// Applies the given function to each element in the input list , - /// and returns an option containing a list of the results. If any of the function applications return ValueNone, + /// Applies the given function to each element in the input array , + /// and returns an option containing an array of the results. If any of the function applications return ValueNone, /// the entire result will be ValueNone. /// - /// The function to apply to each element in the input list. - /// The input list + /// The function to apply to each element in the input array. + /// The input array. /// An Option monad containing the collected results. let inline traverseVOptionM ([] f: 'okInput -> 'okOutput voption) @@ -194,10 +234,10 @@ module Array = if ok then ValueSome(results.ToArray()) else ValueNone /// - /// Applies the function to each element in the input list , + /// Applies the function to each element in the input array , /// and returns the result as a value option. If any element in the list is ValueNone, the entire result will be ValueNone. /// - /// The input list. + /// The input array. /// A representing the sequence of results. let sequenceVOptionM xs = traverseVOptionM id xs diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs index b9a4e035..16cfab7b 100644 --- a/src/FsToolkit.ErrorHandling/List.fs +++ b/src/FsToolkit.ErrorHandling/List.fs @@ -220,12 +220,11 @@ module List = let private traverseTaskResultM' (f: 'c -> Task>) (xs: 'c list) = let mutable state = Ok [] let mutable remaining = xs - let mutable hasMore = true task { - while hasMore - && state - |> Result.isOk do + while state + |> Result.isOk + && not (List.isEmpty remaining) do match remaining with | x :: xs -> remaining <- xs @@ -236,7 +235,7 @@ module List = | Ok y, Ok ys -> state <- Ok(y :: ys) | Error e, _ -> state <- Error e | _, _ -> () - | [] -> hasMore <- false + | [] -> () return state From 9ae4cfe3fc581f5dc3fd0a33b52afc1fc6ba0d46 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 17 May 2026 12:12:22 -0400 Subject: [PATCH 8/8] Add validation all-ok benchmark --- benchmarks/Benchmarks.fs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/benchmarks/Benchmarks.fs b/benchmarks/Benchmarks.fs index 657181c7..88bbf925 100644 --- a/benchmarks/Benchmarks.fs +++ b/benchmarks/Benchmarks.fs @@ -6,7 +6,6 @@ open BenchmarkDotNet.Attributes open System.Threading.Tasks open FsToolkit.ErrorHandling open Hopac -// open FsToolkit.ErrorHandling let okF x = x + 2 let errorF x = x - 4 @@ -904,6 +903,18 @@ type ArrayTraverseBenchmarks() = member _.Array_Candidate_OptionM_AllSome() = ArrayCandidates.traverseOptionM toOption allOk + [] + member _.Array_Original_ValidationA_AllOk() = + ArrayOriginal.traverseValidationA toValidation allOk + + [] + member _.Array_Current_ValidationA_AllOk() = + FsToolkit.ErrorHandling.Array.traverseValidationA toValidation allOk + + [] + member _.Array_Candidate_ValidationA_AllOk() = + ArrayCandidates.traverseValidationA toValidation allOk + [] member _.Array_Original_ValidationA_Errors() = ArrayOriginal.traverseValidationA toValidation halfError