diff --git a/src/FSharpPlus/Control/Comonad.fs b/src/FSharpPlus/Control/Comonad.fs
index fa0f1e511..3b7af55f1 100644
--- 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
index 4ffe184b3..26ead785a 100644
--- 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)
/// Creates a that's completed successfully with the specified result.
/// The type of the result returned by the task.
@@ -31,12 +36,24 @@ module ValueTask =
/// Task workflow.
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)
+
/// Creates a ValueTask workflow from 'source' another, mapping its result with 'f'.
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>
+
/// Creates a ValueTask workflow from two workflows 'x' and 'y', mapping its results with 'f'.
/// Workflows are run in sequence.
@@ -44,11 +61,12 @@ module ValueTask =
/// First ValueTask workflow.
/// Second ValueTask workflow.
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>
/// Creates a ValueTask workflow from three workflows 'x', 'y' and z, mapping its results with 'f'.
/// Workflows are run in sequence.
@@ -56,58 +74,65 @@ module ValueTask =
/// First ValueTask workflow.
/// Second ValueTask workflow.
/// Third ValueTask workflow.
- 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>
/// 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
/// ValueTask workflow returning a function
/// ValueTask workflow returning a value
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>
/// Creates a ValueTask workflow from two workflows 'x' and 'y', tupling its results.
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> =
- 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>
/// Creates a ValueTask workflow from 'source' workflow, mapping and flattening its result with 'f'.
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>
/// Creates a ValueTask that ignores the result of the source ValueTask.
/// It can be used to convert non-generic ValueTask to unit ValueTask.
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
\ No newline at end of file