ValueOption support

paket.dependencies

@@ -2,14 +2,15 @@ source https://api.nuget.org/v3/index.json
 
 
 storage: none
-nuget FSharp.Core 4.6.2
+nuget FSharp.Core 4.7.0
 nuget Hopac
 nuget Microsoft.SourceLink.GitHub prerelease copy_local: true
 nuget Ply
 
 group Test
 source https://api.nuget.org/v3/index.json
 storage: none
+nuget FSharp.Core 4.7.0
 nuget Expecto
 nuget Expecto.Hopac
 nuget Fable.Mocha 2.10.0

src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj

@@ -27,6 +27,8 @@
     <Compile Include="ValidationCE.fs" />
     <Compile Include="Option.fs" />
     <Compile Include="OptionCE.fs" />
+    <Compile Include="ValueOption.fs" />
+    <Compile Include="ValueOptionCE.fs" />
     <Compile Include="AsyncOption.fs" />
     <Compile Include="AsyncOptionCE.fs" />
     <Compile Include="AsyncOptionOp.fs" />

src/FsToolkit.ErrorHandling/Option.fs

@@ -3,6 +3,16 @@ namespace FsToolkit.ErrorHandling
 [<RequireQualifiedAccess>]
 module Option =
 
+    let ofValueOption (vopt: _ voption) =
+        match vopt with
+        | ValueSome v -> Some v
+        | ValueNone -> None
+
+    let toValueOption (opt: _ option) =
+        match opt with
+        | Some v -> ValueSome v
+        | None -> ValueNone
+
     let traverseResult f opt =
         match opt with
         | None -> Ok None
@@ -30,11 +40,12 @@ module Option =
     /// <param name="option1">The input option</param>
     /// <param name="option2">The input option</param>
     /// <returns></returns>
-    let zip (option1: option<'a>) (option2: option<'b>) =
+    let zip (option1: 'a option) (option2: 'b option) =
         match option1, option2 with
         | Some v1, Some v2 -> Some(v1, v2)
         | _ -> None
 
+
     let ofResult =
         function
         | Ok v -> Some v

src/FsToolkit.ErrorHandling/OptionCE.fs

@@ -67,8 +67,12 @@ module OptionCE =
         member inline _.Source(result: _ option) : _ option = result
 
 
-    let option = OptionBuilder()
+        // /// <summary>
+        // /// Method lets us transform data types into our internal representation.
+        // /// </summary>
+        member inline _.Source(vopt: ValueOption<_>) : Option<_> = vopt |> Option.ofValueOption
 
+    let option = OptionBuilder()
 
 [<AutoOpen>]
 // Having members as extensions gives them lower priority in
