Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions src/FSharpPlus/Control/Monad.fs
Original file line number Diff line number Diff line change
Expand Up @@ -217,6 +217,7 @@ type TryWith =
static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWith , _) = async.TryWith ((computation ()), catchHandler)
#if !FABLE_COMPILER
static member TryWith (computation: unit -> Task<_> , catchHandler: exn -> Task<_> , _: TryWith, True) = Task.tryWith computation catchHandler
static member TryWith (computation: unit -> ValueTask<_> , catchHandler: exn -> ValueTask<_> , _: TryWith, True) = ValueTask.tryWith catchHandler computation
#endif
static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWith , _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_>

Expand Down Expand Up @@ -245,7 +246,8 @@ type TryFinally =
static member TryFinally ((computation: unit -> Id<_> , compensation: unit -> unit), _: TryFinally, _, _) = try computation () finally compensation ()
static member TryFinally ((computation: unit -> Async<_>, compensation: unit -> unit), _: TryFinally, _, _) = async.TryFinally (computation (), compensation) : Async<_>
#if !FABLE_COMPILER
static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinally, _, True) = Task.tryFinally computation compensation : Task<_>
static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinally, _, True) = Task.tryFinally computation compensation : Task<_>
static member TryFinally ((computation: unit -> ValueTask<_>, compensation: unit -> unit), _: TryFinally, _, True) = ValueTask.tryFinally compensation computation : ValueTask<_>
#endif
static member TryFinally ((computation: unit -> Lazy<_> , compensation: unit -> unit), _: TryFinally, _, _) = lazy (try (computation ()).Force () finally compensation ()) : Lazy<_>

Expand Down Expand Up @@ -281,7 +283,8 @@ type Using =
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> 'R -> 'U , _: Using ) = (fun s -> try body resource s finally if not (isNull (box resource)) then resource.Dispose ()) : 'R->'U
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Async<'U>, _: Using ) = async.Using (resource, body)
#if !FABLE_COMPILER
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Task<'U>, _: Using ) = Task.using resource body
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Task<'U> , _: Using) = Task.using resource body
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> ValueTask<'U>, _: Using) = ValueTask.using resource body
#endif
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Lazy<'U> , _: Using ) = lazy (try (body resource).Force () finally if not (isNull (box resource)) then resource.Dispose ()) : Lazy<'U>

Expand Down
69 changes: 47 additions & 22 deletions src/FSharpPlus/Extensions/Task.fs
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,12 @@ module Task =
open System.Threading.Tasks
open FSharpPlus.Internals.Errors

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
/// Active pattern to match the state of a completed Task
let inline private (|Succeeded|Canceled|Faulted|) (t: Task<'a>) =
if t.IsCompletedSuccessfully then Succeeded t.Result
elif t.IsFaulted then Faulted (Unchecked.nonNull (t.Exception))
elif t.IsCanceled then Canceled
else invalidOp "Internal error: The task is not yet completed."

/// <summary>Creates a task workflow from 'source' another, mapping its result with 'f'.</summary>
let map (f: 'T -> 'U) (source: Task<'T>) : Task<'U> =
Expand All @@ -38,7 +40,7 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r ->
| Succeeded r ->
try tcs.SetResult (f r)
with e -> tcs.SetException e
source.ContinueWith k |> ignore
Expand Down Expand Up @@ -70,15 +72,15 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r ->
| 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
| Completed r ->
| Succeeded r ->
try tcs.SetResult (f r y.Result)
with e -> tcs.SetException e
x.ContinueWith k |> ignore
Expand All @@ -87,12 +89,12 @@ module Task =
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r ->
| Succeeded r ->
y.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r' ->
| Succeeded r' ->
try tcs.SetResult (f r r')
with e -> tcs.SetException e
) |> ignore) |> ignore
Expand Down Expand Up @@ -129,17 +131,17 @@ module Task =
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r ->
| Succeeded r ->
y.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r' ->
| Succeeded r' ->
z.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r'' ->
| Succeeded r'' ->
try tcs.SetResult (f r r' r'')
with e -> tcs.SetException e
) |> ignore) |> ignore) |> ignore
Expand Down Expand Up @@ -183,7 +185,7 @@ module Task =
match t with
| Canceled -> cancelled <- true
| Faulted e -> failures[i] <- e.InnerExceptions
| Completed r -> v.Value <- r
| Succeeded r -> v.Value <- r
trySet ()

if task1.IsCompleted && task2.IsCompleted then
Expand Down Expand Up @@ -235,7 +237,7 @@ module Task =
match t with
| Canceled -> cancelled <- true
| Faulted e -> failures[i] <- e.InnerExceptions
| Completed r -> v.Value <- r
| Succeeded r -> v.Value <- r
trySet ()

