Skip to content

Commit 66d13e4

Browse files
gustygusty
committed
+ tryWith and tryFinally for ValueTask
1 parent 46e4d7a commit 66d13e4

File tree

3 files changed

+92
-27
lines changed

3 files changed

+92
-27
lines changed

‎src/FSharpPlus/Control/Comonad.fs‎

Lines changed: 2 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -29,16 +29,12 @@ type Extract =
2929
#endif
3030
#if !FABLE_COMPILER
3131
static member Extract (f: Task<'T> ) = f.Result
32-
#endif
33-
#if !FABLE_COMPILER
34-
static member Extract (f: ValueTask<'T> ) = f.Result
32+
static member Extract (f: ValueTask<'T>) = f.Result
3533
#endif
3634
static member inline Invoke (x: '``Comonad<'T>``) : 'T =
3735
let inline call_2 (_mthd: ^M, x: ^I) = ((^M or ^I) : (static member Extract : _ -> _) x)
3836
call_2 (Unchecked.defaultof<Extract>, x)
3937

40-
#nowarn "0025" // (see nowarn comment below)
41-
4238
type Extend =
4339
static member (=>>) (g: Async<'T> , f: Async<'T> -> 'U) = async.Return (f g) : Async<'U>
4440
static member (=>>) (g: Lazy<'T> , f: Lazy<'T> -> 'U ) = Lazy<_>.Create (fun () -> f g) : Lazy<'U>
@@ -68,25 +64,7 @@ type Extend =
6864
#endif
6965

7066
#if !FABLE_COMPILER
71-
static member (=>>) (g: ValueTask<'T> , f: ValueTask<'T> -> 'U ) : ValueTask<'U> =
72-
if g.IsCompletedSuccessfully then
73-
try
74-
let r = f g
75-
ValueTask<'U> r
76-
with e -> ValueTask<'U> (Task.FromException<'U> e)
77-
else
78-
let tcs = TaskCompletionSource<'U> ()
79-
if g.IsCompleted then
80-
match g with
81-
| ValueTask.Faulted e -> tcs.SetException e
82-
| ValueTask.Canceled -> tcs.SetCanceled ()
83-
// nowarn here, this case has been handled already if g.IsCompleted
84-
else
85-
ValueTask.continueTask tcs g (fun _ ->
86-
try tcs.SetResult (f g)
87-
with e -> tcs.SetException e)
88-
tcs.Task |> ValueTask<'U>
89-
67+
static member (=>>) (g: ValueTask<'T> , f: ValueTask<'T> -> 'U ) : ValueTask<'U> = ValueTask.extend f g
9068
#endif
9169

9270
// Restricted Comonads

‎src/FSharpPlus/Control/Monad.fs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -217,6 +217,7 @@ type TryWith =
217217
static member TryWith (computation: unit -> Async<_> , catchHandler: exn -> Async<_> , _: TryWith , _) = async.TryWith ((computation ()), catchHandler)
218218
#if !FABLE_COMPILER
219219
static member TryWith (computation: unit -> Task<_> , catchHandler: exn -> Task<_> , _: TryWith, True) = Task.tryWith computation catchHandler
220+
static member TryWith (computation: unit -> ValueTask<_> , catchHandler: exn -> ValueTask<_> , _: TryWith, True) = ValueTask.tryWith catchHandler computation
220221
#endif
221222
static member TryWith (computation: unit -> Lazy<_> , catchHandler: exn -> Lazy<_> , _: TryWith , _) = lazy (try (computation ()).Force () with e -> (catchHandler e).Force ()) : Lazy<_>
222223

@@ -245,7 +246,8 @@ type TryFinally =
245246
static member TryFinally ((computation: unit -> Id<_> , compensation: unit -> unit), _: TryFinally, _, _) = try computation () finally compensation ()
246247
static member TryFinally ((computation: unit -> Async<_>, compensation: unit -> unit), _: TryFinally, _, _) = async.TryFinally (computation (), compensation) : Async<_>
247248
#if !FABLE_COMPILER
248-
static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinally, _, True) = Task.tryFinally computation compensation : Task<_>
249+
static member TryFinally ((computation: unit -> Task<_> , compensation: unit -> unit), _: TryFinally, _, True) = Task.tryFinally computation compensation : Task<_>
250+
static member TryFinally ((computation: unit -> ValueTask<_>, compensation: unit -> unit), _: TryFinally, _, True) = ValueTask.tryFinally compensation computation : ValueTask<_>
249251
#endif
250252
static member TryFinally ((computation: unit -> Lazy<_> , compensation: unit -> unit), _: TryFinally, _, _) = lazy (try (computation ()).Force () finally compensation ()) : Lazy<_>
251253

@@ -281,7 +283,8 @@ type Using =
281283
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
282284
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Async<'U>, _: Using ) = async.Using (resource, body)
283285
#if !FABLE_COMPILER
284-
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Task<'U>, _: Using ) = Task.using resource body
286+
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> Task<'U> , _: Using) = Task.using resource body
287+
static member Using (resource: 'T when 'T :> IDisposable, body: 'T -> ValueTask<'U>, _: Using) = ValueTask.using resource body
285288
#endif
286289
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>
287290

‎src/FSharpPlus/Extensions/ValueTask.fs‎

Lines changed: 85 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
namespace FSharpPlus
22

3+
#nowarn "0025" // (see nowarn comment below)
34
#if !FABLE_COMPILER
45

56
/// Additional operations on ValueTask<'T>
@@ -28,6 +29,26 @@ module ValueTask =
2829
if x.IsCompleted then f x
2930
else x.ConfigureAwait(false).GetAwaiter().UnsafeOnCompleted (fun () -> f x)
3031

32+
let inline extend (f: ValueTask<'T> -> 'U) (g: ValueTask<'T>) : ValueTask<'U> =
33+
if g.IsCompletedSuccessfully then
34+
try
35+
let r = f g
36+
ValueTask<'U> r
37+
with e -> ValueTask<'U> (Task.FromException<'U> e)
38+
else
39+
let tcs = TaskCompletionSource<'U> ()
40+
if g.IsCompleted then
41+
match g with
42+
| Faulted e -> tcs.SetException e
43+
| Canceled -> tcs.SetCanceled ()
44+
// nowarn here, this case has been handled already by if g.IsCompleted
45+
else
46+
continueTask tcs g (fun _ ->
47+
try tcs.SetResult (f g)
48+
with e -> tcs.SetException e)
49+
tcs.Task |> ValueTask<'U>
50+
51+
3152
/// Creates a ValueTask from a value
3253
let result (value: 'T) : ValueTask<'T> =
3354
#if NET5_0_OR_GREATER
@@ -233,8 +254,71 @@ module ValueTask =
233254
else
234255
new ValueTask (source.AsTask ())
235256

257+
/// Used to de-sugar try .. with .. blocks in Computation Expressions.
258+
let rec tryWith (compensation: exn -> ValueTask<'T>) (body: unit -> ValueTask<'T>) : ValueTask<'T> =
259+
let unwrapException (agg: AggregateException) =
260+
if agg.InnerExceptions.Count = 1 then agg.InnerExceptions.[0]
261+
else agg :> Exception
262+
try
263+
let task = body ()
264+
let f = function
265+
| Succeeded _ -> task
266+
| Faulted e -> extend (fun (_: ValueTask<'T>) -> compensation (unwrapException e)) task |> join
267+
| Canceled -> task
268+
269+
if task.IsCompleted then f task
270+
else extend (fun (x: ValueTask<'T>) -> tryWith compensation (fun () -> x)) task |> join
271+
with
272+
| :? AggregateException as exn -> compensation (unwrapException exn)
273+
| exn -> compensation exn
274+
275+
/// Used to de-sugar try .. finally .. blocks in Computation Expressions.
276+
let tryFinally (compensation : unit -> unit) (body: unit -> ValueTask<'T>) : ValueTask<'T> =
277+
let mutable ran = false
278+
let compensation () =
279+
if not ran then
280+
compensation ()
281+
ran <- true
282+
try
283+
let task = body ()
284+
let rec loop (task: ValueTask<'T>) (compensation : unit -> unit) =
285+
let f = function
286+
| Succeeded _ -> compensation (); task
287+
| Faulted _ -> extend (fun (x: ValueTask<'T>) -> compensation (); x) task |> join
288+
| Canceled -> task
289+
if task.IsCompleted then f task
290+
else extend (fun (x: ValueTask<'T>) -> (loop x compensation: ValueTask<_>)) task |> join
291+
loop task compensation
292+
with _ ->
293+
compensation ()
294+
reraise ()
295+
296+
/// Used to de-sugar use .. blocks in Computation Expressions.
297+
let using (disp: 'T when 'T :> IDisposable) (body: 'T -> ValueTask<'U>) =
298+
tryFinally
299+
(fun () -> if not (isNull (box disp)) then disp.Dispose ())
300+
(fun () -> body disp)
301+
302+
/// <summary>Returns <paramref name="source"/> if it is not faulted, otherwise evaluates <paramref name="fallbackThunk"/> and returns the result.</summary>
303+
///
304+
/// <param name="fallbackThunk">A thunk that provides an alternate task computation when evaluated.</param>
305+
/// <param name="source">The input task.</param>
306+
///
307+
/// <returns>The task if it is not faulted, else the result of evaluating <paramref name="fallbackThunk"/>.</returns>
308+
/// <remarks><paramref name="fallbackThunk"/> is not evaluated unless <paramref name="source"/> is faulted.</remarks>
309+
///
310+
let orElseWith (fallbackThunk: exn -> ValueTask<'T>) (source: ValueTask<'T>) : ValueTask<'T> = tryWith fallbackThunk (fun () -> source)
311+
312+
/// <summary>Returns <paramref name="source"/> if it is not faulted, otherwise e<paramref name="fallbackValueTask"/>.</summary>
313+
///
314+
/// <param name="fallbackValueTask">The alternative ValueTask to use if <paramref name="source"/> is faulted.</param>
315+
/// <param name="source">The input task.</param>
316+
///
317+
/// <returns>The option if the option is Some, else the alternate option.</returns>
318+
let orElse (fallbackValueTask: ValueTask<'T>) (source: ValueTask<'T>) : ValueTask<'T> = orElseWith (fun _ -> fallbackValueTask) source
319+
236320

237321
/// Raises an exception in the ValueTask
238-
let raise (``exception``: exn) = ValueTask<'TResult> (Task.FromException<'TResult> ``exception``)
322+
let raise<'TResult> (``exception``: exn) = ValueTask<'TResult> (Task.FromException<'TResult> ``exception``)
239323

240324
#endif

0 commit comments

Comments
 (0)