Fixing while loops

package.json

@@ -11,10 +11,10 @@
   "scripts": {
     "pretest:FsToolkit.ErrorHandling.Tests": "dotnet fable tests/FsToolkit.ErrorHandling.Tests -o js-dist/tests/FsToolkit.ErrorHandling.Tests",
     "pretest:FsToolkit.ErrorHandling.AsyncSeq.Tests": "dotnet fable tests/FsToolkit.ErrorHandling.AsyncSeq.Tests -o js-dist/tests/FsToolkit.ErrorHandling.AsyncSeq.Tests",
-    "test:FsToolkit.ErrorHandling.Tests": "mocha js-dist/tests/FsToolkit.ErrorHandling.Tests/Main.js",
+    "test:FsToolkit.ErrorHandling.Tests": "mocha js-dist/tests/FsToolkit.ErrorHandling.Tests/Main.js --timeout 60000",
     "test:FsToolkit.ErrorHandling.AsyncSeq.Tests": "mocha js-dist/tests/FsToolkit.ErrorHandling.AsyncSeq.Tests/Main.js",
     "test": "npm-run-all test:*",
-    "watch-test:FsToolkit.ErrorHandling.Tests": "dotnet fable watch tests/FsToolkit.ErrorHandling.Tests -o js-dist/tests/FsToolkit.ErrorHandling.Tests --runWatch mocha js-dist/tests/FsToolkit.ErrorHandling.Tests/Main.js",
+    "watch-test:FsToolkit.ErrorHandling.Tests": "dotnet fable watch tests/FsToolkit.ErrorHandling.Tests -o js-dist/tests/FsToolkit.ErrorHandling.Tests --runWatch mocha js-dist/tests/FsToolkit.ErrorHandling.Tests/Main.js --timeout 10000",
     "watch-test:FsToolkit.ErrorHandling.AsyncSeq.Tests": "dotnet fable watch tests/FsToolkit.ErrorHandling.AsyncSeq.Tests -o js-dist/tests/FsToolkit.ErrorHandling.AsyncSeq.Tests --runWatch mocha js-dist/tests/FsToolkit.ErrorHandling.AsyncSeq.Tests/Main.js",
     "watch-test": "npm-run-all -p  watch-test:*"
   }

src/FsToolkit.ErrorHandling.JobResult/JobOptionCE.fs

@@ -84,11 +84,21 @@ module JobOptionCE =
             ) : Job<_ option> =
             job.Using(resource, binder)
 
-        member this.While(guard: unit -> bool, computation: Job<_ option>) : Job<_ option> =
-            if not (guard ()) then
-                this.Zero()
-            else
-                this.Bind(computation, (fun () -> this.While(guard, computation)))
+        member this.While(guard: unit -> bool, computation: Job<_ option>) : Job<_ option> = job {
+            let mutable doContinue = true
+            let mutable result = Some()
+
+            while doContinue
+                  && guard () do
+                match! computation with
+                | Some () -> ()
+                | None ->
+                    doContinue <- false
+                    result <- None
+
+            return result
+
+        }
 
         member inline this.For
             (

src/FsToolkit.ErrorHandling.JobResult/JobResultCE.fs

@@ -85,10 +85,21 @@ module JobResultCE =
                 guard: unit -> bool,
                 computation: Job<Result<unit, 'TError>>
             ) : Job<Result<unit, 'TError>> =
-            if not (guard ()) then
-                this.Zero()
-            else
-                this.Bind(computation, (fun () -> this.While(guard, computation)))
+            job {
+                let mutable doContinue = true
+                let mutable result = Ok()
+
+                while doContinue
+                      && guard () do
+                    match! computation with
+                    | Ok () -> ()
+                    | Error e ->
+                        doContinue <- false
+                        result <- Error e
+
+                return result
+
+            }
 
         member inline this.For
             (

src/FsToolkit.ErrorHandling.TaskResult/TaskOption.fs

@@ -22,6 +22,7 @@ module TaskOption =
     }
 
     let inline retn x = task { return Some x }
