From 7008cc0dc9df8d28472436ab4611254b31ecf4ae Mon Sep 17 00:00:00 2001 From: Gus <1261319+gusty@users.noreply.github.com> Date: Fri, 2 Jan 2026 01:17:25 +0100 Subject: [PATCH 1/5] Task related fixes (#657) --- src/FSharpPlus/Control/Comonad.fs | 10 +- src/FSharpPlus/Extensions/Extensions.fs | 15 +- src/FSharpPlus/Extensions/Task.fs | 548 ++++++++++-------------- src/FSharpPlus/Extensions/ValueTask.fs | 405 +++++++++-------- tests/FSharpPlus.Tests/Task.fs | 198 ++++++--- tests/FSharpPlus.Tests/ValueTask.fs | 157 +++++-- 6 files changed, 719 insertions(+), 614 deletions(-) diff --git a/src/FSharpPlus/Control/Comonad.fs b/src/FSharpPlus/Control/Comonad.fs index 3f78fc87e..99706999a 100644 --- a/src/FSharpPlus/Control/Comonad.fs +++ b/src/FSharpPlus/Control/Comonad.fs @@ -16,7 +16,7 @@ type Extract = #if FABLE_COMPILER_3 || FABLE_COMPILER_4 Async.RunSynchronously x #else - Async.AsTask(x).Result + Async.AsTask(x).GetAwaiter().GetResult () #endif static member Extract (x: Lazy<'T> ) = x.Value static member Extract ((_: 'W, a: 'T) ) = a @@ -28,10 +28,10 @@ type Extract = static member inline Extract (f: 'Monoid -> 'T) = f (LanguagePrimitives.GenericZero) #endif #if !FABLE_COMPILER - static member Extract (f: Task<'T> ) = f.Result + static member Extract (f: Task<'T> ) = f.GetAwaiter().GetResult () #endif #if !NET45 && !NETSTANDARD2_0 && !FABLE_COMPILER - static member Extract (f: ValueTask<'T> ) = f.Result + static member Extract (f: ValueTask<'T>) = f.GetAwaiter().GetResult () #endif static member inline Invoke (x: '``Comonad<'T>``) : 'T = let inline call_2 (_mthd: ^M, x: ^I) = ((^M or ^I) : (static member Extract : _ -> _) x) @@ -82,10 +82,10 @@ type Extend = | ValueTask.Canceled -> tcs.SetCanceled () // nowarn here, this case has been handled already if g.IsCompleted else - ValueTask.continueTask tcs g (fun _ -> + g |> ValueTask.continueTask tcs (fun _ -> try tcs.SetResult (f g) with e -> tcs.SetException e) - tcs.Task |> ValueTask<'U> + ValueTask<'U> tcs.Task #endif diff --git a/src/FSharpPlus/Extensions/Extensions.fs b/src/FSharpPlus/Extensions/Extensions.fs index 76247c17d..e477ac447 100644 --- a/src/FSharpPlus/Extensions/Extensions.fs +++ b/src/FSharpPlus/Extensions/Extensions.fs @@ -38,11 +38,6 @@ module Extensions = open System.Threading.Tasks open FSharp.Core.CompilerServices - let private (|Canceled|Faulted|Completed|) (t: Task<'a>) = - if t.IsCanceled then Canceled - else if t.IsFaulted then Faulted (Unchecked.nonNull t.Exception) - else Completed t.Result - type Task<'t> with static member WhenAll (tasks: Task<'a>[], ?cancellationToken: CancellationToken) = let tcs = TaskCompletionSource<'a[]> () @@ -53,9 +48,9 @@ module Extensions = tasks |> Seq.iteri (fun i t -> let continuation = function - | Canceled -> tcs.TrySetCanceled () |> ignore - | Faulted e -> tcs.TrySetException e |> ignore - | Completed r -> + | Task.Canceled -> tcs.TrySetCanceled () |> ignore + | Task.Faulted e -> tcs.TrySetException e |> ignore + | Task.Succeeded r -> results.[i] <- r if Interlocked.Decrement pending = 0 then tcs.SetResult results @@ -132,7 +127,7 @@ module Extensions = computation, ts.SetResult, (function - | :? AggregateException as agg -> ts.SetException agg.InnerExceptions + | :? AggregateException as aex when aex.InnerExceptions.Count > 0 -> ts.SetException aex.InnerExceptions | exn -> ts.SetException exn), (fun _ -> ts.SetCanceled ()), cancellationToken) @@ -198,7 +193,7 @@ module Extensions = /// Similar to Async.Sequential but the returned Async contains a sequence, which is lazily evaluated. static member SequentialLazy (t: seq>) : Async> = async { let! ct = Async.CancellationToken - return Seq.map (fun t -> Async.AsTask(t, ct).Result) t } + return Seq.map (fun t -> Async.AsTask(t, ct).GetAwaiter().GetResult ()) t } []static member Sequence (t: seq>) = Async.SequentialLazy t #endif diff --git a/src/FSharpPlus/Extensions/Task.fs b/src/FSharpPlus/Extensions/Task.fs index b8edcebb9..c86a08f3c 100644 --- a/src/FSharpPlus/Extensions/Task.fs +++ b/src/FSharpPlus/Extensions/Task.fs @@ -20,148 +20,130 @@ module Task = elif t.IsCompleted then Succeeded t.Result else invalidOp "Internal error: The task is not yet completed." - /// Creates a task workflow from 'source' another, mapping its result with 'f'. - let map (f: 'T -> 'U) (source: Task<'T>) : Task<'U> = + let inline internal continueTask (tcs: TaskCompletionSource<'Result>) (k: 't -> unit) (x: Task<'t>) = + let f = function + | Succeeded r -> k r + | Faulted axn -> tcs.SetException axn.InnerExceptions + | Canceled -> tcs.SetCanceled () + x.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> f x) + + + /// Creates a Task that's completed successfully with the specified value. + /// + /// A Task that is completed successfully with the specified value. + let result (value: 'T) : Task<'T> = Task.FromResult value + + /// Creates a Task that's completed unsuccessfully with the specified exceptions. + /// The AggregateException to be raised. + /// A Task that is completed unsuccessfully with the specified exceptions. + /// + /// Prefer this function to handle AggregateExceptions over Task.FromException as it handles them correctly. + /// + let internal FromExceptions<'T> (aex: AggregateException) : Task<'T> = + match aex with + | agg when agg.InnerExceptions.Count = 1 -> Task.FromException<'T> agg.InnerExceptions[0] + | agg -> + let tcs = TaskCompletionSource<'T> () + tcs.SetException agg.InnerExceptions + tcs.Task + + let private cancellationTokenSingleton = CancellationToken true + + /// Creates a Task that's canceled. + /// A Task that's canceled. + let canceled<'T> : Task<'T> = Task.FromCanceled<'T> cancellationTokenSingleton + + + /// Creates a task workflow from 'source' workflow, mapping its result with 'mapper'. + /// The mapping function. + /// The source task workflow. + /// The resulting task workflow. + let map (mapper: 'T -> 'U) (source: Task<'T>) : Task<'U> = #if !NET45 let source = nullArgCheck (nameof source) source #else raiseIfNull "source" source #endif - if source.Status = TaskStatus.RanToCompletion then - try Task.FromResult (f source.Result) - with e -> - let tcs = TaskCompletionSource<'U> () - tcs.SetException e - tcs.Task - else - let tcs = TaskCompletionSource<'U> () - if source.Status = TaskStatus.Faulted then - tcs.SetException (Unchecked.nonNull source.Exception).InnerExceptions - tcs.Task - elif source.Status = TaskStatus.Canceled then - tcs.SetCanceled () - tcs.Task - else - let k = function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> - try tcs.SetResult (f r) - with e -> tcs.SetException e - source.ContinueWith k |> ignore - tcs.Task - - /// Creates a task workflow from two workflows 'x' and 'y', mapping its results with 'f'. + backgroundTask { + let! r = source + return mapper r + } + + /// Creates a task workflow from two workflows 'task1' and 'task2', mapping its results with 'mapper'. /// Workflows are run in sequence. - /// The mapping function. - /// First task workflow. - /// Second task workflow. - let lift2 (f: 'T -> 'U -> 'V) (x: Task<'T>) (y: Task<'U>) : Task<'V> = + /// The mapping function. + /// First task workflow. + /// Second task workflow. + let lift2 (mapper: 'T1 -> 'T2 -> 'U) (task1: Task<'T1>) (task2: Task<'T2>) : Task<'U> = #if !NET45 - let x = nullArgCheck (nameof x) x - let y = nullArgCheck (nameof y) y + let task1 = nullArgCheck (nameof task1) task1 + let task2 = nullArgCheck (nameof task2) task2 #else - raiseIfNull "x" x - raiseIfNull "y" y + raiseIfNull "task1" task1 + raiseIfNull "task2" task2 #endif - if x.Status = TaskStatus.RanToCompletion && y.Status = TaskStatus.RanToCompletion then - try Task.FromResult (f x.Result y.Result) - with e -> - let tcs = TaskCompletionSource<'V> () - tcs.SetException e - tcs.Task + if task1.IsCompleted && task2.IsCompleted then + match task1, task2 with + | Succeeded r1, Succeeded r2 -> try result (mapper r1 r2) with e -> Task.FromException<_> e + | Succeeded _ , Faulted exn -> FromExceptions exn + | Succeeded _ , Canceled -> canceled + | Faulted exn , _ -> FromExceptions exn + | Canceled , _ -> canceled else - let tcs = TaskCompletionSource<'V> () - match x.Status, y.Status with + let tcs = TaskCompletionSource<'U> () + + match task1.Status, task2.Status with | TaskStatus.Canceled, _ -> tcs.SetCanceled () - | TaskStatus.Faulted, _ -> tcs.SetException (Unchecked.nonNull x.Exception).InnerExceptions + | TaskStatus.Faulted, _ -> tcs.SetException (Unchecked.nonNull task1.Exception).InnerExceptions | _, TaskStatus.Canceled -> tcs.SetCanceled () - | _, TaskStatus.Faulted -> tcs.SetException (Unchecked.nonNull y.Exception).InnerExceptions - | TaskStatus.RanToCompletion, _ -> - let k = function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> - try tcs.SetResult (f x.Result r) - with e -> tcs.SetException e - y.ContinueWith k |> ignore - | _, TaskStatus.RanToCompletion -> - let k = function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> - try tcs.SetResult (f r y.Result) - with e -> tcs.SetException e - x.ContinueWith k |> ignore - | _, _ -> - x.ContinueWith ( - function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> - y.ContinueWith ( - function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r' -> - try tcs.SetResult (f r r') - with e -> tcs.SetException e - ) |> ignore) |> ignore + | _, TaskStatus.Faulted -> tcs.SetException (Unchecked.nonNull task2.Exception).InnerExceptions + | TaskStatus.RanToCompletion, _ -> task2 |> continueTask tcs (fun r -> try tcs.SetResult (mapper task1.Result r) with e -> tcs.SetException e) + | _, TaskStatus.RanToCompletion -> task1 |> continueTask tcs (fun r -> try tcs.SetResult (mapper r task2.Result) with e -> tcs.SetException e) + | _, _ -> task1 |> continueTask tcs (fun r -> task2 |> continueTask tcs (fun r' -> try tcs.SetResult (mapper r r') with e -> tcs.SetException e)) tcs.Task /// Creates a task workflow from three workflows 'x', 'y' and z, mapping its results with 'f'. /// Workflows are run in sequence. - /// The mapping function. - /// First task workflow. - /// Second task workflow. - /// Third task workflow. - let lift3 (f : 'T1 -> 'T2 -> 'T3 -> 'U) (x : Task<'T1>) (y : Task<'T2>) (z: Task<'T3>) : Task<'U> = + /// The mapping function. + /// First task workflow. + /// Second task workflow. + /// Third task workflow. + let lift3 (mapper : 'T1 -> 'T2 -> 'T3 -> 'U) (task1 : Task<'T1>) (task2 : Task<'T2>) (task3 : Task<'T3>) : Task<'U> = #if !NET45 - let x = nullArgCheck (nameof x) x - let y = nullArgCheck (nameof y) y - let z = nullArgCheck (nameof z) z + let task1 = nullArgCheck (nameof task1) task1 + let task2 = nullArgCheck (nameof task2) task2 + let task3 = nullArgCheck (nameof task3) task3 #else - raiseIfNull "x" x - raiseIfNull "y" y - raiseIfNull "z" z + raiseIfNull "task1" task1 + raiseIfNull "task2" task2 + raiseIfNull "task3" task3 #endif - if x.Status = TaskStatus.RanToCompletion && y.Status = TaskStatus.RanToCompletion && z.Status = TaskStatus.RanToCompletion then - try Task.FromResult (f x.Result y.Result z.Result) - with e -> - let tcs = TaskCompletionSource<'U> () - tcs.SetException e - tcs.Task + if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then + match task1, task2, task3 with + | Succeeded r1, Succeeded r2, Succeeded r3 -> try result (mapper r1 r2 r3) with e -> Task.FromException<_> e + | Faulted exn , _ , _ -> FromExceptions exn + | Canceled , _ , _ -> canceled + | _ , Faulted exn , _ -> FromExceptions exn + | _ , Canceled , _ -> canceled + | _ , _ , Faulted exn -> FromExceptions exn + | _ , _ , Canceled -> canceled else let tcs = TaskCompletionSource<'U> () - match x.Status, y.Status, z.Status with + match task1.Status, task2.Status, task3.Status with | TaskStatus.Canceled, _ , _ -> tcs.SetCanceled () - | TaskStatus.Faulted , _ , _ -> tcs.SetException (Unchecked.nonNull x.Exception).InnerExceptions + | TaskStatus.Faulted , _ , _ -> tcs.SetException (Unchecked.nonNull task1.Exception).InnerExceptions | _ , TaskStatus.Canceled, _ -> tcs.SetCanceled () - | _ , TaskStatus.Faulted , _ -> tcs.SetException (Unchecked.nonNull y.Exception).InnerExceptions + | _ , TaskStatus.Faulted , _ -> tcs.SetException (Unchecked.nonNull task2.Exception).InnerExceptions | _ , _ , TaskStatus.Canceled -> tcs.SetCanceled () - | _ , _ , TaskStatus.Faulted -> tcs.SetException (Unchecked.nonNull z.Exception).InnerExceptions + | _ , _ , TaskStatus.Faulted -> tcs.SetException (Unchecked.nonNull task3.Exception).InnerExceptions | _ , _ , _ -> - x.ContinueWith ( - function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> - y.ContinueWith ( - function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r' -> - z.ContinueWith ( - function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r'' -> - try tcs.SetResult (f r r' r'') - with e -> tcs.SetException e - ) |> ignore) |> ignore) |> ignore + task1 |> continueTask tcs (fun r1 -> + task2 |> continueTask tcs (fun r2 -> + task3 |> continueTask tcs (fun r3 -> + try tcs.SetResult (mapper r1 r2 r3) with e -> tcs.SetException e))) tcs.Task /// Creates a Task workflow from two workflows, mapping its results with a specified function. @@ -181,42 +163,38 @@ module Task = #endif if task1.Status = TaskStatus.RanToCompletion && task2.Status = TaskStatus.RanToCompletion then - try Task.FromResult (mapper task1.Result task2.Result) - with e -> - let tcs = TaskCompletionSource<_> () - tcs.SetException e - tcs.Task + try result (mapper task1.Result task2.Result) with e -> Task.FromException<'U> e else - let tcs = TaskCompletionSource<_> () - let r1 = ref Unchecked.defaultof<_> - let r2 = ref Unchecked.defaultof<_> - let mutable cancelled = false - let failures = [|IReadOnlyCollection.empty; IReadOnlyCollection.empty|] - let pending = ref 2 - - let trySet () = - if Interlocked.Decrement pending = 0 then - let noFailures = Array.forall IReadOnlyCollection.isEmpty failures - if noFailures && not cancelled then - try tcs.TrySetResult (mapper r1.Value r2.Value) |> ignore - with e -> tcs.TrySetException e |> ignore - elif noFailures then tcs.TrySetCanceled () |> ignore - else tcs.TrySetException (failures |> Seq.map AggregateException |> Seq.reduce Exception.add).InnerExceptions |> ignore - - let k (v: ref<_>) i t = - match t with - | Canceled -> cancelled <- true - | Faulted e -> failures[i] <- e.InnerExceptions - | Succeeded r -> v.Value <- r - trySet () - - if task1.IsCompleted && task2.IsCompleted then - task1 |> k r1 0 - task2 |> k r2 1 - else - task1.ContinueWith (k r1 0) |> ignore - task2.ContinueWith (k r2 1) |> ignore - tcs.Task + let tcs = TaskCompletionSource<_> () + let r1 = ref Unchecked.defaultof<_> + let r2 = ref Unchecked.defaultof<_> + let mutable cancelled = false + let failures = [|IReadOnlyCollection.empty; IReadOnlyCollection.empty|] + let pending = ref 2 + + let trySet () = + if Interlocked.Decrement pending = 0 then + let noFailures = Array.forall IReadOnlyCollection.isEmpty failures + if noFailures && not cancelled then + try tcs.TrySetResult (mapper r1.Value r2.Value) |> ignore + with e -> tcs.TrySetException e |> ignore + elif noFailures then tcs.TrySetCanceled () |> ignore + else tcs.TrySetException (failures |> Seq.map AggregateException |> Seq.reduce Exception.add).InnerExceptions |> ignore + + let k (v: ref<_>) i t = + match t with + | Succeeded r -> v.Value <- r + | Faulted aex -> failures[i] <- aex.InnerExceptions + | Canceled -> cancelled <- true + trySet () + + if task1.IsCompleted && task2.IsCompleted then + k r1 0 task1 + k r2 1 task2 + else + task1.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r1 0) task1) + task2.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r2 1) task2) + tcs.Task /// Creates a Task workflow from three workflows, mapping its results with a specified function. /// Similar to lift3 but although workflows are started in sequence they might end independently in different order @@ -238,51 +216,48 @@ module Task = #endif if task1.Status = TaskStatus.RanToCompletion && task2.Status = TaskStatus.RanToCompletion && task3.Status = TaskStatus.RanToCompletion then - try Task.FromResult (mapper task1.Result task2.Result task3.Result) - with e -> - let tcs = TaskCompletionSource<_> () - tcs.SetException e - tcs.Task - else - let tcs = TaskCompletionSource<_> () - let r1 = ref Unchecked.defaultof<_> - let r2 = ref Unchecked.defaultof<_> - let r3 = ref Unchecked.defaultof<_> - let mutable cancelled = false - let failures = [|IReadOnlyCollection.empty; IReadOnlyCollection.empty; IReadOnlyCollection.empty|] - let pending = ref 3 - - let trySet () = - if Interlocked.Decrement pending = 0 then - let noFailures = Array.forall IReadOnlyCollection.isEmpty failures - if noFailures && not cancelled then - try tcs.TrySetResult (mapper r1.Value r2.Value r3.Value) |> ignore - with e -> tcs.TrySetException e |> ignore - elif noFailures then tcs.TrySetCanceled () |> ignore - else tcs.TrySetException (failures |> Seq.map AggregateException |> Seq.reduce Exception.add).InnerExceptions |> ignore - - let k (v: ref<_>) i t = - match t with - | Canceled -> cancelled <- true - | Faulted e -> failures[i] <- e.InnerExceptions - | Succeeded r -> v.Value <- r - trySet () - - if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then - task1 |> k r1 0 - task2 |> k r2 1 - task3 |> k r3 2 + try result (mapper task1.Result task2.Result task3.Result) + with e -> Task.FromException<'U> e else - task1.ContinueWith (k r1 0) |> ignore - task2.ContinueWith (k r2 1) |> ignore - task3.ContinueWith (k r3 2) |> ignore - tcs.Task + let tcs = TaskCompletionSource<_> () + let r1 = ref Unchecked.defaultof<_> + let r2 = ref Unchecked.defaultof<_> + let r3 = ref Unchecked.defaultof<_> + let mutable cancelled = false + let failures = [|IReadOnlyCollection.empty; IReadOnlyCollection.empty; IReadOnlyCollection.empty|] + let pending = ref 3 + + let trySet () = + if Interlocked.Decrement pending = 0 then + let noFailures = Array.forall IReadOnlyCollection.isEmpty failures + if noFailures && not cancelled then + try tcs.TrySetResult (mapper r1.Value r2.Value r3.Value) |> ignore + with e -> tcs.TrySetException e |> ignore + elif noFailures then tcs.TrySetCanceled () |> ignore + else tcs.TrySetException (failures |> Seq.map AggregateException |> Seq.reduce Exception.add).InnerExceptions |> ignore + + let k (v: ref<_>) i t = + match t with + | Succeeded r -> v.Value <- r + | Faulted axn -> failures[i] <- axn.InnerExceptions + | Canceled -> cancelled <- true + trySet () + + if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then + k r1 0 task1 + k r2 1 task2 + k r3 2 task3 + else + task1.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r1 0) task1) + task2.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r2 1) task2) + task3.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r3 2) task3) + tcs.Task /// Creates a task workflow that is the result of applying the resulting function of a task workflow /// to the resulting value of another task workflow /// Task workflow returning a function /// Task workflow returning a value - let apply (f: Task<'T->'U>) (x: Task<'T>) : Task<'U> = + let apply (f: Task<'T -> 'U>) (x: Task<'T>) : Task<'U> = #if !NET45 let f = nullArgCheck (nameof f) f let x = nullArgCheck (nameof x) x @@ -291,12 +266,13 @@ module Task = raiseIfNull "x" x #endif - if f.Status = TaskStatus.RanToCompletion && x.Status = TaskStatus.RanToCompletion then - try Task.FromResult (f.Result x.Result) - with e -> - let tcs = TaskCompletionSource<'U> () - tcs.SetException e - tcs.Task + if f.IsCompleted && x.IsCompleted then + match f, x with + | Succeeded r1, Succeeded r2 -> try result (r1 r2) with e -> Task.FromException<_> e + | Succeeded _ , Faulted exn -> FromExceptions exn + | Succeeded _ , Canceled -> canceled + | Faulted exn , _ -> FromExceptions exn + | Canceled , _ -> canceled else let tcs = TaskCompletionSource<'U> () match f.Status, x.Status with @@ -304,79 +280,37 @@ module Task = | TaskStatus.Faulted, _ -> tcs.SetException (Unchecked.nonNull f.Exception).InnerExceptions | _, TaskStatus.Canceled -> tcs.SetCanceled () | _, TaskStatus.Faulted -> tcs.SetException (Unchecked.nonNull x.Exception).InnerExceptions - | TaskStatus.RanToCompletion, _ -> - let k = function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> - try tcs.SetResult (f.Result r) - with e -> tcs.SetException e - x.ContinueWith k |> ignore - | _, TaskStatus.RanToCompletion -> - let k = function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> - try tcs.SetResult (r x.Result) - with e -> tcs.SetException e - f.ContinueWith k |> ignore - | _, _ -> - f.ContinueWith ( - function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> - x.ContinueWith ( - function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r' -> - try tcs.SetResult (r r') - with e -> tcs.SetException e - ) |> ignore) |> ignore + | TaskStatus.RanToCompletion, _ -> x |> continueTask tcs (fun r -> try tcs.SetResult (f.Result r) with e -> tcs.SetException e) + | _, TaskStatus.RanToCompletion -> f |> continueTask tcs (fun r -> try tcs.SetResult (r x.Result) with e -> tcs.SetException e) + | _, _ -> f |> continueTask tcs (fun r -> x |> continueTask tcs (fun r' -> try tcs.SetResult (r r') with e -> tcs.SetException e)) tcs.Task - /// Creates a task workflow from two workflows 'x' and 'y', tupling its results. - let zipSequentially (x: Task<'T>) (y: Task<'U>) : Task<'T * 'U> = + /// Creates a task workflow from two workflows 'task1' and 'task2', tupling its results. + let zipSequentially (task1: Task<'T1>) (task2: Task<'T2>) : Task<'T1 * 'T2> = #if !NET45 - let x = nullArgCheck (nameof x) x - let y = nullArgCheck (nameof y) y + let task1 = nullArgCheck (nameof task1) task1 + let task2 = nullArgCheck (nameof task2) task2 #else - raiseIfNull "x" x - raiseIfNull "y" y + raiseIfNull "task1" task1 + raiseIfNull "task2" task2 #endif - - if x.Status = TaskStatus.RanToCompletion && y.Status = TaskStatus.RanToCompletion then - Task.FromResult (x.Result, y.Result) + if task1.IsCompleted && task2.IsCompleted then + match task1, task2 with + | Succeeded r1, Succeeded r2 -> result (r1, r2) + | Succeeded _ , Faulted exn -> FromExceptions exn + | Succeeded _ , Canceled -> canceled + | Faulted exn , _ -> FromExceptions exn + | Canceled , _ -> canceled else - let tcs = TaskCompletionSource<'T * 'U> () - match x.Status, y.Status with + let tcs = TaskCompletionSource<'T1 * 'T2> () + match task1.Status, task2.Status with | TaskStatus.Canceled, _ -> tcs.SetCanceled () - | TaskStatus.Faulted, _ -> tcs.SetException (Unchecked.nonNull x.Exception).InnerExceptions + | TaskStatus.Faulted, _ -> tcs.SetException (Unchecked.nonNull task1.Exception).InnerExceptions | _, TaskStatus.Canceled -> tcs.SetCanceled () - | _, TaskStatus.Faulted -> tcs.SetException (Unchecked.nonNull y.Exception).InnerExceptions - | TaskStatus.RanToCompletion, _ -> - let k = function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> tcs.SetResult (x.Result, r) - y.ContinueWith k |> ignore - | _, TaskStatus.RanToCompletion -> - let k = function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> tcs.SetResult (r, y.Result) - x.ContinueWith k |> ignore - | _, _ -> - x.ContinueWith ( - function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r -> - y.ContinueWith (function - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - | Succeeded r' -> tcs.SetResult (r, r')) |> ignore) |> ignore + | _, TaskStatus.Faulted -> tcs.SetException (Unchecked.nonNull task2.Exception).InnerExceptions + | TaskStatus.RanToCompletion, _ -> task2 |> continueTask tcs (fun r -> tcs.SetResult (task1.Result, r)) + | _, TaskStatus.RanToCompletion -> task1 |> continueTask tcs (fun r -> tcs.SetResult (r, task2.Result)) + | _, _ -> task1 |> continueTask tcs (fun r -> task2 |> continueTask tcs (fun r' -> tcs.SetResult (r, r'))) tcs.Task /// Creates a task workflow from two workflows 'task1' and 'task2', tupling its results. @@ -399,70 +333,52 @@ module Task = raiseIfNull "source" source #endif - source.Unwrap() + backgroundTask { + let! inner = source + return! inner + } /// Creates a task workflow from 'source' workflow, mapping and flattening its result with 'f'. - let bind (f: 'T -> Task<'U>) (source: Task<'T>) : Task<'U> = source |> Unchecked.nonNull |> map f |> join + let bind (f: 'T -> Task<'U>) (source: Task<'T>) : Task<'U> = + let source = nullArgCheck (nameof source) source + + backgroundTask { + let! r = source + return! f r + } /// Creates a task that ignores the result of the source task. + /// The source Task. + /// A Task that completes when the source completes. /// It can be used to convert non-generic Task to unit Task. - let ignore (task: Task) = + let ignore (source: Task) = #if !NET45 - let task = nullArgCheck (nameof task) task + let source = nullArgCheck (nameof source) source #else - raiseIfNull "task" task + raiseIfNull "source" source #endif - if task.Status = TaskStatus.RanToCompletion then Task.FromResult () + if source.IsCompletedSuccessfully then result () + elif source.IsFaulted then FromExceptions (Unchecked.nonNull source.Exception) + elif source.IsCanceled then canceled else let tcs = TaskCompletionSource () - if task.Status = TaskStatus.Faulted then - tcs.SetException (Unchecked.nonNull task.Exception).InnerExceptions - elif task.Status = TaskStatus.Canceled then - tcs.SetCanceled () - else - let k (t: Task) : unit = - if t.IsCanceled then tcs.SetCanceled () - elif t.IsFaulted then tcs.SetException (Unchecked.nonNull t.Exception).InnerExceptions - else tcs.SetResult () - task.ContinueWith k |> ignore + let k (t: Task) : unit = + if t.IsCanceled then tcs.SetCanceled () + elif t.IsFaulted then tcs.SetException (Unchecked.nonNull source.Exception).InnerExceptions + else tcs.SetResult () + source.ContinueWith k |> ignore tcs.Task [] - let rec tryWith (body: unit -> Task<'T>) (compensation: exn -> Task<'T>) : Task<'T> = - let unwrapException (agg: AggregateException) = - if agg.InnerExceptions.Count = 1 then agg.InnerExceptions.[0] - else agg :> Exception - try - let task = body () - match task.Status with - | TaskStatus.RanToCompletion -> task - | TaskStatus.Faulted -> task.ContinueWith((fun (x:Task<'T>) -> compensation (unwrapException (Unchecked.nonNull x.Exception)))).Unwrap () - | TaskStatus.Canceled -> task - | _ -> task.ContinueWith((fun (x:Task<'T>) -> tryWith (fun () -> x) compensation) ).Unwrap () - with - | :? AggregateException as exn -> compensation (unwrapException exn) - | exn -> compensation exn + let tryWith (body: unit -> Task<'T>) (compensation: exn -> Task<'T>) : Task<'T> = backgroundTask { + try return! body () + with e -> return! compensation e } [] - let tryFinally (body: unit -> Task<'T>) (compensation : unit -> unit) : Task<'T> = - let mutable ran = false - let compensation () = - if not ran then - compensation () - ran <- true - try - let task = body () - let rec loop (task: Task<'T>) (compensation : unit -> unit) = - match task.Status with - | TaskStatus.RanToCompletion -> compensation (); task - | TaskStatus.Faulted -> task.ContinueWith((fun (x:Task<'T>) -> compensation (); x)).Unwrap () - | TaskStatus.Canceled -> task - | _ -> task.ContinueWith((fun (x:Task<'T>) -> (loop x compensation: Task<_>))).Unwrap () - loop task compensation - with _ -> - compensation () - reraise () + let tryFinally (body: unit -> Task<'T>) (compensation : unit -> unit) : Task<'T> = backgroundTask { + try return! body () + finally compensation () } /// Used to de-sugar use .. blocks in Computation Expressions. let using (disp: 'T when 'T :> IDisposable) (body: 'T -> Task<'U>) = @@ -506,14 +422,10 @@ module Task = #endif orElseWith (fun _ -> fallbackTask) source - /// Creates a Task from a value - let result (value: 'T) = Task.FromResult value - - /// Raises an exception in the Task - let raise<'T> (e: exn) = - let tcs = TaskCompletionSource<'T> () - tcs.SetException e - tcs.Task + /// Creates a Task that's completed unsuccessfully with the specified exception. + /// The exception to be raised. + /// A Task that is completed unsuccessfully with the specified exception. + let raise<'T> (exn: exn) : Task<'T> = Task.FromException<'T> exn /// Workaround to fix signatures without breaking binary compatibility. @@ -528,7 +440,7 @@ module Task_v2 = /// The resulting task. /// This function is used to de-sugar try .. with .. blocks in Computation Expressions. #if !NET45 - let inline tryWith ([] compensation: exn -> Task<'T>) ([] body: unit -> Task<'T>) = Task.tryWith body compensation + let inline tryWith ([] compensation: exn -> Task<'T>) ([]body: unit -> Task<'T>) = Task.tryWith body compensation #else let inline tryWith (compensation: exn -> Task<'T>) (body: unit -> Task<'T>) = Task.tryWith body compensation #endif @@ -539,8 +451,8 @@ module Task_v2 = /// The resulting task. /// This function is used to de-sugar try .. finally .. blocks in Computation Expressions. #if !NET45 - let inline tryFinally ([] compensation: unit -> unit) ([] body: unit -> Task<'T>) = Task.tryFinally body compensation + let inline tryFinally ([] compensation: unit -> unit) ([]body: unit -> Task<'T>) = Task.tryFinally body compensation #else - let inline tryFinally (compensation: unit -> unit) (body: unit -> Task<'T>) = Task.tryFinally body compensation + let inline tryFinally (compensation: unit -> unit) (body: unit -> Task<'T>) = Task.tryFinally body compensation #endif #endif diff --git a/src/FSharpPlus/Extensions/ValueTask.fs b/src/FSharpPlus/Extensions/ValueTask.fs index bb8d23e56..e492277d4 100644 --- a/src/FSharpPlus/Extensions/ValueTask.fs +++ b/src/FSharpPlus/Extensions/ValueTask.fs @@ -17,67 +17,112 @@ module ValueTask = elif t.IsFaulted then Faulted (Unchecked.nonNull (t.AsTask().Exception)) elif t.IsCanceled then Canceled else invalidOp "Internal error: The task is not yet completed." - - let inline continueTask (tcs: TaskCompletionSource<'Result>) (x: ValueTask<'t>) (k: 't -> unit) = + + let inline internal continueTask (tcs: TaskCompletionSource<'Result>) (k: 't -> unit) (x: ValueTask<'t>) = let f = function - | Succeeded r -> k r - | Canceled -> tcs.SetCanceled () - | Faulted e -> tcs.SetException e.InnerExceptions - if x.IsCompleted then f x - else x.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> f x) + | Succeeded r -> k r + | Faulted axn -> tcs.SetException axn.InnerExceptions + | Canceled -> tcs.SetCanceled () + x.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> f x) - let inline continueWith (x: ValueTask<'t>) f = - if x.IsCompleted then f x - else x.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> f x) - /// Creates a ValueTask from a value + /// Creates a ValueTask that's completed successfully with the specified value. + /// + /// A ValueTask that is completed successfully with the specified value. let result (value: 'T) : ValueTask<'T> = #if NET5_0_OR_GREATER ValueTask.FromResult value #else let tcs = TaskCompletionSource<'T> () tcs.SetResult value - tcs.Task |> ValueTask<'T> + ValueTask<'T> tcs.Task #endif + + /// Creates a Task that's completed unsuccessfully with the specified exceptions. + /// The AggregateException to be raised. + /// A Task that is completed unsuccessfully with the specified exceptions. + /// + /// Prefer this function to handle AggregateExceptions over Task.FromException as it handles them correctly. + /// + let internal FromExceptions<'T> (aex: AggregateException) : ValueTask<'T> = + match aex with + | agg when agg.InnerExceptions.Count = 1 -> ValueTask.FromException<'T> agg.InnerExceptions[0] + | agg -> + let tcs = TaskCompletionSource<'T> () + tcs.SetException agg.InnerExceptions + ValueTask<'T> tcs.Task - /// Creates a ValueTask workflow from 'source' another, mapping its result with 'f'. - /// The mapping function. - /// ValueTask workflow. - let map (f: 'T -> 'U) (source: ValueTask<'T>) : 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> + let private cancellationTokenSingleton = CancellationToken true + + /// Creates a ValueTask that's canceled. + /// A ValueTask that's canceled. + let canceled<'T> : ValueTask<'T> = ValueTask.FromCanceled<'T> cancellationTokenSingleton + + /// Creates a ValueTask workflow from 'source' workflow, mapping its result with 'mapper'. + /// The mapping function. + /// The source ValueTask workflow. + /// The resulting ValueTask workflow. + let map (mapper: 'T -> 'U) (source: ValueTask<'T>) : ValueTask<'U> = + backgroundTask { + let! r = source + return mapper r + } |> ValueTask<'U> /// Creates a ValueTask workflow from two workflows 'x' and 'y', mapping its results with 'f'. /// Workflows are run in sequence. - /// The mapping function. - /// First ValueTask workflow. - /// Second ValueTask workflow. - let lift2 (f: 'T -> 'U -> 'V) (x: ValueTask<'T>) (y: ValueTask<'U>) : 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> - + /// The mapping function. + /// First ValueTask workflow. + /// Second ValueTask workflow. + let lift2 (mapper: 'T1 -> 'T2 -> 'U) (task1: ValueTask<'T1>) (task2: ValueTask<'T2>) : ValueTask<'U> = + if task1.IsCompleted && task2.IsCompleted then + match task1, task2 with + | Succeeded r1, Succeeded r2 -> try result (mapper r1 r2) with e -> ValueTask.FromException<_> e + | Succeeded _ , Faulted exn -> FromExceptions exn + | Succeeded _ , Canceled -> canceled + | Faulted exn , _ -> FromExceptions exn + | Canceled , _ -> canceled + else + let tcs = TaskCompletionSource<'U> () + if task1.IsCanceled then tcs.SetCanceled () + elif task1.IsFaulted then tcs.SetException (Unchecked.nonNull (task1.AsTask().Exception)).InnerExceptions + elif task2.IsCanceled then tcs.SetCanceled () + elif task2.IsFaulted then tcs.SetException (Unchecked.nonNull (task2.AsTask().Exception)).InnerExceptions + elif task1.IsCompletedSuccessfully then task2 |> continueTask tcs (fun y -> try tcs.SetResult (mapper task1.Result y) with e -> tcs.SetException e) + elif task2.IsCompletedSuccessfully then task1 |> continueTask tcs (fun x -> try tcs.SetResult (mapper x task2.Result) with e -> tcs.SetException e) + else task1 |> continueTask tcs (fun x -> task2 |> continueTask tcs (fun y -> try tcs.SetResult (mapper x y) with e -> tcs.SetException e)) + ValueTask<'U> tcs.Task + /// Creates a ValueTask workflow from three workflows 'x', 'y' and z, mapping its results with 'f'. /// Workflows are run in sequence. - /// The mapping function. - /// First ValueTask workflow. - /// Second ValueTask workflow. - /// Third ValueTask workflow. - let lift3 (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> + /// The mapping function. + /// First ValueTask workflow. + /// Second ValueTask workflow. + /// Third ValueTask workflow. + let lift3 (mapper: 'T1 -> 'T2 -> 'T3 -> 'U) (task1: ValueTask<'T1>) (task2: ValueTask<'T2>) (task3: ValueTask<'T3>) : ValueTask<'U> = + if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then + match task1, task2, task3 with + | Succeeded r1, Succeeded r2, Succeeded r3 -> try result (mapper r1 r2 r3) with e -> ValueTask.FromException<_> e + | Faulted exn , _ , _ -> FromExceptions exn + | Canceled , _ , _ -> canceled + | _ , Faulted exn , _ -> FromExceptions exn + | _ , Canceled , _ -> canceled + | _ , _ , Faulted exn -> FromExceptions exn + | _ , _ , Canceled -> canceled + else + let tcs = TaskCompletionSource<'U> () + if task1.IsCanceled then tcs.SetCanceled () + elif task1.IsFaulted then tcs.SetException (Unchecked.nonNull (task1.AsTask().Exception)).InnerExceptions + elif task2.IsCanceled then tcs.SetCanceled () + elif task2.IsFaulted then tcs.SetException (Unchecked.nonNull (task2.AsTask().Exception)).InnerExceptions + elif task3.IsCanceled then tcs.SetCanceled () + elif task3.IsFaulted then tcs.SetException (Unchecked.nonNull (task3.AsTask().Exception)).InnerExceptions + else + task1 |> continueTask tcs (fun r1 -> + task2 |> continueTask tcs (fun r2 -> + task3 |> continueTask tcs (fun r3 -> + try tcs.SetResult (mapper r1 r2 r3) with e -> tcs.SetException e))) + ValueTask<'U> tcs.Task /// Creates a ValueTask workflow from two workflows, mapping its results with a specified function. /// Similar to lift2 but although workflows are started in sequence they might end independently in different order @@ -89,41 +134,38 @@ module ValueTask = let map2 mapper (task1: ValueTask<'T1>) (task2: ValueTask<'T2>) : ValueTask<'U> = if task1.IsCompletedSuccessfully && task2.IsCompletedSuccessfully then try result (mapper task1.Result task2.Result) - with e -> - let tcs = TaskCompletionSource<_> () - tcs.SetException e - tcs.Task |> ValueTask<'U> + with e -> ValueTask.FromException<'U> e else - let tcs = TaskCompletionSource<_> () - let r1 = ref Unchecked.defaultof<_> - let r2 = ref Unchecked.defaultof<_> - let mutable cancelled = false - let failures = [|IReadOnlyCollection.empty; IReadOnlyCollection.empty|] - let pending = ref 2 + let tcs = TaskCompletionSource<_> () + let r1 = ref Unchecked.defaultof<_> + let r2 = ref Unchecked.defaultof<_> + let mutable cancelled = false + let failures = [|IReadOnlyCollection.empty; IReadOnlyCollection.empty|] + let pending = ref 2 - let trySet () = - if Interlocked.Decrement pending = 0 then - let noFailures = Array.forall IReadOnlyCollection.isEmpty failures - if noFailures && not cancelled then - try tcs.TrySetResult (mapper r1.Value r2.Value) |> ignore - with e -> tcs.TrySetException e |> ignore - elif noFailures then tcs.TrySetCanceled () |> ignore - else tcs.TrySetException (failures |> Seq.map AggregateException |> Seq.reduce Exception.add).InnerExceptions |> ignore + let trySet () = + if Interlocked.Decrement pending = 0 then + let noFailures = Array.forall IReadOnlyCollection.isEmpty failures + if noFailures && not cancelled then + try tcs.TrySetResult (mapper r1.Value r2.Value) |> ignore + with e -> tcs.TrySetException e |> ignore + elif noFailures then tcs.TrySetCanceled () |> ignore + else tcs.TrySetException (failures |> Seq.map AggregateException |> Seq.reduce Exception.add).InnerExceptions |> ignore - let k (v: ref<_>) i t = - match t with - | Succeeded r -> v.Value <- r - | Canceled -> cancelled <- true - | Faulted e -> failures[i] <- e.InnerExceptions - trySet () + let k (v: ref<_>) i t = + match t with + | Succeeded r -> v.Value <- r + | Faulted aex -> failures[i] <- aex.InnerExceptions + | Canceled -> cancelled <- true + trySet () - if task1.IsCompleted && task2.IsCompleted then - task1 |> k r1 0 - task2 |> k r2 1 - else - continueWith task1 (k r1 0) - continueWith task2 (k r2 1) - tcs.Task |> ValueTask<'U> + if task1.IsCompleted && task2.IsCompleted then + task1 |> k r1 0 + task2 |> k r2 1 + else + task1.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r1 0) task1) + task2.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r2 1) task2) + ValueTask<'U> tcs.Task /// Creates a ValueTask workflow from three workflows, mapping its results with a specified function. /// Similar to lift3 but although workflows are started in sequence they might end independently in different order @@ -136,64 +178,84 @@ module ValueTask = let map3 mapper (task1: ValueTask<'T1>) (task2: ValueTask<'T2>) (task3: ValueTask<'T3>) : ValueTask<'U> = if task1.IsCompletedSuccessfully && task2.IsCompletedSuccessfully && task3.IsCompletedSuccessfully then try result (mapper task1.Result task2.Result task3.Result) - with e -> - let tcs = TaskCompletionSource<_> () - tcs.SetException e - tcs.Task |> ValueTask<'U> + with e -> ValueTask.FromException<'U> e else - let tcs = TaskCompletionSource<_> () - let r1 = ref Unchecked.defaultof<_> - let r2 = ref Unchecked.defaultof<_> - let r3 = ref Unchecked.defaultof<_> - let mutable cancelled = false - let failures = [|IReadOnlyCollection.empty; IReadOnlyCollection.empty; IReadOnlyCollection.empty|] - let pending = ref 3 + let tcs = TaskCompletionSource<_> () + let r1 = ref Unchecked.defaultof<_> + let r2 = ref Unchecked.defaultof<_> + let r3 = ref Unchecked.defaultof<_> + let mutable cancelled = false + let failures = [|IReadOnlyCollection.empty; IReadOnlyCollection.empty; IReadOnlyCollection.empty|] + let pending = ref 3 - let trySet () = - if Interlocked.Decrement pending = 0 then - let noFailures = Array.forall IReadOnlyCollection.isEmpty failures - if noFailures && not cancelled then - try tcs.TrySetResult (mapper r1.Value r2.Value r3.Value) |> ignore - with e -> tcs.TrySetException e |> ignore - elif noFailures then tcs.TrySetCanceled () |> ignore - else tcs.TrySetException (failures |> Seq.map AggregateException |> Seq.reduce Exception.add).InnerExceptions |> ignore + let trySet () = + if Interlocked.Decrement pending = 0 then + let noFailures = Array.forall IReadOnlyCollection.isEmpty failures + if noFailures && not cancelled then + try tcs.TrySetResult (mapper r1.Value r2.Value r3.Value) |> ignore + with e -> tcs.TrySetException e |> ignore + elif noFailures then tcs.TrySetCanceled () |> ignore + else tcs.TrySetException (failures |> Seq.map AggregateException |> Seq.reduce Exception.add).InnerExceptions |> ignore - let k (v: ref<_>) i t = - match t with - | Succeeded r -> v.Value <- r - | Canceled -> cancelled <- true - | Faulted e -> failures[i] <- e.InnerExceptions - trySet () + let k (v: ref<_>) i t = + match t with + | Succeeded r -> v.Value <- r + | Faulted aex -> failures[i] <- aex.InnerExceptions + | Canceled -> cancelled <- true + trySet () - if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then - task1 |> k r1 0 - task2 |> k r2 1 - task3 |> k r3 2 - else - continueWith task1 (k r1 0) - continueWith task2 (k r2 1) - continueWith task3 (k r3 2) - tcs.Task |> ValueTask<'U> + if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then + task1 |> k r1 0 + task2 |> k r2 1 + task3 |> k r3 2 + else + task1.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r1 0) task1) + task2.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r2 1) task2) + task3.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> (k r3 2) task3) + ValueTask<'U> tcs.Task /// 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> = - 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> + let apply (f: ValueTask<'T -> 'U>) (x: ValueTask<'T>) : ValueTask<'U> = + if f.IsCompleted && x.IsCompleted then + match f, x with + | Succeeded r1, Succeeded r2 -> try result (r1 r2) with e -> ValueTask.FromException<_> e + | Succeeded _ , Faulted exn -> FromExceptions exn + | Succeeded _ , Canceled -> canceled + | Faulted exn , _ -> FromExceptions exn + | Canceled , _ -> canceled + else + let tcs = TaskCompletionSource<'U> () + if f.IsCanceled then tcs.SetCanceled () + elif f.IsFaulted then tcs.SetException (Unchecked.nonNull (f.AsTask().Exception)).InnerExceptions + elif x.IsCanceled then tcs.SetCanceled () + elif x.IsFaulted then tcs.SetException (Unchecked.nonNull (x.AsTask().Exception)).InnerExceptions + elif f.IsCompletedSuccessfully then x |> continueTask tcs (fun r -> try tcs.SetResult (f.Result r) with e -> tcs.SetException e) + elif x.IsCompletedSuccessfully then f |> continueTask tcs (fun r -> try tcs.SetResult (r x.Result) with e -> tcs.SetException e) + else f |> continueTask tcs (fun r -> x |> continueTask tcs (fun r' -> try tcs.SetResult (r r') with e -> tcs.SetException e)) + ValueTask<'U> tcs.Task - /// Creates a ValueTask workflow from two workflows 'x' and 'y', tupling its results. - let zipSequentially (x: ValueTask<'T>) (y: ValueTask<'U>) : 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> + /// Creates a ValueTask workflow from two workflows 'task1' and 'task2', tupling its results. + let zipSequentially (task1: ValueTask<'T1>) (task2: ValueTask<'T2>) : ValueTask<'T1 * 'T2> = + if task1.IsCompleted && task2.IsCompleted then + match task1, task2 with + | Succeeded r1, Succeeded r2 -> result (r1, r2) + | Succeeded _ , Faulted exn -> FromExceptions exn + | Succeeded _ , Canceled -> canceled + | Faulted exn , _ -> FromExceptions exn + | Canceled , _ -> canceled + else + let tcs = TaskCompletionSource<'T1 * 'T2> () + if task1.IsCanceled then tcs.SetCanceled () + elif task1.IsFaulted then tcs.SetException (Unchecked.nonNull (task1.AsTask().Exception)).InnerExceptions + elif task2.IsCanceled then tcs.SetCanceled () + elif task2.IsFaulted then tcs.SetException (Unchecked.nonNull (task2.AsTask().Exception)).InnerExceptions + elif task1.IsCompletedSuccessfully then task2 |> continueTask tcs (fun y -> tcs.SetResult (task1.Result, y)) + elif task2.IsCompletedSuccessfully then task1 |> continueTask tcs (fun x -> tcs.SetResult (x, task2.Result)) + else task1 |> continueTask tcs (fun x -> task2 |> continueTask tcs (fun y -> tcs.SetResult (x, y))) + ValueTask<'T1 * 'T2> tcs.Task /// Creates a ValueTask workflow from two workflows, tupling its results. /// Similar to zipSequentially but although workflows are started in sequence they might end independently in different order @@ -209,85 +271,48 @@ module ValueTask = /// Flattens two nested ValueTask into one. let join (source: ValueTask>) : ValueTask<'T> = - let tcs = TaskCompletionSource<'T> () - continueTask tcs source (fun x -> - continueTask tcs x (fun x -> - tcs.SetResult x)) - tcs.Task |> ValueTask<'T> - + backgroundTask { + let! inner = source + return! inner + } |> 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> = - 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> + backgroundTask { + let! r = source + return! f r + } |> ValueTask<'U> /// Creates a ValueTask that ignores the result of the source ValueTask. + /// The source ValueTask. + /// A ValueTask that completes when the source completes. /// It can be used to convert non-generic ValueTask to unit ValueTask. let ignore (source: ValueTask) : ValueTask = - if source.IsCompletedSuccessfully then Unchecked.defaultof<_> + if source.IsCompleted then Unchecked.defaultof<_> + elif source.IsFaulted then FromExceptions (Unchecked.nonNull (source.AsTask().Exception)) + elif source.IsCanceled then canceled else let tcs = TaskCompletionSource () - if source.IsFaulted then tcs.SetException (Unchecked.nonNull (source.AsTask().Exception)).InnerExceptions - elif source.IsCanceled then tcs.SetCanceled () - else - let k (t: ValueTask) : unit = - if t.IsCanceled then tcs.SetCanceled () - elif t.IsFaulted then tcs.SetException (Unchecked.nonNull (source.AsTask().Exception)).InnerExceptions - else tcs.SetResult () - if source.IsCompleted then k source - else source.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> k source) - tcs.Task |> ValueTask + let k (t: ValueTask) : unit = + if t.IsCanceled then tcs.SetCanceled () + elif t.IsFaulted then tcs.SetException (Unchecked.nonNull (source.AsTask().Exception)).InnerExceptions + else tcs.SetResult () + source.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> k source) + ValueTask tcs.Task /// Used to de-sugar try .. with .. blocks in Computation Expressions. let inline tryWith ([]compensation: exn -> ValueTask<'T>) ([]body: unit -> ValueTask<'T>) : ValueTask<'T> = - let unwrapException (agg: AggregateException) = - if agg.InnerExceptions.Count = 1 then agg.InnerExceptions.[0] - else agg :> Exception - try - let task = body () - if task.IsCompleted then - match task with - | Succeeded _ -> task - | Faulted exn -> compensation (unwrapException exn) - | Canceled -> compensation (TaskCanceledException ()) - else - let tcs = TaskCompletionSource<'T> () - let f = function - | Succeeded r -> tcs.SetResult r - | Faulted exn -> continueTask tcs (compensation (unwrapException exn)) (fun r -> try tcs.SetResult r with e -> tcs.SetException e) - | Canceled -> continueTask tcs (compensation (TaskCanceledException ())) (fun r -> try tcs.SetResult r with e -> tcs.SetException e) - task.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> f task) - ValueTask<'T> tcs.Task - with - | :? AggregateException as exn -> compensation (unwrapException exn) - | exn -> compensation exn + backgroundTask { + try return! body () + with e -> return! compensation e + } |> ValueTask<'T> /// Used to de-sugar try .. finally .. blocks in Computation Expressions. let inline tryFinally ([]compensation : unit -> unit) ([]body: unit -> ValueTask<'T>) : ValueTask<'T> = - let mutable ran = false - let compensation () = - if not ran then - compensation () - ran <- true - try - let task = body () - if task.IsCompleted then compensation (); task - else - let tcs = TaskCompletionSource<'T> () - let f = function - | Succeeded r -> tcs.SetResult r - | Faulted exn -> tcs.SetException exn.InnerExceptions - | Canceled -> tcs.SetCanceled () - task.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> compensation (); f task) - ValueTask<'T> tcs.Task - with _ -> - compensation () - reraise () + backgroundTask { + try return! body () + finally compensation () + } |> ValueTask<'T> /// Used to de-sugar use .. blocks in Computation Expressions. let inline using (disp: 'T when 'T :> IDisposable) ([]body: 'T -> ValueTask<'U>) = @@ -313,7 +338,9 @@ module ValueTask = /// The option if the option is Some, else the alternate option. let orElse (fallbackValueTask: ValueTask<'T>) (source: ValueTask<'T>) : ValueTask<'T> = orElseWith (fun _ -> fallbackValueTask) source - /// Raises an exception in the ValueTask - let raise<'TResult> (``exception``: exn) = ValueTask<'TResult> (Task.FromException<'TResult> ``exception``) + /// Creates a ValueTask that's completed unsuccessfully with the specified exception. + /// The exception to be raised. + /// A ValueTask that is completed unsuccessfully with the specified exception. + let raise<'T> (exn: exn) : ValueTask<'T> = ValueTask.FromException<'T> exn #endif \ No newline at end of file diff --git a/tests/FSharpPlus.Tests/Task.fs b/tests/FSharpPlus.Tests/Task.fs index fe1e4fc0f..4ff40beec 100644 --- a/tests/FSharpPlus.Tests/Task.fs +++ b/tests/FSharpPlus.Tests/Task.fs @@ -3,16 +3,22 @@ module Task = open System + open System.Threading open System.Threading.Tasks open NUnit.Framework open FSharpPlus - open FSharpPlus.Data open FSharpPlus.Tests.Helpers exception TestException of string + let (|AggregateException|_|) (x: exn) = + match x with + | :? AggregateException as e -> e.InnerExceptions |> Seq.toList |> Some + | _ -> None + module TaskTests = - open System.Threading + + open FSharpPlus.Extensions let createTask isFailed delay value = if not isFailed && delay = 0 then Task.FromResult value @@ -25,11 +31,6 @@ module Task = if isFailed then tcs.SetException (excn) else tcs.SetResult value) |> ignore tcs.Task - let (|AggregateException|_|) (x: exn) = - match x with - | :? AggregateException as e -> e.InnerExceptions |> Seq.toList |> Some - | _ -> None - [] let shortCircuits () = let x1 = createTask false 0 1 @@ -241,6 +242,101 @@ module Task = CollectionAssert.AreEquivalent (t123.Exception.InnerExceptions, t123'.Exception.InnerExceptions, "Task.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is the same as transpose [t1; t2; t3]") CollectionAssert.AreNotEquivalent (t123.Exception.InnerExceptions, t123''.Exception.InnerExceptions, "Task.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is not the same as sequence [t1; t2; t3]") + let cleanUp str = [0..9] |> List.fold (fun s i -> String.replace (string i) "" s) str + + let exnRoundtrips failure = + let mutable exn1: exn = null + let mutable exn2: exn = null + + let runFailure () = + Task.raise failure + + let r1 = try runFailure () |> Async.Await |> extract with | ex -> exn1 <- ex + let r2 = try runFailure () |> Async.Await |> Async.AsTask |> extract with | ex -> exn2 <- ex + + let e0 = cleanUp (string failure) + let e1 = cleanUp (string exn1) + let e2 = cleanUp (string exn2) + + e0, e1, e2 + + [] + let roundTripSingleExn () = + let (e0, e1, e2) = exnRoundtrips (TestException "one") + Assert.AreEqual (e0, e1, "Original exception is not the same as that extracted from the Async") + Assert.AreEqual (e1, e2, "The exception extracted from the Async is not the same as that extracted from the roundtripped Task") + + [] + let roundTripAggExn () = + let (e0, e1, e2) = exnRoundtrips (TestException "one" ++ TestException "two") + Assert.AreNotEqual (e0, e1, "Original exception can't be the same as that extracted from the Async, as Async uses the first exception.") + Assert.AreEqual (e1, e2, "The exception extracted from the Async is not the same as that extracted from the roundtripped Task") + + [] + let roundTripEmptyAggExn () = + let (e0, e1, e2) = exnRoundtrips (AggregateException "zero") + Assert.AreEqual (e0, e1, "Original exception is not the same as that extracted from the Async") + Assert.AreEqual (e1, e2, "The exception extracted from the Async is not the same as that extracted from the roundtripped Task") + + + // This module contains tests for ComputationExpression not covered by the below TaskBuilderTests module + module ComputationExpressionTests = + + [] + let testTryFinally () = + let mutable ran = false + let t = monad' { + try + do! Task.FromException (exn "This is a failed task") + finally + ran <- true + return 1 + } + require t.IsCompleted "task didn't complete synchronously" + require t.IsFaulted "task didn't fail" + require (not (isNull t.Exception)) "didn't capture exception" + require ran "never ran" + + [] + let testExcInCompensationSync () = + let t = monad' { + try + let! x = Task.result 1 + raise (TestException "task failed") + return x + finally + raise (TestException "compensation failed") + } + try + t.Wait() + failwith "Didn't fail" + with + | AggregateException [TestException "compensation failed"] -> () + | AggregateException [TestException x] -> failwithf "Expected 'compensation failed', got %s" x + | AggregateException [exn] -> failwithf "Expected TestException, got %A" exn + | AggregateException lst -> failwithf "Expected single TestException, got %A" lst + | exn -> failwithf "Expected AggregateException, got %A" exn + + [] + let testExcInCompensationAsync () = + let t = monad' { + try + do! Task.Delay 20 |> Task.ignore + let! x = Task.result 1 + raise (TestException "task failed") + return x + finally + raise (TestException "compensation failed") + } + try + t.Wait() + failwith "Didn't fail" + with + | AggregateException [TestException "compensation failed"] -> () + | AggregateException [TestException x] -> failwithf "Expected 'compensation failed', got %s" x + | AggregateException [exn] -> failwithf "Expected TestException, got %A" exn + | AggregateException lst -> failwithf "Expected single TestException, got %A" lst + | exn -> failwithf "Expected AggregateException, got %A" exn module TaskBuilderTests = @@ -254,12 +350,9 @@ module Task = // You should have received a copy of the CC0 Public Domain Dedication along with this software. // If not, see . - open System open System.Collections open System.Collections.Generic open System.Diagnostics - open System.Threading - open System.Threading.Tasks module Task = let Yield () = @@ -310,7 +403,7 @@ module Task = let t = monad' { do! Task.Yield() - Thread.Sleep(100) + do! Task.Delay(100) |> Task.ignore } sw.Stop() require (sw.ElapsedMilliseconds < 50L) "sleep blocked caller" @@ -682,7 +775,7 @@ module Task = try ranInitial <- true do! Task.Yield() - Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes + do! Task.Delay(100) |> Task.ignore // shouldn't be blocking so we should get through to requires before this finishes ranNext <- true finally ranFinally <- ranFinally + 1 @@ -707,7 +800,7 @@ module Task = try ranInitial <- true do! Task.Yield() - Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes + do! Task.Delay(100) |> Task.ignore // shouldn't be blocking so we should get through to requires before this finishes ranNext <- true failtest "uhoh" finally @@ -938,46 +1031,55 @@ module Task = [] let taskbuilderTests () = printfn "Running taskbuilder tests..." - try - testShortCircuitResult() - testDelay() - testNoDelay() - testNonBlocking() - testCatching1() - testCatching2() - testNestedCatching() - testTryFinallyHappyPath() - testTryFinallySadPath() - testTryFinallyCaught() - testUsing() - testUsingFromTask() - testUsingSadPath() - testForLoop() - testForLoopSadPath() - testExceptionAttachedToTaskWithoutAwait() // *1 - testExceptionAttachedToTaskWithAwait() // *1 - testExceptionThrownInFinally() - test2ndExceptionThrownInFinally() - testFixedStackWhileLoop() // *2 - testFixedStackForLoop() // *2 - testTypeInference() - // testNoStackOverflowWithImmediateResult() // *3 - testNoStackOverflowWithYieldResult() + let tests = [ + testShortCircuitResult + testDelay + testNoDelay + testNonBlocking // *0 + testCatching1 + testCatching2 + testNestedCatching + testTryFinallyHappyPath + testTryFinallySadPath + testTryFinallyCaught + testUsing + testUsingFromTask + testUsingSadPath + testForLoop + testForLoopSadPath + testExceptionAttachedToTaskWithoutAwait // *1 + testExceptionAttachedToTaskWithAwait // *1 + testExceptionThrownInFinally // *0 + test2ndExceptionThrownInFinally // *0 + // testFixedStackWhileLoop // *2 + // testFixedStackForLoop // *2 + testTypeInference + // testNoStackOverflowWithImmediateResult // *3 + testNoStackOverflowWithYieldResult // (Original note from TaskBuilder, n/a here) // we don't support TCO, so large tail recursions will stack overflow // or at least use O(n) heap. but small ones should at least function OK. - testSmallTailRecursion() - testTryOverReturnFrom() - testTryFinallyOverReturnFromWithException() - testTryFinallyOverReturnFromWithoutException() - // testCompatibilityWithOldUnitTask() // *4 - testAsyncsMixedWithTasks() // *5 - printfn "Passed all tests!" - with - | exn -> - eprintfn "Exception: %O" exn + testSmallTailRecursion + testTryOverReturnFrom + testTryFinallyOverReturnFromWithException + testTryFinallyOverReturnFromWithoutException + // testCompatibilityWithOldUnitTask // *4 + testAsyncsMixedWithTasks // *5 + ] + + let passed, failed = + tests + |> List.map Choice.protect + |> List.partitionMap (fun x -> x()) + + let failureMsg = sprintf "Some tests failed: %s %s" Environment.NewLine (failed |> List.map (sprintf "Test Failure -> %O") |> String.concat Environment.NewLine) + + Assert.AreEqual (0, List.length failed, failureMsg) + printfn "Passed all TaskBuilder tests (%i) !" (List.length passed) + () + // *0 Changed Thread.Sleep to Task.Delay to avoid blocking. These tests seems to have been designed te measure performance of the CE machinery // *1 Test adapted due to errors not being part of the workflow, this is by-design. // *2 Fails if run multiple times with System.Exception: Stack depth increased! // *3 Fails with Stack Overflow. diff --git a/tests/FSharpPlus.Tests/ValueTask.fs b/tests/FSharpPlus.Tests/ValueTask.fs index 95255039e..a1c0962e4 100644 --- a/tests/FSharpPlus.Tests/ValueTask.fs +++ b/tests/FSharpPlus.Tests/ValueTask.fs @@ -12,6 +12,11 @@ module ValueTask = open FSharpPlus.Tests.Helpers exception TestException of string + + let (|AggregateException|_|) (x: exn) = + match x with + | :? AggregateException as e -> e.InnerExceptions |> Seq.toList |> Some + | _ -> None type ValueTask<'T> with static member WhenAll (source: ValueTask<'T> seq) = source |> Seq.map (fun x -> x.AsTask ()) |> Task.WhenAll |> ValueTask<'T []> @@ -52,11 +57,6 @@ module ValueTask = else (Task.Delay delay).ContinueWith (fun _ -> if isFailed then tcs.SetException (excn) else tcs.SetResult value) |> ignore tcs.Task |> ValueTask<'T> - - let (|AggregateException|_|) (x: exn) = - match x with - | :? AggregateException as e -> e.InnerExceptions |> Seq.toList |> Some - | _ -> None let require x msg = if not x then failwith msg @@ -205,6 +205,66 @@ module ValueTask = CollectionAssert.AreEquivalent (t123.Exception.InnerExceptions, t123'.Exception.InnerExceptions, "ValueTask.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is the same as transpose [t1; t2; t3]") CollectionAssert.AreNotEquivalent (t123.Exception.InnerExceptions, t123''.Exception.InnerExceptions, "ValueTask.map3 (fun x y z -> [x; y; z]) t1 t2 t3 is not the same as sequence [t1; t2; t3]") + + // This module contains tests for ComputationExpression not covered by the below TaskBuilderTests module + module ComputationExpressionTests = + + [] + let testTryFinally () = + let mutable ran = false + let t = monad' { + try + do! ValueTask.FromException (exn "This is a failed task") + finally + ran <- true + return 1 + } + require t.IsCompleted "task didn't complete synchronously" + require t.IsFaulted "task didn't fail" + require (not (isNull t.Exception)) "didn't capture exception" + require ran "never ran" + + [] + let testExcInCompensationSync () = + let t = monad' { + try + let! x = ValueTask.result 1 + raise (TestException "task failed") + return x + finally + raise (TestException "compensation failed") + } + try + t.Wait() + failwith "Didn't fail" + with + | AggregateException [TestException "compensation failed"] -> () + | AggregateException [TestException x] -> failwithf "Expected 'compensation failed', got %s" x + | AggregateException [exn] -> failwithf "Expected TestException, got %A" exn + | AggregateException lst -> failwithf "Expected single TestException, got %A" lst + | exn -> failwithf "Expected AggregateException, got %A" exn + + [] + let testExcInCompensationAsync () = + let t = monad' { + try + do! ValueTask.Delay 20 |> ValueTask.ignore + let! x = ValueTask.result 1 + raise (TestException "task failed") + return x + finally + raise (TestException "compensation failed") + } + try + t.Wait() + failwith "Didn't fail" + with + | AggregateException [TestException "compensation failed"] -> () + | AggregateException [TestException x] -> failwithf "Expected 'compensation failed', got %s" x + | AggregateException [exn] -> failwithf "Expected TestException, got %A" exn + | AggregateException lst -> failwithf "Expected single TestException, got %A" lst + | exn -> failwithf "Expected AggregateException, got %A" exn + module ValueTaskBuilderTests = // Same tests, same note as in Task.fs about these tests @@ -262,7 +322,7 @@ module ValueTask = let t = monad' { do! ValueTask.Yield() - Thread.Sleep(100) + do! ValueTask.Delay(100) |> ValueTask.ignore } sw.Stop() require (sw.ElapsedMilliseconds < 50L) "sleep blocked caller" @@ -634,7 +694,7 @@ module ValueTask = try ranInitial <- true do! ValueTask.Yield() - Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes + do! ValueTask.Delay(100) |> ValueTask.ignore // shouldn't be blocking so we should get through to requires before this finishes ranNext <- true finally ranFinally <- ranFinally + 1 @@ -659,7 +719,7 @@ module ValueTask = try ranInitial <- true do! ValueTask.Yield() - Thread.Sleep(100) // shouldn't be blocking so we should get through to requires before this finishes + do! ValueTask.Delay(100) |> ValueTask.ignore // shouldn't be blocking so we should get through to requires before this finishes ranNext <- true failtest "uhoh" finally @@ -889,47 +949,56 @@ module ValueTask = [] let taskbuilderTests () = - printfn "Running taskbuilder tests..." - try - testShortCircuitResult() - testDelay() - testNoDelay() - testNonBlocking() - testCatching1() - testCatching2() - testNestedCatching() - testTryFinallyHappyPath() - testTryFinallySadPath() - testTryFinallyCaught() - testUsing() - testUsingFromValueTask() - testUsingSadPath() - testForLoop() - testForLoopSadPath() - testExceptionAttachedToValueTaskWithoutAwait() // *1 - testExceptionAttachedToValueTaskWithAwait() // *1 - testExceptionThrownInFinally() - test2ndExceptionThrownInFinally() - testFixedStackWhileLoop() // *2 - testFixedStackForLoop() // *2 - testTypeInference() - // testNoStackOverflowWithImmediateResult() // *3 - testNoStackOverflowWithYieldResult() + printfn "Running (value) taskbuilder tests..." + let tests = [ + testShortCircuitResult + testDelay + testNoDelay + testNonBlocking // *0 + testCatching1 + testCatching2 + testNestedCatching + testTryFinallyHappyPath + testTryFinallySadPath + testTryFinallyCaught + testUsing + testUsingFromValueTask + testUsingSadPath + testForLoop + testForLoopSadPath + testExceptionAttachedToValueTaskWithoutAwait // *1 + testExceptionAttachedToValueTaskWithAwait // *1 + testExceptionThrownInFinally // *0 + test2ndExceptionThrownInFinally // *0 + // testFixedStackWhileLoop // *2 + // testFixedStackForLoop // *2 + testTypeInference + // testNoStackOverflowWithImmediateResult // *3 + testNoStackOverflowWithYieldResult // (Original note from ValueTaskBuilder, n/a here) // we don't support TCO, so large tail recursions will stack overflow // or at least use O(n) heap. but small ones should at least function OK. - testSmallTailRecursion() - testTryOverReturnFrom() - testTryFinallyOverReturnFromWithException() - testTryFinallyOverReturnFromWithoutException() - // testCompatibilityWithOldUnitValueTask() // *4 - testAsyncsMixedWithValueTasks() // *5 - printfn "Passed all tests!" - with - | exn -> - eprintfn "Exception: %O" exn + testSmallTailRecursion + testTryOverReturnFrom + testTryFinallyOverReturnFromWithException + testTryFinallyOverReturnFromWithoutException + // testCompatibilityWithOldUnitValueTask // *4 + testAsyncsMixedWithValueTasks // *5 + ] + + let passed, failed = + tests + |> List.map Choice.protect + |> List.partitionMap (fun x -> x()) + + let failureMsg = sprintf "Some tests failed: %s %s" Environment.NewLine (failed |> List.map (sprintf "Test Failure -> %O") |> String.concat Environment.NewLine) + + Assert.AreEqual (0, List.length failed, failureMsg) + printfn "Passed all TaskBuilder tests (%i) !" (List.length passed) + () + // *0 Changed Thread.Sleep to ValueTask.Delay to avoid blocking. These tests seems to have been designed te measure performance of the CE machinery // *1 Test adapted due to errors not being part of the workflow, this is by-design. // *2 Fails if run multiple times with System.Exception: Stack depth increased! // *3 Fails with Stack Overflow. From 077cf609d4d8b398733b0b1c54600e0e079ac989 Mon Sep 17 00:00:00 2001 From: Oskar Mathieu Gewalli Date: Thu, 8 Jan 2026 09:18:44 +0200 Subject: [PATCH 2/5] Task active pattern should be internal --- src/FSharpPlus/Extensions/Task.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharpPlus/Extensions/Task.fs b/src/FSharpPlus/Extensions/Task.fs index c86a08f3c..dd67a15e7 100644 --- a/src/FSharpPlus/Extensions/Task.fs +++ b/src/FSharpPlus/Extensions/Task.fs @@ -14,7 +14,7 @@ module Task = open FSharpPlus.Internals.Errors /// Active pattern to match the state of a completed Task - let inline private (|Succeeded|Canceled|Faulted|) (t: Task<'a>) = + let inline internal (|Succeeded|Canceled|Faulted|) (t: Task<'a>) = if t.IsFaulted then Faulted (Unchecked.nonNull (t.Exception)) elif t.IsCanceled then Canceled elif t.IsCompleted then Succeeded t.Result From 57e7d2e8d180b7a391b2b46d40d858bd05aab892 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Fri, 9 Jan 2026 12:24:20 +0100 Subject: [PATCH 3/5] Avoid F# built-in task CEs --- src/FSharpPlus/Extensions/Task.fs | 62 +++++++++++++++++-------- src/FSharpPlus/Extensions/ValueTask.fs | 63 ++++++++++++++++++-------- 2 files changed, 87 insertions(+), 38 deletions(-) diff --git a/src/FSharpPlus/Extensions/Task.fs b/src/FSharpPlus/Extensions/Task.fs index dd67a15e7..f962e2639 100644 --- a/src/FSharpPlus/Extensions/Task.fs +++ b/src/FSharpPlus/Extensions/Task.fs @@ -65,10 +65,15 @@ module Task = raiseIfNull "source" source #endif - backgroundTask { - let! r = source - return mapper r - } + if source.IsCompleted then + match source with + | Succeeded r -> try result (mapper r) with e -> Task.FromException<_> e + | Faulted exn -> FromExceptions exn + | Canceled -> canceled + else + let tcs = TaskCompletionSource<'U> TaskCreationOptions.RunContinuationsAsynchronously + source |> continueTask tcs (fun r -> try tcs.SetResult (mapper r) with e -> tcs.SetException e) + tcs.Task /// Creates a task workflow from two workflows 'task1' and 'task2', mapping its results with 'mapper'. /// Workflows are run in sequence. @@ -333,19 +338,13 @@ module Task = raiseIfNull "source" source #endif - backgroundTask { - let! inner = source - return! inner - } + source.Unwrap() /// Creates a task workflow from 'source' workflow, mapping and flattening its result with 'f'. let bind (f: 'T -> Task<'U>) (source: Task<'T>) : Task<'U> = let source = nullArgCheck (nameof source) source - backgroundTask { - let! r = source - return! f r - } + source |> Unchecked.nonNull |> map f |> join /// Creates a task that ignores the result of the source task. /// The source Task. @@ -371,14 +370,41 @@ module Task = tcs.Task [] - let tryWith (body: unit -> Task<'T>) (compensation: exn -> Task<'T>) : Task<'T> = backgroundTask { - try return! body () - with e -> return! compensation e } + let rec tryWith (body: unit -> Task<'T>) (compensation: exn -> Task<'T>) : Task<'T> = + let runCompensation exn = + try compensation exn + with e -> Task.FromException<'T> e + let unwrapException (agg: AggregateException) = + if agg.InnerExceptions.Count = 1 then agg.InnerExceptions.[0] + else agg :> Exception + try Ok (body ()) with e -> Error e + |> function + | Ok task -> + if task.IsCompleted then + match task with + | Succeeded _ -> task + | Faulted aex -> runCompensation (unwrapException aex) + | Canceled -> canceled + else + task.ContinueWith(fun (x: Task<'T>) -> tryWith (fun () -> x) compensation).Unwrap () + | Error exn -> runCompensation exn [] - let tryFinally (body: unit -> Task<'T>) (compensation : unit -> unit) : Task<'T> = backgroundTask { - try return! body () - finally compensation () } + let rec tryFinally (body: unit -> Task<'T>) (compensation : unit -> unit) : Task<'T> = + let task = + try body () + with _ -> + try + compensation () + reraise () + with e -> Task.FromException<'T> e + if task.IsCompleted then + try + compensation () + task + with e -> Task.FromException<'T> e + else + task.ContinueWith(fun (x: Task<'T>) -> tryFinally (fun () -> x) compensation).Unwrap () /// Used to de-sugar use .. blocks in Computation Expressions. let using (disp: 'T when 'T :> IDisposable) (body: 'T -> Task<'U>) = diff --git a/src/FSharpPlus/Extensions/ValueTask.fs b/src/FSharpPlus/Extensions/ValueTask.fs index e492277d4..8545f75b1 100644 --- a/src/FSharpPlus/Extensions/ValueTask.fs +++ b/src/FSharpPlus/Extensions/ValueTask.fs @@ -63,10 +63,15 @@ module ValueTask = /// The source ValueTask workflow. /// The resulting ValueTask workflow. let map (mapper: 'T -> 'U) (source: ValueTask<'T>) : ValueTask<'U> = - backgroundTask { - let! r = source - return mapper r - } |> ValueTask<'U> + if source.IsCompleted then + match source with + | Succeeded r -> try result (mapper r) with e -> ValueTask.FromException<_> e + | Faulted exn -> FromExceptions exn + | Canceled -> canceled + else + let tcs = TaskCompletionSource<'U> TaskCreationOptions.RunContinuationsAsynchronously + source |> continueTask tcs (fun r -> try tcs.SetResult (mapper r) with e -> tcs.SetException e) + tcs.Task |> ValueTask<'U> /// Creates a ValueTask workflow from two workflows 'x' and 'y', mapping its results with 'f'. @@ -271,17 +276,11 @@ module ValueTask = /// Flattens two nested ValueTask into one. let join (source: ValueTask>) : ValueTask<'T> = - backgroundTask { - let! inner = source - return! inner - } |> ValueTask<'T> + (source |> map (fun x -> x.AsTask())).AsTask().Unwrap () |> 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> = - backgroundTask { - let! r = source - return! f r - } |> ValueTask<'U> + source |> map f |> join /// Creates a ValueTask that ignores the result of the source ValueTask. /// The source ValueTask. @@ -302,17 +301,41 @@ module ValueTask = /// Used to de-sugar try .. with .. blocks in Computation Expressions. let inline tryWith ([]compensation: exn -> ValueTask<'T>) ([]body: unit -> ValueTask<'T>) : ValueTask<'T> = - backgroundTask { - try return! body () - with e -> return! compensation e - } |> ValueTask<'T> + let runCompensation exn = + try compensation exn + with e -> ValueTask.FromException<'T> e + let unwrapException (agg: AggregateException) = + if agg.InnerExceptions.Count = 1 then agg.InnerExceptions.[0] + else agg :> Exception + try Ok (body ()) with e -> Error e + |> function + | Ok task -> + if task.IsCompleted then + match task with + | Succeeded _ -> task + | Faulted aex -> runCompensation (unwrapException aex) + | Canceled -> canceled + else + task.AsTask().ContinueWith(fun (x: Task<'T>) -> Task.tryWith (compensation >> fun x -> x.AsTask()) (fun () -> x)).Unwrap () |> ValueTask<'T> + | Error exn -> runCompensation exn + /// Used to de-sugar try .. finally .. blocks in Computation Expressions. let inline tryFinally ([]compensation : unit -> unit) ([]body: unit -> ValueTask<'T>) : ValueTask<'T> = - backgroundTask { - try return! body () - finally compensation () - } |> ValueTask<'T> + let task = + try body () + with _ -> + try + compensation () + reraise () + with e -> ValueTask.FromException<'T> e + if task.IsCompleted then + try + compensation () + task + with e -> ValueTask.FromException<'T> e + else + task.AsTask().ContinueWith(fun (x: Task<'T>) -> Task.tryFinally compensation (fun () -> x)).Unwrap () |> ValueTask<'T> /// Used to de-sugar use .. blocks in Computation Expressions. let inline using (disp: 'T when 'T :> IDisposable) ([]body: 'T -> ValueTask<'U>) = From 8331587d5d15caacfc48d9b663019f4916f91e25 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 10 Jan 2026 09:23:54 +0100 Subject: [PATCH 4/5] Reorganize code for multitargeting --- src/FSharpPlus/Extensions/Task.fs | 139 ++++++++++++++++++------- src/FSharpPlus/Extensions/ValueTask.fs | 117 +++++++++++++++------ 2 files changed, 186 insertions(+), 70 deletions(-) diff --git a/src/FSharpPlus/Extensions/Task.fs b/src/FSharpPlus/Extensions/Task.fs index f962e2639..81f96be48 100644 --- a/src/FSharpPlus/Extensions/Task.fs +++ b/src/FSharpPlus/Extensions/Task.fs @@ -15,10 +15,11 @@ module Task = /// Active pattern to match the state of a completed Task let inline internal (|Succeeded|Canceled|Faulted|) (t: Task<'a>) = - if t.IsFaulted then Faulted (Unchecked.nonNull (t.Exception)) - elif t.IsCanceled then Canceled - elif t.IsCompleted then Succeeded t.Result - else invalidOp "Internal error: The task is not yet completed." + match t.Status with + | TaskStatus.RanToCompletion -> Succeeded t.Result + | TaskStatus.Faulted -> Faulted (Unchecked.nonNull t.Exception) + | TaskStatus.Canceled -> Canceled + | _ -> invalidOp (sprintf "Internal error: The task is not yet in a final state. State = TaskStatus.%A" t.Status) let inline internal continueTask (tcs: TaskCompletionSource<'Result>) (k: 't -> unit) (x: Task<'t>) = let f = function @@ -27,32 +28,56 @@ module Task = | Canceled -> tcs.SetCanceled () x.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> f x) + #if NET5_0_OR_GREATER + let [] private tcsOptions = TaskCreationOptions.RunContinuationsAsynchronously + #else + let private tcsOptions = () + #endif /// Creates a Task that's completed successfully with the specified value. /// /// A Task that is completed successfully with the specified value. let result (value: 'T) : Task<'T> = Task.FromResult value - + + + /// Creates a Task that's completed unsuccessfully with the specified exception. + /// The exception to be raised. + /// A Task that is completed unsuccessfully with the specified exception. + let raise<'T> (exn: exn) : Task<'T> = + #if NET5_0_OR_GREATER + Task.FromException<'T> exn + #else + let tcs = TaskCompletionSource<'T> tcsOptions + tcs.SetException exn + tcs.Task + #endif + /// Creates a Task that's completed unsuccessfully with the specified exceptions. - /// The AggregateException to be raised. + /// The AggregateException to be raised. /// A Task that is completed unsuccessfully with the specified exceptions. /// /// Prefer this function to handle AggregateExceptions over Task.FromException as it handles them correctly. /// - let internal FromExceptions<'T> (aex: AggregateException) : Task<'T> = + let inline internal FromExceptions<'T> (aex: AggregateException) : Task<'T> = + #if NET5_0_OR_GREATER match aex with | agg when agg.InnerExceptions.Count = 1 -> Task.FromException<'T> agg.InnerExceptions[0] - | agg -> - let tcs = TaskCompletionSource<'T> () - tcs.SetException agg.InnerExceptions + | _ -> + #endif + let tcs = TaskCompletionSource<'T> tcsOptions + tcs.SetException aex.InnerExceptions tcs.Task - let private cancellationTokenSingleton = CancellationToken true - /// Creates a Task that's canceled. /// A Task that's canceled. - let canceled<'T> : Task<'T> = Task.FromCanceled<'T> cancellationTokenSingleton - + let canceled<'T> : Task<'T> = + #if NET5_0_OR_GREATER + Task.FromCanceled<'T> (CancellationToken true) + #else + let tcs = TaskCompletionSource<'T> tcsOptions + tcs.SetCanceled () + tcs.Task + #endif /// Creates a task workflow from 'source' workflow, mapping its result with 'mapper'. /// The mapping function. @@ -67,11 +92,11 @@ module Task = if source.IsCompleted then match source with - | Succeeded r -> try result (mapper r) with e -> Task.FromException<_> e + | Succeeded r -> try result (mapper r) with e -> raise e | Faulted exn -> FromExceptions exn | Canceled -> canceled else - let tcs = TaskCompletionSource<'U> TaskCreationOptions.RunContinuationsAsynchronously + let tcs = TaskCompletionSource<'U> tcsOptions source |> continueTask tcs (fun r -> try tcs.SetResult (mapper r) with e -> tcs.SetException e) tcs.Task @@ -91,13 +116,13 @@ module Task = if task1.IsCompleted && task2.IsCompleted then match task1, task2 with - | Succeeded r1, Succeeded r2 -> try result (mapper r1 r2) with e -> Task.FromException<_> e + | Succeeded r1, Succeeded r2 -> try result (mapper r1 r2) with e -> raise e | Succeeded _ , Faulted exn -> FromExceptions exn | Succeeded _ , Canceled -> canceled | Faulted exn , _ -> FromExceptions exn | Canceled , _ -> canceled else - let tcs = TaskCompletionSource<'U> () + let tcs = TaskCompletionSource<'U> tcsOptions match task1.Status, task2.Status with | TaskStatus.Canceled, _ -> tcs.SetCanceled () @@ -128,7 +153,7 @@ module Task = if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then match task1, task2, task3 with - | Succeeded r1, Succeeded r2, Succeeded r3 -> try result (mapper r1 r2 r3) with e -> Task.FromException<_> e + | Succeeded r1, Succeeded r2, Succeeded r3 -> try result (mapper r1 r2 r3) with e -> raise e | Faulted exn , _ , _ -> FromExceptions exn | Canceled , _ , _ -> canceled | _ , Faulted exn , _ -> FromExceptions exn @@ -136,7 +161,7 @@ module Task = | _ , _ , Faulted exn -> FromExceptions exn | _ , _ , Canceled -> canceled else - let tcs = TaskCompletionSource<'U> () + let tcs = TaskCompletionSource<'U> tcsOptions match task1.Status, task2.Status, task3.Status with | TaskStatus.Canceled, _ , _ -> tcs.SetCanceled () | TaskStatus.Faulted , _ , _ -> tcs.SetException (Unchecked.nonNull task1.Exception).InnerExceptions @@ -168,9 +193,9 @@ module Task = #endif if task1.Status = TaskStatus.RanToCompletion && task2.Status = TaskStatus.RanToCompletion then - try result (mapper task1.Result task2.Result) with e -> Task.FromException<'U> e + try result (mapper task1.Result task2.Result) with e -> raise e else - let tcs = TaskCompletionSource<_> () + let tcs = TaskCompletionSource<_> tcsOptions let r1 = ref Unchecked.defaultof<_> let r2 = ref Unchecked.defaultof<_> let mutable cancelled = false @@ -222,9 +247,9 @@ module Task = if task1.Status = TaskStatus.RanToCompletion && task2.Status = TaskStatus.RanToCompletion && task3.Status = TaskStatus.RanToCompletion then try result (mapper task1.Result task2.Result task3.Result) - with e -> Task.FromException<'U> e + with e -> raise e else - let tcs = TaskCompletionSource<_> () + let tcs = TaskCompletionSource<_> tcsOptions let r1 = ref Unchecked.defaultof<_> let r2 = ref Unchecked.defaultof<_> let r3 = ref Unchecked.defaultof<_> @@ -273,13 +298,13 @@ module Task = if f.IsCompleted && x.IsCompleted then match f, x with - | Succeeded r1, Succeeded r2 -> try result (r1 r2) with e -> Task.FromException<_> e + | Succeeded r1, Succeeded r2 -> try result (r1 r2) with e -> raise e | Succeeded _ , Faulted exn -> FromExceptions exn | Succeeded _ , Canceled -> canceled | Faulted exn , _ -> FromExceptions exn | Canceled , _ -> canceled else - let tcs = TaskCompletionSource<'U> () + let tcs = TaskCompletionSource<'U> tcsOptions match f.Status, x.Status with | TaskStatus.Canceled, _ -> tcs.SetCanceled () | TaskStatus.Faulted, _ -> tcs.SetException (Unchecked.nonNull f.Exception).InnerExceptions @@ -307,7 +332,7 @@ module Task = | Faulted exn , _ -> FromExceptions exn | Canceled , _ -> canceled else - let tcs = TaskCompletionSource<'T1 * 'T2> () + let tcs = TaskCompletionSource<'T1 * 'T2> tcsOptions match task1.Status, task2.Status with | TaskStatus.Canceled, _ -> tcs.SetCanceled () | TaskStatus.Faulted, _ -> tcs.SetException (Unchecked.nonNull task1.Exception).InnerExceptions @@ -357,11 +382,12 @@ module Task = raiseIfNull "source" source #endif - if source.IsCompletedSuccessfully then result () - elif source.IsFaulted then FromExceptions (Unchecked.nonNull source.Exception) - elif source.IsCanceled then canceled - else - let tcs = TaskCompletionSource () + match source.Status with + | TaskStatus.RanToCompletion -> result () + | TaskStatus.Faulted -> FromExceptions (Unchecked.nonNull source.Exception) + | TaskStatus.Canceled -> canceled + | _ -> + let tcs = TaskCompletionSource tcsOptions let k (t: Task) : unit = if t.IsCanceled then tcs.SetCanceled () elif t.IsFaulted then tcs.SetException (Unchecked.nonNull source.Exception).InnerExceptions @@ -373,7 +399,7 @@ module Task = let rec tryWith (body: unit -> Task<'T>) (compensation: exn -> Task<'T>) : Task<'T> = let runCompensation exn = try compensation exn - with e -> Task.FromException<'T> e + with e -> raise e let unwrapException (agg: AggregateException) = if agg.InnerExceptions.Count = 1 then agg.InnerExceptions.[0] else agg :> Exception @@ -397,12 +423,12 @@ module Task = try compensation () reraise () - with e -> Task.FromException<'T> e + with e -> raise e if task.IsCompleted then try compensation () task - with e -> Task.FromException<'T> e + with e -> raise e else task.ContinueWith(fun (x: Task<'T>) -> tryFinally (fun () -> x) compensation).Unwrap () @@ -447,11 +473,46 @@ module Task = raiseIfNull "source" source #endif orElseWith (fun _ -> fallbackTask) source + + /// Attempts to recover from a potentially failed task by mapping the exception to a successful result. + /// Mapping function from exception to result. + /// The source task. + /// A successful resulting task. + /// The result is always a successful task, unless the mapping function itself throws an exception. + let inline recover ([]mapper: exn -> 'T) (source: Task<'T>) : Task<'T> = + let source = nullArgCheck (nameof source) source - /// Creates a Task that's completed unsuccessfully with the specified exception. - /// The exception to be raised. - /// A Task that is completed unsuccessfully with the specified exception. - let raise<'T> (exn: exn) : Task<'T> = Task.FromException<'T> exn + tryWith (fun () -> source) (mapper >> result) + + /// Maps the exception of a faulted task to another exception. + /// Mapping function from exception to exception. + /// The source task. + /// The resulting task. + let inline mapError ([]mapper: exn -> exn) (source: Task<'T>) : Task<'T> = + let source = nullArgCheck (nameof source) source + + if source.IsCompleted then + match source with + | Faulted exn -> FromExceptions (AggregateException (mapper exn)) + | _ -> source + else + let tcs = TaskCompletionSource<'T> tcsOptions + let k = function + | Succeeded r -> tcs.SetResult r + | Faulted aex -> tcs.SetException (AggregateException (mapper aex)).InnerExceptions + | Canceled -> tcs.SetCanceled () + source.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> k source) + tcs.Task + + /// Creates a Task from a Result value. + /// If the Result is Ok, the Task will complete successfully with the value. + /// If the Result is Error, the Task will complete unsuccessfully with the exception. + /// The source Result. + /// The resulting Task. + let ofResult (source: Result<'T, exn>) : Task<'T> = + match source with + | Ok x -> result x + | Error exn -> raise exn /// Workaround to fix signatures without breaking binary compatibility. diff --git a/src/FSharpPlus/Extensions/ValueTask.fs b/src/FSharpPlus/Extensions/ValueTask.fs index 8545f75b1..02be715fa 100644 --- a/src/FSharpPlus/Extensions/ValueTask.fs +++ b/src/FSharpPlus/Extensions/ValueTask.fs @@ -16,7 +16,7 @@ module ValueTask = if t.IsCompletedSuccessfully then Succeeded t.Result elif t.IsFaulted then Faulted (Unchecked.nonNull (t.AsTask().Exception)) elif t.IsCanceled then Canceled - else invalidOp "Internal error: The task is not yet completed." + else invalidOp "Internal error: The task is not yet in a final state." let inline internal continueTask (tcs: TaskCompletionSource<'Result>) (k: 't -> unit) (x: ValueTask<'t>) = let f = function @@ -25,6 +25,11 @@ module ValueTask = | Canceled -> tcs.SetCanceled () x.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> f x) + #if NET5_0_OR_GREATER + let [] private tcsOptions = TaskCreationOptions.RunContinuationsAsynchronously + #else + let private tcsOptions = () + #endif /// Creates a ValueTask that's completed successfully with the specified value. /// @@ -33,30 +38,49 @@ module ValueTask = #if NET5_0_OR_GREATER ValueTask.FromResult value #else - let tcs = TaskCompletionSource<'T> () + let tcs = TaskCompletionSource<'T> tcsOptions tcs.SetResult value ValueTask<'T> tcs.Task #endif + + /// Creates a ValueTask that's completed unsuccessfully with the specified exception. + /// The exception to be raised. + /// A ValueTask that is completed unsuccessfully with the specified exception. + let raise<'T> (exn: exn) : ValueTask<'T> = + #if NET5_0_OR_GREATER + ValueTask.FromException<'T> exn + #else + let tcs = TaskCompletionSource<'T> tcsOptions + tcs.SetException exn + ValueTask<'T> tcs.Task + #endif /// Creates a Task that's completed unsuccessfully with the specified exceptions. - /// The AggregateException to be raised. + /// The AggregateException to be raised. /// A Task that is completed unsuccessfully with the specified exceptions. /// /// Prefer this function to handle AggregateExceptions over Task.FromException as it handles them correctly. /// - let internal FromExceptions<'T> (aex: AggregateException) : ValueTask<'T> = + let inline internal FromExceptions<'T> (aex: AggregateException) : ValueTask<'T> = + #if NET5_0_OR_GREATER match aex with | agg when agg.InnerExceptions.Count = 1 -> ValueTask.FromException<'T> agg.InnerExceptions[0] - | agg -> - let tcs = TaskCompletionSource<'T> () - tcs.SetException agg.InnerExceptions + | _ -> + #endif + let tcs = TaskCompletionSource<'T> tcsOptions + tcs.SetException aex.InnerExceptions ValueTask<'T> tcs.Task - let private cancellationTokenSingleton = CancellationToken true - /// Creates a ValueTask that's canceled. /// A ValueTask that's canceled. - let canceled<'T> : ValueTask<'T> = ValueTask.FromCanceled<'T> cancellationTokenSingleton + let canceled<'T> : ValueTask<'T> = + #if NET5_0_OR_GREATER + ValueTask.FromCanceled<'T> (CancellationToken true) + #else + let tcs = TaskCompletionSource<'T> tcsOptions + tcs.SetCanceled () + ValueTask<'T> tcs.Task + #endif /// Creates a ValueTask workflow from 'source' workflow, mapping its result with 'mapper'. /// The mapping function. @@ -65,11 +89,11 @@ module ValueTask = let map (mapper: 'T -> 'U) (source: ValueTask<'T>) : ValueTask<'U> = if source.IsCompleted then match source with - | Succeeded r -> try result (mapper r) with e -> ValueTask.FromException<_> e + | Succeeded r -> try result (mapper r) with e -> raise e | Faulted exn -> FromExceptions exn | Canceled -> canceled else - let tcs = TaskCompletionSource<'U> TaskCreationOptions.RunContinuationsAsynchronously + let tcs = TaskCompletionSource<'U> tcsOptions source |> continueTask tcs (fun r -> try tcs.SetResult (mapper r) with e -> tcs.SetException e) tcs.Task |> ValueTask<'U> @@ -82,13 +106,13 @@ module ValueTask = let lift2 (mapper: 'T1 -> 'T2 -> 'U) (task1: ValueTask<'T1>) (task2: ValueTask<'T2>) : ValueTask<'U> = if task1.IsCompleted && task2.IsCompleted then match task1, task2 with - | Succeeded r1, Succeeded r2 -> try result (mapper r1 r2) with e -> ValueTask.FromException<_> e + | Succeeded r1, Succeeded r2 -> try result (mapper r1 r2) with e -> raise e | Succeeded _ , Faulted exn -> FromExceptions exn | Succeeded _ , Canceled -> canceled | Faulted exn , _ -> FromExceptions exn | Canceled , _ -> canceled else - let tcs = TaskCompletionSource<'U> () + let tcs = TaskCompletionSource<'U> tcsOptions if task1.IsCanceled then tcs.SetCanceled () elif task1.IsFaulted then tcs.SetException (Unchecked.nonNull (task1.AsTask().Exception)).InnerExceptions elif task2.IsCanceled then tcs.SetCanceled () @@ -107,7 +131,7 @@ module ValueTask = let lift3 (mapper: 'T1 -> 'T2 -> 'T3 -> 'U) (task1: ValueTask<'T1>) (task2: ValueTask<'T2>) (task3: ValueTask<'T3>) : ValueTask<'U> = if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then match task1, task2, task3 with - | Succeeded r1, Succeeded r2, Succeeded r3 -> try result (mapper r1 r2 r3) with e -> ValueTask.FromException<_> e + | Succeeded r1, Succeeded r2, Succeeded r3 -> try result (mapper r1 r2 r3) with e -> raise e | Faulted exn , _ , _ -> FromExceptions exn | Canceled , _ , _ -> canceled | _ , Faulted exn , _ -> FromExceptions exn @@ -115,7 +139,7 @@ module ValueTask = | _ , _ , Faulted exn -> FromExceptions exn | _ , _ , Canceled -> canceled else - let tcs = TaskCompletionSource<'U> () + let tcs = TaskCompletionSource<'U> tcsOptions if task1.IsCanceled then tcs.SetCanceled () elif task1.IsFaulted then tcs.SetException (Unchecked.nonNull (task1.AsTask().Exception)).InnerExceptions elif task2.IsCanceled then tcs.SetCanceled () @@ -139,9 +163,9 @@ module ValueTask = let map2 mapper (task1: ValueTask<'T1>) (task2: ValueTask<'T2>) : ValueTask<'U> = if task1.IsCompletedSuccessfully && task2.IsCompletedSuccessfully then try result (mapper task1.Result task2.Result) - with e -> ValueTask.FromException<'U> e + with e -> raise e else - let tcs = TaskCompletionSource<_> () + let tcs = TaskCompletionSource<_> tcsOptions let r1 = ref Unchecked.defaultof<_> let r2 = ref Unchecked.defaultof<_> let mutable cancelled = false @@ -183,9 +207,9 @@ module ValueTask = let map3 mapper (task1: ValueTask<'T1>) (task2: ValueTask<'T2>) (task3: ValueTask<'T3>) : ValueTask<'U> = if task1.IsCompletedSuccessfully && task2.IsCompletedSuccessfully && task3.IsCompletedSuccessfully then try result (mapper task1.Result task2.Result task3.Result) - with e -> ValueTask.FromException<'U> e + with e -> raise e else - let tcs = TaskCompletionSource<_> () + let tcs = TaskCompletionSource<_> tcsOptions let r1 = ref Unchecked.defaultof<_> let r2 = ref Unchecked.defaultof<_> let r3 = ref Unchecked.defaultof<_> @@ -226,13 +250,13 @@ module ValueTask = let apply (f: ValueTask<'T -> 'U>) (x: ValueTask<'T>) : ValueTask<'U> = if f.IsCompleted && x.IsCompleted then match f, x with - | Succeeded r1, Succeeded r2 -> try result (r1 r2) with e -> ValueTask.FromException<_> e + | Succeeded r1, Succeeded r2 -> try result (r1 r2) with e -> raise e | Succeeded _ , Faulted exn -> FromExceptions exn | Succeeded _ , Canceled -> canceled | Faulted exn , _ -> FromExceptions exn | Canceled , _ -> canceled else - let tcs = TaskCompletionSource<'U> () + let tcs = TaskCompletionSource<'U> tcsOptions if f.IsCanceled then tcs.SetCanceled () elif f.IsFaulted then tcs.SetException (Unchecked.nonNull (f.AsTask().Exception)).InnerExceptions elif x.IsCanceled then tcs.SetCanceled () @@ -252,7 +276,7 @@ module ValueTask = | Faulted exn , _ -> FromExceptions exn | Canceled , _ -> canceled else - let tcs = TaskCompletionSource<'T1 * 'T2> () + let tcs = TaskCompletionSource<'T1 * 'T2> tcsOptions if task1.IsCanceled then tcs.SetCanceled () elif task1.IsFaulted then tcs.SetException (Unchecked.nonNull (task1.AsTask().Exception)).InnerExceptions elif task2.IsCanceled then tcs.SetCanceled () @@ -291,7 +315,7 @@ module ValueTask = elif source.IsFaulted then FromExceptions (Unchecked.nonNull (source.AsTask().Exception)) elif source.IsCanceled then canceled else - let tcs = TaskCompletionSource () + let tcs = TaskCompletionSource tcsOptions let k (t: ValueTask) : unit = if t.IsCanceled then tcs.SetCanceled () elif t.IsFaulted then tcs.SetException (Unchecked.nonNull (source.AsTask().Exception)).InnerExceptions @@ -303,7 +327,7 @@ module ValueTask = let inline tryWith ([]compensation: exn -> ValueTask<'T>) ([]body: unit -> ValueTask<'T>) : ValueTask<'T> = let runCompensation exn = try compensation exn - with e -> ValueTask.FromException<'T> e + with e -> raise e let unwrapException (agg: AggregateException) = if agg.InnerExceptions.Count = 1 then agg.InnerExceptions.[0] else agg :> Exception @@ -328,12 +352,12 @@ module ValueTask = try compensation () reraise () - with e -> ValueTask.FromException<'T> e + with e -> raise e if task.IsCompleted then try compensation () task - with e -> ValueTask.FromException<'T> e + with e -> raise e else task.AsTask().ContinueWith(fun (x: Task<'T>) -> Task.tryFinally compensation (fun () -> x)).Unwrap () |> ValueTask<'T> @@ -361,9 +385,40 @@ module ValueTask = /// The option if the option is Some, else the alternate option. let orElse (fallbackValueTask: ValueTask<'T>) (source: ValueTask<'T>) : ValueTask<'T> = orElseWith (fun _ -> fallbackValueTask) source - /// Creates a ValueTask that's completed unsuccessfully with the specified exception. - /// The exception to be raised. - /// A ValueTask that is completed unsuccessfully with the specified exception. - let raise<'T> (exn: exn) : ValueTask<'T> = ValueTask.FromException<'T> exn + /// Attempts to recover from a potentially failed task by mapping the exception to a successful result. + /// Mapping function from exception to result. + /// The source task. + /// A successful resulting task. + /// The result is always a successful task, unless the mapping function itself throws an exception. + let inline recover ([]mapper: exn -> 'T) (source: ValueTask<'T>) : ValueTask<'T> = + tryWith (mapper >> result) (fun () -> source) + + /// Maps the exception of a faulted task to another exception. + /// Mapping function from exception to exception. + /// The source task. + /// The resulting task. + let inline mapError ([]mapper: exn -> exn) (source: ValueTask<'T>) : ValueTask<'T> = + if source.IsCompleted then + match source with + | Faulted exn -> FromExceptions (AggregateException (mapper exn)) + | _ -> source + else + let tcs = TaskCompletionSource<'T> tcsOptions + let k = function + | Succeeded r -> tcs.SetResult r + | Faulted aex -> tcs.SetException (AggregateException (mapper aex)).InnerExceptions + | Canceled -> tcs.SetCanceled () + source.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> k source) + ValueTask<'T> tcs.Task + + /// Creates a Task from a Result value. + /// If the Result is Ok, the Task will complete successfully with the value. + /// If the Result is Error, the Task will complete unsuccessfully with the exception. + /// The source Result. + /// The resulting Task. + let ofResult (source: Result<'T, exn>) : ValueTask<'T> = + match source with + | Ok x -> result x + | Error exn -> raise exn #endif \ No newline at end of file From 20a4d8d1addd1551bd4aa7061c071e6e457928b5 Mon Sep 17 00:00:00 2001 From: gusty <1261319+gusty@users.noreply.github.com> Date: Sat, 10 Jan 2026 11:55:35 +0100 Subject: [PATCH 5/5] Adapt for release --- src/FSharpPlus/Extensions/Task.fs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Extensions/Task.fs b/src/FSharpPlus/Extensions/Task.fs index 81f96be48..98036f22a 100644 --- a/src/FSharpPlus/Extensions/Task.fs +++ b/src/FSharpPlus/Extensions/Task.fs @@ -367,7 +367,11 @@ module Task = /// Creates a task workflow from 'source' workflow, mapping and flattening its result with 'f'. let bind (f: 'T -> Task<'U>) (source: Task<'T>) : Task<'U> = + #if !NET45 let source = nullArgCheck (nameof source) source + #else + raiseIfNull "source" source + #endif source |> Unchecked.nonNull |> map f |> join @@ -479,8 +483,12 @@ module Task = /// The source task. /// A successful resulting task. /// The result is always a successful task, unless the mapping function itself throws an exception. - let inline recover ([]mapper: exn -> 'T) (source: Task<'T>) : Task<'T> = + let inline recover (mapper: exn -> 'T) (source: Task<'T>) : Task<'T> = + #if !NET45 let source = nullArgCheck (nameof source) source + #else + raiseIfNull "source" source + #endif tryWith (fun () -> source) (mapper >> result) @@ -488,8 +496,12 @@ module Task = /// Mapping function from exception to exception. /// The source task. /// The resulting task. - let inline mapError ([]mapper: exn -> exn) (source: Task<'T>) : Task<'T> = + let mapError (mapper: exn -> exn) (source: Task<'T>) : Task<'T> = + #if !NET45 let source = nullArgCheck (nameof source) source + #else + raiseIfNull "source" source + #endif if source.IsCompleted then match source with