if task1.IsCompleted && task2.IsCompleted && task3.IsCompleted then
Expand Down Expand Up @@ -273,15 +275,15 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r ->
| 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
| Completed r ->
| Succeeded r ->
try tcs.SetResult (r x.Result)
with e -> tcs.SetException e
f.ContinueWith k |> ignore
Expand All @@ -290,12 +292,12 @@ module Task =
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r ->
| Succeeded r ->
x.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r' ->
| Succeeded r' ->
try tcs.SetResult (r r')
with e -> tcs.SetException e
) |> ignore) |> ignore
Expand All @@ -319,24 +321,24 @@ module Task =
let k = function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r -> tcs.SetResult (x.Result, r)
| 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
| Completed r -> tcs.SetResult (r, y.Result)
| Succeeded r -> tcs.SetResult (r, y.Result)
x.ContinueWith k |> ignore
| _, _ ->
x.ContinueWith (
function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r ->
| Succeeded r ->
y.ContinueWith (function
| Canceled -> tcs.SetCanceled ()
| Faulted e -> tcs.SetException e.InnerExceptions
| Completed r' -> tcs.SetResult (r, r')) |> ignore) |> ignore
| Succeeded r' -> tcs.SetResult (r, r')) |> ignore) |> ignore
tcs.Task

/// <summary>Creates a task workflow from two workflows 'task1' and 'task2', tupling its results.</summary>
Expand Down Expand Up @@ -422,6 +424,29 @@ module Task =
(fun () -> body disp)
(fun () -> if not (isNull (box disp)) then disp.Dispose ())

/// <summary>Returns <paramref name="source"/> if it is not faulted, otherwise evaluates <paramref name="fallbackThunk"/> and returns the result.</summary>
///
/// <param name="fallbackThunk">A thunk that provides an alternate task computation when evaluated.</param>
/// <param name="source">The input task.</param>
///
/// <returns>The task if it is not faulted, else the result of evaluating <paramref name="fallbackThunk"/>.</returns>
/// <remarks><paramref name="fallbackThunk"/> is not evaluated unless <paramref name="source"/> is faulted.</remarks>
///
let inline orElseWith ([<InlineIfLambda>]fallbackThunk: exn -> Task<'T>) (source: Task<'T>) : Task<'T> =
let source = nullArgCheck (nameof source) source
tryWith (fun () -> source) fallbackThunk

/// <summary>Returns <paramref name="source"/> if it is not faulted, otherwise e<paramref name="fallbackTask"/>.</summary>
///
/// <param name="fallbackTask">The alternative Task to use if <paramref name="source"/> is faulted.</param>
/// <param name="source">The input task.</param>
///
/// <returns>The option if the option is Some, else the alternate option.</returns>
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

/// Creates a Task from a value
let result (value: 'T) = Task.FromResult value

Expand Down
73 changes: 72 additions & 1 deletion src/FSharpPlus/Extensions/ValueTask.fs
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,12 @@ module ValueTask =
open System.Threading.Tasks
open FSharpPlus.Internals.Errors

/// Active pattern to match the state of a completed ValueTask
let inline (|Succeeded|Canceled|Faulted|) (t: ValueTask<'T>) =
if t.IsCompletedSuccessfully then Succeeded t.Result
elif t.IsFaulted then Faulted (Unchecked.nonNull (t.AsTask().Exception))
elif t.IsCanceled then Canceled
else Faulted (t.AsTask().Exception |> Unchecked.nonNull)
else invalidOp "Internal error: The task is not yet completed."

let inline continueTask (tcs: TaskCompletionSource<'Result>) (x: ValueTask<'t>) (k: 't -> unit) =
let f = function
Expand Down Expand Up @@ -241,6 +243,75 @@ module ValueTask =
else source.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> k source)
tcs.Task |> ValueTask<unit>

/// Used to de-sugar try .. with .. blocks in Computation Expressions.
let inline tryWith ([<InlineIfLambda>]compensation: exn -> ValueTask<'T>) ([<InlineIfLambda>]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

/// Used to de-sugar try .. finally .. blocks in Computation Expressions.
let inline tryFinally ([<InlineIfLambda>]compensation : unit -> unit) ([<InlineIfLambda>]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 ()

/// Used to de-sugar use .. blocks in Computation Expressions.
let inline using (disp: 'T when 'T :> IDisposable) ([<InlineIfLambda>]body: 'T -> ValueTask<'U>) =
tryFinally
(fun () -> if not (isNull (box disp)) then disp.Dispose ())
(fun () -> body disp)

/// <summary>Returns <paramref name="source"/> if it is not faulted, otherwise evaluates <paramref name="fallbackThunk"/> and returns the result.</summary>
///
/// <param name="fallbackThunk">A thunk that provides an alternate task computation when evaluated.</param>
/// <param name="source">The input task.</param>
///
/// <returns>The task if it is not faulted, else the result of evaluating <paramref name="fallbackThunk"/>.</returns>
/// <remarks><paramref name="fallbackThunk"/> is not evaluated unless <paramref name="source"/> is faulted.</remarks>
///
let inline orElseWith ([<InlineIfLambda>]fallbackThunk: exn -> ValueTask<'T>) (source: ValueTask<'T>) : ValueTask<'T> = tryWith fallbackThunk (fun () -> source)

/// <summary>Returns <paramref name="source"/> if it is not faulted, otherwise e<paramref name="fallbackValueTask"/>.</summary>
///
/// <param name="fallbackValueTask">The alternative ValueTask to use if <paramref name="source"/> is faulted.</param>
/// <param name="source">The input task.</param>
///
/// <returns>The option if the option is Some, else the alternate option.</returns>
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``)
Expand Down
Loading
Loading