Merge remote-tracking branch 'origin/master' into v1.3

Author: wallymathieu

src/FSharpPlus/Control/Comonad.fs

@@ -62,14 +62,27 @@ type Extend =
                         elif k.Status = TaskStatus.Canceled then tcs.SetCanceled ()
                         elif k.Status = TaskStatus.Faulted  then tcs.SetException k.Exception.InnerExceptions) |> ignore
                 tcs.Task
-                
-
     #endif
+
     #if NETSTANDARD2_1 && !FABLE_COMPILER
     static member        (=>>) (g: ValueTask<'T>     , f: ValueTask<'T> -> 'U ) : ValueTask<'U> =
-        backgroundTask {
-            return! f g
-        } |> ValueTask<'U>
+        if g.IsCompletedSuccessfully then
+            try
+                let r = f g
+                ValueTask<'U> r
+            with e -> ValueTask<'U> (Task.FromException<'U> e)
+        else
+            let tcs = TaskCompletionSource<'U> ()
+            if g.IsCompleted then
+                match g with
+                | ValueTask.Faulted e -> tcs.SetException e
+                | ValueTask.Canceled  -> tcs.SetCanceled ()
+            else
+                ValueTask.continueTask tcs g (fun _ ->
+                    try tcs.SetResult (f g)
+                    with e -> tcs.SetException e)
+            tcs.Task |> ValueTask<'U>
+            
     #endif
 
     // Restricted Comonads

src/FSharpPlus/Control/Monad.fs

