Avoid use of backgroundTask CE

gusty · gusty · commit 68588db30f01 · 2022-12-02T10:49:29.000+01:00
diff --git a/src/FSharpPlus/Control/Comonad.fs b/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
diff --git a/src/FSharpPlus/Extensions/ValueTask.fs b/src/FSharpPlus/Extensions/ValueTask.fs
@@ -8,6 +8,11 @@ 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)
     
     /// <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>
@@ -31,83 +36,103 @@ module ValueTask =
     /// <param name="source">Task workflow.</param>
     let FromTask<'TResult> (source: Task<'TResult>) = ValueTask<'TResult> source
 
+    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>
     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 (e: exn) = FromException e
         
 #endif
