diff --git a/src/FSharpPlus/Control/Comonad.fs b/src/FSharpPlus/Control/Comonad.fs index 1b92d19c3..3466edb4a 100644 --- a/src/FSharpPlus/Control/Comonad.fs +++ b/src/FSharpPlus/Control/Comonad.fs @@ -16,7 +16,7 @@ type Extract = #if FABLE_COMPILER 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,8 @@ type Extract = static member inline Extract (f: 'Monoid -> 'T) = f (LanguagePrimitives.GenericZero) #endif #if !FABLE_COMPILER - static member Extract (f: Task<'T> ) = f.Result - #endif - #if !FABLE_COMPILER - static member Extract (f: ValueTask<'T> ) = f.Result + static member Extract (f: Task<'T> ) = f.GetAwaiter().GetResult () + 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 +80,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 83409e559..81a038a61 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 } #endif diff --git a/src/FSharpPlus/Extensions/Task.fs b/src/FSharpPlus/Extensions/Task.fs index 5bb72053f..60c9f1d17 100644 --- a/src/FSharpPlus/Extensions/Task.fs +++ b/src/FSharpPlus/Extensions/Task.fs @@ -13,139 +13,121 @@ 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.IsCompletedSuccessfully then Succeeded t.Result - elif t.IsFaulted then Faulted (Unchecked.nonNull (t.Exception)) + elif t.IsFaulted then Faulted (Unchecked.nonNull t.Exception) elif t.IsCanceled then Canceled 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> = let source = nullArgCheck (nameof source) source - 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> = - let x = nullArgCheck (nameof x) x - let y = nullArgCheck (nameof y) y - - 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 + /// The mapping function. + /// First task workflow. + /// Second task workflow. + let lift2 (mapper: 'T1 -> 'T2 -> 'U) (task1: Task<'T1>) (task2: Task<'T2>) : Task<'U> = + let task1 = nullArgCheck (nameof task1) task1 + let task2 = nullArgCheck (nameof task2) task2 + + 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> = - let x = nullArgCheck (nameof x) x - let y = nullArgCheck (nameof y) y - let z = nullArgCheck (nameof z) z - - 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 + /// 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> = + let task1 = nullArgCheck (nameof task1) task1 + let task2 = nullArgCheck (nameof task2) task2 + let task3 = nullArgCheck (nameof task3) task3 + + 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. @@ -160,42 +142,38 @@ module Task = let task2 = nullArgCheck (nameof task2) task2 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 @@ -211,60 +189,58 @@ module Task = let task3 = nullArgCheck (nameof task3) task3 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 + try result (mapper task1.Result task2.Result task3.Result) + with e -> Task.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 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 - 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> = let f = nullArgCheck (nameof f) f let x = nullArgCheck (nameof x) x - 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 @@ -272,74 +248,33 @@ 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> = - let x = nullArgCheck (nameof x) x - let y = nullArgCheck (nameof y) y + /// Creates a task workflow from two workflows 'task1' and 'task2', tupling its results. + let zipSequentially (task1: Task<'T1>) (task2: Task<'T2>) : Task<'T1 * 'T2> = + let task1 = nullArgCheck (nameof task1) task1 + let task2 = nullArgCheck (nameof task2) task2 - 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. @@ -358,66 +293,48 @@ module Task = let join (source: Task>) : Task<'T> = let source = nullArgCheck (nameof source) source - 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 task = nullArgCheck (nameof task) task + let ignore (source: Task) = + let source = nullArgCheck (nameof source) source - 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>) = @@ -435,6 +352,7 @@ module Task = /// let inline orElseWith ([]fallbackThunk: exn -> Task<'T>) (source: Task<'T>) : Task<'T> = let source = nullArgCheck (nameof source) source + tryWith (fun () -> source) fallbackThunk /// Returns if it is not faulted, otherwise e. @@ -445,17 +363,14 @@ module Task = /// The option if the option is Some, else the alternate option. let orElse (fallbackTask: Task<'T>) (source: Task<'T>) : Task<'T> = let fallbackTask = nullArgCheck (nameof fallbackTask) fallbackTask - let source = nullArgCheck (nameof source) source - orElseWith (fun _ -> fallbackTask) source + let source = nullArgCheck (nameof source) source - /// Creates a Task from a value - let result (value: 'T) = Task.FromResult value + orElseWith (fun _ -> fallbackTask) source - /// 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. @@ -469,12 +384,13 @@ module Task_v2 = /// The body function to run. /// The resulting task. /// This function is used to de-sugar try .. with .. blocks in Computation Expressions. - 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 /// Runs a compensation function after the body completes, regardless of whether the body completed successfully, faulted, or was canceled. /// The compensation function to run after the body completes. /// The body function to run. /// The resulting task. /// This function is used to de-sugar try .. finally .. blocks in Computation Expressions. - 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 diff --git a/src/FSharpPlus/Extensions/ValueTask.fs b/src/FSharpPlus/Extensions/ValueTask.fs index 97fe52d6f..3aad65741 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 9b831e052..7212ea5d3 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 86dc238b5..a39e2e96a 100644 --- a/tests/FSharpPlus.Tests/ValueTask.fs +++ b/tests/FSharpPlus.Tests/ValueTask.fs @@ -10,6 +10,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 []> @@ -50,11 +55,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 @@ -203,6 +203,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 @@ -260,7 +320,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" @@ -632,7 +692,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 @@ -657,7 +717,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 @@ -887,47 +947,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.