From 8354d18bfcfc7c1ba76e55e3e0b500edcf85471c Mon Sep 17 00:00:00 2001 From: Matthew Watt Date: Sat, 24 May 2025 11:09:53 -0500 Subject: [PATCH] Add CancellableTaskOption module and CE + tests and documentation --- gitbook/SUMMARY.md | 9 + gitbook/cancellableTaskOption/apply.md | 48 + gitbook/cancellableTaskOption/bind.md | 65 + gitbook/cancellableTaskOption/ce.md | 26 + gitbook/cancellableTaskOption/either.md | 33 + gitbook/cancellableTaskOption/map.md | 30 + gitbook/cancellableTaskOption/others.md | 33 + gitbook/cancellableTaskOption/zip.md | 33 + gitbook/taskOption/ce.md | 4 +- .../CancellableTaskOptionBuilderBase.fs | 1157 +++++++++++++++++ .../CancellableTaskOptionCE.fs | 418 ++++++ .../FsToolkit.ErrorHandling.IcedTasks.fsproj | 2 + .../CancellableTaskOptionCE.fs | 1040 +++++++++++++++ ...olkit.ErrorHandling.IcedTasks.Tests.fsproj | 1 + 14 files changed, 2897 insertions(+), 2 deletions(-) create mode 100644 gitbook/cancellableTaskOption/apply.md create mode 100644 gitbook/cancellableTaskOption/bind.md create mode 100644 gitbook/cancellableTaskOption/ce.md create mode 100644 gitbook/cancellableTaskOption/either.md create mode 100644 gitbook/cancellableTaskOption/map.md create mode 100644 gitbook/cancellableTaskOption/others.md create mode 100644 gitbook/cancellableTaskOption/zip.md create mode 100644 src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskOptionBuilderBase.fs create mode 100644 src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskOptionCE.fs create mode 100644 tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskOptionCE.fs diff --git a/gitbook/SUMMARY.md b/gitbook/SUMMARY.md index be7010a4..8dec8899 100644 --- a/gitbook/SUMMARY.md +++ b/gitbook/SUMMARY.md @@ -254,6 +254,15 @@ * [Computation Expression](pr.md) * FsToolkit.ErrorHandling.IcedTasks + * CancellableTaskOption + * [apply](cancellableTaskOption/apply.md) + * [bind](cancellableTaskOption/bind.md) + * [Computation Expression](cancellableTaskOption/ce.md) + * [either](cancellableTaskOption/either.md) + * [map](cancellableTaskOption/map.md) + * [Other Functions](cancellableTaskOption/others.md) + * [zip](cancellableTaskOption/zip.md) + * [CancellableTaskResult](cancellableTaskResult/index.md) * [apply](cancellableTaskResult/apply.md) * [bind](cancellableTaskResult/bind.md) diff --git a/gitbook/cancellableTaskOption/apply.md b/gitbook/cancellableTaskOption/apply.md new file mode 100644 index 00000000..05d8ca86 --- /dev/null +++ b/gitbook/cancellableTaskOption/apply.md @@ -0,0 +1,48 @@ +# CancellableTaskOption.apply + +Namespace: `FsToolkit.ErrorHandling` + +Function Signature: + +```fsharp +CancellableTask<('a -> 'b) option> -> CancellableTask<'a option> -> CancellableTask<'b option> +``` + +## Examples + +Take the following function for example + +```fsharp +// string -> int +let characterCount (s: string) = s.Length +``` + +### Example 1 + +```fsharp +let result = + CancellableTaskOption.some "foo" // CancellableTask + |> CancellableTaskOption.apply (CancellableTaskOption.some characterCount) // CancellableTask + +// cancellableTask { Some 3 } +``` + +### Example 2 + +```fsharp +let result = + CancellableTask.singleton None // CancellableTask + |> CancellableTaskOption.apply (CancellableTaskOption.some characterCount) // CancellableTask + +// cancellableTask { None } +``` + +### Example 3 + +```fsharp +let result : CancellableTask = + CancellableTaskOption.some "foo" // CancellableTask + |> CancellableTaskOption.apply (CancellableTask.singleton None) // CancellableTask + +// cancellableTask { None } +``` diff --git a/gitbook/cancellableTaskOption/bind.md b/gitbook/cancellableTaskOption/bind.md new file mode 100644 index 00000000..69d71c46 --- /dev/null +++ b/gitbook/cancellableTaskOption/bind.md @@ -0,0 +1,65 @@ +# CancellableTaskOption.bind + +Namespace: `FsToolkit.ErrorHandling` + +## Function Signature + +```fsharp +('input -> CancellableTask<'output option>) -> CancellableTask<'input option> -> CancellableTask<'output option> +``` + +## Examples + +Take the following function for example + +```fsharp +type Account = + { EmailAddress : string + Name : string } + +// string -> CancellableTask +let lookupAccountByEmail email = cancellableTask { + let john = { EmailAddress = "john@test.com"; Name = "John Johnson" } + let jeff = { EmailAddress = "jeff@test.com"; Name = "Jeff Jefferson" } + let jack = { EmailAddress = "jack@test.com"; Name = "Jack Jackson" } + + // Just a map lookup, but imagine we look up an account in our database + let accounts = Map.ofList [ + ("john@test.com", john) + ("jeff@test.com", jeff) + ("jack@test.com", jack) + ] + + return Map.tryFind email accounts +} +``` + +### Example 1 + +```fsharp +let taskOpt : CancellableTask = + CancellableTaskOption.some "john@test.com" // CancellableTask + |> CancellableTaskOption.bind lookupAccountByEmail // CancellableTask + +// cancellableTask { Some { EmailAddress = "john@test.com"; Name = "John Johnson" } } +``` + +### Example 2 + +```fsharp +let taskOpt : CancellableTask = + CancellableTaskOption.some "jerry@test.com" // CancellableTask + |> CancellableTaskOption.bind lookupAccountByEmail // CancellableTask + +// cancellableTask { None } +``` + +### Example 3 + +```fsharp +let taskOpt : CancellableTask = + CancellableTask.singleton None // CancellableTask + |> CancellableTaskOption.bind lookupAccountByEmail // CancellableTask + +// cancellableTask { None } +``` diff --git a/gitbook/cancellableTaskOption/ce.md b/gitbook/cancellableTaskOption/ce.md new file mode 100644 index 00000000..a525ea22 --- /dev/null +++ b/gitbook/cancellableTaskOption/ce.md @@ -0,0 +1,26 @@ +## CancellableTaskOption Computation Expression + +Namespace: `FsToolkit.ErrorHandling` + +## Examples: + +### Example 1 + +Given a personId and an age, find a person and update their age. + +```fsharp +tryParseInt : string -> Option +tryFindPersonById : int -> CancellableTask +updatePerson : Person -> CancellableTask +``` + +```fsharp +// CancellableTask +let addResult = cancellableTaskOption { + let! personId = tryParseInt "3001" + let! age = tryParseInt "35" + let! person = tryFindPersonById personId + let person = { person with Age = age } + do! updatePerson person +} +``` diff --git a/gitbook/cancellableTaskOption/either.md b/gitbook/cancellableTaskOption/either.md new file mode 100644 index 00000000..0fafe1b3 --- /dev/null +++ b/gitbook/cancellableTaskOption/either.md @@ -0,0 +1,33 @@ +# CancellableTaskOption.either + +Namespace: `FsToolkit.ErrorHandling` + +## Function Signature + +Provide two functions to execute depending on the value of the option. If the option is `Some`, the first function will be executed. If the option is `None`, the second function will be executed. + +```fsharp +(onSome : 'T -> CancellableTask<'output>) + -> (onNone : CancellableTask<'output>) + -> (input : CancellableTask<'T option>) + -> CancellableTask<'output> +``` + +## Examples + +### Example 1 + +```fsharp +CancellableTaskOption.either (fun x -> cancellableTask { x * 2 }) (cancellableTask { 0 }) (CancellableTaskOption.some 5) + +// cancellableTask { 10 } +``` + +### Example 2 + +```fsharp +CancellableTaskOption.either (fun x -> x * 2) (cancellableTask { 0 }) None + +// cancellableTask { 0 } +``` + diff --git a/gitbook/cancellableTaskOption/map.md b/gitbook/cancellableTaskOption/map.md new file mode 100644 index 00000000..5a30adcd --- /dev/null +++ b/gitbook/cancellableTaskOption/map.md @@ -0,0 +1,30 @@ +# CancellableTaskOption.map + +Namespace: `FsToolkit.ErrorHandling` + +Apply a function to the value of a cancellable task option if it is `Some`. If the option is `None`, return `None`. + +## Function Signature + +```fsharp +('input -> 'output) -> CancellableTask<'input option> -> CancellableTask<'output option> +``` + +## Examples + +### Example 1 + +```fsharp +CancellableTaskOption.map (fun x -> x + 1) (CancellableTaskOption.some 1) + +// cancellableTask { Some 2 } +``` + +### Example 2 + +```fsharp +CancellableTaskOption.map (fun x -> x + 1) (CancellableTask.singleton None) + +// cancellableTask { None } +``` + diff --git a/gitbook/cancellableTaskOption/others.md b/gitbook/cancellableTaskOption/others.md new file mode 100644 index 00000000..50f5034c --- /dev/null +++ b/gitbook/cancellableTaskOption/others.md @@ -0,0 +1,33 @@ +# Other CancellableTaskOption Functions + +## defaultValue + +Returns the contained value if Some, otherwise returns the provided value + +### Function Signature + +```fsharp +'a -> CancellableTask<'a option> -> CancellableTask<'a> +``` + +## defaultWith + +Returns the contained value if Some, otherwise evaluates the given function and returns the result. + +### Function Signature + +```fsharp +(unit -> 'a) -> CancellableTask<'a option> -> CancellableTask<'a> +``` + +## some + +Wraps the provided value in an CancellableTask<'a option> + +### Function Signature + +```fsharp +'a -> CancellableTask<'a option> +``` + + diff --git a/gitbook/cancellableTaskOption/zip.md b/gitbook/cancellableTaskOption/zip.md new file mode 100644 index 00000000..951cf712 --- /dev/null +++ b/gitbook/cancellableTaskOption/zip.md @@ -0,0 +1,33 @@ +# CancellableTaskOption.zip + +Namespace: `FsToolkit.ErrorHandling` + +Takes two options and returns a tuple of the pair or None if either are None + +## Function Signature + +```fsharp +CancellableTask<'left option> -> CancellableTask<'right option> -> CancellableTask<('left * 'right) option> +``` + +## Examples + +### Example 1 + +```fsharp +let left = CancellableTaskOption.some 123 +let right = CancellableTaskOption.some "abc" + +CancellableTaskOption.zip left right +// cancellableTask { Some (123, "abc") } +``` + +### Example 2 + +```fsharp +let left = CancellableTaskOption.some 123 +let right = CancellableTaskOption.singleton None + +CancellableTaskOption.zip left right +// cancellableTask { None } +``` diff --git a/gitbook/taskOption/ce.md b/gitbook/taskOption/ce.md index a832e900..531532c3 100644 --- a/gitbook/taskOption/ce.md +++ b/gitbook/taskOption/ce.md @@ -19,8 +19,8 @@ updatePerson : Person -> Task let addResult = taskOption { let! personId = tryParseInt "3001" let! age = tryParseInt "35" - let! person = tryFindPersonById personId "US-OH" + let! person = tryFindPersonById personId let person = { person with Age = age } do! updatePerson person } -``` \ No newline at end of file +``` diff --git a/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskOptionBuilderBase.fs b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskOptionBuilderBase.fs new file mode 100644 index 00000000..72482903 --- /dev/null +++ b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskOptionBuilderBase.fs @@ -0,0 +1,1157 @@ +namespace FsToolkit.ErrorHandling + +open System.Diagnostics + + +/// Contains methods to build Tasks using the F# computation expression syntax +[] +module CancellableTaskOptionBuilderBase = + open System + open System.Runtime.CompilerServices + open System.Threading + open System.Threading.Tasks + open Microsoft.FSharp.Core + open Microsoft.FSharp.Core.CompilerServices + open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers + open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators + open Microsoft.FSharp.Collections + open System.Collections.Generic + open IcedTasks + + + /// CancellationToken -> Task> + type CancellableTaskOption<'T> = CancellableTask> + + + /// The extra data stored in ResumableStateMachine for tasks + [] + type CancellableTaskOptionBuilderBaseStateMachineData<'T> = + [] + val mutable CancellationToken: CancellationToken + + [] + val mutable Result: 'T option voption + + [] + val mutable MethodBuilder: AsyncTaskOptionMethodBuilder<'T> + + member inline this.IsResultNone = + match this.Result with + | ValueNone -> false + | ValueSome(None) -> true + | ValueSome _ -> false + + member inline this.SetResult() = + match this.Result with + | ValueNone -> this.MethodBuilder.SetResult None + | ValueSome x -> this.MethodBuilder.SetResult x + + /// Throws a if this token has had cancellation requested. + /// The token has had cancellation requested. + /// The associated has been disposed. + member inline this.ThrowIfCancellationRequested() = + this.CancellationToken.ThrowIfCancellationRequested() + + and AsyncTaskOptionMethodBuilder<'TOverall> = AsyncTaskMethodBuilder<'TOverall option> + + /// This is used by the compiler as a template for creating state machine structs + and CancellableTaskOptionBuilderBaseStateMachine<'TOverall> = + ResumableStateMachine> + + /// Represents the runtime continuation of a cancellableTasks state machine created dynamically + and CancellableTaskOptionBuilderBaseResumptionFunc<'TOverall> = + ResumptionFunc> + + /// Represents the runtime continuation of a cancellableTasks state machine created dynamically + and CancellableTaskOptionBuilderBaseResumptionDynamicInfo<'TOverall> = + ResumptionDynamicInfo> + + /// A special compiler-recognised delegate type for specifying blocks of cancellableTasks code with access to the state machine + and CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> = + ResumableCode, 'T> + + /// + /// Contains methods to build TaskLikes using the F# computation expression syntax + /// + type CancellableTaskOptionBuilderBase() = + /// Creates a CancellableTasks that runs generator + /// The function to run + /// A CancellableTasks that runs generator + member inline _.Delay + ([] generator: + unit -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'T>) + : CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> = + ResumableCode.Delay(fun () -> generator ()) + + /// Creates A CancellableTasks that just returns (). + /// + /// The existence of this method permits the use of empty else branches in the + /// cancellableTasks { ... } computation expression syntax. + /// + /// A CancellableTasks that returns (). + [] + member inline _.Zero() : CancellableTaskOptionBuilderBaseCode<'TOverall, unit> = + CancellableTaskOptionBuilderBaseCode<_, _>(fun sm -> + sm.Data.Result <- ValueSome(Some Unchecked.defaultof<'TOverall>) + true + ) + + /// Creates A Computation that returns the result v. + /// + /// A cancellation check is performed when the computation is executed. + /// + /// The existence of this method permits the use of return in the + /// cancellableTasks { ... } computation expression syntax. + /// + /// The value to return from the computation. + /// + /// A cancellableTasks that returns value when executed. + member inline _.Return(value: 'T) : CancellableTaskOptionBuilderBaseCode<'T, 'T> = + CancellableTaskOptionBuilderBaseCode<'T, 'T>(fun sm -> + sm.Data.Result <- ValueSome(Some value) + true + ) + + /// Creates a CancellableTasks that first runs task1 + /// and then runs computation2, returning the result of computation2. + /// + /// + /// + /// The existence of this method permits the use of expression sequencing in the + /// cancellableTasks { ... } computation expression syntax. + /// + /// The first part of the sequenced computation. + /// The second part of the sequenced computation. + /// + /// A CancellableTasks that runs both of the computations sequentially. + member inline _.Combine + ( + task1: CancellableTaskOptionBuilderBaseCode<'TOverall, unit>, + task2: CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> + ) : CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> = + ResumableCode.Combine( + task1, + CancellableTaskOptionBuilderBaseCode<'TOverall, 'T>(fun sm -> + if sm.Data.IsResultNone then true else task2.Invoke(&sm) + ) + ) + + /// Creates A CancellableTasks that runs computation repeatedly + /// until guard() becomes false. + /// + /// + /// + /// The existence of this method permits the use of while in the + /// cancellableTasks { ... } computation expression syntax. + /// + /// The function to determine when to stop executing computation. + /// The function to be executed. Equivalent to the body + /// of a while expression. + /// + /// A CancellableTasks that behaves similarly to a while loop when run. + member inline _.While + (guard: unit -> bool, computation: CancellableTaskOptionBuilderBaseCode<'TOverall, unit>) : CancellableTaskOptionBuilderBaseCode< + 'TOverall, + unit + > + = + let mutable keepGoing = true + + ResumableCode.While( + (fun () -> + keepGoing + && guard () + ), + CancellableTaskOptionBuilderBaseCode<'TOverall, unit>(fun sm -> + if sm.Data.IsResultNone then + keepGoing <- false + true + else + computation.Invoke(&sm) + ) + ) + + /// Creates A CancellableTasks that runs computation and returns its result. + /// If an exception happens then catchHandler(exn) is called and the resulting computation executed instead. + /// + /// + /// + /// The existence of this method permits the use of try/with in the + /// cancellableTasks { ... } computation expression syntax. + /// + /// The input computation. + /// The function to run when computation throws an exception. + /// + /// A CancellableTasks that executes computation and calls catchHandler if an + /// exception is thrown. + member inline _.TryWith + ( + computation: CancellableTaskOptionBuilderBaseCode<'TOverall, 'T>, + catchHandler: exn -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> + ) : CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> = + ResumableCode.TryWith(computation, catchHandler) + + /// Creates A CancellableTasks that runs computation. The action compensation is executed + /// after computation completes, whether computation exits normally or by an exception. If compensation raises an exception itself + /// the original exception is discarded and the new exception becomes the overall result of the computation. + /// + /// + /// + /// The existence of this method permits the use of try/finally in the + /// cancellableTasks { ... } computation expression syntax. + /// + /// The input computation. + /// The action to be run after computation completes or raises an + /// exception (including cancellation). + /// + /// A CancellableTasks that executes computation and compensation afterwards or + /// when an exception is raised. + member inline _.TryFinally + ( + computation: CancellableTaskOptionBuilderBaseCode<'TOverall, 'T>, + compensation: unit -> unit + ) : CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> = + ResumableCode.TryFinally( + computation, + ResumableCode<_, _>(fun _ -> + compensation () + true + ) + ) + + + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve tasks or other reflective execution of F# code. + /// + [] + static member inline BindDynamic + ( + sm: + byref< + ResumableStateMachine< + CancellableTaskOptionBuilderBaseStateMachineData<'TOverall> + > + >, + [] getAwaiter: CancellationToken -> 'Awaiter, + continuation: + 'TResult1 -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> + ) : bool = + sm.Data.ThrowIfCancellationRequested() + + let mutable awaiter = getAwaiter sm.Data.CancellationToken + + let cont = + CancellableTaskOptionBuilderBaseResumptionFunc<'TOverall>(fun sm -> + let result = Awaiter.GetResult awaiter + + match result with + | Some result -> (continuation result).Invoke(&sm) + | None -> + sm.Data.Result <- ValueSome None + true + ) + + // shortcut to continue immediately + if Awaiter.IsCompleted awaiter then + cont.Invoke(&sm) + else + sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion) + + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + + /// Creates A CancellableTask that runs computation, and when + /// computation generates a result T, runs binder res. + /// + /// A cancellation check is performed when the computation is executed. + /// + /// The existence of this method permits the use of let! in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The computation to provide an unbound result. + /// The function to bind the result of computation. + /// + /// A CancellableTask that performs a monadic bind on the result + /// of computation. + [] + member inline _.Bind + ( + [] getAwaiterTResult: CancellationToken -> 'Awaiter, + continuation: + 'TResult1 -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> + ) : CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> = + + CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + sm.Data.ThrowIfCancellationRequested() + // Get an awaiter from the Awaiter + let mutable awaiter = getAwaiterTResult sm.Data.CancellationToken + + let mutable __stack_fin = true + + if not (Awaiter.IsCompleted awaiter) then + // This will yield with __stack_yield_fin = false + // This will resume with __stack_yield_fin = true + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_fin <- __stack_yield_fin + + if __stack_fin then + let result = Awaiter.GetResult awaiter + + match result with + | Some result -> (continuation result).Invoke(&sm) + | None -> + sm.Data.Result <- ValueSome None + true + else + let mutable awaiter = awaiter :> ICriticalNotifyCompletion + + MethodBuilder.AwaitUnsafeOnCompleted(&sm.Data.MethodBuilder, &awaiter, &sm) + + false + else + CancellableTaskOptionBuilderBase.BindDynamic( + &sm, + getAwaiterTResult, + continuation + ) + //-- RESUMABLE CODE END + ) + + + /// Creates a CancellableTask that enumerates the sequence seq + /// on demand and runs body for each element. + /// + /// A cancellation check is performed on each iteration of the loop. + /// + /// The existence of this method permits the use of for in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The sequence to enumerate. + /// A function to take an item from the sequence and create + /// A CancellableTask. Can be seen as the body of the for expression. + /// + /// A CancellableTask that will enumerate the sequence and run body + /// for each element. + member inline this.For + (sequence: seq<'T>, body: 'T -> CancellableTaskOptionBuilderBaseCode<'TOverall, unit>) + : CancellableTaskOptionBuilderBaseCode<'TOverall, unit> = + ResumableCode.Using( + sequence.GetEnumerator(), + // ... and its body is a while loop that advances the enumerator and runs the body on each element. + (fun e -> + printfn "this.For" + + this.While( + (fun () -> e.MoveNext()), + CancellableTaskOptionBuilderBaseCode<'TOverall, unit>(fun sm -> + (body e.Current).Invoke(&sm) + ) + ) + ) + ) + + /// Creates A CancellableTask that runs computation. The action compensation is executed + /// after computation completes, whether computation exits normally or by an exception. If compensation raises an exception itself + /// the original exception is discarded and the new exception becomes the overall result of the computation. + /// + /// + /// + /// The existence of this method permits the use of try/finally in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The input computation. + /// The action to be run after computation completes or raises an + /// exception. + /// + /// A CancellableTask that executes computation and compensation afterward or + /// when an exception is raised. + member inline internal this.TryFinallyAsync + ( + computation: CancellableTaskOptionBuilderBaseCode<'TOverall, 'T>, + compensation: unit -> 'Awaitable + ) : CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> = + ResumableCode.TryFinallyAsync( + computation, + ResumableCode<_, _>(fun sm -> + + if __useResumableCode then + let mutable __stack_condition_fin = true + let mutable awaiter = compensation () + + if not (Awaiter.IsCompleted awaiter) then + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_condition_fin <- __stack_yield_fin + + if __stack_condition_fin then + Awaiter.GetResult awaiter + else + + let mutable awaiter = awaiter :> ICriticalNotifyCompletion + + MethodBuilder.AwaitUnsafeOnCompleted( + &sm.Data.MethodBuilder, + &awaiter, + &sm + ) + + __stack_condition_fin + else + let mutable awaiter = compensation () + + let cont = + CancellableTaskOptionBuilderBaseResumptionFunc<'TOverall>(fun sm -> + Awaiter.GetResult awaiter + true + ) + + // shortcut to continue immediately + if Awaiter.IsCompleted awaiter then + cont.Invoke(&sm) + else + sm.ResumptionDynamicInfo.ResumptionData <- + (awaiter :> ICriticalNotifyCompletion) + + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + ) + ) + + /// Creates A CancellableTask that runs binder(resource). + /// The action resource.DisposeAsync() is executed as this computation yields its result + /// or if the CancellableTask exits by an exception or by cancellation. + /// + /// + /// + /// The existence of this method permits the use of use and use! in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The resource to be used and disposed. + /// The function that takes the resource and returns an asynchronous + /// computation. + /// + /// A CancellableTask that binds and eventually disposes resource. + /// + member inline this.Using + ( + resource: #IAsyncDisposable, + binder: #IAsyncDisposable -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> + ) : CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> = + this.TryFinallyAsync( + (fun sm -> (binder resource).Invoke(&sm)), + (fun () -> + if not (isNull (box resource)) then + resource.DisposeAsync() + |> Awaitable.GetAwaiter + else + ValueTask() + |> Awaitable.GetAwaiter + ) + ) + + + member inline internal _.WhileAsync + ([] condition, body: CancellableTaskOptionBuilderBaseCode<_, unit>) + : CancellableTaskOptionBuilderBaseCode<_, unit> = + let mutable condition_res = true + + ResumableCode.While( + (fun () -> condition_res), + CancellableTaskOptionBuilderBaseCode<_, unit>(fun sm -> + if __useResumableCode then + + let mutable __stack_condition_fin = true + let mutable awaiter = condition () + + if Awaiter.IsCompleted awaiter then + + __stack_condition_fin <- true + + condition_res <- Awaiter.GetResult awaiter + else + + // This will yield with __stack_fin = false + // This will resume with __stack_fin = true + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_condition_fin <- __stack_yield_fin + + if __stack_condition_fin then + condition_res <- Awaiter.GetResult awaiter + + + if __stack_condition_fin then + + if condition_res then body.Invoke(&sm) else true + else + let mutable awaiter = awaiter :> ICriticalNotifyCompletion + + MethodBuilder.AwaitUnsafeOnCompleted( + &sm.Data.MethodBuilder, + &awaiter, + &sm + ) + + false + else + + let mutable awaiter = condition () + + let cont = + CancellableTaskOptionBuilderBaseResumptionFunc<'TOverall>(fun sm -> + condition_res <- Awaiter.GetResult awaiter + if condition_res then body.Invoke(&sm) else true + ) + + if Awaiter.IsCompleted awaiter then + cont.Invoke(&sm) + else + sm.ResumptionDynamicInfo.ResumptionData <- + (awaiter :> ICriticalNotifyCompletion) + + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + ) + ) + + member inline this.For + ( + source: #IAsyncEnumerable<'T>, + body: 'T -> CancellableTaskOptionBuilderBaseCode<_, unit> + ) : CancellableTaskOptionBuilderBaseCode<_, _> = + + CancellableTaskOptionBuilderBaseCode<_, _>(fun sm -> + this + .Using( + source.GetAsyncEnumerator sm.Data.CancellationToken, + (fun (e: IAsyncEnumerator<'T>) -> + this.WhileAsync( + (fun () -> Awaitable.GetAwaiter(e.MoveNextAsync())), + (fun sm -> (body e.Current).Invoke(&sm)) + ) + ) + + ) + .Invoke(&sm) + ) + + + /// + [] + module LowPriority2 = + // Low priority extensions + type CancellableTaskOptionBuilderBase with + + + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve tasks or other reflective execution of F# code. + /// + [] + static member inline BindDynamic + ( + sm: + byref< + ResumableStateMachine< + CancellableTaskOptionBuilderBaseStateMachineData<'TOverall> + > + >, + [] getAwaiter: CancellationToken -> 'Awaiter, + continuation: + 'TResult1 -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> + ) : bool = + sm.Data.ThrowIfCancellationRequested() + + let mutable awaiter = getAwaiter sm.Data.CancellationToken + + let cont = + CancellableTaskOptionBuilderBaseResumptionFunc<'TOverall>(fun sm -> + let result = Awaiter.GetResult awaiter + + (continuation result).Invoke(&sm) + ) + + // shortcut to continue immediately + if Awaiter.IsCompleted awaiter then + cont.Invoke(&sm) + else + sm.ResumptionDynamicInfo.ResumptionData <- + (awaiter :> ICriticalNotifyCompletion) + + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + + /// Creates A CancellableTask that runs computation, and when + /// computation generates a result T, runs binder res. + /// + /// A cancellation check is performed when the computation is executed. + /// + /// The existence of this method permits the use of let! in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The computation to provide an unbound result. + /// The function to bind the result of computation. + /// + /// A CancellableTask that performs a monadic bind on the result + /// of computation. + [] + member inline _.Bind + ( + [] getAwaiterT: CancellationToken -> 'Awaiter, + continuation: + 'TResult1 -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> + ) : CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> = + + CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + sm.Data.ThrowIfCancellationRequested() + // Get an awaiter from the Awaiter + let mutable awaiter = getAwaiterT sm.Data.CancellationToken + + let mutable __stack_fin = true + + if not (Awaiter.IsCompleted awaiter) then + // This will yield with __stack_yield_fin = false + // This will resume with __stack_yield_fin = true + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_fin <- __stack_yield_fin + + if __stack_fin then + let result = Awaiter.GetResult awaiter + + (continuation result).Invoke(&sm) + else + let mutable awaiter = awaiter :> ICriticalNotifyCompletion + + MethodBuilder.AwaitUnsafeOnCompleted( + &sm.Data.MethodBuilder, + &awaiter, + &sm + ) + + false + else + CancellableTaskOptionBuilderBase.BindDynamic( + &sm, + getAwaiterT, + continuation + ) + //-- RESUMABLE CODE END + ) + + + /// Delegates to the input computation. + /// + /// The existence of this method permits the use of return! in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The input computation. + /// + /// The input computation. + [] + member inline this.ReturnFrom + ([] getAwaiterT: CancellationToken -> 'Awaiter) + = + this.Bind( + getAwaiterT = (fun ct -> getAwaiterT ct), + continuation = (fun v -> this.Return v) + ) + + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve tasks or other reflective execution of F# code. + /// + [] + static member inline BindDynamic + ( + sm: + byref< + ResumableStateMachine< + CancellableTaskOptionBuilderBaseStateMachineData<'TOverall> + > + >, + awaiter: 'Awaiter, + continuation: + 'TResult1 -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> + ) : bool = + sm.Data.ThrowIfCancellationRequested() + let mutable awaiter = awaiter + + let cont = + CancellableTaskOptionBuilderBaseResumptionFunc<'TOverall>(fun sm -> + let result = Awaiter.GetResult awaiter + + (continuation result).Invoke(&sm) + ) + + // shortcut to continue immediately + if Awaiter.IsCompleted awaiter then + cont.Invoke(&sm) + else + sm.ResumptionDynamicInfo.ResumptionData <- + (awaiter :> ICriticalNotifyCompletion) + + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + + /// Creates A CancellableTask that runs computation, and when + /// computation generates a result T, runs binder res. + /// + /// A cancellation check is performed when the computation is executed. + /// + /// The existence of this method permits the use of let! in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The computation to provide an unbound result. + /// The function to bind the result of computation. + /// + /// A CancellableTask that performs a monadic bind on the result + /// of computation. + [] + member inline _.Bind + ( + awaiterT: 'Awaiter, + continuation: + 'TResult1 -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> + ) : CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> = + + CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + sm.Data.ThrowIfCancellationRequested() + // Get an awaiter from the Awaiter + let mutable awaiter = awaiterT + + let mutable __stack_fin = true + + if not (Awaiter.IsCompleted awaiter) then + // This will yield with __stack_yield_fin = false + // This will resume with __stack_yield_fin = true + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_fin <- __stack_yield_fin + + if __stack_fin then + let result = Awaiter.GetResult awaiter + + (continuation result).Invoke(&sm) + else + let mutable awaiter = awaiter :> ICriticalNotifyCompletion + + MethodBuilder.AwaitUnsafeOnCompleted( + &sm.Data.MethodBuilder, + &awaiter, + &sm + ) + + false + else + CancellableTaskOptionBuilderBase.BindDynamic(&sm, awaiterT, continuation) + //-- RESUMABLE CODE END + ) + + /// Delegates to the input computation. + /// + /// The existence of this method permits the use of return! in the + /// task { ... } computation expression syntax. + /// + /// The input computation. + /// + /// The input computation. + [] + member inline this.ReturnFrom + (awaiterT: 'Awaiter) + : CancellableTaskOptionBuilderBaseCode<_, _> = + this.Bind(awaiterT = awaiterT, continuation = (fun v -> this.Return v)) + + /// + [] + module LowPriority = + // Low priority extensions + type CancellableTaskOptionBuilderBase with + + /// Delegates to the input computation. + /// + /// The existence of this method permits the use of return! in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The input computation. + /// + /// The input computation. + [] + member inline this.ReturnFrom + ([] getAwaiterTResult: CancellationToken -> 'Awaiter) + = + this.Bind( + getAwaiterTResult = (fun ct -> getAwaiterTResult ct), + continuation = (fun v -> this.Return v) + ) + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a CancellationToken -> 'Awaitable into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + [] + member inline _.Source<'Awaitable, 'TResult1, 'Awaiter, 'TOverall + when Awaitable<'Awaitable, 'Awaiter, 'TResult1>> + ([] cancellableAwaiter: CancellationToken -> 'Awaiter) + : CancellationToken -> 'Awaiter = + (fun ct -> cancellableAwaiter ct) + + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a CancellationToken -> 'Awaitable into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + [] + member inline _.Source<'Awaitable, 'TResult1, 'Awaiter, 'TOverall + when Awaitable<'Awaitable, 'Awaiter, 'TResult1>> + ([] cancellableAwaitable: CancellationToken -> 'Awaitable) + : CancellationToken -> 'Awaiter = + (fun ct -> Awaitable.GetAwaiter(cancellableAwaitable ct)) + + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a unit -> 'Awaitable into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + [] + member inline _.Source<'Awaitable, 'TResult1, 'Awaiter, 'TOverall + when Awaitable<'Awaitable, 'Awaiter, 'TResult1>> + ([] coldAwaitable: unit -> 'Awaitable) + : CancellationToken -> 'Awaiter = + (fun ct -> Awaitable.GetAwaiter(coldAwaitable ())) + + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve tasks or other reflective execution of F# code. + /// + [] + static member inline BindDynamic + ( + sm: + byref< + ResumableStateMachine< + CancellableTaskOptionBuilderBaseStateMachineData<'TOverall> + > + >, + awaiter: 'Awaiter, + continuation: + 'TResult1 -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> + ) : bool = + sm.Data.ThrowIfCancellationRequested() + let mutable awaiter = awaiter + + let cont = + CancellableTaskOptionBuilderBaseResumptionFunc<'TOverall>(fun sm -> + let result = Awaiter.GetResult awaiter + + match result with + | Some result -> (continuation result).Invoke(&sm) + | None -> + sm.Data.Result <- ValueSome None + true + ) + + // shortcut to continue immediately + if Awaiter.IsCompleted awaiter then + cont.Invoke(&sm) + else + sm.ResumptionDynamicInfo.ResumptionData <- + (awaiter :> ICriticalNotifyCompletion) + + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + + /// Creates A CancellableTask that runs computation, and when + /// computation generates a result T, runs binder res. + /// + /// A cancellation check is performed when the computation is executed. + /// + /// The existence of this method permits the use of let! in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The computation to provide an unbound result. + /// The function to bind the result of computation. + /// + /// A CancellableTask that performs a monadic bind on the result + /// of computation. + [] + member inline _.Bind + ( + awaiterTResult: 'Awaiter, + continuation: + 'TResult1 -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> + ) : CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2> = + + CancellableTaskOptionBuilderBaseCode<'TOverall, 'TResult2>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + sm.Data.ThrowIfCancellationRequested() + // Get an awaiter from the Awaiter + let mutable awaiter = awaiterTResult + + let mutable __stack_fin = true + + if not (Awaiter.IsCompleted awaiter) then + // This will yield with __stack_yield_fin = false + // This will resume with __stack_yield_fin = true + let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) + __stack_fin <- __stack_yield_fin + + if __stack_fin then + let result = Awaiter.GetResult awaiter + + match result with + | Some result -> (continuation result).Invoke(&sm) + | None -> + sm.Data.Result <- ValueSome None + true + else + let mutable awaiter = awaiter :> ICriticalNotifyCompletion + + MethodBuilder.AwaitUnsafeOnCompleted( + &sm.Data.MethodBuilder, + &awaiter, + &sm + ) + + false + else + CancellableTaskOptionBuilderBase.BindDynamic( + &sm, + awaiterTResult, + continuation + ) + //-- RESUMABLE CODE END + ) + + /// Delegates to the input computation. + /// + /// The existence of this method permits the use of return! in the + /// task { ... } computation expression syntax. + /// + /// The input computation. + /// + /// The input computation. + [] + member inline this.ReturnFrom + (awaiterTResult: 'Awaiter) + : CancellableTaskOptionBuilderBaseCode<_, _> = + this.Bind(awaiterTResult = awaiterTResult, continuation = (fun v -> this.Return v)) + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This is the identify function. + /// + /// 'Awaiter + [] + member inline _.Source<'TResult1, 'TResult2, 'Awaiter, 'TOverall + when Awaiter<'Awaiter, 'TResult1>> + (awaiter: 'Awaiter) + : 'Awaiter = + awaiter + + + /// Allows the computation expression to turn other types into 'Awaiter + /// + /// This turns a ^Awaitable into a 'Awaiter. + /// + /// 'Awaiter + [] + member inline _.Source<'Awaitable, 'TResult1, 'TResult2, 'Awaiter, 'TOverall + when Awaitable<'Awaitable, 'Awaiter, 'TResult1>> + (task: 'Awaitable) + : 'Awaiter = + Awaitable.GetAwaiter task + + + /// Creates A CancellableTask that runs binder(resource). + /// The action resource.Dispose() is executed as this computation yields its result + /// or if the CancellableTask exits by an exception or by cancellation. + /// + /// + /// + /// The existence of this method permits the use of use and use! in the + /// cancellableTask { ... } computation expression syntax. + /// + /// The resource to be used and disposed. + /// The function that takes the resource and returns an asynchronous + /// computation. + /// + /// A CancellableTask that binds and eventually disposes resource. + /// + member inline _.Using + ( + resource: #IDisposable, + binder: #IDisposable -> CancellableTaskOptionBuilderBaseCode<'TOverall, 'T> + ) = + ResumableCode.Using(resource, binder) + + + /// Allows the computation expression to turn other types into other types + /// + /// This is the identify function for For binds. + /// + /// IEnumerable + member inline _.Source(s: #seq<_>) : #seq<_> = s + + + [] + module MedHighPriority = + + type CancellableTaskOptionBuilderBase with + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a Task<'T> into a CancellationToken -> 'Awaiter. + /// + /// 'Awaiter + member inline _.Source(taskAwaiter: TaskAwaiter<'T>) : Awaiter, 'T> = + taskAwaiter + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a Task<'T> into a CancellationToken -> 'Awaiter. + /// + /// 'Awaiter + member inline _.Source(taskT: Task<'T>) : Awaiter, 'T> = + Awaitable.GetTaskAwaiter taskT + + + member inline _.Source + (cancellableTask: CancellationToken -> Task<_>) + : CancellationToken -> Awaiter, _> = + fun ct -> Awaitable.GetTaskAwaiter(cancellableTask ct) + + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a Async<'T> into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + member inline this.Source(computation: Async<'T>) = + this.Source(Async.AsCancellableTask(computation)) + + + /// + [] + module HighPriority = + + + type Microsoft.FSharp.Control.Async with + + static member inline AwaitCancellableTaskOption + ([] t: CancellableTaskOption<'T>) + = + async { + let! ct = Async.CancellationToken + + return! + t ct + |> Async.AwaitTask + } + + static member inline AsCancellableTaskOption(computation: Async<'T>) = + fun ct -> Async.StartImmediateAsTask(computation, cancellationToken = ct) + + type AsyncEx with + + static member inline AwaitCancellableTaskOption + ([] t: CancellableTaskOption<'T>) + = + async { + let! ct = Async.CancellationToken + + return! + t ct + |> Async.AwaitTask + } + + static member inline AsCancellableTaskOption(computation: Async<'T>) = + fun ct -> Async.StartImmediateAsTask(computation, cancellationToken = ct) + + + type AsyncOptionBuilder with + + member inline this.Source([] t: CancellableTaskOption<'T>) : Async<_> = + Async.AwaitCancellableTaskOption t + + // High priority extensions + type CancellableTaskOptionBuilderBase with + + /// Allows the computation expression to turn other types into other types + /// + /// This is the identify function for For binds. + /// + /// IEnumerable + member inline _.Source(s: #IAsyncEnumerable<_>) = s + + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a ColdTask<'T> into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + member inline _.Source + ([] task: unit -> TaskAwaiter<'T>) + : CancellationToken -> Awaiter, 'T> = + (fun (ct: CancellationToken) -> (task ())) + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a ColdTask<'T> into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + member inline _.Source + ([] task: unit -> Task<'T>) + : CancellationToken -> Awaiter, 'T> = + (fun (ct: CancellationToken) -> Awaitable.GetTaskAwaiter(task ())) + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a CancellableTask<'T> into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + member inline _.Source + ([] cancellableTaskAwaiter: CancellationToken -> TaskAwaiter<'T>) + : CancellationToken -> Awaiter, 'T> = + (fun ct -> (cancellableTaskAwaiter ct)) + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a CancellableTask<'T> into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + member inline _.Source + ([] task: CancellationToken -> Task<'T>) + : CancellationToken -> Awaiter, 'T> = + (fun ct -> Awaitable.GetTaskAwaiter(task ct)) + + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a ColdTask<'T> into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + member inline _.Source(taskOption: TaskOption<'T>) = + Awaitable.GetTaskAwaiter(taskOption) + + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a ColdTask<'T> into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + member inline this.Source + (asyncOption: Async<'T option>) + : CancellationToken -> TaskAwaiter<'T option> = + this.Source(Async.AsCancellableTask asyncOption) + + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a ColdTask<'T> into a CancellationToken -> 'Awaiter. + /// + /// CancellationToken -> 'Awaiter + member inline this.Source(option: Option<'T>) = this.Source(ValueTask<_>(option)) diff --git a/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskOptionCE.fs b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskOptionCE.fs new file mode 100644 index 00000000..4fca6a95 --- /dev/null +++ b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskOptionCE.fs @@ -0,0 +1,418 @@ +namespace FsToolkit.ErrorHandling + +/// Contains methods to build CancellableTasks using the F# computation expression syntax +[] +module CancellableTaskOptionCE = + + open System + open System.Runtime.CompilerServices + open System.Threading + open System.Threading.Tasks + open Microsoft.FSharp.Core + open Microsoft.FSharp.Core.CompilerServices + open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers + open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators + open Microsoft.FSharp.Collections + open IcedTasks + + + /// Contains methods to build CancellableTasks using the F# computation expression syntax + type CancellableTaskOptionBuilder() = + + inherit CancellableTaskOptionBuilderBase() + + // This is the dynamic implementation - this is not used + // for statically compiled tasks. An executor (resumptionFuncExecutor) is + // registered with the state machine, plus the initial resumption. + // The executor stays constant throughout the execution, it wraps each step + // of the execution in a try/with. The resumption is changed at each step + // to represent the continuation of the computation. + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve tasks or other reflective execution of F# code. + /// + static member inline RunDynamic + (code: CancellableTaskOptionBuilderBaseCode<'T, 'T>) + : CancellableTaskOption<'T> = + + let mutable sm = CancellableTaskOptionBuilderBaseStateMachine<'T>() + + let initialResumptionFunc = + CancellableTaskOptionBuilderBaseResumptionFunc<'T>(fun sm -> code.Invoke(&sm)) + + let resumptionInfo = + { new CancellableTaskOptionBuilderBaseResumptionDynamicInfo<'T>(initialResumptionFunc) with + member info.MoveNext(sm) = + let mutable savedExn = null + + try + sm.ResumptionDynamicInfo.ResumptionData <- null + let step = info.ResumptionFunc.Invoke(&sm) + + if step then + sm.Data.SetResult() + else + let mutable awaiter = + sm.ResumptionDynamicInfo.ResumptionData + :?> ICriticalNotifyCompletion + + MethodBuilder.AwaitUnsafeOnCompleted( + &sm.Data.MethodBuilder, + &awaiter, + &sm + ) + + with exn -> + savedExn <- exn + // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 + match savedExn with + | null -> () + | exn -> MethodBuilder.SetException(&sm.Data.MethodBuilder, exn) + + member _.SetStateMachine(sm, state) = + MethodBuilder.SetStateMachine(&sm.Data.MethodBuilder, state) + } + + fun ct -> + if ct.IsCancellationRequested then + Task.FromCanceled<_>(ct) + else + sm.Data.CancellationToken <- ct + sm.ResumptionDynamicInfo <- resumptionInfo + sm.Data.MethodBuilder <- AsyncTaskMethodBuilder>.Create() + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + + + /// Hosts the task code in a state machine and starts the task. + member inline _.Run + (code: CancellableTaskOptionBuilderBaseCode<'T, 'T>) + : CancellableTaskOption<'T> = + if __useResumableCode then + __stateMachine< + CancellableTaskOptionBuilderBaseStateMachineData<'T>, + CancellableTaskOption<'T> + > + (MoveNextMethodImpl<_>(fun sm -> + //-- RESUMABLE CODE START + __resumeAt sm.ResumptionPoint + let mutable __stack_exn: ExceptionNull = null + + try + let __stack_code_fin = code.Invoke(&sm) + + if __stack_code_fin then + sm.Data.SetResult() + with exn -> + __stack_exn <- exn + // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 + match __stack_exn with + | null -> () + | exn -> MethodBuilder.SetException(&sm.Data.MethodBuilder, exn) + //-- RESUMABLE CODE END + )) + (SetStateMachineMethodImpl<_>(fun sm state -> + MethodBuilder.SetStateMachine(&sm.Data.MethodBuilder, state) + )) + (AfterCode<_, _>(fun sm -> + let sm = sm + + fun ct -> + if ct.IsCancellationRequested then + Task.FromCanceled<_>(ct) + else + let mutable sm = sm + sm.Data.CancellationToken <- ct + + sm.Data.MethodBuilder <- + AsyncTaskMethodBuilder>.Create() + + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + )) + else + CancellableTaskOptionBuilder.RunDynamic(code) + + /// Specify a Source of CancellationToken -> Task<_> on the real type to allow type inference to work + member inline _.Source + (x: CancellationToken -> Task<_>) + : CancellationToken -> Awaiter, _> = + fun ct -> Awaitable.GetTaskAwaiter(x ct) + + /// Contains methods to build CancellableTasks using the F# computation expression syntax + type BackgroundCancellableTaskOptionBuilder() = + + inherit CancellableTaskOptionBuilderBase() + + /// + /// The entry point for the dynamic implementation of the corresponding operation. Do not use directly, only used when executing quotations that involve tasks or other reflective execution of F# code. + /// + static member inline RunDynamic + (code: CancellableTaskOptionBuilderBaseCode<'T, 'T>) + : CancellableTaskOption<'T> = + // backgroundTask { .. } escapes to a background thread where necessary + // See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/ + if + isNull SynchronizationContext.Current + && obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default) + then + CancellableTaskOptionBuilder.RunDynamic(code) + else + fun ct -> + Task.Run>( + (fun () -> CancellableTaskOptionBuilder.RunDynamic code ct), + ct + ) + + /// + /// Hosts the task code in a state machine and starts the task, executing in the ThreadPool using Task.Run + /// + member inline _.Run + (code: CancellableTaskOptionBuilderBaseCode<'T, 'T>) + : CancellableTaskOption<'T> = + if __useResumableCode then + __stateMachine< + CancellableTaskOptionBuilderBaseStateMachineData<'T>, + CancellableTaskOption<'T> + > + (MoveNextMethodImpl<_>(fun sm -> + //-- RESUMABLE CODE START + __resumeAt sm.ResumptionPoint + let mutable __stack_exn: ExceptionNull = null + + try + let __stack_code_fin = code.Invoke(&sm) + + if __stack_code_fin then + sm.Data.MethodBuilder.SetResult(sm.Data.Result.Value) + with exn -> + __stack_exn <- exn + // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 + match __stack_exn with + | null -> () + | exn -> MethodBuilder.SetException(&sm.Data.MethodBuilder, exn) + //-- RESUMABLE CODE END + )) + (SetStateMachineMethodImpl<_>(fun sm state -> + MethodBuilder.SetStateMachine(&sm.Data.MethodBuilder, state) + )) + (AfterCode<_, CancellableTaskOption<'T>>(fun sm -> + // backgroundTask { .. } escapes to a background thread where necessary + // See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/ + if + isNull SynchronizationContext.Current + && obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default) + then + let mutable sm = sm + + fun ct -> + if ct.IsCancellationRequested then + Task.FromCanceled<_>(ct) + else + sm.Data.CancellationToken <- ct + + sm.Data.MethodBuilder <- + AsyncTaskMethodBuilder>.Create() + + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + else + let sm = sm // copy contents of state machine so we can capture it + + fun (ct) -> + if ct.IsCancellationRequested then + Task.FromCanceled<_>(ct) + else + Task.Run>( + (fun () -> + let mutable sm = sm // host local mutable copy of contents of state machine on this thread pool thread + sm.Data.CancellationToken <- ct + + sm.Data.MethodBuilder <- + AsyncTaskMethodBuilder>.Create() + + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + ), + ct + ) + )) + + else + BackgroundCancellableTaskOptionBuilder.RunDynamic(code) + + /// Contains the cancellableTask computation expression builder. + [] + module CancellableTaskOptionBuilder = + + /// + /// Builds a cancellableTask using computation expression syntax. + /// + let cancellableTaskOption = CancellableTaskOptionBuilder() + + /// + /// Builds a cancellableTask using computation expression syntax which switches to execute on a background thread if not already doing so. + /// + let backgroundCancellableTaskOption = BackgroundCancellableTaskOptionBuilder() + + +[] +module CancellableTaskOption = + open System.Threading.Tasks + open System.Threading + open IcedTasks + + /// Gets the default cancellation token for executing computations. + /// + /// The default CancellationToken. + /// + /// Cancellation and Exceptions + /// + /// + /// + /// use tokenSource = new CancellationTokenSource() + /// let primes = [ 2; 3; 5; 7; 11 ] + /// for i in primes do + /// let computation = + /// cancellableTask { + /// let! cancellationToken = CancellableTask.getCancellationToken() + /// do! Task.Delay(i * 1000, cancellationToken) + /// printfn $"{i}" + /// } + /// computation tokenSource.Token |> ignore + /// Thread.Sleep(6000) + /// tokenSource.Cancel() + /// printfn "Tasks Finished" + /// + /// This will print "2" 2 seconds from start, "3" 3 seconds from start, "5" 5 seconds from start, cease computation and then + /// followed by "Tasks Finished". + /// + let inline getCancellationToken () = + fun (ct: CancellationToken) -> ValueTask ct + + /// Lifts an item to a CancellableTask. + /// The item to be the result of the CancellableTask. + /// A CancellableTask with the item as the result. + let inline some x = cancellableTask { return Some x } + + + /// Allows chaining of CancellableTasks. + /// The continuation. + /// The value. + /// The result of the binder. + let inline bind + ([] binder: 'input -> CancellableTaskOption<'output>) + ([] cTask: CancellableTaskOption<'input>) + = + cancellableTaskOption { + let! cResult = cTask + return! binder cResult + } + + /// Allows chaining of CancellableTasks. + /// The continuation. + /// The value. + /// The result of the mapper wrapped in a CancellableTasks. + let inline map + ([] mapper: 'input -> 'output) + ([] cTask: CancellableTaskOption<'input>) + = + cancellableTaskOption { + let! cResult = cTask + return mapper cResult + } + + /// Allows chaining of CancellableTasks. + /// A function wrapped in a CancellableTasks + /// The value. + /// The result of the applicable. + let inline apply + ([] applicable: CancellableTaskOption<'input -> 'output>) + ([] cTask: CancellableTaskOption<'input>) + = + cancellableTaskOption { + let! (applier: 'input -> 'output) = applicable + let! (cResult: 'input) = cTask + return applier cResult + } + + /// Takes two CancellableTasks, starts them serially in order of left to right, and returns a tuple of the pair. + /// The left value. + /// The right value. + /// A tuple of the parameters passed in + let inline zip + ([] left: CancellableTaskOption<'left>) + ([] right: CancellableTaskOption<'right>) + = + cancellableTaskOption { + let! r1 = left + let! r2 = right + return r1, r2 + } + + /// Takes two CancellableTask, starts them concurrently, and returns a tuple of the pair. + /// The left value. + /// The right value. + /// A tuple of the parameters passed in. + let inline parallelZip + ([] left: CancellableTaskOption<'left>) + ([] right: CancellableTaskOption<'right>) + = + cancellableTask { + let! ct = getCancellationToken () + let r1 = left ct + let r2 = right ct + let! r1 = r1 + let! r2 = r2 + return Option.zip r1 r2 + } + + /// + /// Returns result of running if it is Some, otherwise returns result of running + /// + /// The function to run if is Some + /// The function to run if is None + /// The input option. + /// + /// The result of running if the input is Some, else returns result of running . + /// + let inline either + ([] onSome: 'input -> CancellableTask<'output>) + ([] onNone: unit -> CancellableTask<'output>) + (input: CancellableTask<'input option>) + : CancellableTask<'output> = + input + |> CancellableTask.bind ( + function + | Some v -> onSome v + | None -> onNone () + ) + + /// + /// Gets the value of the option if the option is Some, otherwise returns the specified default value. + /// + /// The specified default value. + /// The input option. + /// + /// The option if the option is Some, else the default value. + /// + let inline defaultValue + (value: 'value) + (cancellableTaskOption: CancellableTask<'value option>) + = + cancellableTaskOption + |> CancellableTask.map (Option.defaultValue value) + + /// + /// Gets the value of the option if the option is Some, otherwise evaluates and returns the result. + /// + /// A thunk that provides a default value when evaluated. + /// The input option. + /// + /// The option if the option is Some, else the result of evaluating . + /// + let inline defaultWith + ([] defThunk: unit -> 'value) + (cancellableTaskOption: CancellableTask<'value option>) + : CancellableTask<'value> = + cancellableTaskOption + |> CancellableTask.map (Option.defaultWith defThunk) diff --git a/src/FsToolkit.ErrorHandling.IcedTasks/FsToolkit.ErrorHandling.IcedTasks.fsproj b/src/FsToolkit.ErrorHandling.IcedTasks/FsToolkit.ErrorHandling.IcedTasks.fsproj index 5ef28543..9d503743 100644 --- a/src/FsToolkit.ErrorHandling.IcedTasks/FsToolkit.ErrorHandling.IcedTasks.fsproj +++ b/src/FsToolkit.ErrorHandling.IcedTasks/FsToolkit.ErrorHandling.IcedTasks.fsproj @@ -9,7 +9,9 @@ + + diff --git a/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskOptionCE.fs b/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskOptionCE.fs new file mode 100644 index 00000000..2e16260b --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskOptionCE.fs @@ -0,0 +1,1040 @@ +namespace FsToolkit.ErrorHandling.IcedTasks.Tests + +open Expecto +open System.Threading +open System.Threading.Tasks +open IcedTasks +open FsToolkit.ErrorHandling + +module OptionCompileTests = + // Just having these compile is a test in itself + // Ensuring we don't see https://github.com/dotnet/fsharp/issues/12761#issuecomment-1241892425 again + let testFunctionCTO<'Dto> () = + cancellableTaskOption { + let dto = Unchecked.defaultof<'Dto> + System.Console.WriteLine(dto) + } + + let testFunctionBCTO<'Dto> () = + backgroundCancellableTaskOption { + let dto = Unchecked.defaultof<'Dto> + System.Console.WriteLine(dto) + } + +module CancellableTaskOptionCE = + + let makeDisposable () = + { new System.IDisposable with + member this.Dispose() = () + } + + + let cancellableTaskOptionBuilderTests = + testList "CancellableTaskOptionBuilder" [ + testList "Return" [ + testCaseTask "return" + <| fun () -> + task { + let data = 42 + let ctr = cancellableTaskOption { return data } + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to Return value" + } + ] + testList "ReturnFrom" [ + testCaseTask "return! cancellableTaskOption" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { return! cancellableTaskOption { return data } } + + let! actual = ctr CancellationToken.None + + Expect.equal + actual + (Some data) + "Should be able to Return! cancellableTaskOption" + } + testCaseTask "return! taskOption" + <| fun () -> + task { + let data = 42 + + let ctr = cancellableTaskOption { return! taskOption { return data } } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to Return! taskOption" + } + testCaseTask "return! asyncOption" + <| fun () -> + task { + let data = 42 + + let ctr = cancellableTaskOption { return! asyncOption { return data } } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to Return! asyncOption" + } + + testCaseTask "return! valueTaskOption" + <| fun () -> + task { + let data = 42 + + let ctr = cancellableTaskOption { return! ValueTask.FromResult(Some data) } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to Return! valueTaskOption" + } + testCaseTask "return! option" + <| fun () -> + task { + let data = 42 + + let ctr = cancellableTaskOption { return! Some data } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to Return! option" + } + + testCaseTask "return! task<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = cancellableTaskOption { return! task { return data } } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to Return! task<'T>" + } + + testCaseTask "return! task" + <| fun () -> + task { + let ctr = cancellableTaskOption { return! Task.CompletedTask } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some()) "Should be able to Return! task" + } + + testCaseTask "return! valuetask<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = cancellableTaskOption { return! ValueTask.FromResult data } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to Return! valuetask<'T>" + } + + testCaseTask "return! valuetask" + <| fun () -> + task { + let ctr = cancellableTaskOption { return! ValueTask.CompletedTask } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some()) "Should be able to Return! valuetask" + } + + testCaseTask "return! async<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = cancellableTaskOption { return! async { return data } } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to Return! async<'T>" + } + testCaseTask "return! ColdTask<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = cancellableTaskOption { return! coldTask { return data } } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to Return! ColdTask<'T>" + } + + testCaseTask "return! ColdTask" + <| fun () -> + task { + + let ctr = cancellableTaskOption { return! fun () -> Task.CompletedTask } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some()) "Should be able to Return! ColdTask" + } + + testCaseTask "return! CancellableTask<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = cancellableTaskOption { return! cancellableTask { return data } } + + let! actual = ctr CancellationToken.None + + Expect.equal + actual + (Some data) + "Should be able to Return! CancellableTask<'T>" + } + + testCaseTask "return! CancellableValueTask<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { return! cancellableValueTask { return data } } + + let! actual = ctr CancellationToken.None + + Expect.equal + actual + (Some data) + "Should be able to Return! CancellableTask<'T>" + } + + testCaseTask "return! CancellableTask" + <| fun () -> + task { + + let ctr = + cancellableTaskOption { + return! fun (ct: CancellationToken) -> Task.CompletedTask + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some()) "Should be able to Return! CancellableTask" + } + + testCaseTask "return! CancellableValueTask" + <| fun () -> + task { + + let ctr = + cancellableTaskOption { + return! fun (ct: CancellationToken) -> ValueTask.CompletedTask + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some()) "Should be able to Return! CancellableTask<'T>" + } + + testCaseTask "return! TaskLike" + <| fun () -> + task { + let ctr = cancellableTaskOption { return! Task.Yield() } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some()) "Should be able to Return! CancellableTask" + } + testCaseTask "return! Cold TaskLike" + <| fun () -> + task { + let ctr = cancellableTaskOption { return! fun () -> Task.Yield() } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some()) "Should be able to Return! CancellableTask" + } + + testCaseTask "return! Cancellable TaskLike" + <| fun () -> + task { + let ctr = + cancellableTaskOption { + return! fun (ct: CancellationToken) -> Task.Yield() + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some()) "Should be able to Return! CancellableTask" + } + + ] + + testList "Binds" [ + testCaseTask "let! cancellableTaskOption" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { + let! someValue = cancellableTaskOption { return data } + return someValue + } + + let! actual = ctr CancellationToken.None + + Expect.equal + actual + (Some data) + "Should be able to let! cancellableTaskOption" + } + + testCaseTask "let! taskOption" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { + let! someValue = taskOption { return data } + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! taskOption" + } + + testCaseTask "let! asyncOption" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { + let! someValue = asyncOption { return data } + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! asyncResult" + } + + testCaseTask "let! valueTaskOption" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { + let! someValue = ValueTask.FromResult(Some data) + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! valueTaskOption" + } + testCaseTask "let! Option.Some" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { + let! someValue = Some data + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! Option.Some" + } + + testCaseTask "let! Option.None" + <| fun () -> + task { + let ctr = + cancellableTaskOption { + let! someValue = None + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual None "Should be able to let! Option.None" + } + + testCaseTask "let! task<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { + let! someValue = task { return data } + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! task<'T>" + } + + testCaseTask "let! task" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + let! someValue = Task.CompletedTask + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! task" + } + + testCaseTask "let! valuetask<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { + let! someValue = ValueTask.FromResult data + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! valuetask<'T>" + } + + testCaseTask "let! valuetask" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + let! someValue = ValueTask.CompletedTask + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! valuetask" + } + + testCaseTask "let! async<'t>" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + let! someValue = async { return data } + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! async<'t>" + } + + testCaseTask "let! ColdTask<'t>" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + let! someValue = coldTask { return data } + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! ColdTask<'t>" + } + testCaseTask "let! ColdTask" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + let! someValue = fun () -> Task.CompletedTask + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! ColdTask" + } + testCaseTask "let! CancellableTask<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { + let! someValue = cancellableTask { return data } + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! CancellableTask<'T>" + } + testCaseTask "let! CancellableValueTask<'T>" + <| fun () -> + task { + let data = 42 + + let ctr = + cancellableTaskOption { + let! someValue = cancellableValueTask { return data } + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! CancellableTask<'T>" + } + testCaseTask "let! CancellableTask" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + let! someValue = fun (ct: CancellationToken) -> Task.CompletedTask + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! CancellableTask" + } + + testCaseTask "do! CancellableValueTask" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + do! fun (ct: CancellationToken) -> ValueTask.CompletedTask + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to do! CancellableValueTask" + } + testCaseTask "let! TaskLike" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + let! someValue = Task.Yield() + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! TaskLike" + } + + testCaseTask "let! Cold TaskLike" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + let! someValue = fun () -> Task.Yield() + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! TaskLike" + } + + testCaseTask "let! Cancellable TaskLike" + <| fun () -> + task { + let data = () + + let ctr = + cancellableTaskOption { + let! someValue = fun (ct: CancellationToken) -> Task.Yield() + return someValue + } + + let! actual = ctr CancellationToken.None + Expect.equal actual (Some data) "Should be able to let! TaskLike" + } + + ] + testList "Zero/Combine/Delay" [ + testCaseAsync "if statement" + <| async { + let data = 42 + + let! actual = + cancellableTaskOption { + let result = data + + if true then + () + + return result + } + + Expect.equal actual (Some data) "Zero/Combine/Delay should work" + } + ] + testList "TryWith" [ + testCaseAsync "try with" + <| async { + let data = 42 + + let! actual = + cancellableTaskOption { + let data = data + + try + () + with _ -> + () + + return data + } + + Expect.equal actual (Some data) "TryWith should work" + } + ] + + + testList "TryFinally" [ + testCaseAsync "try finally" + <| async { + let data = 42 + + let! actual = + cancellableTaskOption { + let data = data + + try + () + finally + () + + return data + } + + Expect.equal actual (Some data) "TryFinally should work" + } + ] + + testList "Using" [ + testCaseAsync "use" + <| async { + let data = 42 + + let! actual = + cancellableTaskOption { + use d = makeDisposable () + return data + } + + Expect.equal actual (Some data) "Should be able to use use" + } + testCaseAsync "use!" + <| async { + let data = 42 + + let! actual = + cancellableTaskOption { + use! d = + makeDisposable () + |> async.Return + + return data + } + + Expect.equal actual (Some data) "Should be able to use use!" + } + testCaseAsync "null" + <| async { + let data = 42 + + let! actual = + cancellableTaskOption { + use d = null + return data + } + + Expect.equal actual (Some data) "Should be able to use null" + } + ] + + testList "While" [ + testCaseAsync "while 10" + <| async { + let loops = 10 + let mutable index = 0 + + let! actual = + cancellableTaskOption { + while index < loops do + index <- index + 1 + + return index + } + + Expect.equal actual (Some loops) "Should be some" + } + + testCaseAsync "while 10000000" + <| async { + let loops = 10000000 + let mutable index = 0 + + let! actual = + cancellableTaskOption { + while index < loops do + index <- index + 1 + + return index + } + + Expect.equal actual (Some loops) "Should be some" + } + + testCaseTask "while fail" + <| fun () -> + task { + + let mutable loopCount = 0 + let mutable wasCalled = false + + let sideEffect () = + wasCalled <- true + "some" + + let expected = None + + let data = [ + Some "42" + Some "1024" + expected + Some "1M" + Some "1M" + Some "1M" + ] + + let ctr = + cancellableTaskOption { + while loopCount < data.Length do + let! x = data.[loopCount] + + loopCount <- + loopCount + + 1 + + return sideEffect () + } + + let! actual = ctr CancellationToken.None + + Expect.equal loopCount 2 "Should only loop twice" + Expect.equal actual expected "Should be none" + Expect.isFalse wasCalled "No additional side effects should occur" + } + + ] + + testList "For" [ + testCaseAsync "for in" + <| async { + let mutable index = 0 + + let! actual = + cancellableTaskOption { + for i in [ 1..10 ] do + index <- i + i + + return index + } + + Expect.equal actual (Some index) "Should be some" + } + + + testCaseAsync "for to" + <| async { + let loops = 10 + let mutable index = 0 + + let! actual = + cancellableTaskOption { + for i = 1 to loops do + index <- i + i + + return index + } + + Expect.equal actual (Some index) "Should be some" + } + testCaseTask "for in fail" + <| fun () -> + task { + + let mutable loopCount = 0 + let expected = None + + let data = [ + Some "42" + Some "1024" + expected + Some "1M" + Some "1M" + Some "1M" + ] + + let ctr = + cancellableTaskOption { + for i in data do + let! x = i + + loopCount <- + loopCount + + 1 + + () + + return "some" + } + + let! actual = ctr CancellationToken.None + + Expect.equal loopCount 2 "Should only loop twice" + Expect.equal actual expected "Should be none" + } + ] + testList "Cancellations" [ + testCaseTask "Simple Cancellation" + <| fun () -> + task { + do! + Expect.CancellationRequested( + task { + let foo = cancellableTaskOption { return "lol" } + use cts = new CancellationTokenSource() + cts.Cancel() + let! result = foo cts.Token + failtestf "Should not get here" + } + ) + } + testCaseTask "CancellableTasks are lazily evaluated" + <| fun () -> + task { + + let mutable someValue = null + + do! + Expect.CancellationRequested( + task { + let work = cancellableTaskOption { someValue <- "lol" } + + do! Async.Sleep(100) + Expect.equal someValue null "" + use cts = new CancellationTokenSource() + cts.Cancel() + let workInProgress = work cts.Token + do! Async.Sleep(100) + Expect.equal someValue null "" + + let! _ = workInProgress + + failtestf "Should not get here" + } + ) + } + testCase + "CancellationToken flows from Async to CancellableTaskOption via Async.AwaitCancellableTask" + <| fun () -> + let innerTask = + cancellableTaskOption { + return! CancellableTaskOption.getCancellationToken () + } + + let outerAsync = + async { + return! + innerTask + |> Async.AwaitCancellableTaskOption + } + + use cts = new CancellationTokenSource() + + let actual = Async.RunSynchronously(outerAsync, cancellationToken = cts.Token) + + Expect.equal actual (Some cts.Token) "" + + + testCase "CancellationToken flows from AsyncOption to CancellableTaskOption" + <| fun () -> + let innerTask = + cancellableTaskOption { + return! CancellableTaskOption.getCancellationToken () + } + + let outerAsync = asyncOption { return! innerTask } + + use cts = new CancellationTokenSource() + + let actual = Async.RunSynchronously(outerAsync, cancellationToken = cts.Token) + + Expect.equal actual (Some cts.Token) "" + + testCase "CancellationToken flows from CancellableTaskOption to Async" + <| fun () -> + let innerAsync = async { return! Async.CancellationToken } + + let outerTask = cancellableTaskOption { return! innerAsync } + + use cts = new CancellationTokenSource() + + let actual = (outerTask cts.Token).GetAwaiter().GetResult() + + Expect.equal actual (Some cts.Token) "" + + testCase + "CancellationToken flows from CancellableTaskOption to AsyncOption" + <| fun () -> + let innerAsync = asyncOption { return! Async.CancellationToken } + + let outerTask = cancellableTaskOption { return! innerAsync } + + use cts = new CancellationTokenSource() + + let actual = (outerTask cts.Token).GetAwaiter().GetResult() + + Expect.equal actual (Some cts.Token) "" + testCase + "CancellationToken flows from CancellableTaskOption to CancellableTask" + <| fun () -> + let innerAsync = + cancellableTask { return! CancellableTask.getCancellationToken () } + + let outerTask = cancellableTaskOption { return! innerAsync } + + use cts = new CancellationTokenSource() + + let actual = (outerTask cts.Token).GetAwaiter().GetResult() + + Expect.equal actual (Some cts.Token) "" + + testCase + "CancellationToken flows from CancellableTaskOption to CancellableTaskOption" + <| fun () -> + let innerAsync = + cancellableTaskOption { + return! CancellableTaskOption.getCancellationToken () + } + + let outerTask = cancellableTaskOption { return! innerAsync } + + use cts = new CancellationTokenSource() + + let actual = (outerTask cts.Token).GetAwaiter().GetResult() + + Expect.equal actual (Some cts.Token) "" + + + ] + ] + + let functionTests = + testList "functions" [ + testList "singleton" [ + testCaseAsync "Simple" + <| async { + let innerCall = CancellableTaskOption.some "lol" + + let! someTask = innerCall + + Expect.equal (Some "lol") someTask "" + } + ] + testList "bind" [ + testCaseAsync "Simple" + <| async { + let innerCall = cancellableTaskOption { return "lol" } + + let! someTask = + innerCall + |> CancellableTaskOption.bind (fun x -> + cancellableTaskOption { return x + "fooo" } + ) + + Expect.equal (Some "lolfooo") someTask "" + } + ] + testList "map" [ + testCaseAsync "Simple" + <| async { + let innerCall = cancellableTaskOption { return "lol" } + + let! someTask = + innerCall + |> CancellableTaskOption.map (fun x -> x + "fooo") + + Expect.equal (Some "lolfooo") someTask "" + } + ] + testList "apply" [ + testCaseAsync "Simple" + <| async { + let innerCall = cancellableTaskOption { return "lol" } + let applier = cancellableTaskOption { return fun x -> x + "fooo" } + + let! someTask = + innerCall + |> CancellableTaskOption.apply applier + + Expect.equal (Some "lolfooo") someTask "" + } + ] + + testList "zip" [ + testCaseAsync "Simple" + <| async { + let innerCall = cancellableTaskOption { return "fooo" } + let innerCall2 = cancellableTaskOption { return "lol" } + + let! someTask = + innerCall + |> CancellableTaskOption.zip innerCall2 + + Expect.equal (Some("lol", "fooo")) someTask "" + } + ] + + testList "parZip" [ + testCaseAsync "Simple" + <| async { + let innerCall = cancellableTaskOption { return "fooo" } + let innerCall2 = cancellableTaskOption { return "lol" } + + let! someTask = + innerCall + |> CancellableTaskOption.parallelZip innerCall2 + + Expect.equal (Some("lol", "fooo")) someTask "" + } + ] + ] + + [] + let ``CancellableTaskOptionCE inference checks`` = + testList "CancellableTaskOptionCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = cancellableTaskOption { return! res } + + f (CancellableTaskOption.some ()) + |> ignore + ] + + + [] + let cancellableTaskOptionTests = + testList "CancellableTaskOption" [ + cancellableTaskOptionBuilderTests + functionTests + ``CancellableTaskOptionCE inference checks`` + ] diff --git a/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/FsToolkit.ErrorHandling.IcedTasks.Tests.fsproj b/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/FsToolkit.ErrorHandling.IcedTasks.Tests.fsproj index 186c5b25..588de37d 100644 --- a/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/FsToolkit.ErrorHandling.IcedTasks.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/FsToolkit.ErrorHandling.IcedTasks.Tests.fsproj @@ -11,6 +11,7 @@ +