Adding Seq.traverse & sequence functions

.vscode/launch.json

@@ -0,0 +1,18 @@
+{
+    "version": "0.2.0",
+    "configurations": [
+        {
+            "name": "benchmarks",
+            "type": "coreclr",
+            "request": "launch",
+            "program": "${workspaceFolder}/benchmarks/bin/Release/net7.0/benchmarks.exe",
+            "args": [],
+            "env": {
+                "ASPNETCORE_ENVIRONMENT": "Development"
+            },
+            "console": "integratedTerminal",
+            "preLaunchTask": "build release",
+            "cwd": "${workspaceFolder}/benchmarks/bin/Release/net7.0/"
+        }
+    ]
+}

.vscode/settings.json

@@ -1,13 +1,11 @@
 {
     "editor.inlayHints.enabled": "off",
-    "FSharp.enableAdaptiveLspServer": true,
     "FSharp.enableMSBuildProjectGraph": true,
     "editor.formatOnSave": true,
     "FSharp.notifications.trace": false,
     "FSharp.notifications.traceNamespaces": [
         "BoundModel.TypeCheck",
         "BackgroundCompiler."
     ],
-    "FSharp.fsac.conserveMemory": true,
     "FSharp.fsac.parallelReferenceResolution": false
 }

.vscode/tasks.json

@@ -0,0 +1,18 @@
+{
+    "version": "2.0.0",
+    "tasks": [
+        {
+            "label": "build release",
+            "type": "process",
+            "command": "dotnet",
+            "args": [
+                "build",
+                "-c",
+                "Release",
+                "${workspaceFolder}/FsToolkit.ErrorHandling.sln",
+                "/property:GenerateFullPaths=true",
+                "/consoleloggerparameters:NoSummary"
+            ]
+        }
+    ]
+}

benchmarks/Program.fs

@@ -3,23 +3,26 @@ open BenchmarkDotNet.Running
 open benchmarks
 open BenchmarkDotNet.Configs
 open BenchmarkDotNet.Jobs
+open BenchmarkDotNet.Columns
 open BenchmarkDotNet.Environments
+open BenchmarkDotNet.Reports
 open FsToolkit.ErrorHandling.Benchmarks
 open ApplicativeTests
 
 [<EntryPoint>]
 let main argv =
+
     let cfg =
-        DefaultConfig
-            .Instance
+        DefaultConfig.Instance
             // .AddJob(Job.Default.WithRuntime(CoreRuntime.Core50))
-            .AddJob(Job.Default.WithRuntime(CoreRuntime.Core60))
+            .AddJob(Job.Default.WithRuntime(CoreRuntime.Core70))
+            .AddColumn(StatisticColumn.P80, StatisticColumn.P95)
+            .WithSummaryStyle(SummaryStyle.Default.WithRatioStyle(RatioStyle.Trend))
     // BenchmarkRunner.Run<EitherMapBenchmarks>() |> ignore
     // BenchmarkRunner.Run<TaskResult_BindCEBenchmarks>(cfg) |> ignore
     // BenchmarkRunner.Run<BindSameBenchmarks>() |> ignore
 
-    BenchmarkRunner.Run<Result_BindvsAndCEBenchmarks>(cfg)
+    BenchmarkRunner.Run<SeqTests.SeqBenchmarks>(cfg, argv)
     |> ignore
-    //
 
     0 // return an integer exit code

benchmarks/SeqTests.fs

