fixing while loops for option, voption, validation

Author: TheAngryByrd

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

@@ -17,12 +17,12 @@ module OptionCE =
             Option.bind binder input
 
         // Could not get it to work solely with Source. In loop cases it would potentially match the #seq overload and ask for type annotation
-        member inline this.Bind
-            (
-                m: 'input when 'input: null,
-                [<InlineIfLambda>] binder: 'input -> 'output option
-            ) : 'output option =
-            this.Bind(Option.ofObj m, binder)
+        // member inline this.Bind
+        //     (
+        //         m: 'input when 'input: null,
+        //         [<InlineIfLambda>] binder: 'input -> 'output option
+        //     ) : 'output option =
+        //     this.Bind(Option.ofObj m, binder)
 
         member inline this.Zero() : unit option = this.Return()
 
@@ -71,21 +71,16 @@ 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 rec whileBuilder () =
+                if guard () then
+                    this.Bind(this.Run(fun () -> generator ()), (fun () -> this.Run(fun () -> whileBuilder ())))
+                else
+                    this.Zero()
+
+            this.Run(fun () -> whileBuilder ())
 
         member inline this.For
             (

src/FsToolkit.ErrorHandling/ResultCE.fs

@@ -75,12 +75,11 @@ module ResultCE =
                 [<InlineIfLambda>] generator: unit -> Result<unit, 'error>
             ) : Result<unit, 'error> =
 
-            let rec whileBuilder =
-                fun () ->
-                    if guard () then
-                        this.Bind(this.Run(fun () -> generator ()), (fun () -> this.Run(fun () -> whileBuilder ())))
-                    else
-                        this.Zero()
+            let rec whileBuilder () =
+                if guard () then
+                    this.Bind(this.Run(fun () -> generator ()), (fun () -> this.Run(fun () -> whileBuilder ())))
+                else
+                    this.Zero()
 
             this.Run(fun () -> whileBuilder ())
 
@@ -92,7 +91,7 @@ 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,13 @@ 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 rec whileBuilder () =
+                if guard () then
+                    this.Bind(this.Run(fun () -> generator ()), (fun () -> this.Run(fun () -> whileBuilder ())))
+                else
+                    this.Zero()
+
+            this.Run(fun () -> whileBuilder ())
 
         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,14 @@ 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 rec whileBuilder () =
+                if guard () then
+                    this.Bind(this.Run(fun () -> generator ()), (fun () -> this.Run(fun () -> whileBuilder ())))
+                else
+                    this.Zero()
+
+            this.Run(fun () -> whileBuilder ())
 
         member inline this.For
             (

tests/FsToolkit.ErrorHandling.Tests/OptionCE.fs

@@ -126,19 +126,26 @@ let ceTests =
             }
 
             Expect.equal actual (Some data) "Should be ok"
-        testCase "While"
-        <| fun () ->
-            let data = 42
-            let mutable index = 0
-
-            let actual = option {
-                while index < 10 do
-                    index <- index + 1
-
-                return data
-            }
-
-            Expect.equal actual (Some data) "Should be ok"
+        yield! [
+            let maxIndices = [10; 1000000]
+            for maxIndex in maxIndices do
+                testCase <| sprintf "While - %i" maxIndex
+                <| fun () ->
+                    let data = 42
+                    let mutable index = 0
+
+                    let actual = option {
+                        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"
+        ]
+        
+            
         testCase "For in"
         <| fun () ->
             let data = 42

tests/FsToolkit.ErrorHandling.Tests/ResultCE.fs

@@ -233,34 +233,23 @@ let ``ResultCE using Tests`` =
 
 let ``ResultCE loop Tests`` =
     testList "ResultCE loop Tests" [
-        testCase "while"
-        <| fun () ->
-            let data = 42
-            let maxLoop = 10
-            let mutable index = maxLoop
-
-            let actual = result {
-                while index < 10 do
-                    index <- index + 1
-
-                return data
-            }
-            Expect.equal index maxLoop "index should match maxLoop"
-            Expect.equal actual (Result.Ok data) "Should be ok"
-        testCase "while long"
-        <| fun () ->
-            let data = 42
-            let mutable index = 0
-            let maxLoop = 1000000
-            let actual = result {
-                while index < maxLoop do
-                    index <- index + 1
-
-                return data
-            }
-
-            Expect.equal index (maxLoop ) "index should match maxLoop"
-            Expect.equal actual (Result.Ok data) "Should be ok"
+        yield! [
+            let maxIndices = [10; 10000; 1000000]
+            for maxIndex in maxIndices do
+                testCase <| sprintf "While - %i" maxIndex
+                <| fun () ->
+                    let data = 42
+                    let mutable index = 0
+
+                    let actual = result {
+                        while index < maxIndex do
+                            index <- index + 1
+
+                        return data
+                    }
+                    Expect.equal index (maxIndex) "Index should reach maxIndex"
+                    Expect.equal actual (Ok data) "Should be ok"
+        ]
         testCase "for in"
         <| fun () ->
             let data = 42

tests/FsToolkit.ErrorHandling.Tests/ValidationCE.fs

@@ -277,19 +277,24 @@ let ``ValidationCE using Tests`` =
 
 let ``ValidationCE loop Tests`` =
     testList "ValidationCE loop Tests" [
-        testCase "while"
-        <| fun () ->
-            let data = 42
-            let mutable index = 0
-
-            let actual = validation {
-                while index < 10 do
-                    index <- index + 1
-
-                return data
-            }
-
-            Expect.equal actual (Result.Ok data) "Should be ok"
+        yield! [
+            let maxIndices = [10; 1000000]
+            for maxIndex in maxIndices do
+                testCase <| sprintf "While - %i" maxIndex
+                <| fun () ->
+                    let data = 42
+                    let mutable index = 0
+
+                    let actual = validation {
+                        while index < maxIndex do
+                            index <- index + 1
+
+                        return data
+                    }
+
+                    Expect.equal index maxIndex "Index should reach maxIndex"
+                    Expect.equal actual (Ok data) "Should be ok"
+        ]
         testCase "for in"
         <| fun () ->
             let data = 42

tests/FsToolkit.ErrorHandling.Tests/ValueOptionCE.fs

@@ -129,19 +129,24 @@ let ceTests =
             }
 
             Expect.equal actual (ValueSome data) "Should be ok"
-        testCase "While"
-        <| fun () ->
-            let data = 42
-            let mutable index = 0
-
-            let actual = voption {
-                while index < 10 do
-                    index <- index + 1
-
-                return data
-            }
-
-            Expect.equal actual (ValueSome data) "Should be ok"
+        yield! [
+            let maxIndices = [10; 1000000]
+            for maxIndex in maxIndices do
+                testCase <| sprintf "While - %i" maxIndex
+                <| fun () ->
+                    let data = 42
+                    let mutable index = 0
+
+                    let actual = voption {
+                        while index < maxIndex do
+                            index <- index + 1
+
+                        return data
+                    }
+
+                    Expect.equal index maxIndex "Index should reach maxIndex"
+                    Expect.equal actual (ValueSome data) "Should be ok"
+        ]
         testCase "For in"
         <| fun () ->
             let data = 42