Updated Seq.fooM functions to have an early exit condition

benchmarks/SeqTests.fs

@@ -4,6 +4,8 @@ open BenchmarkDotNet.Attributes
 open BenchmarkDotNet.Order
 open BenchmarkDotNet.Mathematics
 open BenchmarkDotNet.Configs
+open System.Threading
+open System
 
 module sequenceResultMTests =
 
@@ -113,19 +115,24 @@ module sequenceResultMTests =
 
     module v6 =
 
+        // adds an early exit upon encountering an error
         let inline traverseResultM'
             state
             ([<InlineIfLambda>] f: 'okInput -> Result<'okOutput, 'error>)
             (xs: seq<'okInput>)
             =
             let mutable state = state
-
             let enumerator = xs.GetEnumerator()
 
-            while enumerator.MoveNext() do
+            while Result.isOk state
+                  && enumerator.MoveNext() do
                 match state, f enumerator.Current with
-                | Error _, _ -> ()
-                | Ok oks, Ok ok -> state <- Ok(Seq.append oks (Seq.singleton ok))
+                | Error e, _ -> state <- Error e
+                | Ok oks, Ok ok ->
+                    state <-
+                        Seq.singleton ok
+                        |> Seq.append oks
+                        |> Ok
                 | Ok _, Error e -> state <- Error e
 
             state
@@ -144,12 +151,13 @@ type SeqBenchmarks() =
     member _.GetPartialOkSeq size =
         seq {
             for i in 1u .. size do
+                Thread.Sleep(TimeSpan.FromMicroseconds(1.0))
                 if i = size / 2u then Error "error" else Ok i
         }
 
-    member _.SmallSize = 1000u
+    member _.SmallSize = 100u
 
-    member _.LargeSize = 500_000u
+    member _.LargeSize = 1_000u
 
     [<Benchmark(Baseline = true, Description = "original")>]
     [<BenchmarkCategory("Small")>]

src/FsToolkit.ErrorHandling/Seq.fs

@@ -10,17 +10,22 @@ module Seq =
     /// <param name="f">The function to apply to each element</param>
     /// <param name="xs">The input sequence</param>
     /// <returns>A result with the ok elements in a sequence or the first error occurring in the sequence</returns>
-    let traverseResultM' state (f: 'okInput -> Result<'okOutput, 'error>) xs =
-        let folder state x =
-            match state, f x with
-            | Error e, _ -> Error e
+    let traverseResultM' state (f: 'okInput -> Result<'okOutput, 'error>) (xs: 'okInput seq) =
+        let mutable state = state
+        let enumerator = xs.GetEnumerator()
+
+        while Result.isOk state
+              && enumerator.MoveNext() do
+            match state, f enumerator.Current with
+            | Error e, _ -> state <- Error e
             | Ok oks, Ok ok ->
-                Seq.singleton ok
-                |> Seq.append oks
-                |> Ok
-            | Ok _, Error e -> Error e
+                state <-
+                    Seq.singleton ok
+                    |> Seq.append oks
+                    |> Ok
+            | Ok _, Error e -> state <- Error e
 
-        Seq.fold folder state xs
+        state
 
     /// <summary>
     /// Applies a function to each element of a sequence and returns a single result
@@ -86,23 +91,27 @@ module Seq =
     /// <param name="f">The function to apply to each element</param>
     /// <param name="xs">The input sequence</param>
     /// <returns>An async result with the ok elements in a sequence or the first error occurring in the sequence</returns>
-    let traverseAsyncResultM' state (f: 'okInput -> Async<Result<'okOutput, 'error>>) xs =
-        let folder state x =
-            async {
-                let! state = state
-                let! result = f x
-
-                return
-                    match state, result with
-                    | Error e, _ -> Error e
-                    | Ok oks, Ok ok ->
-                        Seq.singleton ok
-                        |> Seq.append oks
-                        |> Ok
-                    | Ok _, Error e -> Error e
-            }
-
-        Seq.fold folder state xs
+    let traverseAsyncResultM'
+        state
+        (f: 'okInput -> Async<Result<'okOutput, 'error>>)
+        (xs: 'okInput seq)
+        =
+        async {
+            let! state' = state
+            let mutable state = state'
+            let enumerator = xs.GetEnumerator()
+
+            while Result.isOk state
+                  && enumerator.MoveNext() do
+                let! result = f enumerator.Current
+
+                match state, result with
+                | Error _, _ -> ()
+                | Ok oks, Ok ok -> state <- Ok(Seq.append oks (Seq.singleton ok))
+                | Ok _, Error e -> state <- Error e
+
+            return state
+        }
 
     /// <summary>
     /// Applies a function to each element of a sequence and returns a single async result
@@ -176,17 +185,22 @@ module Seq =
     /// <param name="f">The function to apply to each element</param>
     /// <param name="xs">The input sequence</param>
     /// <returns>An option containing Some sequence of elements or None if any of the function applications return None</returns>
-    let traverseOptionM' state (f: 'okInput -> 'okOutput option) xs =
-        let folder state x =
-            match state, f x with
-            | None, _ -> None
-            | Some oks, Some ok ->
-                Seq.singleton ok
-                |> Seq.append oks
-                |> Some
-            | Some _, None -> None
-
-        Seq.fold folder state xs
+    let traverseOptionM' state (f: 'okInput -> 'okOutput option) (xs: 'okInput seq) =
+        let mutable state = state
+        let enumerator = xs.GetEnumerator()
+
+        while Option.isSome state
+              && enumerator.MoveNext() do
+            match state, f enumerator.Current with
+            | None, _ -> state <- None
+            | Some values, Some value ->
+                state <-
+                    Seq.singleton value
+                    |> Seq.append values
+                    |> Some
+            | Some _, None -> state <- None
+
+        state
 
     /// <summary>
     /// Applies a function to each element of a sequence and returns a single option
@@ -212,23 +226,27 @@ module Seq =
     /// <param name="f">The function to apply to each element</param>
     /// <param name="xs">The input sequence</param>
     /// <returns>An async option containing Some sequence of elements or None if any of the function applications return None</returns>
-    let traverseAsyncOptionM' state (f: 'okInput -> Async<'okOutput option>) xs =
-        let folder state x =
-            async {
-                let! state = state
-                let! result = f x
-
-                return
-                    match state, result with
-                    | None, _ -> None
-                    | Some oks, Some ok ->
-                        Seq.singleton ok
-                        |> Seq.append oks
+    let traverseAsyncOptionM' state (f: 'okInput -> Async<'okOutput option>) (xs: 'okInput seq) =
+        async {
+            let! state' = state
+            let mutable state = state'
+            let enumerator = xs.GetEnumerator()
+
+            while Option.isSome state
+                  && enumerator.MoveNext() do
+                let! result = f enumerator.Current
+
+                match state, result with
+                | None, _ -> state <- None
+                | Some values, Some value ->
+                    state <-
+                        Seq.singleton value
+                        |> Seq.append values
                         |> Some
-                    | Some _, None -> None
-            }
+                | Some _, None -> state <- None
 
-        Seq.fold folder state xs
+            return state
+        }
 
     /// <summary>
     /// Applies a function to each element of a sequence and returns a single async option