@@ -145,7 +145,7 @@ type Return =
     static member        Return (_: 'T Task        , _: Return  ) = fun x -> Task.FromResult x                    : 'T Task
     #endif
     #if NETSTANDARD2_1 && !FABLE_COMPILER
-    static member        Return (_: 'T ValueTask   , _: Return  ) = fun x -> ValueTask.FromResult x               : 'T ValueTask
+    static member        Return (_: 'T ValueTask   , _: Return  ) = fun (x: 'T) -> ValueTask<'T> x                : 'T ValueTask
     #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>

src/FSharpPlus/Extensions/ValueTask.fs

@@ -5,99 +5,113 @@ namespace FSharpPlus
 /// Additional operations on ValueTask<'T>
 [<RequireQualifiedAccess>]
 module ValueTask =
-    
-    open System.Threading
+
     open System.Threading.Tasks
+
+    let inline internal (|Succeeded|Canceled|Faulted|) (t: ValueTask<'T>) =
+        if t.IsCompletedSuccessfully then Succeeded t.Result
+        elif t.IsCanceled then Canceled
+        else Faulted (t.AsTask().Exception.InnerExceptions)    
 
-    let FromResult<'T> (result : 'T) =
-        ValueTask<'T>(result)
-        
-    let FromException<'T> (e : exn) =
-        ValueTask<'T>(Task.FromException<'T>(e))
-    
-    let FromCanceled<'T> (ct : CancellationToken) =
-        ValueTask<'T>(Task.FromCanceled<'T>(ct))
-        
-    let FromTask<'T> (t : Task<'T>) =
-        ValueTask<'T>(t)
+    let inline internal continueTask (tcs: TaskCompletionSource<'Result>) (x: ValueTask<'t>) (k: 't -> unit) =
+        let f = function
+        | Succeeded r -> k r
+        | Canceled  -> tcs.SetCanceled ()
+        | Faulted e -> tcs.SetException e
+        if x.IsCompleted then f x
+        else
+            let aw = x.GetAwaiter ()
+            aw.OnCompleted (fun () -> f x)
 
     /// <summary>Creates a ValueTask workflow from 'source' another, mapping its result with 'f'.</summary>
+    /// <param name="f">The mapping function.</param>
+    /// <param name="source">ValueTask workflow.</param>
     let map (f: 'T -> 'U) (source: ValueTask<'T>) : ValueTask<'U> =
-        backgroundTask {
-            let! r = source
-            return f r
-        } |> ValueTask<'U>
+        let tcs = TaskCompletionSource<'U> ()
+        continueTask tcs source (fun x ->
+            try tcs.SetResult (f x)
+            with e -> tcs.SetException e)
+        tcs.Task |> ValueTask<'U>
+
 
     /// <summary>Creates a ValueTask workflow from two workflows 'x' and 'y', mapping its results with 'f'.</summary>
     /// <remarks>Workflows are run in sequence.</remarks>
     /// <param name="f">The mapping function.</param>
     /// <param name="x">First ValueTask workflow.</param>
     /// <param name="y">Second ValueTask workflow.</param>
     let map2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'V> =
-        backgroundTask {
-            let! rX = x
-            let! rY = y
-            return f rX rY
-        } |> ValueTask<'V>
+        let tcs = TaskCompletionSource<'V> ()
+        continueTask tcs x (fun x ->
+            continueTask tcs y (fun y ->
+                try tcs.SetResult (f x y)
+                with e -> tcs.SetException e))
+        tcs.Task |> ValueTask<'V>
 
     /// <summary>Creates a ValueTask workflow from three workflows 'x', 'y' and z, mapping its results with 'f'.</summary>
     /// <remarks>Workflows are run in sequence.</remarks>
     /// <param name="f">The mapping function.</param>
     /// <param name="x">First ValueTask workflow.</param>
     /// <param name="y">Second ValueTask workflow.</param>
     /// <param name="z">Third ValueTask workflow.</param>
-    let map3 (f : 'T -> 'U -> 'V -> 'W) (x : ValueTask<'T>) (y : ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> =
-        backgroundTask {
-            let! rX = x
-            let! rY = y
-            let! rZ = z
-            return f rX rY rZ
-        } |> ValueTask<'W>
+    let map3 (f: 'T -> 'U -> 'V -> 'W) (x: ValueTask<'T>) (y: ValueTask<'U>) (z: ValueTask<'V>) : ValueTask<'W> =
+        let tcs = TaskCompletionSource<'W> ()
+        continueTask tcs x (fun x ->
+            continueTask tcs y (fun y ->
+                continueTask tcs z (fun z ->
+                    try tcs.SetResult (f x y z)
+                    with e -> tcs.SetException e)))
+        tcs.Task |> ValueTask<'W>
 
     /// <summary>Creates a ValueTask workflow that is the result of applying the resulting function of a ValueTask workflow
     /// to the resulting value of another ValueTask workflow</summary>
     /// <param name="f">ValueTask workflow returning a function</param>
     /// <param name="x">ValueTask workflow returning a value</param>
     let apply (f: ValueTask<'T->'U>) (x: ValueTask<'T>) : ValueTask<'U> =
-        backgroundTask {
-            let! r = x
-            let! fn = f
-            return (fn r)
-        } |> ValueTask<'U>
+        let tcs = TaskCompletionSource<'U> ()
+        continueTask tcs f (fun f ->
+            continueTask tcs x (fun x ->
+                try tcs.SetResult (f x)
+                with e -> tcs.SetException e))
+        tcs.Task |> ValueTask<'U>
 
     /// <summary>Creates a ValueTask workflow from two workflows 'x' and 'y', tupling its results.</summary>
     let zip (x: ValueTask<'T>) (y: ValueTask<'U>) : ValueTask<'T * 'U> =
-        backgroundTask {
-            let! rX = x
-            let! rY = y
-            return (rX, rY)
-        } |> ValueTask<'T * 'U>
+        let tcs = TaskCompletionSource<'T * 'U> ()
+        continueTask tcs x (fun x ->
+            continueTask tcs y (fun y ->
+                tcs.SetResult (x, y)))
+        tcs.Task |> ValueTask<'T * 'U>
 
     /// Flattens two nested ValueTask into one.
     let join (source: ValueTask<ValueTask<'T>>) : ValueTask<'T> =
-        backgroundTask {
-            let! s = source
-            return! s
-        } |> ValueTask<'T>
+        let tcs = TaskCompletionSource<'T> ()
+        continueTask tcs source (fun x ->
+            continueTask tcs x (fun x ->
+                tcs.SetResult x))
+        tcs.Task |> ValueTask<'T>
 
 
     /// <summary>Creates a ValueTask workflow from 'source' workflow, mapping and flattening its result with 'f'.</summary>
     let bind (f: 'T -> ValueTask<'U>) (source: ValueTask<'T>) : ValueTask<'U> =
-        source
-        |> map f
-        |> join
+        let tcs = TaskCompletionSource<'U> ()
+        continueTask tcs source (fun x ->
+            try 
+                continueTask tcs (f x) (fun fx ->
+                    tcs.SetResult fx)
+            with e -> tcs.SetException e)
+        tcs.Task |> ValueTask<'U>
 
     /// <summary>Creates a ValueTask that ignores the result of the source ValueTask.</summary>
     /// <remarks>It can be used to convert non-generic ValueTask to unit ValueTask.</remarks>
     let ignore (source: ValueTask<'T>) =
-        backgroundTask {
-            let! _ = source
-            return ()
-        } |> ValueTask
+        if source.IsCompletedSuccessfully then
+            source.GetAwaiter().GetResult() |> ignore
+            Unchecked.defaultof<_>
+        else
+            new ValueTask (source.AsTask ())
 
 
     /// Raises an exception in the ValueTask
-    let raise (e: exn) =
-        FromException e
+    let raise (``exception``: exn) = ValueTask<'TResult> (Task.FromException<'TResult> ``exception``)
 
 #endif

src/FSharpPlus/FSharpPlus.fsproj

@@ -24,7 +24,7 @@
     <AutoGenerateBindingRedirects>true</AutoGenerateBindingRedirects>
     <Configurations>Debug;Release;Fable;Fable3</Configurations>
     <Platforms>AnyCPU</Platforms>
-    <LangVersion Condition=" '$(Configuration)' == 'Fable' OR '$(Configuration)' == 'Fable3' ">6.0</LangVersion>
+    <LangVersion>6.0</LangVersion>
     <DefineConstants Condition=" '$(Configuration)' == 'Fable'">$(DefineConstants);FABLE_COMPILER</DefineConstants>
     <DefineConstants Condition=" '$(Configuration)' == 'Fable3'">$(DefineConstants);FABLE_COMPILER;FABLE_COMPILER_3</DefineConstants>
     <!--<OutputPath>..\..\bin</OutputPath>-->

tests/FSharpPlus.Tests/ValueTask.fs

@@ -12,12 +12,35 @@ module ValueTask =
 
     exception TestException of string
 
+
+    module ValueTask =
+        
+        // Following is not available in F#6
+
+        /// <summary>Creates a <see cref="ValueTask{TResult}"/> that's completed successfully with the specified result.</summary>
+        /// <typeparam name="TResult">The type of the result returned by the task.</typeparam>
+        /// <param name="result">The result to store into the completed task.</param>
+        /// <returns>The successfully completed task.</returns>
+        let FromResult<'TResult> (result: 'TResult) = ValueTask<'TResult> result
+
+        /// <summary>Creates a <see cref="ValueTask{TResult}"/> that's completed exceptionally with the specified exception.</summary>
+        /// <typeparam name="TResult">The type of the result returned by the task.</typeparam>
+        /// <param name="exception">The exception with which to complete the task.</param>
+        /// <returns>The faulted task.</returns>
+        let FromException<'TResult> (``exception``: exn) = ValueTask<'TResult> (Task.FromException<'TResult> ``exception``)
+
+        /// <summary>Creates a <see cref="ValueTask{TResult}"/> that's completed due to cancellation with the specified token.</summary>
+        /// <typeparam name="TResult">The type of the result returned by the task.</typeparam>
+        /// <param name="cancellationToken">The token with which to complete the task.</param>
+        /// <returns>The canceled task.</returns>
+        let FromCanceled<'TResult> (cancellationToken: CancellationToken) = ValueTask<'TResult> (Task.FromCanceled<'TResult> cancellationToken)
+
     module ValueTaskTests =
 
         let createValueTask isFailed value =
-            if not isFailed then ValueTask.FromResult value
+            if not isFailed then ValueTask.FromResult<_> value
             else
-                ValueTask.FromException (TestException (sprintf "Ouch, can't create: %A" value ))
+                ValueTask.FromException<_> (TestException (sprintf "Ouch, can't create: %A" value ))
 
         let (|AggregateException|_|) (x: exn) =
             match x with