@@ -102,7 +106,6 @@ module OptionExtensions =
         /// </summary>
         member inline _.Source(s: #seq<_>) = s
 
-
         // /// <summary>
         // /// Method lets us transform data types into our internal representation.
         // /// </summary>

src/FsToolkit.ErrorHandling/ValueOption.fs

@@ -0,0 +1,53 @@
+namespace FsToolkit.ErrorHandling
+
+#if !FABLE_COMPILER
+[<RequireQualifiedAccess>]
+module ValueOption =
+
+    let ofOption (opt: 'a option) =
+        match opt with
+        | Some v -> ValueSome v
+        | None -> ValueNone
+
+    let toOption (vopt: 'a voption) =
+        match vopt with
+        | ValueSome v -> Some v
+        | ValueNone -> None
+
+    let traverseResult f vopt =
+        match vopt with
+        | ValueNone -> Ok ValueNone
+        | ValueSome v -> f v |> Result.map ValueSome
+
+    let sequenceResult opt = traverseResult id opt
+
+    let inline tryParse< ^T when ^T: (static member TryParse : string * byref< ^T > -> bool) and ^T: (new : unit -> ^T)>
+        valueToParse
+        =
+        let mutable output = new ^T()
+
+        let parsed =
+            (^T: (static member TryParse : string * byref< ^T > -> bool) (valueToParse, &output))
+
+        match parsed with
+        | true -> ValueSome output
+        | _ -> ValueNone
+
+    /// <summary>
+    /// Takes two voptions and returns a tuple of the pair or none if either are none
+    /// </summary>
+    /// <param name="voption1">The input option</param>
+    /// <param name="voption2">The input option</param>
+    /// <returns></returns>
+    let zip (voption1: 'a voption) (voption2: 'b voption) =
+        match voption1, voption2 with
+        | ValueSome v1, ValueSome v2 -> ValueSome(v1, v2)
+        | _ -> ValueNone
+
+
+    let ofResult =
+        function
+        | Ok v -> ValueSome v
+        | Error _ -> ValueNone
+
+#endif

src/FsToolkit.ErrorHandling/ValueOptionCE.fs

@@ -0,0 +1,118 @@
+namespace FsToolkit.ErrorHandling
+
+
+#if !FABLE_COMPILER
+[<AutoOpen>]
+module ValueOptionCE =
+    open System
+
+    type ValueOptionBuilder() =
+        member inline _.Return(x) = ValueSome x
+
+        member inline _.ReturnFrom(m: 'T voption) = m
+
+        member inline _.Bind(m: 'a voption, f: 'a -> 'b voption) = ValueOption.bind f m
+
+        // 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 this.Bind(m: 'a when 'a: null, f: 'a -> 'b voption) = this.Bind(m |> ValueOption.ofObj, f)
+
+        member inline this.Zero() = this.Return()
+
+        member inline _.Combine(m, f) = ValueOption.bind f m
+        member inline this.Combine(m1: _ voption, m2: _ voption) = this.Bind(m1, (fun () -> m2))
+
+        member inline _.Delay(f: unit -> _) = f
+
+        member inline _.Run(f) = f ()
+
+        member inline this.TryWith(m, h) =
+            try
+                this.Run m
+            with
+            | e -> h e
+
+        member inline this.TryFinally(m, compensation) =
+            try
+                this.Run m
+            finally
+                compensation ()
+
+        member inline this.Using(resource: 'T :> IDisposable, binder) : _ voption =
+            this.TryFinally(
+                (fun () -> binder resource),
+                (fun () ->
+                    if not <| obj.ReferenceEquals(resource, null) then
+                        resource.Dispose())
+            )
+
+        member this.While(guard: unit -> bool, generator: unit -> _ voption) : _ voption =
+            if not <| guard () then
+                this.Zero()
+            else
+                this.Bind(this.Run generator, (fun () -> this.While(guard, generator)))
+
+        member inline this.For(sequence: #seq<'T>, binder: 'T -> _ voption) : _ voption =
+            this.Using(
+                sequence.GetEnumerator(),
+                fun enum -> this.While(enum.MoveNext, this.Delay(fun () -> binder enum.Current))
+            )
+
+        member inline _.BindReturn(x, f) = ValueOption.map f x
+
+        member inline _.BindReturn(x, f) =
+            x |> ValueOption.ofObj |> ValueOption.map f
+
+        member inline _.MergeSources(option1, option2) = ValueOption.zip option1 option2
+
+        /// <summary>
+        /// Method lets us transform data types into our internal representation.  This is the identity method to recognize the self type.
+        ///
+        /// See https://stackoverflow.com/questions/35286541/why-would-you-use-builder-source-in-a-custom-computation-expression-builder
+        /// </summary>
+        member inline _.Source(result: _ voption) : _ voption = result
+
+
+        // /// <summary>
+        // /// Method lets us transform data types into our internal representation.
+        // /// </summary>
+        member inline _.Source(vopt: _ option) : _ voption = vopt |> ValueOption.ofOption
+
+    let voption = ValueOptionBuilder()
+
+[<AutoOpen>]
+// Having members as extensions gives them lower priority in
+// overload resolution and allows skipping more type annotations.
+module ValueOptionExtensionsLower =
+    type ValueOptionBuilder with
+        member inline _.Source(nullableObj: 'a when 'a: null) = nullableObj |> ValueOption.ofObj
+        member inline _.Source(m: string) = m |> ValueOption.ofObj
+
+        member inline _.MergeSources(nullableObj1, option2) =
+            ValueOption.zip (ValueOption.ofObj nullableObj1) option2
+
+
+        member inline _.MergeSources(option1, nullableObj2) =
+            ValueOption.zip (option1) (ValueOption.ofObj nullableObj2)
+
+
+        member inline _.MergeSources(nullableObj1, nullableObj2) =
+            ValueOption.zip (ValueOption.ofObj nullableObj1) (ValueOption.ofObj nullableObj2)
+
+[<AutoOpen>]
+// Having members as extensions gives them lower priority in
+// overload resolution and allows skipping more type annotations.
+// The later declared, the higher than previous extension methods, this is magic
+module ValueOptionExtensions =
+    open System
+
+    type ValueOptionBuilder with
+        /// <summary>
+        /// Needed to allow `for..in` and `for..do` functionality
+        /// </summary>
+        member inline _.Source(s: #seq<_>) = s
+
+        // /// <summary>
+        // /// Method lets us transform data types into our internal representation.
+        // /// </summary>
+        member inline _.Source(nullable: Nullable<'a>) : 'a voption = nullable |> ValueOption.ofNullable
+#endif

tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj

@@ -20,6 +20,8 @@
     <Compile Include="ResultOption.fs" />
     <Compile Include="Option.fs" />
     <Compile Include="OptionCE.fs" />
+    <Compile Include="ValueOption.fs" />
+    <Compile Include="ValueOptionCE.fs" />
     <Compile Include="AsyncOption.fs" />
     <Compile Include="AsyncOptionCE.fs" />
     <Compile Include="List.fs" />

tests/FsToolkit.ErrorHandling.Tests/Main.fs

@@ -14,6 +14,10 @@ let allTests =
           ResultOptionTests.allTests
           OptionTests.allTests
           OptionCETests.allTests
+#if !FABLE_COMPILER
+          ValueOptionTests.allTests
+          ValueOptionCETests.allTests
+#endif
           AsyncOptionTests.allTests
           AsyncOptionCETests.allTests
           ListTests.allTests

tests/FsToolkit.ErrorHandling.Tests/OptionCE.fs

@@ -78,7 +78,7 @@ let ceTests =
                       try
                           return data
                       with
-                      | e -> return! raise e
+                      | e -> return raise e
                   }
 
               Expect.equal actual (Some data) "Try with failed"
@@ -442,7 +442,29 @@ let ``OptionCE applicative tests`` =
                       return a + b - c
                   }
 
-              Expect.equal actual None "Should be None" ]
+              Expect.equal actual None "Should be None"
+
+          testCase "ValueOption.Some"
+          <| fun () ->
+              let actual =
+                  option {
+                      let! a = ValueSome 3
+                      return a
+                  }
+
+              Expect.equal actual (Some 3) "Should be None"
+
+          testCase "ValueOption.None"
+          <| fun () ->
+              let actual =
+                  option {
+                      let! a = ValueNone
+                      return a
+                  }
+
+              Expect.equal actual (None) "Should be None" ]
+
+
 
 let allTests =
     testList

tests/FsToolkit.ErrorHandling.Tests/ValueOption.fs

@@ -0,0 +1,77 @@
+module ValueOptionTests
+
+#if !FABLE_COMPILER
+open System
+open Expecto
+open SampleDomain
+open TestData
+open TestHelpers
+open FsToolkit.ErrorHandling
+
+
+let traverseResultTests =
+    testList
+        "ValueOption.traverseResult Tests"
+        [ testCase "traverseResult with ValueSome of valid data"
+          <| fun _ ->
+              let (latitude, longitude) = (ValueSome lat), (ValueSome lng)
+
+              latitude
+              |> ValueOption.traverseResult Latitude.TryCreate
+              |> Expect.hasOkValue (ValueSome validLat)
+
+              longitude
+              |> ValueOption.traverseResult Longitude.TryCreate
+              |> Expect.hasOkValue (ValueSome validLng) ]
+
+
+let tryParseTests =
+    testList
+        "ValueOption.tryParse"
+        [ testCase "Can Parse int"
+          <| fun _ ->
+              let expected = 3
+
+              let actual =
+                  ValueOption.tryParse<int> (string expected)
+
+              Expect.equal actual (ValueSome expected) "Should be parsed"
+
+          testCase "Can Parse double"
+          <| fun _ ->
+              let expected: float = 3.0
+
+              let actual =
+                  ValueOption.tryParse<float> (string expected)
+
+              Expect.equal actual (ValueSome expected) "Should be parsed"
+
+          testCase "Can Parse Guid"
+          <| fun _ ->
+              let expectedGuid = Guid.NewGuid()
+
+              let parsedValue =
+                  ValueOption.tryParse<Guid> (string expectedGuid)
+
+              Expect.equal parsedValue (ValueSome expectedGuid) "Should be same guid"
+
+          ]
+
+
+let ofResultTests =
+    testList
+        "ValueOption.ofResult Tests"
+        [ testCase "ofResult simple cases"
+          <| fun _ ->
+              Expect.equal (ValueOption.ofResult (Ok 123)) (ValueSome 123) "Ok int"
+              Expect.equal (ValueOption.ofResult (Ok "abc")) (ValueSome "abc") "Ok string"
+              Expect.equal (ValueOption.ofResult (Error "x")) ValueNone "Error _" ]
+
+
+let allTests =
+    testList
+        "ValueOption Tests"
+        [ traverseResultTests
+          tryParseTests
+          ofResultTests ]
+#endif