Add support for ValueOption (#521)

fcallejon · web-flow · commit e3f71e8349e4 · 2022-11-28T15:38:34.000+01:00
diff --git a/FSharpPlus.sln b/FSharpPlus.sln
@@ -64,6 +64,7 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "content", "content", "{8E6D
 		docsrc\content\type-mult.fsx = docsrc\content\type-mult.fsx
 		docsrc\content\type-nonempty.fsx = docsrc\content\type-nonempty.fsx
 		docsrc\content\type-optiont.fsx = docsrc\content\type-optiont.fsx
+		docsrc\content\type-valueoptiont.fsx = docsrc\content\type-valueoptiont.fsx
 		docsrc\content\type-parallelarray.fsx = docsrc\content\type-parallelarray.fsx
 		docsrc\content\type-reader.fsx = docsrc\content\type-reader.fsx
 		docsrc\content\type-readert.fsx = docsrc\content\type-readert.fsx
diff --git a/docsrc/content/abstraction-applicative.fsx b/docsrc/content/abstraction-applicative.fsx
@@ -58,6 +58,7 @@ From F#
  -  ``'T [,,]``
  -  ``'T [,,,]``
  -  ``option<'T>`` 
+ -  ``voption<'T>`` 
  -  ``IObservable<'T>``
  -  ``Lazy<'T>``
  -  ``Async<'T>``
@@ -82,6 +83,7 @@ From F#+
  -  [``State<'S,'T * 'S>``](type-state.html)
  -  [``StateT<'S,'Monad<'T * 'S>>``](type-statet.html)
  -  [``OptionT<'Monad<option<'T>>``](type-optiont.html)
+ -  [``ValueOptionT<'Monad<voption<'T>>``](type-valueoptiont.html)
  -  [``SeqT<'Monad<seq<'T>>``](type-seqt.html)
  -  [``ListT<'Monad<list<'T>>``](type-listt.html)
  -  [``ResultT<'Monad<Result<'T,'TError>>``](type-resultt.html)
diff --git a/docsrc/content/abstraction-foldable.fsx b/docsrc/content/abstraction-foldable.fsx
@@ -59,6 +59,7 @@ From .Net/F#
  -  ``list<'T>``
  -  ``'T []``
  -  ``option<'T>`` 
+ -  ``voption<'T>`` 
  -  ``ResizeArray<'T>`` 
  -  ``ReadOnlyCollection<'T>`` 
  -  ``IReadOnlyCollection<'T>``
diff --git a/docsrc/content/abstraction-functor.fsx b/docsrc/content/abstraction-functor.fsx
@@ -48,6 +48,7 @@ From F#
  -  ``'T [,,]``
  -  ``'T [,,,]``
  -  ``option<'T>`` 
+ -  ``voption<'T>`` 
  -  ``IObservable<'T>``
  -  ``Lazy<'T>``
  -  ``Async<'T>``
@@ -75,6 +76,7 @@ From F#+
  -  [``State<'S,'T * 'S>``](type-state.html)
  -  [``StateT<'S,'Monad<'T * 'S>>``](type-statet.html)
  -  [``OptionT<'Monad<option<'T>>``](type-optiont.html)
+ -  [``ValueOptionT<'Monad<voption<'T>>``](type-valueoptiont.html)
  -  [``SeqT<'Monad<seq<'T>>``](type-seqt.html)
  -  [``ListT<'Monad<list<'T>>``](type-listt.html)
  -  [``ResultT<'Monad<Result<'T,'TError>>``](type-resultt.html)
diff --git a/docsrc/content/abstraction-monad.fsx b/docsrc/content/abstraction-monad.fsx
@@ -68,6 +68,7 @@ From F#
  -  ``list<'T>``
  -  ``array<'T>``
  -  ``option<'T>`` 
+ -  ``voption<'T>`` 
  -  ``Lazy<'T>``
  -  ``Async<'T>``
  -  ``Result<'T,'U>`` 
@@ -90,6 +91,7 @@ From F#+
  -  [``State<'S,'T * 'S>``](type-state.html)
  -  [``StateT<'S,'Monad<'T * 'S>>``](type-statet.html)
  -  [``OptionT<'Monad<option<'T>>``](type-optiont.html)
+ -  [``ValueOptionT<'Monad<voption<'T>>``](type-valueoptiont.html)
  -  [``SeqT<'Monad<seq<'T>>``](type-seqt.html)
  -  [``ListT<'Monad<list<'T>>``](type-listt.html)
  -  [``ResultT<'Monad<Result<'T,'TError>>``](type-resultt.html)
diff --git a/docsrc/content/abstraction-traversable.fsx b/docsrc/content/abstraction-traversable.fsx
@@ -56,6 +56,7 @@ From .Net/F#
  -  ``list<'T>``
  -  ``array<'T>``
  -  ``option<'T>`` 
+ -  ``voption<'T>`` 
  -  ``ResizeArray<'T>``
  -  ``Map<'K, 'T>``
  -  ``Result<'T, 'Error>``
diff --git a/docsrc/content/type-valueoptiont.fsx b/docsrc/content/type-valueoptiont.fsx
@@ -0,0 +1,19 @@
+(*** hide ***)
+// This block of code is omitted in the generated HTML documentation. Use 
+// it to define helpers that you do not want to show in the documentation.
+#r @"../../src/FSharpPlus/bin/Release/netstandard2.0/FSharpPlus.dll"
+(**
+TO-DO Add some docs here !
+=========================
+
+Examples
+--------
+*)
+
+(**
+```f#
+#r @"nuget: FSharpPlus"
+```
+*)
+
+open FSharpPlus
diff --git a/src/FSharpPlus/Control/Alternative.fs b/src/FSharpPlus/Control/Alternative.fs
@@ -22,6 +22,7 @@ type Empty =
     static member inline Empty (_output: ^t when ^t: null and ^t: struct ,             _mthd: Default1) = id    
 
     static member        Empty ([<Optional>]_output: option<'T>          , [<Optional>]_mthd: Empty   ) = None         : option<'T>
+    static member        Empty ([<Optional>]_output: voption<'T>         , [<Optional>]_mthd: Empty   ) = ValueNone    : voption<'T>
     static member        Empty ([<Optional>]_output: list<'T>            , [<Optional>]_mthd: Empty   ) = [  ]         : list<'T>
     static member        Empty ([<Optional>]_output: 'T []               , [<Optional>]_mthd: Empty   ) = [||]         : 'T []    
 
@@ -44,6 +45,7 @@ type Append =
     static member inline ``<|>`` (x: Choice<_,_>         , y              , [<Optional>]_mthd: Append  ) = match x, y with Choice1Of2 _, _ -> x | Choice2Of2 x, Choice2Of2 y -> Choice2Of2 (Plus.Invoke x y) | _, _ -> y
     static member inline ``<|>`` (x: Either<_,_>         , y              , [<Optional>]_mthd: Append  ) = match x with Left _ -> y | xs -> xs
     static member        ``<|>`` (x: 'T option           , y              , [<Optional>]_mthd: Append  ) = match x with None   -> y | xs -> xs
+    static member        ``<|>`` (x: 'T voption          , y              , [<Optional>]_mthd: Append  ) = match x with ValueNone   -> y | xs -> xs
     static member        ``<|>`` (x: 'T list             , y              , [<Optional>]_mthd: Append  ) = x @ y
     static member        ``<|>`` (x: 'T []               , y              , [<Optional>]_mthd: Append  ) = Array.append x y
 
@@ -63,6 +65,9 @@ type IsAltLeftZero =
     static member inline IsAltLeftZero (_: ref< ^t> when ^t: null and ^t: struct , _mthd: Default1) = ()
 
     static member        IsAltLeftZero (t: ref<option<_>  > , _mthd: IsAltLeftZero) = Option.isSome t.Value
+    #if !FABLE_COMPILER
+    static member        IsAltLeftZero (t: ref<voption<_>  >, _mthd: IsAltLeftZero) = ValueOption.isSome t.Value
+    #endif
     static member        IsAltLeftZero (t: ref<Result<_,_>> , _mthd: IsAltLeftZero) = match t.Value with (Ok _        ) -> true | _ -> false
     static member        IsAltLeftZero (t: ref<Choice<_,_>> , _mthd: IsAltLeftZero) = match t.Value with (Choice1Of2 _) -> true | _ -> false
 
diff --git a/src/FSharpPlus/Control/Applicative.fs b/src/FSharpPlus/Control/Applicative.fs
@@ -32,6 +32,7 @@ type Apply =
     #endif
     static member        ``<*>`` (f: Async<_>         , x: Async<'T>            , [<Optional>]_output: Async<'U>            , [<Optional>]_mthd: Apply) = Async.apply  f x : Async<'U>
     static member        ``<*>`` (f: option<_>        , x: option<'T>           , [<Optional>]_output: option<'U>           , [<Optional>]_mthd: Apply) = Option.apply f x : option<'U>
+    static member        ``<*>`` (f: voption<_>       , x: voption<'T>          , [<Optional>]_output: voption<'U>          , [<Optional>]_mthd: Apply) = ValueOption.apply f x : voption<'U>
     static member        ``<*>`` (f: Result<_,'E>     , x: Result<'T,'E>        , [<Optional>]_output: Result<'b,'E>        , [<Optional>]_mthd: Apply) = Result.apply f x : Result<'U,'E>
     static member        ``<*>`` (f: Choice<_,'E>     , x: Choice<'T,'E>        , [<Optional>]_output: Choice<'b,'E>        , [<Optional>]_mthd: Apply) = Choice.apply f x : Choice<'U,'E>
     static member inline ``<*>`` (KeyValue(a: 'Key, f), KeyValue(b: 'Key, x: 'T), [<Optional>]_output: KeyValuePair<'Key,'U>, [<Optional>]_mthd: Apply) : KeyValuePair<'Key,'U> = KeyValuePair (Plus.Invoke a b, f x)
@@ -83,6 +84,10 @@ type Lift2 =
     #endif
     static member        Lift2 (f, (x                     , y                     ), _mthd: Lift2) = Async.map2  f x y
     static member        Lift2 (f, (x                     , y                     ), _mthd: Lift2) = Option.map2 f x y
+    
+    #if !FABLE_COMPILER
+    static member        Lift2 (f, (x                     , y                     ), _mthd: Lift2) = ValueOption.map2 f x y
+    #endif
     static member        Lift2 (f, (x: Result<'T,'Error>  , y: Result<'U,'Error>  ), _mthd: Lift2) = Result.map2 f x y
     static member        Lift2 (f, (x: Choice<'T,'Error>  , y: Choice<'U,'Error>  ), _mthd: Lift2) = Choice.map2 f x y
     static member        Lift2 (f, (x: Map<'Key,'T>       , y : Map<'Key,'U>      ), _mthd: Lift2) = Map.mapValues2 f x y
@@ -121,6 +126,10 @@ type Lift3 =
     #endif
     static member        Lift3 (f, (x                     , y                     , z                      ), _mthd: Lift3) = Async.map3  f x y z
     static member        Lift3 (f, (x                     , y                     , z                      ), _mthd: Lift3) = Option.map3 f x y z
+    
+    #if !FABLE_COMPILER
+    static member        Lift3 (f, (x                     , y                     , z                      ), _mthd: Lift3) = ValueOption.map3 f x y z
+    #endif
     static member        Lift3 (f, (x: Result<'T,'Error>  , y: Result<'U,'Error>  , z: Result<'V, 'Error>  ), _mthd: Lift3) = Result.map3 f x y z
     static member        Lift3 (f, (x: Choice<'T,'Error>  , y: Choice<'U,'Error>  , z: Choice<'V, 'Error>  ), _mthd: Lift3) = Choice.map3 f x y z
     static member        Lift3 (f, (x: Map<'Key,'T>       , y: Map<'Key,'U>       , z: Map<'Key, 'V>       ), _mthd: Lift3) = Map.mapValues3 f x y z
@@ -151,6 +160,9 @@ type IsLeftZero =
     static member IsLeftZero (t: ref<list<_>>     , _mthd: IsLeftZero) = List.isEmpty t.Value
     static member IsLeftZero (t: ref<array<_>>    , _mthd: IsLeftZero) = Array.isEmpty t.Value
     static member IsLeftZero (t: ref<option<_>>   , _mthd: IsLeftZero) = Option.isNone t.Value
+    #if !FABLE_COMPILER
+    static member IsLeftZero (t: ref<voption<_>>  , _mthd: IsLeftZero) = ValueOption.isNone t.Value
+    #endif
     static member IsLeftZero (t: ref<Result<_,_>> , _mthd: IsLeftZero) = match t.Value with Error _      -> true | _ -> false
     static member IsLeftZero (t: ref<Choice<_,_>> , _mthd: IsLeftZero) = match t.Value with Choice2Of2 _ -> true | _ -> false
 
diff --git a/src/FSharpPlus/Control/Functor.fs b/src/FSharpPlus/Control/Functor.fs
@@ -21,6 +21,7 @@ type Iterate =
     static member Iterate (x: Lazy<'T>   , action) = action x.Value : unit
     static member Iterate (x: seq<'T>    , action) = Seq.iter action x
     static member Iterate (x: option<'T> , action) = match x with Some x -> action x | _ -> ()
+    static member Iterate (x: voption<'T> , action) = match x with ValueSome x -> action x | _ -> ()
     static member Iterate (x: list<'T>   , action) = List.iter action x
     static member Iterate ((_: 'W, a: 'T), action) = action a :unit
     static member Iterate (x: 'T []      , action) = Array.iter   action x
@@ -67,6 +68,9 @@ type Map =
     static member Map ((x: Task<'T>            , f: 'T->'U), _mthd: Map) = Task.map f x : Task<'U>
     #endif
     static member Map ((x: option<_>           , f: 'T->'U), _mthd: Map) = Option.map  f x
+    #if !FABLE_COMPILER
+    static member Map ((x: voption<_>          , f: 'T->'U), _mthd: Map) = ValueOption.map  f x
+    #endif
     static member Map ((x: list<_>             , f: 'T->'U), _mthd: Map) = List.map    f x : list<'U>
     static member Map ((g: 'R->'T              , f: 'T->'U), _mthd: Map) = (>>) g f
     static member Map ((g: Func<'R, 'T>        , f: 'T->'U), _mthd: Map) = Func<'R, 'U> (g.Invoke >> f)
@@ -145,6 +149,7 @@ type Unzip =
     static member        Unzip ((source: Task<'T * 'U>                     , _output: Task<'T> * Task<'U>                                  ) , _mthd: Unzip   ) = Map.Invoke fst source, Map.Invoke snd source
     #endif
     static member        Unzip ((source: option<'T * 'U>                   , _output: option<'T> * option<'U>                              ) , _mthd: Unzip   ) = Option.unzip source
+    static member        Unzip ((source: voption<'T * 'U>                  , _output: voption<'T> * voption<'U>                            ) , _mthd: Unzip   ) = ValueOption.unzip source
 
     static member        Unzip ((source: list<'T * 'U>                     , _output: list<'T> * list<'U>                                  ) , _mthd: Unzip   ) = List.unzip   source
     static member        Unzip ((source: 'R -> ('T * 'U)                   , _output: ('R -> 'T) * ('R -> 'U)                              ) , _mthd: Unzip   ) = (fun x -> fst (source x)), (fun x -> snd (source x))
@@ -203,6 +208,7 @@ type Zip =
     static member Zip ((x: 'T []                      , y: 'U []                     , _output: ('T*'U) []                   ), _mthd: Zip) = Array.zipShortest       x y
     static member Zip ((x: ResizeArray<'T>            , y: ResizeArray<'U>           , _output: ResizeArray<'T*'U>           ), _mthd: Zip) = ResizeArray.zipShortest x y
     static member Zip ((x: option<'T>                 , y: option<'U>                , _output: option<'T*'U>                ), _mthd: Zip) = Option.zip              x y
+    static member Zip ((x: voption<'T>                , y: voption<'U>              , _output: voption<'T*'U>                ), _mthd: Zip) = ValueOption.zip         x y
     static member Zip ((x: Result<'T, 'Error>         , y: Result<'U, 'Error>        , _output: Result<'T * 'U, 'Error>      ), _mthd: Zip) = Result.zip              x y
     static member Zip ((x: Async<'T>                  , y: Async<'U>                 , _output: Async<'T*'U>                 ), _mthd: Zip) = Async.zip               x y
     #if !FABLE_COMPILER
diff --git a/src/FSharpPlus/Control/Monad.fs b/src/FSharpPlus/Control/Monad.fs
@@ -23,6 +23,9 @@ type Bind =
     static member        (>>=) (source             , f: 'T -> _           ) = Nullable.bind f source                  : Nullable<'U>
     #endif
     static member        (>>=) (source             , f: 'T -> _           ) = Option.bind   f source                  : option<'U>
+    #if !FABLE_COMPILER
+    static member        (>>=) (source             , f: 'T -> _           ) = ValueOption.bind   f source             : voption<'U>
+    #endif
     static member        (>>=) (source             , f: 'T -> _           ) = List.collect  f source                  : list<'U>
     static member        (>>=) (source             , f: 'T -> _           ) = Array.collect f source                  : 'U []
     static member        (>>=) (source             , k: 'T -> _           ) = (fun r -> k (source r) r)               : 'R->'U
@@ -75,6 +78,9 @@ type Join =
     static member        Join (x: Task<Task<_>>         , [<Optional>]_output: Task<'T>        , [<Optional>]_mthd: Join    ) = Task.join x                : Task<'T>
     #endif
     static member        Join (x                        , [<Optional>]_output: option<'T>      , [<Optional>]_mthd: Join    ) = Option.flatten x           : option<'T>
+    #if !FABLE_COMPILER
+    static member        Join (x                        , [<Optional>]_output: voption<'T>     , [<Optional>]_mthd: Join    ) = ValueOption.flatten x     : voption<'T>
+    #endif
     static member        Join (x: list<list<_>>         , [<Optional>]_output: list<'T>        , [<Optional>]_mthd: Join    ) = List.concat x              : list<'T>
     static member        Join (x: _ [][]                , [<Optional>]_output: 'T []           , [<Optional>]_mthd: Join    ) = Array.concat x             : 'T []
     static member        Join (g                        , [<Optional>]_output: 'R->'T          , [<Optional>]_mthd: Join    ) = (fun r -> (g r) r)         : 'R->'T
@@ -129,6 +135,7 @@ type Return =
     static member        Return (_: 'T Task        , _: Return  ) = fun x -> Task.FromResult x                    : 'T Task
     #endif
     static member        Return (_: option<'a>     , _: Return  ) = fun x -> Some x                               : option<'a>
+    static member        Return (_  : voption<'a>  , _: Return  ) = fun x -> ValueSome x                          : voption<'a>
     static member        Return (_: list<'a>       , _: Return  ) = fun x -> [ x ]                                : list<'a>
     static member        Return (_: 'a []          , _: Return  ) = fun x -> [|x|]                                : 'a []
     static member        Return (_: 'r -> 'a       , _: Return  ) = const': 'a -> 'r -> _
diff --git a/src/FSharpPlus/Control/Monoid.fs b/src/FSharpPlus/Control/Monoid.fs
@@ -54,6 +54,12 @@ type Plus with
                     | (Some a , None  ) -> Some a
                     | (None   , Some b) -> Some b
                     | _                 -> None
+    static member inline ``+`` (x: voption<_>, y, [<Optional>]_mthd: Plus) =
+                    match x, y with
+                    | (ValueSome a , ValueSome b) -> ValueSome (Plus.Invoke a b)
+                    | (ValueSome a , ValueNone  ) -> ValueSome a
+                    | (ValueNone   , ValueSome b) -> ValueSome b
+                    | _                 -> ValueNone
 
 type Plus with
     static member inline ``+`` (x: Result<_,_>, y, [<Optional>]_mthd: Plus) =
diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs
@@ -79,6 +79,7 @@ type Traverse =
     
     static member        Traverse (t: Id<'t>   , f: 't->option<'u>, [<Optional>]_output: option<Id<'u>>, [<Optional>]_impl: Traverse) = Option.map Id.create (f (Id.run t))
     static member inline Traverse (t: option<_>, f, [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R = match t with Some x -> Map.Invoke Some (f x) | _ -> result None
+    static member inline Traverse (t: voption<_>, f, [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R = match t with ValueSome x -> Map.Invoke ValueSome (f x) | _ -> result ValueNone
 
     static member inline Traverse (t:Map<_,_>  , f, [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R =
         let insert_f m k v = Map.Invoke (Map.add k) v <*> m        
@@ -129,6 +130,9 @@ type Sequence with
 
     static member inline Sequence (t: seq<'``Applicative<'T>``>, [<Optional>]_output: '``Applicative<seq<'T>>``   , [<Optional>]_impl: Default4) = Sequence.ForInfiniteSequences (t, IsLeftZero.Invoke, List.toSeq)   : '``Applicative<seq<'T>>``
     static member        Sequence (t: seq<option<'t>>   , [<Optional>]_output: option<seq<'t>>    , [<Optional>]_impl: Default3) = Sequence.ForInfiniteSequences(t, Option.isNone, List.toSeq)                                : option<seq<'t>>
+    #if !FABLE_COMPILER
+    static member        Sequence (t: seq<voption<'t>>  , [<Optional>]_output: voption<seq<'t>>   , [<Optional>]_impl: Default3) = Sequence.ForInfiniteSequences(t, ValueOption.isNone, List.toSeq)                           : voption<seq<'t>>
+    #endif
     static member        Sequence (t: seq<Result<'t,'e>>, [<Optional>]_output: Result<seq<'t>, 'e>, [<Optional>]_impl: Default3) = Sequence.ForInfiniteSequences(t, (function Error _      -> true | _ -> false), List.toSeq) : Result<seq<'t>, 'e>
     static member        Sequence (t: seq<Choice<'t,'e>>, [<Optional>]_output: Choice<seq<'t>, 'e>, [<Optional>]_impl: Default3) = Sequence.ForInfiniteSequences(t, (function Choice2Of2 _ -> true | _ -> false), List.toSeq) : Choice<seq<'t>, 'e>
     static member        Sequence (t: seq<list<'t>>     , [<Optional>]_output: list<seq<'t>>      , [<Optional>]_impl: Default3) = Sequence.ForInfiniteSequences(t, List.isEmpty, List.toSeq)                                 : list<seq<'t>>
@@ -151,6 +155,9 @@ type Sequence with
     static member inline Sequence (t: ^a                , [<Optional>]_output: 'R                 , [<Optional>]_impl: Default1) = Sequence.InvokeOnInstance t                                               : 'R
 
     static member inline Sequence (t: option<_>         , [<Optional>]_output: 'R                 , [<Optional>]_impl: Sequence) = match t with Some x -> Map.Invoke Some x | _ -> result None               : 'R
+    #if !FABLE_COMPILER
+    static member inline Sequence (t: voption<_>        , [<Optional>]_output: 'R                 , [<Optional>]_impl: Sequence) = match t with ValueSome x -> Map.Invoke ValueSome x | _ -> result ValueNone: 'R
+    #endif
     static member inline Sequence (t: list<_>           , [<Optional>]_output: 'R                 , [<Optional>]_impl: Sequence) = Sequence.ForInfiniteSequences(t, IsLeftZero.Invoke, id) : 'R
 
     static member inline Sequence (t: Map<_,_>          , [<Optional>]_output: 'R                 , [<Optional>]_impl: Sequence) : 'R =
diff --git a/src/FSharpPlus/Data/ValueOption.fs b/src/FSharpPlus/Data/ValueOption.fs
diff --git a/src/FSharpPlus/Extensions/Extensions.fs b/src/FSharpPlus/Extensions/Extensions.fs
diff --git a/src/FSharpPlus/Extensions/ValueOption.fs b/src/FSharpPlus/Extensions/ValueOption.fs
diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj
diff --git a/tests/FSharpPlus.Tests/ComputationExpressions.fs b/tests/FSharpPlus.Tests/ComputationExpressions.fs
