From fead27c6f66b4171960ea3c935975d114a53a212 Mon Sep 17 00:00:00 2001 From: isaacabraham Date: Thu, 25 Feb 2021 20:17:56 +0100 Subject: [PATCH 1/7] Refactor traverseValidationARev (perf). --- src/FsToolkit.ErrorHandling/List.fs | 45 +++++++++++++++-------------- 1 file changed, 24 insertions(+), 21 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs index 535aaf04..f39b161d 100644 --- a/src/FsToolkit.ErrorHandling/List.fs +++ b/src/FsToolkit.ErrorHandling/List.fs @@ -6,12 +6,12 @@ module List = let rec private traverseResultM' (state : Result<_,_>) (f : _ -> Result<_,_>) xs = match xs with | [] -> state - | x :: xs -> + | x :: xs -> let r = result { let! y = f x let! ys = state return ys @ [y] - } + } match r with | Ok _ -> traverseResultM' r f xs | Error _ -> r @@ -19,22 +19,22 @@ module List = let rec private traverseAsyncResultM' (state : Async>) (f : _ -> Async>) xs = match xs with | [] -> state - | x :: xs -> + | x :: xs -> async { let! r = asyncResult { let! ys = state let! y = f x return ys @ [y] - } + } match r with - | Ok _ -> + | Ok _ -> return! traverseAsyncResultM' (Async.singleton r) f xs | Error _ -> return r } let traverseResultM f xs = traverseResultM' (Ok []) f xs - + let sequenceResultM xs = traverseResultM id xs @@ -43,20 +43,20 @@ module List = let sequenceAsyncResultM xs = traverseAsyncResultM id xs - + let rec private traverseResultA' state f xs = match xs with | [] -> state | x :: xs -> - let fR = + let fR = f x |> Result.mapError List.singleton match state, fR with - | Ok ys, Ok y -> + | Ok ys, Ok y -> traverseResultA' (Ok (ys @ [y])) f xs - | Error errs, Error e -> + | Error errs, Error e -> traverseResultA' (Error (errs @ e)) f xs - | Ok _, Error e | Error e , Ok _ -> + | Ok _, Error e | Error e , Ok _ -> traverseResultA' (Error e) f xs let rec private traverseAsyncResultA' state f xs = @@ -67,11 +67,11 @@ module List = let! s = state let! fR = f x |> AsyncResult.mapError List.singleton match s, fR with - | Ok ys, Ok y -> + | Ok ys, Ok y -> return! traverseAsyncResultA' (AsyncResult.retn (ys @ [y])) f xs - | Error errs, Error e -> + | Error errs, Error e -> return! traverseAsyncResultA' (AsyncResult.returnError (errs @ e)) f xs - | Ok _, Error e | Error e , Ok _ -> + | Ok _, Error e | Error e , Ok _ -> return! traverseAsyncResultA' (AsyncResult.returnError e) f xs } @@ -82,16 +82,19 @@ module List = traverseResultA id xs let rec traverseValidationA' state f xs = - match xs with - | [] -> state - | x :: xs -> + match state, xs with + | Ok items, [] -> + Ok (List.rev items) + | errors, [] -> + errors + | _, x :: xs -> let fR = f x match state, fR with - | Ok ys, Ok y -> - traverseValidationA' (Ok (ys @ [y])) f xs - | Error errs1, Error errs2 -> + | Ok ys, Ok y -> + traverseValidationA' (Ok (y :: ys)) f xs + | Error errs1, Error errs2 -> traverseValidationA' (Error (errs2 @ errs1)) f xs - | Ok _, Error errs | Error errs, Ok _ -> + | Ok _, Error errs | Error errs, Ok _ -> traverseValidationA' (Error errs) f xs let traverseValidationA f xs = From 0c16dba5205e850415fe7a04e26775e21f70debe Mon Sep 17 00:00:00 2001 From: isaacabraham Date: Fri, 26 Feb 2021 00:49:16 +0100 Subject: [PATCH 2/7] traverseResultM' --- src/FsToolkit.ErrorHandling/List.fs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs index f39b161d..80e8d285 100644 --- a/src/FsToolkit.ErrorHandling/List.fs +++ b/src/FsToolkit.ErrorHandling/List.fs @@ -4,13 +4,16 @@ namespace FsToolkit.ErrorHandling module List = let rec private traverseResultM' (state : Result<_,_>) (f : _ -> Result<_,_>) xs = - match xs with - | [] -> state - | x :: xs -> + match state, xs with + | Ok v, [] -> + Ok (List.rev v) + | v, [] -> + v + | _, x :: xs -> let r = result { let! y = f x let! ys = state - return ys @ [y] + return y :: ys } match r with | Ok _ -> traverseResultM' r f xs From 4d9e87952b72facacc2e3f4f3f1b994785041027 Mon Sep 17 00:00:00 2001 From: isaacabraham Date: Fri, 26 Feb 2021 01:01:23 +0100 Subject: [PATCH 3/7] traverseAsyncResultM --- src/FsToolkit.ErrorHandling/List.fs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs index 80e8d285..4db716d2 100644 --- a/src/FsToolkit.ErrorHandling/List.fs +++ b/src/FsToolkit.ErrorHandling/List.fs @@ -21,17 +21,20 @@ module List = let rec private traverseAsyncResultM' (state : Async>) (f : _ -> Async>) xs = match xs with - | [] -> state + | [] -> + asyncResult { + let! v = state + return List.rev v + } | x :: xs -> async { let! r = asyncResult { let! ys = state let! y = f x - return ys @ [y] + return y :: ys } match r with - | Ok _ -> - return! traverseAsyncResultM' (Async.singleton r) f xs + | Ok _ -> return! traverseAsyncResultM' (Async.singleton r) f xs | Error _ -> return r } From 958e37d9baaf94618aee642d64d451ff560b10e9 Mon Sep 17 00:00:00 2001 From: isaacabraham Date: Fri, 26 Feb 2021 01:05:16 +0100 Subject: [PATCH 4/7] traverseResultA --- src/FsToolkit.ErrorHandling/List.fs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs index 4db716d2..6525d46a 100644 --- a/src/FsToolkit.ErrorHandling/List.fs +++ b/src/FsToolkit.ErrorHandling/List.fs @@ -52,14 +52,17 @@ module List = let rec private traverseResultA' state f xs = - match xs with - | [] -> state - | x :: xs -> + match state, xs with + | Ok v, [] -> + Ok (List.rev v) + | v, [] -> + v + | _, x :: xs -> let fR = f x |> Result.mapError List.singleton match state, fR with | Ok ys, Ok y -> - traverseResultA' (Ok (ys @ [y])) f xs + traverseResultA' (Ok (y :: ys)) f xs | Error errs, Error e -> traverseResultA' (Error (errs @ e)) f xs | Ok _, Error e | Error e , Ok _ -> From a2cc43efa9eadba010e194728429311b3db00575 Mon Sep 17 00:00:00 2001 From: isaacabraham Date: Fri, 26 Feb 2021 01:12:43 +0100 Subject: [PATCH 5/7] traverseAsyncResultA' --- src/FsToolkit.ErrorHandling/List.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs index 6525d46a..f1e98355 100644 --- a/src/FsToolkit.ErrorHandling/List.fs +++ b/src/FsToolkit.ErrorHandling/List.fs @@ -77,7 +77,7 @@ module List = let! fR = f x |> AsyncResult.mapError List.singleton match s, fR with | Ok ys, Ok y -> - return! traverseAsyncResultA' (AsyncResult.retn (ys @ [y])) f xs + return! traverseAsyncResultA' (AsyncResult.retn (y :: ys)) f xs | Error errs, Error e -> return! traverseAsyncResultA' (AsyncResult.returnError (errs @ e)) f xs | Ok _, Error e | Error e , Ok _ -> From 211bd16216f421b463bd2ddab469429158d1651c Mon Sep 17 00:00:00 2001 From: isaacabraham Date: Fri, 26 Feb 2021 01:24:55 +0100 Subject: [PATCH 6/7] Fix final traverse --- src/FsToolkit.ErrorHandling/List.fs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs index f1e98355..3b3e1506 100644 --- a/src/FsToolkit.ErrorHandling/List.fs +++ b/src/FsToolkit.ErrorHandling/List.fs @@ -70,7 +70,8 @@ module List = let rec private traverseAsyncResultA' state f xs = match xs with - | [] -> state + | [] -> + state |> AsyncResult.map List.rev | x :: xs -> async { let! s = state From f8cac1498f61fbe4fec8e90ad1dca36b706b1a15 Mon Sep 17 00:00:00 2001 From: isaacabraham Date: Fri, 26 Feb 2021 01:27:55 +0100 Subject: [PATCH 7/7] Small refactor --- src/FsToolkit.ErrorHandling/List.fs | 35 +++++++++++------------------ 1 file changed, 13 insertions(+), 22 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs index 3b3e1506..67343cdd 100644 --- a/src/FsToolkit.ErrorHandling/List.fs +++ b/src/FsToolkit.ErrorHandling/List.fs @@ -4,12 +4,10 @@ namespace FsToolkit.ErrorHandling module List = let rec private traverseResultM' (state : Result<_,_>) (f : _ -> Result<_,_>) xs = - match state, xs with - | Ok v, [] -> - Ok (List.rev v) - | v, [] -> - v - | _, x :: xs -> + match xs with + | [] -> + state |> Result.map List.rev + | x :: xs -> let r = result { let! y = f x let! ys = state @@ -22,10 +20,7 @@ module List = let rec private traverseAsyncResultM' (state : Async>) (f : _ -> Async>) xs = match xs with | [] -> - asyncResult { - let! v = state - return List.rev v - } + state |> AsyncResult.map List.rev | x :: xs -> async { let! r = asyncResult { @@ -52,12 +47,10 @@ module List = let rec private traverseResultA' state f xs = - match state, xs with - | Ok v, [] -> - Ok (List.rev v) - | v, [] -> - v - | _, x :: xs -> + match xs with + | [] -> + state |> Result.map List.rev + | x :: xs -> let fR = f x |> Result.mapError List.singleton match state, fR with @@ -92,12 +85,10 @@ module List = traverseResultA id xs let rec traverseValidationA' state f xs = - match state, xs with - | Ok items, [] -> - Ok (List.rev items) - | errors, [] -> - errors - | _, x :: xs -> + match xs with + | [] -> + state |> Result.map List.rev + | x :: xs -> let fR = f x match state, fR with | Ok ys, Ok y ->