+    let inline some x = task { return Some x }
 
     let inline apply f x =
         bind (fun f' -> bind (fun x' -> retn (f' x')) x) f

src/FsToolkit.ErrorHandling/AsyncOption.fs

@@ -21,10 +21,11 @@ module AsyncOption =
             )
             input
 
-    let inline lol (value: 'value) : Async<'value option> = Async.singleton (Some value)
-
     let inline retn (value: 'value) : Async<'value option> = Async.singleton (Some value)
 
+
+    let inline some (value: 'value) : Async<'value option> = Async.singleton (Some value)
+
     let inline apply
         (applier: Async<('input -> 'output) option>)
         (input: Async<'input option>)

src/FsToolkit.ErrorHandling/Option.fs

@@ -3,6 +3,16 @@ namespace FsToolkit.ErrorHandling
 [<RequireQualifiedAccess>]
 module Option =
 
+    let inline bind ([<InlineIfLambdaAttribute>] f) x =
+        match x with
+        | Some v -> f v
+        | None -> None
+
+    let inline map ([<InlineIfLambdaAttribute>] f) x =
+        match x with
+        | Some v -> Some(f v)
+        | None -> None
+
     let inline ofValueOption (vopt: 'value voption) : 'value option =
         match vopt with
         | ValueSome v -> Some v

src/FsToolkit.ErrorHandling/OptionCE.fs

@@ -71,21 +71,21 @@ module OptionCE =
         member inline this.While
             (
                 [<InlineIfLambda>] guard: unit -> bool,
-                [<InlineIfLambda>] computation: unit -> unit option
+                [<InlineIfLambda>] generator: unit -> unit option
             ) : unit option =
-            if guard () then
-                let mutable whileBuilder = Unchecked.defaultof<_>
-
-                whileBuilder <-
-                    fun () ->
-                        this.Bind(
-                            this.Run computation,
-                            (fun () -> if guard () then this.Run whileBuilder else this.Zero())
-                        )
-
-                this.Run whileBuilder
-            else
-                this.Zero()
+
+            let mutable doContinue = true
+            let mutable result = Some()
+
+            while doContinue
+                  && guard () do
+                match generator () with
+                | Some () -> ()
+                | None ->
+                    doContinue <- false
+                    result <- None
+
+            result
 
         member inline this.For
             (

src/FsToolkit.ErrorHandling/ResultCE.fs

@@ -74,19 +74,19 @@ module ResultCE =
                 [<InlineIfLambda>] guard: unit -> bool,
                 [<InlineIfLambda>] generator: unit -> Result<unit, 'error>
             ) : Result<unit, 'error> =
-            if guard () then
-                let mutable whileBuilder = Unchecked.defaultof<_>
 
-                whileBuilder <-
-                    fun () ->
-                        this.Bind(
-                            this.Run generator,
-                            (fun () -> if guard () then this.Run whileBuilder else this.Zero())
-                        )
+            let mutable doContinue = true
+            let mutable result = Ok()
 
-                this.Run whileBuilder
-            else
-                this.Zero()
+            while doContinue
+                  && guard () do
+                match generator () with
+                | Ok () -> ()
+                | Error e ->
+                    doContinue <- false
+                    result <- Error e
+
+            result
 
         member inline this.For
             (
@@ -95,7 +95,11 @@ module ResultCE =
             ) : Result<unit, 'TError> =
             this.Using(
                 sequence.GetEnumerator(),
-                fun enum -> this.While(enum.MoveNext, this.Delay(fun () -> binder enum.Current))
+                fun enum ->
+                    this.While(
+                        (fun () -> enum.MoveNext()),
+                        this.Delay(fun () -> binder enum.Current)
+                    )
             )
 
         member inline _.BindReturn

src/FsToolkit.ErrorHandling/ValidationCE.fs

@@ -74,19 +74,18 @@ module ValidationCE =
                 [<InlineIfLambda>] guard: unit -> bool,
                 [<InlineIfLambda>] generator: unit -> Validation<unit, 'error>
             ) : Validation<unit, 'error> =
-            if guard () then
-                let mutable whileBuilder = Unchecked.defaultof<_>
-
-                whileBuilder <-
-                    fun () ->
-                        this.Bind(
-                            this.Run generator,
-                            (fun () -> if guard () then this.Run whileBuilder else this.Zero())
-                        )
-
-                this.Run whileBuilder
-            else
-                this.Zero()
+            let mutable doContinue = true
+            let mutable result = Ok()
+
+            while doContinue
+                  && guard () do
+                match generator () with
+                | Ok () -> ()
+                | Error e ->
+                    doContinue <- false
+                    result <- Error e
+
+            result
 
         member inline this.For
             (

src/FsToolkit.ErrorHandling/ValueOption.fs

@@ -4,6 +4,17 @@ namespace FsToolkit.ErrorHandling
 [<RequireQualifiedAccess>]
 module ValueOption =
 
+
+    let inline bind ([<InlineIfLambdaAttribute>] f) x =
+        match x with
+        | ValueSome v -> f v
+        | ValueNone -> ValueNone
+
+    let inline map ([<InlineIfLambdaAttribute>] f) x =
+        match x with
+        | ValueSome v -> ValueSome(f v)
+        | ValueNone -> ValueNone
+
     let inline ofOption (opt: 'value option) : 'value voption =
         match opt with
         | Some v -> ValueSome v

src/FsToolkit.ErrorHandling/ValueOptionCE.fs

@@ -72,19 +72,19 @@ module ValueOptionCE =
                 [<InlineIfLambda>] guard: unit -> bool,
                 [<InlineIfLambda>] generator: unit -> _ voption
             ) : _ voption =
-            if guard () then
-                let mutable whileBuilder = Unchecked.defaultof<_>
-
-                whileBuilder <-
-                    fun () ->
-                        this.Bind(
-                            this.Run generator,
-                            (fun () -> if guard () then this.Run whileBuilder else this.Zero())
-                        )
-
-                this.Run whileBuilder
-            else
-                this.Zero()
+
+            let mutable doContinue = true
+            let mutable result = ValueSome()
+
+            while doContinue
+                  && guard () do
+                match generator () with
+                | ValueSome () -> ()
+                | ValueNone ->
+                    doContinue <- false
+                    result <- ValueNone
+
+            result
 
         member inline this.For
             (

tests/FsToolkit.ErrorHandling.JobResult.Tests/JobOptionCE.fs

@@ -226,19 +226,66 @@ let ceTests =
 
             Expect.equal actual (Some data) "Should be ok"
         }
-        testCaseJob "While"
+        yield! [
+            let maxIndices = [
+                10
+                1000000
+            ]
+
+            for maxIndex in maxIndices do
+                testCaseJob
+                <| sprintf "While - %i" maxIndex
+                <| job {
+                    let data = 42
+                    let mutable index = 0
+
+                    let! actual = jobOption {
+                        while index < maxIndex do
+                            index <- index + 1
+
+                        return data
+                    }
+
+                    Expect.equal index maxIndex "Index should reach maxIndex"
+                    Expect.equal actual (Some data) "Should be ok"
+                }
+        ]
+
+        testCaseJob "while fail"
         <| job {
-            let data = 42
-            let mutable index = 0
+
+            let mutable loopCount = 0
+            let mutable wasCalled = false
+
+            let sideEffect () =
+                wasCalled <- true
+                "ok"
+
+            let expected = None
+
+            let data = [
+                Some "42"
+                Some "1024"
+                expected
+                Some "1M"
+                Some "1M"
+                Some "1M"
+            ]
 
             let! actual = jobOption {
-                while index < 10 do
-                    index <- index + 1
+                while loopCount < data.Length do
+                    let! x = data.[loopCount]
 
-                return data
+                    loopCount <-
+                        loopCount
+                        + 1
+
+                return sideEffect ()
             }
 
-            Expect.equal actual (Some data) "Should be ok"
+            Expect.equal loopCount 2 "Should only loop twice"
+            Expect.equal actual expected "Should be an error"
+            Expect.isFalse wasCalled "No additional side effects should occur"
         }
         testCaseJob "For in"
         <| job {