Fixing List.traverseResultA issues

demystifyfp · Oct 18, 2022 · d4e7288 · d4e7288
1 parent ed43d87
commit d4e7288
Show file tree

Hide file tree

Showing 7 changed files with 264 additions and 265 deletions.
diff --git a/FsToolkit.ErrorHandling.sln b/FsToolkit.ErrorHandling.sln
diff --git a/src/FsToolkit.ErrorHandling.JobResult/JobResult.fs b/src/FsToolkit.ErrorHandling.JobResult/JobResult.fs
@@ -21,6 +21,9 @@ module JobResult =
     let inline foldResult ([<InlineIfLambda>] onSuccess) ([<InlineIfLambda>] onError) jr =
         Job.map (Result.fold onSuccess onError) jr
 
+    let inline eitherMap ([<InlineIfLambda>] onSuccess) ([<InlineIfLambda>] onError) jr =
+        Job.map (Result.eitherMap onSuccess onError) jr
+
     let inline ofAsync aAsync =
         aAsync
         |> Job.fromAsync

diff --git a/src/FsToolkit.ErrorHandling.JobResult/List.fs b/src/FsToolkit.ErrorHandling.JobResult/List.fs
@@ -27,23 +27,22 @@ module List =
     let sequenceJobResultM xs = traverseJobResultM id xs
 
 
-    let rec private traverseJobResultA' state f xs =
+    let rec private traverseJobResultA' state (f : _ -> Job<Result<_,_>>) xs =
         match xs with
         | [] ->
             state
-            |> JobResult.map List.rev
+            |> JobResult.eitherMap List.rev List.rev
         | x :: xs -> job {
             let! s = state
 
-            let! fR =
-                f x
-                |> JobResult.mapError List.singleton
+            let! fR = f x
+
 
             match s, fR with
             | Ok ys, Ok y -> return! traverseJobResultA' (JobResult.retn (y :: ys)) f xs
             | Error errs, Error e ->
-                return! traverseJobResultA' (JobResult.returnError (errs @ e)) f xs
-            | Ok _, Error e
+                return! traverseJobResultA' (JobResult.returnError (e :: errs)) f xs
+            | Ok _, Error e -> return! traverseJobResultA' (JobResult.returnError [e]) f xs
             | Error e, Ok _ -> return! traverseJobResultA' (JobResult.returnError e) f xs
           }
 

diff --git a/src/FsToolkit.ErrorHandling.TaskResult/Task.fs b/src/FsToolkit.ErrorHandling.TaskResult/Task.fs
@@ -12,10 +12,11 @@ module Task =
         value
         |> Task.FromResult
 
-    let inline bind ([<InlineIfLambda>] f: 'a -> Task<'b>) (x: Task<'a>) = task {
-        let! x = x
-        return! f x
-    }
+    let inline bind ([<InlineIfLambda>] f: 'a -> Task<'b>) (x: Task<'a>) =
+        task {
+            let! x = x
+            return! f x
+        }
 
     let inline bindV ([<InlineIfLambda>] f: 'a -> Task<'b>) (x: ValueTask<'a>) = task {
         let! x = x

diff --git a/src/FsToolkit.ErrorHandling/AsyncResult.fs b/src/FsToolkit.ErrorHandling/AsyncResult.fs
@@ -43,6 +43,9 @@ module AsyncResult =
         : Async<'output> =
         Async.map (Result.either onSuccess onError) input
 
+    let inline eitherMap ([<InlineIfLambda>] onSuccess) ([<InlineIfLambda>] onError) input =
+        Async.map (Result.eitherMap onSuccess onError) input
+
 #if !FABLE_COMPILER
 
     let inline ofTask (aTask: Task<'ok>) : Async<Result<'ok, exn>> =

diff --git a/src/FsToolkit.ErrorHandling/List.fs b/src/FsToolkit.ErrorHandling/List.fs
@@ -51,38 +51,30 @@ module List =
 
 
     let rec private traverseResultA' state f xs =
-        match xs with
-        | [] ->
-            state
-            |> Result.map List.rev
-        | x :: xs ->
-            let fR =
-                f x
-                |> Result.mapError List.singleton
+      match xs with
+      | [] -> state |> Result.eitherMap List.rev List.rev
+      | x :: xs ->
 
-            match state, fR with
-            | Ok ys, Ok y -> traverseResultA' (Ok(y :: ys)) f xs
-            | Error errs, Error e -> traverseResultA' (Error(errs @ e)) f xs
-            | Ok _, Error e
-            | Error e, Ok _ -> traverseResultA' (Error e) f xs
+          match state, f x with
+          | Ok ys, Ok y -> traverseResultA' (Ok(y :: ys)) f xs
+          | Error errs, Error e -> traverseResultA' (Error(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.map List.rev
+            |> AsyncResult.eitherMap List.rev List.rev
+
         | x :: xs -> async {
             let! s = state
-
-            let! fR =
-                f x
-                |> AsyncResult.mapError List.singleton
-
+            let! fR = f x
             match s, fR with
             | Ok ys, Ok y -> return! traverseAsyncResultA' (AsyncResult.retn (y :: ys)) f xs
             | Error errs, Error e ->
-                return! traverseAsyncResultA' (AsyncResult.returnError (errs @ e)) f xs
-            | Ok _, Error e
+                return! traverseAsyncResultA' (AsyncResult.returnError (e :: errs)) f xs
+            | Ok _, Error e  -> return! traverseAsyncResultA' (AsyncResult.returnError [e]) f xs
             | Error e, Ok _ -> return! traverseAsyncResultA' (AsyncResult.returnError e) f xs
           }
 

diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs
@@ -11,6 +11,7 @@ open System.Threading.Tasks
 open FSharp.Control.Tasks
 #endif
 
+
 [<Tests>]
 let ``TaskResultCE return Tests`` =
     testList "TaskResultCE  Tests" [