@@ -0,0 +1,222 @@
+module SeqTests
+
+open BenchmarkDotNet.Attributes
+open BenchmarkDotNet.Order
+open BenchmarkDotNet.Mathematics
+open BenchmarkDotNet.Configs
+open System.Threading
+open System
+
+module sequenceResultMTests =
+
+    module v1 =
+
+        let sequenceResultM (xs: seq<Result<'t, 'e>>) : Result<'t seq, 'e> =
+            let rec loop xs ts =
+                match Seq.tryHead xs with
+                | Some x ->
+                    x
+                    |> Result.bind (fun t -> loop (Seq.tail xs) (t :: ts))
+                | None ->
+                    Ok(
+                        List.rev ts
+                        |> List.toSeq
+                    )
+
+            // Seq.cache prevents double evaluation in Seq.tail
+            loop (Seq.cache xs) []
+
+    module v2 =
+
+        let traverseResultM' state (f: 'okInput -> Result<'okOutput, 'error>) xs =
+            let folder state x =
+                match state, f x 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
+            |> Result.map Seq.rev
+
+        let traverseResultM (f: 'okInput -> Result<'okOutput, 'error>) xs =
+            traverseResultM' (Ok Seq.empty) f xs
+
+        let sequenceResultM xs = traverseResultM id xs
+
+    module v3 =
+
+        let inline traverseResultM'
+            state
+            ([<InlineIfLambda>] f: 'okInput -> Result<'okOutput, 'error>)
+            xs
+            =
+            let folder state x =
+                match state, f x 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
+            |> Result.map Seq.rev
+
+        let traverseResultM (f: 'okInput -> Result<'okOutput, 'error>) xs =
+            traverseResultM' (Ok Seq.empty) f xs
+
+        let sequenceResultM xs = traverseResultM id xs
+
+    module v4 =
+
+        let traverseResultM' initialState (f: 'okInput -> Result<'okOutput, 'error>) xs =
+            (initialState, 0)
+            |> Seq.unfold (fun (state, i) ->
+                xs
+                |> Seq.tryItem i
+                |> Option.bind (fun x ->
+                    match state, f x with
+                    | Error _, _ -> None
+                    | Ok oks, Ok ok ->
+                        let newState =
+                            Seq.singleton ok
+                            |> Seq.append oks
+                            |> Ok
+
+                        Some(newState, (newState, i + 1))
+                    | Ok _, Error e -> Some(Error e, (Error e, i + 1))
+                )
+            )
+            |> Seq.last
+
+        let traverseResultM f xs = traverseResultM' (Ok Seq.empty) f xs
+        let sequenceResultM xs = traverseResultM id xs
+
+    module v5 =
+
+        let traverseResultM' state (f: 'okInput -> Result<'okOutput, 'error>) (xs: seq<'okInput>) =
+            let mutable state = state
+
+            let enumerator = xs.GetEnumerator()
+
+            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))
+                | Ok _, Error e -> state <- Error e
+
+            state
+
+        let traverseResultM f xs = traverseResultM' (Ok Seq.empty) f xs
+        let sequenceResultM xs = traverseResultM id xs
+
+    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 Result.isOk state
+                  && enumerator.MoveNext() do
+                match state, f enumerator.Current with
+                | Error e, _ -> state <- Error e
+                | Ok oks, Ok ok ->
+                    state <-
+                        Seq.singleton ok
+                        |> Seq.append oks
+                        |> Ok
+                | Ok _, Error e -> state <- Error e
+
+            state
+
+        let traverseResultM f xs = traverseResultM' (Ok Seq.empty) f xs
+        let sequenceResultM xs = traverseResultM id xs
+
+
+[<MemoryDiagnoser>]
+[<Orderer(SummaryOrderPolicy.FastestToSlowest)>]
+[<RankColumn(NumeralSystem.Stars)>]
+[<MinColumn; MaxColumn; MedianColumn; MeanColumn; CategoriesColumn>]
+[<GroupBenchmarksBy(BenchmarkLogicalGroupRule.ByCategory)>]
+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 = 100u
+
+    member _.LargeSize = 5_000u
+
+    [<Benchmark(Baseline = true, Description = "original")>]
+    [<BenchmarkCategory("Small")>]
+    member this.original() =
+        sequenceResultMTests.v1.sequenceResultM (this.GetPartialOkSeq this.SmallSize)
+        |> ignore
+
+    [<Benchmark(Description = "Seq.fold")>]
+    [<BenchmarkCategory("Small")>]
+    member this.seqFoldSmall() =
+        sequenceResultMTests.v2.sequenceResultM (this.GetPartialOkSeq this.SmallSize)
+        |> ignore
+
+    [<Benchmark(Description = "inlined Seq.fold")>]
+    [<BenchmarkCategory("Small")>]
+    member this.inlineSeqFoldSmall() =
+        sequenceResultMTests.v3.sequenceResultM (this.GetPartialOkSeq this.SmallSize)
+        |> ignore
+
+    [<Benchmark(Description = "Seq.unfold")>]
+    [<BenchmarkCategory("Small")>]
+    member this.seqUnfoldSmall() =
+        sequenceResultMTests.v4.sequenceResultM (this.GetPartialOkSeq this.SmallSize)
+        |> ignore
+
+    [<Benchmark(Description = "GetEnumerator w/ mutability")>]
+    [<BenchmarkCategory("Small")>]
+    member this.getEnumeratorSmall() =
+        sequenceResultMTests.v5.sequenceResultM (this.GetPartialOkSeq this.SmallSize)
+        |> ignore
+
+    [<Benchmark(Description = "inlined GetEnumerator w/ mutability")>]
+    [<BenchmarkCategory("Small")>]
+    member this.inlineGetEnumeratorSmall() =
+        sequenceResultMTests.v6.sequenceResultM (this.GetPartialOkSeq this.SmallSize)
+        |> ignore
+
+    // made this baseline for this category since unfold and original were so unperformant for this size of data
+    [<Benchmark(Baseline = true, Description = "Seq.fold")>]
+    [<BenchmarkCategory("Large")>]
+    member this.seqFoldLarge() =
+        sequenceResultMTests.v2.sequenceResultM (this.GetPartialOkSeq this.LargeSize)
+        |> ignore
+
+    [<Benchmark(Description = "inlined Seq.fold")>]
+    [<BenchmarkCategory("Large")>]
+    member this.inlineSeqFoldLarge() =
+        sequenceResultMTests.v3.sequenceResultM (this.GetPartialOkSeq this.LargeSize)
+        |> ignore
+
+    [<Benchmark(Description = "GetEnumerator w/ mutability")>]
+    [<BenchmarkCategory("Large")>]
+    member this.getEnumeratorLarge() =
+        sequenceResultMTests.v5.sequenceResultM (this.GetPartialOkSeq this.LargeSize)
+        |> ignore
+
+    [<Benchmark(Description = "inlined GetEnumerator w/ mutability")>]
+    [<BenchmarkCategory("Large")>]
+    member this.inlineGetEnumeratorLarge() =
+        sequenceResultMTests.v6.sequenceResultM (this.GetPartialOkSeq this.LargeSize)
+        |> ignore