@@ -257,17 +275,22 @@ module Seq =
     /// <param name="f">The function to apply to each element</param>
     /// <param name="xs">The input sequence</param>
     /// <returns>A voption containing Some sequence of elements or None if any of the function applications return None</returns>
-    let traverseVOptionM' state (f: 'okInput -> 'okOutput voption) xs =
-        let folder state x =
-            match state, f x with
-            | ValueNone, _ -> ValueNone
-            | ValueSome oks, ValueSome ok ->
-                Seq.singleton ok
-                |> Seq.append oks
-                |> ValueSome
-            | ValueSome _, ValueNone -> ValueNone
-
-        Seq.fold folder state xs
+    let traverseVOptionM' state (f: 'okInput -> 'okOutput voption) (xs: 'okInput seq) =
+        let mutable state = state
+        let enumerator = xs.GetEnumerator()
+
+        while ValueOption.isSome state
+              && enumerator.MoveNext() do
+            match state, f enumerator.Current with
+            | ValueNone, _ -> state <- ValueNone
+            | ValueSome values, ValueSome value ->
+                state <-
+                    Seq.singleton value
+                    |> Seq.append values
+                    |> ValueSome
+            | ValueSome _, ValueNone -> state <- ValueNone
+
+        state
 
     /// <summary>
     /// Applies a function to each element of a sequence and returns a single voption

