Skip to content

Commit

Permalink
Avoid use of backgroundTask CE
Browse files Browse the repository at this point in the history
  • Loading branch information
@gusty @wallymathieu
gusty authored and wallymathieu committed Dec 3, 2022
1 parent 5dada85 commit 63b1c43
Show file tree
Hide file tree
Showing 2 changed files with 82 additions and 44 deletions.
23 changes: 18 additions & 5 deletions src/FSharpPlus/Control/Comonad.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
103 changes: 64 additions & 39 deletions src/FSharpPlus/Extensions/ValueTask.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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>
Expand All @@ -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

0 comments on commit 63b1c43

Please sign in to comment.