benchmarks/benchmarks.fsproj

@@ -18,6 +18,7 @@
     <Tailcalls>true</Tailcalls>
   </PropertyGroup>
   <ItemGroup>
+    <Compile Include="SeqTests.fs" />
     <Compile Include="ApplicativeTests.fs" />
     <Compile Include="Benchmarks.fs" />
     <Compile Include="AsyncResultCE.fs" />

gitbook/SUMMARY.md

@@ -25,6 +25,11 @@
       * [sequenceResultM](list/sequenceResultM.md)
       * [traverseResultA](list/traverseResultA.md)
       * [sequenceResultA](list/sequenceResultA.md)
+    * Sequences
+      * [traverseResultM](seq/traverseResultM.md)
+      * [sequenceResultM](seq/sequenceResultM.md)
+      * [traverseResultA](seq/traverseResultA.md)
+      * [sequenceResultA](seq/sequenceResultA.md)
     * Transforms
       * [ofChoice](result/ofChoice.md)
 
@@ -45,6 +50,11 @@
         * [sequenceOptionM](option/sequenceOptionM.md)
         * [traverseVOptionM](option/traverseVOptionM.md)
         * [sequenceVOptionM](option/sequenceVOptionM.md)
+    * Sequences
+        * [traverseOptionM](seq/traverseOptionM.md)
+        * [sequenceOptionM](seq/sequenceOptionM.md)
+        * [traverseVOptionM](seq/traverseVOptionM.md)
+        * [sequenceVOptionM](seq/sequenceVOptionM.md)
     * Transforms
       * [ofNull](option/ofNull.md)
       * [ofPair](option/ofPair.md)
@@ -89,6 +99,11 @@
       * [sequenceAsyncResultM](list/sequenceAsyncResultM.md)
       * [traverseAsyncResultA](list/traverseAsyncResultA.md)
       * [sequenceAsyncResultA](list/sequenceAsyncResultA.md)
+    * Sequences
+      * [traverseAsyncResultM](seq/traverseAsyncResultM.md)
+      * [sequenceAsyncResultM](seq/sequenceAsyncResultM.md)
+      * [traverseAsyncResultA](seq/traverseAsyncResultA.md)
+      * [sequenceAsyncResultA](seq/sequenceAsyncResultA.md)
     * Transforms
       * [ofAsync](asyncResult/ofAsync.md)
       * [ofResult](asyncResult/ofResult.md)

gitbook/seq/sequenceAsyncResultA.md

@@ -0,0 +1,20 @@
+## Seq.sequenceAsyncResultA
+
+Namespace: `FsToolkit.ErrorHandling`
+
+Function Signature:
+
+```
+Async<Result<'a, 'b>> seq -> Async<Result<'a seq, 'b seq>>
+```
+
+Note that `sequence` is the same as `traverse id`. See also [Seq.traverseAsyncResultA](traverseAsyncResultA.md).
+
+This is applicative, collecting all errors.
+
+This is the same as [sequenceResultA](sequenceResultA.md) except that it uses `Async<Result<_,_>>` instead of `Result<_,_>`.
+
+See also Scott Wlaschin's [Understanding traverse and sequence](https://fsharpforfunandprofit.com/posts/elevated-world-4/).
+
+## Examples
+

gitbook/seq/sequenceAsyncResultM.md

@@ -0,0 +1,19 @@
+## Seq.sequenceAsyncResultM
+
+Namespace: `FsToolkit.ErrorHandling`
+
+Function Signature:
+
+```
+Async<Result<'a, 'b>> seq -> Async<Result<'a seq, 'b>>
+```
+
+Note that `sequence` is the same as `traverse id`. See also [Seq.traverseAsyncResultM](traverseAsyncResultM.md).
+
+This is monadic, stopping on the first error.
+
+This is the same as [sequenceResultM](sequenceResultM.md) except that it uses `Async<Result<_,_>>` instead of `Result<_,_>`.
+
+See also Scott Wlaschin's [Understanding traverse and sequence](https://fsharpforfunandprofit.com/posts/elevated-world-4/).
+
+## Examples