tests/FsToolkit.ErrorHandling.Tests/Seq.fs

@@ -130,6 +130,39 @@ let sequenceResultMTests =
 
             let actual = Seq.sequenceResultM (Seq.map Tweet.TryCreate tweets)
 
+            Expect.equal
+                actual
+                (Error emptyTweetErrMsg)
+                "traverse the sequence and return the first error"
+
+        testCase "sequenceResultM with few invalid data should exit early"
+        <| fun _ ->
+
+            let mutable lastValue = null
+            let mutable callCount = 0
+
+            let tweets =
+                seq {
+                    ""
+                    "Hello"
+                    aLongerInvalidTweet
+                }
+
+            let tryCreate tweet =
+                callCount <-
+                    callCount
+                    + 1
+
+                match tweet with
+                | x when String.IsNullOrEmpty x -> Error "Tweet shouldn't be empty"
+                | x when x.Length > 280 -> Error "Tweet shouldn't contain more than 280 characters"
+                | x -> Ok(x)
+
+            let actual = Seq.sequenceResultM (Seq.map tryCreate tweets)
+
+            Expect.equal callCount 1 "Should have called the function only 1 time"
+            Expect.equal lastValue null ""
+
             Expect.equal
                 actual
                 (Error emptyTweetErrMsg)
@@ -172,6 +205,35 @@ let sequenceOptionMTests =
 
             let actual = Seq.sequenceOptionM (Seq.map tryTweetOption tweets)
 
+            Expect.equal actual None "traverse the sequence and return none"
+
+        testCase "sequenceOptionM with few invalid data should exit early"
+        <| fun _ ->
+
+            let mutable lastValue = null
+            let mutable callCount = 0
+
+            let tweets =
+                seq {
+                    ""
+                    "Hello"
+                    aLongerInvalidTweet
+                }
+
+            let tryCreate tweet =
+                callCount <-
+                    callCount
+                    + 1
+
+                match tweet with
+                | x when String.IsNullOrEmpty x -> None
+                | x -> Some x
+
+            let actual = Seq.sequenceOptionM (Seq.map tryCreate tweets)
+
+            Expect.equal callCount 1 "Should have called the function only 1 time"
+            Expect.equal lastValue null ""
+
             Expect.equal actual None "traverse the sequence and return none"
     ]
 
@@ -615,6 +677,37 @@ let sequenceVOptionMTests =
 
             let actual = Seq.sequenceVOptionM (Seq.map tryTweetOption tweets)
             Expect.equal actual ValueNone "traverse the sequence and return value none"
+
+        testCase "sequenceVOptionM with few invalid data should exit early"
+        <| fun _ ->
+
+            let mutable lastValue = null
+            let mutable callCount = 0
+
+            let tweets =
+                seq {
+                    ""
+                    "Hello"
+                    aLongerInvalidTweet
+                }
+
+            let tryCreate tweet =
+                callCount <-
+                    callCount
+                    + 1
+
+                match tweet with
+                | x when String.IsNullOrEmpty x -> ValueNone
+                | x -> ValueSome x
+
+            let actual = Seq.sequenceVOptionM (Seq.map tryCreate tweets)
+
+            match actual with
+            | ValueNone -> ()
+            | ValueSome _ -> failwith "Expected a value none"
+
+            Expect.equal callCount 1 "Should have called the function only 1 time"
+            Expect.equal lastValue null ""
     ]
 
 #endif