diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 9bd42280..551d6481 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -8,6 +8,7 @@ on: pull_request: branches: - master + workflow_dispatch: jobs: diff --git a/Directory.Build.props b/Directory.Build.props index ad7b912b..f339b105 100644 --- a/Directory.Build.props +++ b/Directory.Build.props @@ -1,7 +1,7 @@ true - $(NoWarn);FS2003; NU1903 + $(NoWarn);FS2003; NU1903; NU1904 true diff --git a/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskResultBuilderBase.fs b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskResultBuilderBase.fs new file mode 100644 index 00000000..c4be80d0 --- /dev/null +++ b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskResultBuilderBase.fs @@ -0,0 +1,1365 @@ +namespace FsToolkit.ErrorHandling + + +/// Contains methods to build Tasks using the F# computation expression syntax +[] +module CancellableTaskResultBuilderBase = + 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 CancellableTaskResult<'T, 'Error> = CancellableTask> + + + /// The extra data stored in ResumableStateMachine for tasks + [] + type CancellableTaskResultBuilderBaseStateMachineData<'T, 'Error, 'Builder> = + [] + val mutable CancellationToken: CancellationToken + + [] + val mutable Result: Result<'T, 'Error> + + [] + val mutable MethodBuilder: 'Builder + + member inline this.IsResultError = Result.isError this.Result + + /// 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() + + /// This is used by the compiler as a template for creating state machine structs + and CancellableTaskResultBuilderBaseStateMachine<'TOverall, 'Error, 'Builder> = + ResumableStateMachine> + + /// Represents the runtime continuation of a cancellableTasks state machine created dynamically + and CancellableTaskResultBuilderBaseResumptionFunc<'TOverall, 'Error, 'Builder> = + ResumptionFunc> + + /// Represents the runtime continuation of a cancellableTasks state machine created dynamically + and CancellableTaskResultBuilderBaseResumptionDynamicInfo<'TOverall, 'Error, 'Builder> = + ResumptionDynamicInfo> + + /// A special compiler-recognised delegate type for specifying blocks of cancellableTasks code with access to the state machine + and CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> = + ResumableCode, 'T> + + /// + /// Contains methods to build TaskLikes using the F# computation expression syntax + /// + type CancellableTaskResultBuilderBase() = + /// Creates a CancellableTasks that runs generator + /// The function to run + /// A CancellableTasks that runs generator + member inline _.Delay + ([] generator: + unit -> CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder>) + : CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> = + 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 + () + : CancellableTaskResultBuilderBaseCode<'TOverall, unit, 'Error, 'Builder> = + ResumableCode.Zero() + + /// 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) + : CancellableTaskResultBuilderBaseCode<'T, 'T, 'Error, 'Builder> = + CancellableTaskResultBuilderBaseCode<'T, 'T, 'Error, 'Builder>(fun sm -> + sm.Data.Result <- Ok 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: CancellableTaskResultBuilderBaseCode<'TOverall, unit, 'Error, 'Builder>, + task2: CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> + ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> = + ResumableCode.Combine( + task1, + (CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder>(fun sm -> + if sm.Data.IsResultError 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: CancellableTaskResultBuilderBaseCode<'TOverall, unit, 'Error, 'Builder> + ) : CancellableTaskResultBuilderBaseCode<'TOverall, unit, 'Error, 'Builder> = + let mutable keepGoing = true + + ResumableCode.While( + (fun () -> + keepGoing + && guard () + ), + CancellableTaskResultBuilderBaseCode<'TOverall, unit, 'Error, 'Builder>(fun sm -> + if sm.Data.IsResultError 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: CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder>, + catchHandler: + exn -> CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> + ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> = + 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: CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder>, + compensation: unit -> unit + ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> = + 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>>, + [] getAwaiter: CancellationToken -> 'Awaiter, + continuation: + ('TResult1 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + ) : bool = + sm.Data.ThrowIfCancellationRequested() + + let mutable awaiter = getAwaiter sm.Data.CancellationToken + + let cont = + (CancellableTaskResultBuilderBaseResumptionFunc<'TOverall, 'Error, _>(fun sm -> + let result = Awaiter.GetResult awaiter + + match result with + | Ok result -> (continuation result).Invoke(&sm) + | Error e -> + sm.Data.Result <- Error e + 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 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder> = + + CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>(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 + | Ok result -> (continuation result).Invoke(&sm) + | Error e -> + sm.Data.Result <- Error e + true + else + let mutable awaiter = awaiter :> ICriticalNotifyCompletion + + MethodBuilder.AwaitUnsafeOnCompleted(&sm.Data.MethodBuilder, &awaiter, &sm) + + false + else + CancellableTaskResultBuilderBase.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 -> CancellableTaskResultBuilderBaseCode<'TOverall, unit, 'Error, 'Builder> + ) : CancellableTaskResultBuilderBaseCode<'TOverall, unit, 'Error, 'Builder> = + ResumableCode.Using( + sequence.GetEnumerator(), + // ... and its body is a while loop that advances the enumerator and runs the body on each element. + (fun e -> + this.While( + (fun () -> e.MoveNext()), + CancellableTaskResultBuilderBaseCode<'TOverall, unit, 'Error, 'Builder>(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 afterwards or + /// when an exception is raised. + member inline internal this.TryFinallyAsync + ( + computation: CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder>, + compensation: unit -> 'Awaitable + ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> = + 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 = + CancellableTaskResultBuilderBaseResumptionFunc<'TOverall, 'Error, 'Builder>(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 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> + ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> = + 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: CancellableTaskResultBuilderBaseCode<_, unit, 'Error, 'Builder> + ) : CancellableTaskResultBuilderBaseCode<_, unit, 'Error, 'Builder> = + let mutable condition_res = true + + ResumableCode.While( + (fun () -> condition_res), + CancellableTaskResultBuilderBaseCode<_, unit, 'Error, 'Builder>(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 = + CancellableTaskResultBuilderBaseResumptionFunc<'TOverall, 'Error, 'Builder>(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 -> CancellableTaskResultBuilderBaseCode<_, unit, 'Error, 'Builder> + ) : CancellableTaskResultBuilderBaseCode<_, _, 'Error, 'Builder> = + + CancellableTaskResultBuilderBaseCode<_, _, 'Error, 'Builder>(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 CancellableTaskResultBuilderBase 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>>, + [] getAwaiter: CancellationToken -> 'Awaiter, + continuation: + ('TResult1 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + ) : bool = + sm.Data.ThrowIfCancellationRequested() + + let mutable awaiter = getAwaiter sm.Data.CancellationToken + + let cont = + (CancellableTaskResultBuilderBaseResumptionFunc<'TOverall, 'Error, _>(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 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder> = + + CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>(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 + CancellableTaskResultBuilderBase.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) + ) + + + // [] + // member inline this.BindReturn + // ( + // [] getAwaiterT: CancellationToken -> 'Awaiter, + // mapper: 'TResult1 -> 'TResult2 + // ) : CancellableTaskResultBuilderBaseCode<_, _, _, _> = + // this.Bind((fun ct -> getAwaiterT ct), (fun v -> this.Return(mapper 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>>, + awaiter: 'Awaiter, + continuation: + ('TResult1 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + ) : bool = + sm.Data.ThrowIfCancellationRequested() + let mutable awaiter = awaiter + + let cont = + (CancellableTaskResultBuilderBaseResumptionFunc<'TOverall, 'Error, 'Builder>(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 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder> = + + CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>(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 + CancellableTaskResultBuilderBase.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) + : CancellableTaskResultBuilderBaseCode<_, _, _, 'Builder> = + this.Bind(awaiterT = awaiterT, continuation = (fun v -> this.Return v)) + + // [] + // member inline this.BindReturn + // ( + // awaiterT: 'Awaiter, + // [] mapper: 'a -> 'TResult2 + // ) : CancellableTaskResultBuilderBaseCode<'TResult2, 'TResult2, 'Error, 'Builder> = + // this.Bind(awaiterT = awaiterT, continuation = (fun v -> this.Return(mapper v))) + + + /// + [] + module LowPriority = + // Low priority extensions + type CancellableTaskResultBuilderBase 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>>, + // [] getAwaiter: CancellationToken -> 'Awaiter, + // continuation: + // ('TResult1 + // -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + // ) : bool = + // sm.Data.ThrowIfCancellationRequested() + + // let mutable awaiter = getAwaiter sm.Data.CancellationToken + + // let cont = + // (CancellableTaskResultBuilderBaseResumptionFunc<'TOverall, 'Error, _>(fun sm -> + // let result = Awaiter.GetResult awaiter + + // match result with + // | Ok result -> (continuation result).Invoke(&sm) + // | Error e -> + // sm.Data.Result <- Error e + // 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 + // -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + // ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder> = + + // CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>(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 + // | Ok result -> (continuation result).Invoke(&sm) + // | Error e -> + // sm.Data.Result <- Error e + // true + // else + // let mutable awaiter = awaiter :> ICriticalNotifyCompletion + + // MethodBuilder.AwaitUnsafeOnCompleted( + // &sm.Data.MethodBuilder, + // &awaiter, + // &sm + // ) + + // false + // else + // CancellableTaskResultBuilderBase.BindDynamic( + // &sm, + // getAwaiterTResult, + // 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 + ([] getAwaiterTResult: CancellationToken -> 'Awaiter) + = + this.Bind( + getAwaiterTResult = (fun ct -> getAwaiterTResult ct), + continuation = (fun v -> this.Return v) + ) + + + // [] + // member inline this.BindReturn + // ( + // [] getAwaiterTResult: CancellationToken -> 'Awaiter, + // mapper: 'TResult1 -> 'TResult2 + // ) : CancellableTaskResultBuilderBaseCode<_, _, _, _> = + // this.Bind((fun ct -> getAwaiterTResult ct), (fun v -> this.Return(mapper 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>> + ([] task: CancellationToken -> 'Awaitable) + : CancellationToken -> 'Awaiter = + (fun ct -> Awaitable.GetAwaiter(task 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>> + ([] task: unit -> 'Awaitable) + : CancellationToken -> 'Awaiter = + (fun ct -> Awaitable.GetAwaiter(task ())) + + /// + /// 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>>, + awaiter: 'Awaiter, + continuation: + ('TResult1 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + ) : bool = + sm.Data.ThrowIfCancellationRequested() + let mutable awaiter = awaiter + + let cont = + (CancellableTaskResultBuilderBaseResumptionFunc<'TOverall, 'Error, 'Builder>(fun + sm -> + let result = Awaiter.GetResult awaiter + + match result with + | Ok result -> (continuation result).Invoke(&sm) + | Error e -> + sm.Data.Result <- Error e + 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 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>) + ) : CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder> = + + CancellableTaskResultBuilderBaseCode<'TOverall, 'TResult2, 'Error, 'Builder>(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 + | Ok result -> (continuation result).Invoke(&sm) + | Error e -> + sm.Data.Result <- Error e + true + else + let mutable awaiter = awaiter :> ICriticalNotifyCompletion + + MethodBuilder.AwaitUnsafeOnCompleted( + &sm.Data.MethodBuilder, + &awaiter, + &sm + ) + + false + else + CancellableTaskResultBuilderBase.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) + : CancellableTaskResultBuilderBaseCode<_, _, _, 'Builder> = + this.Bind(awaiterTResult = awaiterTResult, continuation = (fun v -> this.Return v)) + + // [] + // member inline this.BindReturn + // ( + // awaiterTResult: 'Awaiter, + // [] mapper: 'a -> 'TResult2 + // ) : CancellableTaskResultBuilderBaseCode<'TResult2, 'TResult2, 'Error, 'Builder> = + // this.Bind( + // awaiterTResult = awaiterTResult, + // continuation = (fun v -> this.Return(mapper 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 + -> CancellableTaskResultBuilderBaseCode<'TOverall, 'T, 'Error, 'Builder> + ) = + 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 CancellableTaskResultBuilderBase 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(task: TaskAwaiter<'T>) : Awaiter, 'T> = task + + /// Allows the computation expression to turn other types into CancellationToken -> 'Awaiter + /// + /// This turns a Task<'T> into a CancellationToken -> 'Awaiter. + /// + /// 'Awaiter + member inline _.Source(task: Task<'T>) : Awaiter, 'T> = + Awaitable.GetTaskAwaiter task + + + member inline _.Source + (x: CancellationToken -> Task<_>) + : CancellationToken -> Awaiter, _> = + fun ct -> Awaitable.GetTaskAwaiter(x 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 AwaitCancellableTaskResult + ([] t: CancellableTaskResult<'T, 'Error>) + = + async { + let! ct = Async.CancellationToken + + return! + t ct + |> Async.AwaitTask + } + + static member inline AsCancellableTaskResult(computation: Async<'T>) = + fun ct -> Async.StartImmediateAsTask(computation, cancellationToken = ct) + + type AsyncEx with + + static member inline AwaitCancellableTaskResult + ([] t: CancellableTaskResult<'T, 'Error>) + = + async { + let! ct = Async.CancellationToken + + return! + t ct + |> Async.AwaitTask + } + + static member inline AsCancellableTaskResult(computation: Async<'T>) = + fun ct -> Async.StartImmediateAsTask(computation, cancellationToken = ct) + + + type AsyncResultCE.AsyncResultBuilder with + + member inline this.Source + ([] t: CancellableTaskResult<'T, 'Error>) + : Async<_> = + Async.AwaitCancellableTaskResult t + + + // type AsyncEx with + + // /// Return an asynchronous computation that will wait for the given task to complete and return + // /// its result. + // /// + // /// + // /// This is based on Async.Await overload (esp. AwaitTask without throwing AggregateException) + // /// + // static member inline AwaitCancellableTask + // ([] t: CancellationToken -> Task<'T>) + // = + // asyncEx { + // let! ct = Async.CancellationToken + // return! t ct + // } + + // /// Return an asynchronous computation that will wait for the given task to complete and return + // /// its result. + // /// + // /// + // /// This is based on Async.Await overload (esp. AwaitTask without throwing AggregateException) + // /// + // static member inline AwaitCancellableTask + // ([] t: CancellationToken -> Task) + // = + // asyncEx { + // let! ct = Async.CancellationToken + // return! t ct + // } + + // type Microsoft.FSharp.Control.Async with + + // /// Return an asynchronous computation that will wait for the given task to complete and return + // /// its result. + // static member inline AwaitCancellableTask + // ([] t: CancellationToken -> Task<'T>) + // = + // async { + // let! ct = Async.CancellationToken + + // return! + // t ct + // |> Async.AwaitTask + // } + + // /// Return an asynchronous computation that will wait for the given task to complete and return + // /// its result. + // static member inline AwaitCancellableTask + // ([] t: CancellationToken -> Task) + // = + // async { + // let! ct = Async.CancellationToken + + // return! + // t ct + // |> Async.AwaitTask + // } + + // /// Runs an asynchronous computation, starting on the current operating system thread. + // static member inline AsCancellableTask + // (computation: Async<'T>) + // : CancellationToken -> Task<_> = + // fun ct -> Async.StartImmediateAsTask(computation, cancellationToken = ct) + + // High priority extensions + type CancellableTaskResultBuilderBase 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 + ([] task: CancellationToken -> TaskAwaiter<'T>) + : CancellationToken -> Awaiter, 'T> = + (fun ct -> (task 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(taskResult: TaskResult<'T, 'Error>) = + Awaitable.GetTaskAwaiter(taskResult) + + + /// 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 + (asyncResult: Async>) + : CancellationToken -> TaskAwaiter> = + this.Source(Async.AsCancellableTask asyncResult) + + + /// 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 + (asyncChoice: Async>) + : CancellationToken -> TaskAwaiter> = + this.Source(Async.map Result.ofChoice asyncChoice) + + + /// 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(result: Result<'T, 'Error>) = + this.Source(ValueTask<_>(result)) + + + /// 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(result: Choice<'T, 'Error>) = + this.Source(ValueTask<_>(Result.ofChoice result)) diff --git a/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskResultCE.fs b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskResultCE.fs index c8648c2e..28c9676c 100644 --- a/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskResultCE.fs +++ b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskResultCE.fs @@ -1,6 +1,6 @@ namespace FsToolkit.ErrorHandling - +/// Contains methods to build CancellableTasks using the F# computation expression syntax [] module CancellableTaskResultCE = @@ -13,262 +13,10 @@ module CancellableTaskResultCE = open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Collections - open FsToolkit.ErrorHandling open IcedTasks - /// CancellationToken -> Task> - type CancellableTaskResult<'T, 'Error> = CancellableTask> - - - /// The extra data stored in ResumableStateMachine for tasks - [] - type CancellableTaskResultStateMachineData<'T, 'Error> = - [] - val mutable CancellationToken: CancellationToken - - [] - val mutable Result: Result<'T, 'Error> - - [] - val mutable MethodBuilder: CancellableTaskResultMethodBuilder<'T, 'Error> - - - member inline this.IsResultError = Result.isError this.Result - member inline this.IsTaskCompleted = this.MethodBuilder.Task.IsCompleted - - member inline this.ThrowIfCancellationRequested() = - this.CancellationToken.ThrowIfCancellationRequested() - - and CancellableTaskResultMethodBuilder<'TOverall, 'Error> = - AsyncTaskMethodBuilder> - - and CancellableTaskResultStateMachine<'TOverall, 'Error> = - ResumableStateMachine> - - and CancellableTaskResultResumptionFunc<'TOverall, 'Error> = - ResumptionFunc> - - and CancellableTaskResultResumptionDynamicInfo<'TOverall, 'Error> = - ResumptionDynamicInfo> - - and CancellableTaskResultCode<'TOverall, 'Error, 'T> = - ResumableCode, 'T> - - type CancellableTaskResultBuilderBase() = - - member inline _.Delay - (generator: unit -> CancellableTaskResultCode<'TOverall, 'Error, 'T>) - : CancellableTaskResultCode<'TOverall, 'Error, 'T> = - CancellableTaskResultCode<'TOverall, 'Error, 'T>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - (generator ()).Invoke(&sm) - ) - - /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. - [] - member inline _.Zero<'TOverall, 'Error> - () - : CancellableTaskResultCode<'TOverall, 'Error, unit> = - ResumableCode.Zero() - - member inline _.Return(value: 'T) : CancellableTaskResultCode<'T, 'Error, 'T> = - CancellableTaskResultCode<'T, _, _>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - sm.Data.Result <- Ok value - true - ) - - - /// Chains together a step with its following step. - /// Note that this requires that the first step has no result. - /// This prevents constructs like `task { return 1; return 2; }`. - member inline _.Combine - ( - task1: CancellableTaskResultCode<'TOverall, 'Error, unit>, - task2: CancellableTaskResultCode<'TOverall, 'Error, 'T> - ) : CancellableTaskResultCode<'TOverall, 'Error, 'T> = - ResumableCode.Combine( - CancellableTaskResultCode(fun sm -> - sm.Data.ThrowIfCancellationRequested() - task1.Invoke(&sm) - ), - CancellableTaskResultCode<'TOverall, 'Error, 'T>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - if sm.Data.IsResultError then true else task2.Invoke(&sm) - ) - ) - - - /// Builds a step that executes the body while the condition predicate is true. - member inline _.While - ( - [] condition: unit -> bool, - body: CancellableTaskResultCode<'TOverall, 'Error, unit> - ) : CancellableTaskResultCode<'TOverall, 'Error, unit> = - let mutable keepGoing = true - - ResumableCode.While( - (fun () -> - keepGoing - && condition () - ), - CancellableTaskResultCode<_, _, _>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - - if sm.Data.IsResultError then - keepGoing <- false - sm.Data.MethodBuilder.SetResult sm.Data.Result - true - else - body.Invoke(&sm) - ) - ) - - /// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). - member inline _.TryWith - ( - computation: CancellableTaskResultCode<'TOverall, 'Error, 'T>, - catchHandler: exn -> CancellableTaskResultCode<'TOverall, 'Error, 'T> - ) : CancellableTaskResultCode<'TOverall, 'Error, 'T> = - ResumableCode.TryWith( - CancellableTaskResultCode(fun sm -> - sm.Data.ThrowIfCancellationRequested() - computation.Invoke(&sm) - ), - catchHandler - ) - - /// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). - member inline _.TryFinally - ( - computation: CancellableTaskResultCode<'TOverall, 'Error, 'T>, - [] compensation: unit -> unit - ) : CancellableTaskResultCode<'TOverall, 'Error, 'T> = - ResumableCode.TryFinally( - - CancellableTaskResultCode(fun sm -> - sm.Data.ThrowIfCancellationRequested() - computation.Invoke(&sm) - ), - ResumableCode<_, _>(fun _ -> - compensation () - true - ) - ) - - member inline this.For - ( - sequence: seq<'T>, - body: 'T -> CancellableTaskResultCode<'TOverall, 'Error, unit> - ) : CancellableTaskResultCode<'TOverall, 'Error, 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 -> - this.While( - (fun () -> e.MoveNext()), - CancellableTaskResultCode<'TOverall, 'Error, unit>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - (body e.Current).Invoke(&sm) - ) - ) - ) - ) - - member inline internal this.TryFinallyAsync - ( - body: CancellableTaskResultCode<'TOverall, 'Error, 'T>, - compensation: unit -> ValueTask - ) : CancellableTaskResultCode<'TOverall, 'Error, 'T> = - ResumableCode.TryFinallyAsync( - body, - ResumableCode<_, _>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - - if __useResumableCode then - let mutable __stack_condition_fin = true - let __stack_vtask = compensation () - - if not __stack_vtask.IsCompleted then - let mutable awaiter = __stack_vtask.GetAwaiter() - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - __stack_condition_fin <- __stack_yield_fin - - if not __stack_condition_fin then - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) - - __stack_condition_fin - else - let vtask = compensation () - let mutable awaiter = vtask.GetAwaiter() - - let cont = - CancellableTaskResultResumptionFunc<'TOverall, 'Error>(fun sm -> - awaiter.GetResult() - |> ignore - - true - ) - - // shortcut to continue immediately - if awaiter.IsCompleted then - true - else - sm.ResumptionDynamicInfo.ResumptionData <- - (awaiter :> ICriticalNotifyCompletion) - - sm.ResumptionDynamicInfo.ResumptionFunc <- cont - false - ) - ) - - member inline this.Using<'Resource, 'TOverall, 'Error, 'T when 'Resource :> IAsyncDisposable> - ( - resource: 'Resource, - body: 'Resource -> CancellableTaskResultCode<'TOverall, 'Error, 'T> - ) : CancellableTaskResultCode<'TOverall, 'Error, 'T> = - this.TryFinallyAsync( - (fun sm -> (body resource).Invoke(&sm)), - (fun () -> - if not (isNull (box resource)) then - resource.DisposeAsync() - else - ValueTask() - ) - ) - - member inline this.Source - (ctr: CancellableTaskResult<'T, 'Error>) - : CancellableTaskResult<'T, 'Error> = - ctr - - member inline this.Source(xs: #seq<_>) = xs - - member inline _.Source(result: TaskResult<_, _>) : CancellableTaskResult<_, _> = - cancellableTask { return! result } - - member inline _.Source(result: Async>) : CancellableTaskResult<_, _> = - cancellableTask { return! result } - - member inline this.Source(result: Async>) : CancellableTaskResult<_, _> = - result - |> Async.map Result.ofChoice - |> this.Source - - member inline _.Source(t: ValueTask>) : CancellableTaskResult<'T, 'Error> = - cancellableTask { return! t } - - member inline _.Source(result: Result<_, _>) : CancellableTaskResult<_, _> = - CancellableTask.singleton result - - member inline this.Source(result: Choice<_, _>) : CancellableTaskResult<_, _> = - result - |> Result.ofChoice - |> this.Source - + /// Contains methods to build CancellableTasks using the F# computation expression syntax type CancellableTaskResultBuilder() = inherit CancellableTaskResultBuilderBase() @@ -279,17 +27,22 @@ module CancellableTaskResultCE = // 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: CancellableTaskResultCode<'T, 'Error, 'T>) + (code: CancellableTaskResultBuilderBaseCode<'T, 'T, 'Error, _>) : CancellableTaskResult<'T, 'Error> = - let mutable sm = CancellableTaskResultStateMachine<'T, 'Error>() + let mutable sm = CancellableTaskResultBuilderBaseStateMachine<'T, 'Error, _>() let initialResumptionFunc = - CancellableTaskResultResumptionFunc<'T, 'Error>(fun sm -> code.Invoke(&sm)) + CancellableTaskResultBuilderBaseResumptionFunc<'T, 'Error, _>(fun sm -> + code.Invoke(&sm) + ) let resumptionInfo = - { new CancellableTaskResultResumptionDynamicInfo<'T, 'Error>(initialResumptionFunc) with + { new CancellableTaskResultBuilderBaseResumptionDynamicInfo<'T, 'Error, _>(initialResumptionFunc) with member info.MoveNext(sm) = let mutable savedExn = null @@ -297,29 +50,30 @@ module CancellableTaskResultCE = sm.ResumptionDynamicInfo.ResumptionData <- null let step = info.ResumptionFunc.Invoke(&sm) - if sm.Data.IsTaskCompleted then - () - elif step then - sm.Data.MethodBuilder.SetResult(sm.Data.Result) + if step then + MethodBuilder.SetResult(&sm.Data.MethodBuilder, sm.Data.Result) else let mutable awaiter = sm.ResumptionDynamicInfo.ResumptionData :?> ICriticalNotifyCompletion assert not (isNull awaiter) - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + + 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 -> - // printfn "%A" exn - sm.Data.MethodBuilder.SetException exn + | exn -> MethodBuilder.SetException(&sm.Data.MethodBuilder, exn) member _.SetStateMachine(sm, state) = - sm.Data.MethodBuilder.SetStateMachine(state) + MethodBuilder.SetStateMachine(&sm.Data.MethodBuilder, state) } fun (ct) -> @@ -328,17 +82,17 @@ module CancellableTaskResultCE = else sm.Data.CancellationToken <- ct sm.ResumptionDynamicInfo <- resumptionInfo - - sm.Data.MethodBuilder <- CancellableTaskResultMethodBuilder<'T, 'Error>.Create() - + 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: CancellableTaskResultCode<'T, 'Error, 'T>) + (code: CancellableTaskResultBuilderBaseCode<'T, 'T, 'Error, _>) : CancellableTaskResult<'T, 'Error> = if __useResumableCode then - __stateMachine, CancellableTaskResult<'T, 'Error>> + __stateMachine, CancellableTaskResult<'T, 'Error>> (MoveNextMethodImpl<_>(fun sm -> //-- RESUMABLE CODE START __resumeAt sm.ResumptionPoint @@ -347,23 +101,18 @@ module CancellableTaskResultCE = try let __stack_code_fin = code.Invoke(&sm) - if - __stack_code_fin - && not sm.Data.IsTaskCompleted - then - sm.Data.MethodBuilder.SetResult(sm.Data.Result) + if __stack_code_fin then + MethodBuilder.SetResult(&sm.Data.MethodBuilder, sm.Data.Result) 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 -> - // printfn "%A" exn - sm.Data.MethodBuilder.SetException exn + | exn -> MethodBuilder.SetException(&sm.Data.MethodBuilder, exn) //-- RESUMABLE CODE END )) (SetStateMachineMethodImpl<_>(fun sm state -> - sm.Data.MethodBuilder.SetStateMachine(state) + MethodBuilder.SetStateMachine(&sm.Data.MethodBuilder, state) )) (AfterCode<_, _>(fun sm -> let sm = sm @@ -376,7 +125,7 @@ module CancellableTaskResultCE = sm.Data.CancellationToken <- ct sm.Data.MethodBuilder <- - CancellableTaskResultMethodBuilder<'T, 'Error>.Create() + AsyncTaskMethodBuilder>.Create() sm.Data.MethodBuilder.Start(&sm) sm.Data.MethodBuilder.Task @@ -384,12 +133,74 @@ module CancellableTaskResultCE = else CancellableTaskResultBuilder.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) + + // member inline this.MergeSources + // ( + // [] left: CancellationToken -> 'Awaiter1, + // [] right: CancellationToken -> 'Awaiter2 + // ) = + // this.Run( + // this.Bind( + // left, + // fun leftR -> this.BindReturn(right, (fun rightR -> struct (leftR, rightR))) + // ) + // ) + // >> Awaitable.GetTaskAwaiter + + + // member inline this.MergeSources + // ( + // left: 'Awaiter1, + // [] right: CancellationToken -> 'Awaiter2 + // ) = + // this.Run( + // this.Bind( + // left, + // fun leftR -> this.BindReturn(right, (fun rightR -> struct (leftR, rightR))) + // ) + // ) + // >> Awaitable.GetTaskAwaiter + + + // member inline this.MergeSources + // ( + // [] left: CancellationToken -> 'Awaiter1, + // right: 'Awaiter2 + // ) = + // this.Run( + // this.Bind( + // left, + // fun leftR -> this.BindReturn(right, (fun rightR -> struct (leftR, rightR))) + // ) + // ) + // >> Awaitable.GetTaskAwaiter + + + // member inline this.MergeSources(left: 'Awaiter1, right: 'Awaiter2) = + // this.Run( + // this.Bind( + // left, + // fun leftR -> this.BindReturn(right, (fun rightR -> struct (leftR, rightR))) + // ) + // ) + // >> Awaitable.GetTaskAwaiter + + + /// Contains methods to build CancellableTasks using the F# computation expression syntax type BackgroundCancellableTaskResultBuilder() = inherit CancellableTaskResultBuilderBase() + /// + /// 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: CancellableTaskResultCode<'T, 'Error, 'T>) + (code: CancellableTaskResultBuilderBaseCode<'T, 'T, 'Error, _>) : CancellableTaskResult<'T, 'Error> = // backgroundTask { .. } escapes to a background thread where necessary // See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/ @@ -405,32 +216,34 @@ module CancellableTaskResultCE = ct ) - /// Same as CancellableTaskResultBuilder.Run except the start is inside Task.Run if necessary + /// + /// Hosts the task code in a state machine and starts the task, executing in the ThreadPool using Task.Run + /// member inline _.Run - (code: CancellableTaskResultCode<'T, 'Error, 'T>) + (code: CancellableTaskResultBuilderBaseCode<'T, 'T, 'Error, _>) : CancellableTaskResult<'T, 'Error> = if __useResumableCode then - __stateMachine, CancellableTaskResult<'T, 'Error>> + __stateMachine, CancellableTaskResult<'T, 'Error>> (MoveNextMethodImpl<_>(fun sm -> //-- RESUMABLE CODE START __resumeAt sm.ResumptionPoint + let mutable __stack_exn: Exception = null try let __stack_code_fin = code.Invoke(&sm) - if - __stack_code_fin - && not sm.Data.IsTaskCompleted - then - sm.Data.MethodBuilder.SetResult(sm.Data.Result) + if __stack_code_fin then + MethodBuilder.SetResult(&sm.Data.MethodBuilder, sm.Data.Result) with exn -> - - // printfn "%A" exn - sm.Data.MethodBuilder.SetException 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 -> - sm.Data.MethodBuilder.SetStateMachine(state) + MethodBuilder.SetStateMachine(&sm.Data.MethodBuilder, state) )) (AfterCode<_, CancellableTaskResult<'T, 'Error>>(fun sm -> // backgroundTask { .. } escapes to a background thread where necessary @@ -448,7 +261,7 @@ module CancellableTaskResultCE = sm.Data.CancellationToken <- ct sm.Data.MethodBuilder <- - CancellableTaskResultMethodBuilder<'T, 'Error>.Create() + AsyncTaskMethodBuilder>.Create() sm.Data.MethodBuilder.Start(&sm) sm.Data.MethodBuilder.Task @@ -465,7 +278,7 @@ module CancellableTaskResultCE = sm.Data.CancellationToken <- ct sm.Data.MethodBuilder <- - CancellableTaskResultMethodBuilder<'T, 'Error> + AsyncTaskMethodBuilder> .Create() sm.Data.MethodBuilder.Start(&sm) @@ -474,374 +287,175 @@ module CancellableTaskResultCE = ct ) )) + else BackgroundCancellableTaskResultBuilder.RunDynamic(code) - + /// Contains the cancellableTask computation expression builder. [] module CancellableTaskResultBuilder = + /// + /// Builds a cancellableTask using computation expression syntax. + /// let cancellableTaskResult = CancellableTaskResultBuilder() - let backgroundCancellableTaskResult = BackgroundCancellableTaskResultBuilder() - - [] - module LowPriority = - // Low priority extensions - type CancellableTaskResultBuilderBase with - - [] - static member inline BindDynamic<'TResult1, 'TResult2, ^Awaiter, 'TOverall, 'Error - when ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> Result<'TResult1, 'Error>)> - ( - sm: - byref>>, - getAwaiter: CancellationToken -> ^Awaiter, - continuation: - ('TResult1 -> CancellableTaskResultCode<'TOverall, 'Error, 'TResult2>) - ) : bool = - sm.Data.CancellationToken.ThrowIfCancellationRequested() - - let mutable awaiter = getAwaiter sm.Data.CancellationToken - - let cont = - (CancellableTaskResultResumptionFunc<'TOverall, 'Error>(fun sm -> - let result = - (^Awaiter: (member GetResult: unit -> Result<'TResult1, 'Error>) (awaiter)) - - match result with - | Ok result -> (continuation result).Invoke(&sm) - | Error e -> - sm.Data.Result <- Error e - true - )) - - // shortcut to continue immediately - if (^Awaiter: (member get_IsCompleted: unit -> bool) (awaiter)) then - cont.Invoke(&sm) - else - sm.ResumptionDynamicInfo.ResumptionData <- - (awaiter :> ICriticalNotifyCompletion) - - sm.ResumptionDynamicInfo.ResumptionFunc <- cont - false - - [] - member inline _.Bind<'TResult1, 'TResult2, ^Awaiter, 'TOverall, 'Error - when ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> Result<'TResult1, 'Error>)> - ( - getAwaiter: CancellationToken -> ^Awaiter, - continuation: - ('TResult1 -> CancellableTaskResultCode<'TOverall, 'Error, 'TResult2>) - ) : CancellableTaskResultCode<'TOverall, 'Error, 'TResult2> = - - CancellableTaskResultCode<'TOverall, _, _>(fun sm -> - if __useResumableCode then - //-- RESUMABLE CODE START - sm.Data.CancellationToken.ThrowIfCancellationRequested() - // Get an awaiter from the awaitable - let mutable awaiter = getAwaiter sm.Data.CancellationToken - - let mutable __stack_fin = true - - if not (^Awaiter: (member get_IsCompleted: unit -> bool) (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: (member GetResult: unit -> Result<'TResult1, 'Error>) (awaiter)) - - match result with - | Ok result -> (continuation result).Invoke(&sm) - | Error e -> - sm.Data.Result <- Error e - true - else - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) - false - else - CancellableTaskResultBuilderBase.BindDynamic<'TResult1, 'TResult2, ^Awaiter, 'TOverall, 'Error>( - &sm, - getAwaiter, - continuation - ) - //-- RESUMABLE CODE END - ) - - [] - member inline this.ReturnFrom<'TResult1, 'TResult2, ^Awaiter, 'TOverall, 'Error - when ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> Result<'TResult1, 'Error>)> - (getAwaiter: CancellationToken -> ^Awaiter) - : CancellableTaskResultCode<'TResult1, 'Error, 'TResult1> = - - this.Bind(getAwaiter, (fun v -> this.Return v)) - - - [] - member inline _.Source<'TResult1, 'TResult2, ^Awaiter, 'TOverall, 'Error - when ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> Result<'TResult1, 'Error>)> - (getAwaiter: CancellationToken -> ^Awaiter) - : CancellationToken -> ^Awaiter = - getAwaiter - - [] - member inline _.Source< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall, 'Error - when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) - and ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> Result<'TResult1, 'Error>)> - (task: ^TaskLike) - : CancellationToken -> ^Awaiter = - (fun (ct: CancellationToken) -> - (^TaskLike: (member GetAwaiter: unit -> ^Awaiter) (task)) - ) - - [] - member inline this.Source<'Awaitable, 'Awaiter, 'TResult, 'Error - when Awaitable<'Awaitable, 'Awaiter, 'TResult>> - (t: 'Awaitable) - : CancellableTaskResult<'TResult, 'Error> = - - cancellableTask { - let! r = t - return Ok r - } - - - [] - member inline this.Source<'Awaitable, 'Awaiter, 'TResult, 'Error - when Awaitable<'Awaitable, 'Awaiter, 'TResult>> - (t: unit -> 'Awaitable) - : CancellableTaskResult<'TResult, 'Error> = - - cancellableTask { - let! r = t - return Ok r - } - - - [] - member inline this.Source<'Awaitable, 'Awaiter, 'TResult, 'Error - when Awaitable<'Awaitable, 'Awaiter, 'TResult>> - (t: CancellationToken -> 'Awaitable) - : CancellableTaskResult<'TResult, 'Error> = - - cancellableTask { - let! r = t - return Ok r - } - - member inline _.Using<'Resource, 'TOverall, 'Error, 'T when 'Resource :> IDisposable> - ( - resource: 'Resource, - binder: 'Resource -> CancellableTaskResultCode<'TOverall, 'Error, 'T> - ) = - ResumableCode.Using( - resource, - fun resource -> - CancellableTaskResultCode<'TOverall, 'Error, 'T>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - (binder resource).Invoke(&sm) - ) - ) - [] - module HighPriority = - type Microsoft.FSharp.Control.Async with - - static member inline AwaitCancellableTaskResult - ([] t: CancellableTaskResult<'T, 'Error>) - = - async { - let! ct = Async.CancellationToken - - return! - t ct - |> Async.AwaitTask - } - - static member inline AsCancellableTaskResult(computation: Async<'T>) = - fun ct -> Async.StartImmediateAsTask(computation, cancellationToken = ct) + /// + /// Builds a cancellableTask using computation expression syntax which switches to execute on a background thread if not already doing so. + /// + let backgroundCancellableTaskResult = BackgroundCancellableTaskResultBuilder() - type CancellableTaskResultBuilderBase with - member inline this.Bind - ( - task: CancellableTaskResult<'TResult1, 'Error>, - continuation: - ('TResult1 -> CancellableTaskResultCode<'TOverall, 'Error, 'TResult2>) - ) : CancellableTaskResultCode<'TOverall, 'Error, 'TResult2> = - this.Bind((fun ct -> (task ct).GetAwaiter()), continuation) +// /// +// /// A set of extension methods making it possible to bind against in async computations. +// /// +// [] +// module AsyncExtensions = - member inline this.ReturnFrom - (task: CancellableTaskResult<'T, 'Error>) - : CancellableTaskResultCode<'T, 'Error, 'T> = - this.Bind(task, (fun v -> this.Return v)) +// type AsyncExBuilder with +// member inline this.Source([] t: CancellableTask<'T>) : Async<'T> = +// AsyncEx.AwaitCancellableTask t - [] - module MediumPriority = - open HighPriority +// member inline this.Source([] t: CancellableTask) : Async = +// AsyncEx.AwaitCancellableTask t - type CancellableTaskResultBuilder with +// type Microsoft.FSharp.Control.AsyncBuilder with - member inline _.Source(t: Task<'T>) = - cancellableTask { - let! r = t - return Ok r - } +// member inline this.Bind +// ( +// [] t: CancellableTask<'T>, +// [] binder: ('T -> Async<'U>) +// ) : Async<'U> = +// this.Bind(Async.AwaitCancellableTask t, binder) - member inline _.Source(result: CancellableTask<'T>) = - cancellableTask { - let! r = result - return Ok r - } +// member inline this.ReturnFrom([] t: CancellableTask<'T>) : Async<'T> = +// this.ReturnFrom(Async.AwaitCancellableTask t) - member inline _.Source(result: CancellableTask) : CancellableTaskResult = - cancellableTask { - let! r = result - return Ok r - } +// member inline this.Bind +// ( +// [] t: CancellableTask, +// [] binder: (unit -> Async<'U>) +// ) : Async<'U> = +// this.Bind(Async.AwaitCancellableTask t, binder) - member inline _.Source(result: ColdTask<_>) : CancellableTaskResult<_, _> = - cancellableTask { - let! r = result - return Ok r - } +// member inline this.ReturnFrom([] t: CancellableTask) : Async = +// this.ReturnFrom(Async.AwaitCancellableTask t) - member inline _.Source(result: ColdTask) : CancellableTaskResult<_, _> = - cancellableTask { - let! r = result - return Ok r - } +// // There is explicitly no Binds for `CancellableTasks` in `Microsoft.FSharp.Control.TaskBuilderBase`. +// // You need to explicitly pass in a `CancellationToken`to start it, you can use `CancellationToken.None`. +// // Reason is I don't want people to assume cancellation is happening without the caller being explicit about where the CancellationToken came from. +// // Similar reasoning for `IcedTasks.ColdTasks.ColdTaskBuilderBase`. - member inline _.Source(t: Async<'T>) : CancellableTaskResult<'T, 'Error> = - cancellableTask { - let! r = t - return Ok r - } +// // Contains a set of standard functional helper function +[] +module CancellableTaskResult = + open System.Threading.Tasks + open System.Threading - [] - module AsyncExtenions = - type Microsoft.FSharp.Control.AsyncBuilder with - - member inline this.Bind - ( - [] t: CancellableTaskResult<'T, 'Error>, - [] binder: (_ -> Async<_>) - ) : Async<_> = - this.Bind(Async.AwaitCancellableTaskResult t, binder) - - member inline this.ReturnFrom([] t: CancellableTaskResult<'T, 'Error>) = - this.ReturnFrom(Async.AwaitCancellableTaskResult t) - - - type FsToolkit.ErrorHandling.AsyncResultCE.AsyncResultBuilder with - - member inline this.Source - ([] t: CancellableTaskResult<'T, 'Error>) - : Async<_> = - Async.AwaitCancellableTaskResult t - - // There is explicitly no Binds for `CancellableTaskResults` in `Microsoft.FSharp.Control.TaskBuilderBase`. - // You need to explicitly pass in a `CancellationToken`to start it, you can use `CancellationToken.None`. - // Reason is I don't want people to assume cancellation is happening without the caller being explicit about where the CancellationToken came from. - - [] - module CancellableTaskResult = - let getCancellationToken () : CancellableTaskResult = - CancellableTaskResultBuilder.cancellableTaskResult.Run( - CancellableTaskResultCode<_, 'Error, _>(fun sm -> - sm.Data.Result <- Ok sm.Data.CancellationToken - true - ) - ) - - /// Lifts an item to a CancellableTaskResult. - /// The item to be the result of the CancellableTaskResult. - /// A CancellableTaskResult with the item as the result. - let inline singleton (item: 'item) : CancellableTaskResult<'item, 'Error> = - fun _ -> Task.FromResult(Ok item) - - - /// Allows chaining of CancellableTaskResult. - /// The continuation. - /// The value. - /// The result of the binder. - let inline bind - ([] binder: 'input -> CancellableTaskResult<'output, 'error>) - ([] cTask: CancellableTaskResult<'input, 'error>) - = - cancellableTaskResult { - let! cResult = cTask - return! binder cResult - } - - /// Allows chaining of CancellableTaskResult. - /// The continuation. - /// The value. - /// The result of the mapper wrapped in a CancellableTaskResult. - let inline map - ([] mapper: 'input -> 'output) - ([] cTask: CancellableTaskResult<'input, 'error>) - = - cancellableTaskResult { - let! cResult = cTask - return mapper cResult - } - - /// Allows chaining of CancellableTaskResult. - /// A function wrapped in a CancellableTaskResult - /// The value. - /// The result of the applicable. - let inline apply - ([] applicable: CancellableTaskResult<'input -> 'output, 'error>) - ([] cTask: CancellableTaskResult<'input, 'error>) - = - cancellableTaskResult { - let! applier = applicable - let! cResult = cTask - return applier cResult - } - - /// Takes two CancellableTaskResult, 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: CancellableTaskResult<'left, 'error>) - ([] right: CancellableTaskResult<'right, 'error>) - = - cancellableTaskResult { - let! r1 = left - let! r2 = right - return r1, r2 - } - - /// Takes two CancellableTaskResult, 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: CancellableTaskResult<'left, 'error>) - ([] right: CancellableTaskResult<'right, 'error>) - = - cancellableTaskResult { - let! ct = getCancellationToken () - let r1 = left ct - let r2 = right ct - let! r1 = r1 - let! r2 = r2 - return r1, r2 - } + /// 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 singleton (item: 'item) : CancellableTaskResult<'item, 'Error> = + fun _ -> Task.FromResult(Ok item) + + + /// Allows chaining of CancellableTasks. + /// The continuation. + /// The value. + /// The result of the binder. + let inline bind + ([] binder: 'input -> CancellableTaskResult<'output, 'Error>) + ([] cTask: CancellableTaskResult<'input, 'Error>) + = + cancellableTaskResult { + 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: CancellableTaskResult<'input, 'Error>) + = + cancellableTaskResult { + 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: CancellableTaskResult<'input -> 'output, 'Error>) + ([] cTask: CancellableTaskResult<'input, 'Error>) + = + cancellableTaskResult { + 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: CancellableTaskResult<'left, 'Error>) + ([] right: CancellableTaskResult<'right, 'Error>) + = + cancellableTaskResult { + 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: CancellableTaskResult<'left, 'Error>) + ([] right: CancellableTaskResult<'right, 'Error>) + = + cancellableTaskResult { + let! ct = getCancellationToken () + let r1 = left ct + let r2 = right ct + let! r1 = r1 + let! r2 = r2 + return r1, r2 + } diff --git a/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskValidationCE.fs b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskValidationCE.fs index f6af7999..6e0a5664 100644 --- a/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskValidationCE.fs +++ b/src/FsToolkit.ErrorHandling.IcedTasks/CancellableTaskValidationCE.fs @@ -1,6 +1,49 @@ namespace FsToolkit.ErrorHandling +// What's going on here? +// +// F# method overload resolution has some weird quirks we're taking advantage of to allow +// for binding (`let!/do!/return!`) many various types (Such as Task/Async/Result/Validation) +// in a computation expression. .The gist is, any member methods attached to the type itself +// (the Builder object) will be preferred above all else when selection overloads to resolve. It +// will then use the the most recent Extension Methods that have been opened. The way we structure +// these overloads is to provide the most "concrete" overloads first, and then the more generic +// ones later. For example, `Validation` is defined as a `Result<'T, 'Error list>`, but we also +// want to be able to bind to `Result` itself and create a list of errors from it. So we need to +// have a `Validation` member method in a higher module, and then a `Result` member method +// somewhere lower. Another example is `Task>` vs `Task<'T>`. We want to be able +// to bind to both, so we need to have a `Task>` member method in a higher +// module, and then a `Task<'T>` member method somewhere lower. + +// NoEagerConstraintApplication also changes behavior of SRTP methods, read the +// TaskBuilder RFC for more info. + +// The reason we do AutoOpens here instead of using the attribute on the module itself +// is because it may restrict how the implementation is relying on other sections, such as +// The MediumPriority module may use something from the HighPriority module. If we put the +// HighPriority module after the MediumPriority module it will fail to compile. So we don't want +// the order of the code itself to determine the priority, this allows us to control that ordering +// more explicitly. +// +// Additional readings: +// - [F# Computation Expression Method Overload Resolution Ordering](https://gist.github.com/TheAngryByrd/c8b9c8ebcda3bb162f425bfb281d2e2b) +// - [F# RFC FS-1097 - Task builder](https://github.com/fsharp/fslang-design/blob/main/FSharp-6.0/FS-1097-task-builder.md#feature-noeagerconstraintapplicationattribute) +// - ["Most concrete" tiebreaker for generic overloads](https://github.com/fsharp/fslang-suggestions/issues/905) + + +// [] +// [] +// [] +// [] +// [] +// [] +// [] +// [] +// do () + + +/// Contains methods to build CancellableTasks using the F# computation expression syntax [] module CancellableTaskValidationCE = @@ -13,326 +56,17 @@ module CancellableTaskValidationCE = open Microsoft.FSharp.Core.CompilerServices.StateMachineHelpers open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators open Microsoft.FSharp.Collections - open FsToolkit.ErrorHandling open IcedTasks - /// CancellationToken -> Task> - type CancellableTaskValidation<'T, 'Error> = CancellableTask> - /// The extra data stored in ResumableStateMachine for tasks - [] - type CancellableTaskValidationStateMachineData<'T, 'Error> = - [] - val mutable CancellationToken: CancellationToken + /// CancellationToken -> Task> + type CancellableTaskValidation<'T, 'Error> = CancellableTask> - [] - val mutable Result: Result<'T, 'Error list> - - [] - val mutable MethodBuilder: CancellableTaskValidationMethodBuilder<'T, 'Error> - - member inline this.IsResultError = Result.isError this.Result - - member inline this.ThrowIfCancellationRequested() = - this.CancellationToken.ThrowIfCancellationRequested() - - and CancellableTaskValidationMethodBuilder<'TOverall, 'Error> = - AsyncTaskMethodBuilder> - - and CancellableTaskValidationStateMachine<'TOverall, 'Error> = - ResumableStateMachine> - - and CancellableTaskValidationResumptionFunc<'TOverall, 'Error> = - ResumptionFunc> - - and CancellableTaskValidationResumptionDynamicInfo<'TOverall, 'Error> = - ResumptionDynamicInfo> - - and CancellableTaskValidationCode<'TOverall, 'Error, 'T> = - ResumableCode, 'T> - - type CancellableTaskValidationBuilderBase() = - - member inline _.Delay - ([] generator: - unit -> CancellableTaskValidationCode<'TOverall, 'Error, 'T>) - : CancellableTaskValidationCode<'TOverall, 'Error, 'T> = - CancellableTaskValidationCode<'TOverall, 'Error, 'T>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - (generator ()).Invoke(&sm) - ) - - /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. - [] - member inline _.Zero<'TOverall, 'Error> - () - : CancellableTaskValidationCode<'TOverall, 'Error, unit> = - ResumableCode.Zero() - - member inline _.Return(value: 'T) : CancellableTaskValidationCode<'T, 'Error, 'T> = - CancellableTaskValidationCode<'T, _, _>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - sm.Data.Result <- Ok value - true - ) - - - /// Chains together a step with its following step. - /// Note that this requires that the first step has no result. - /// This prevents constructs like `task { return 1; return 2; }`. - member inline _.Combine - ( - [] task1: CancellableTaskValidationCode<'TOverall, 'Error, unit>, - [] task2: CancellableTaskValidationCode<'TOverall, 'Error, 'T> - ) : CancellableTaskValidationCode<'TOverall, 'Error, 'T> = - ResumableCode.Combine( - CancellableTaskValidationCode(fun sm -> - sm.Data.ThrowIfCancellationRequested() - task1.Invoke(&sm) - ), - CancellableTaskValidationCode<'TOverall, 'Error, 'T>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - if sm.Data.IsResultError then true else task2.Invoke(&sm) - ) - ) - - - /// Builds a step that executes the body while the condition predicate is true. - member inline _.While - ( - [] condition: unit -> bool, - [] body: CancellableTaskValidationCode<'TOverall, 'Error, unit> - ) : CancellableTaskValidationCode<'TOverall, 'Error, unit> = - let mutable __stack_keepGoing = true - - ResumableCode.While( - (fun () -> - __stack_keepGoing - && condition () - ), - CancellableTaskValidationCode<_, _, _>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - - if sm.Data.IsResultError then - __stack_keepGoing <- false - true - else - body.Invoke(&sm) - ) - ) - - /// Wraps a step in a try/with. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). - member inline _.TryWith - ( - [] computation: CancellableTaskValidationCode<'TOverall, 'Error, 'T>, - [] catchHandler: - exn -> CancellableTaskValidationCode<'TOverall, 'Error, 'T> - ) : CancellableTaskValidationCode<'TOverall, 'Error, 'T> = - ResumableCode.TryWith( - CancellableTaskValidationCode(fun sm -> - sm.Data.ThrowIfCancellationRequested() - computation.Invoke(&sm) - ), - catchHandler - ) - - /// Wraps a step in a try/finally. This catches exceptions both in the evaluation of the function - /// to retrieve the step, and in the continuation of the step (if any). - member inline _.TryFinally - ( - [] computation: CancellableTaskValidationCode<'TOverall, 'Error, 'T>, - [] compensation: unit -> unit - ) : CancellableTaskValidationCode<'TOverall, 'Error, 'T> = - ResumableCode.TryFinally( - - CancellableTaskValidationCode(fun sm -> - sm.Data.ThrowIfCancellationRequested() - computation.Invoke(&sm) - ), - ResumableCode<_, _>(fun _ -> - compensation () - true - ) - ) - - member inline this.For - ( - sequence: seq<'T>, - [] body: - 'T -> CancellableTaskValidationCode<'TOverall, 'Error, unit> - ) : CancellableTaskValidationCode<'TOverall, 'Error, 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 -> - this.While( - (fun () -> e.MoveNext()), - CancellableTaskValidationCode<'TOverall, 'Error, unit>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - (body e.Current).Invoke(&sm) - ) - ) - ) - ) - - member inline internal this.TryFinallyAsync - ( - [] body: CancellableTaskValidationCode<'TOverall, 'Error, 'T>, - [] compensation: unit -> ValueTask - ) : CancellableTaskValidationCode<'TOverall, 'Error, 'T> = - ResumableCode.TryFinallyAsync( - body, - ResumableCode<_, _>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - - if __useResumableCode then - let mutable __stack_condition_fin = true - let __stack_vtask = compensation () - - if not __stack_vtask.IsCompleted then - let mutable awaiter = __stack_vtask.GetAwaiter() - let __stack_yield_fin = ResumableCode.Yield().Invoke(&sm) - __stack_condition_fin <- __stack_yield_fin - - if not __stack_condition_fin then - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) - - __stack_condition_fin - else - let vtask = compensation () - let mutable awaiter = vtask.GetAwaiter() - - let cont = - CancellableTaskValidationResumptionFunc<'TOverall, 'Error>(fun sm -> - awaiter.GetResult() - |> ignore - - true - ) - - // shortcut to continue immediately - if awaiter.IsCompleted then - true - else - sm.ResumptionDynamicInfo.ResumptionData <- - (awaiter :> ICriticalNotifyCompletion) - - sm.ResumptionDynamicInfo.ResumptionFunc <- cont - false - ) - ) - - member inline this.Using<'Resource, 'TOverall, 'Error, 'T when 'Resource :> IAsyncDisposable> - ( - resource: 'Resource, - [] body: - 'Resource -> CancellableTaskValidationCode<'TOverall, 'Error, 'T> - ) : CancellableTaskValidationCode<'TOverall, 'Error, 'T> = - this.TryFinallyAsync( - (fun sm -> (body resource).Invoke(&sm)), - (fun () -> - if not (isNull (box resource)) then - resource.DisposeAsync() - else - ValueTask() - ) - ) - - [] - static member inline BindDynamic - ( - sm: - byref>>, - [] getAwaiter: CancellationToken -> ^Awaiter, - [] continuation: - ('TResult1 -> CancellableTaskValidationCode<'TOverall, 'Error, 'TResult2>) - ) : bool = - sm.Data.CancellationToken.ThrowIfCancellationRequested() - - let mutable awaiter = getAwaiter sm.Data.CancellationToken - - let cont = - (CancellableTaskValidationResumptionFunc<'TOverall, 'Error>(fun sm -> - let result = Awaiter.GetResult awaiter - - match result with - | Ok result -> (continuation result).Invoke(&sm) - | Error e -> - sm.Data.Result <- Error e - true - )) - - // shortcut to continue immediately - if Awaiter.IsCompleted awaiter then - cont.Invoke(&sm) - else - sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion) - - sm.ResumptionDynamicInfo.ResumptionFunc <- cont - false - - [] - member inline _.Bind - ( - [] getAwaiter: CancellationToken -> ^Awaiter, - [] continuation: - ('TResult1 -> CancellableTaskValidationCode<'TOverall, 'Error, 'TResult2>) - ) : CancellableTaskValidationCode<'TOverall, 'Error, 'TResult2> = - - CancellableTaskValidationCode<'TOverall, _, _>(fun sm -> - if __useResumableCode then - //-- RESUMABLE CODE START - sm.Data.CancellationToken.ThrowIfCancellationRequested() - // Get an awaiter from the awaitable - let mutable awaiter = getAwaiter 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 - match Awaiter.GetResult awaiter with - | Ok result -> (continuation result).Invoke(&sm) - | Error e -> - sm.Data.Result <- Error e - true - else - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) - false - else - CancellableTaskValidationBuilderBase.BindDynamic(&sm, getAwaiter, continuation) - //-- RESUMABLE CODE END - ) - - - member inline this.Source(xs: #seq<_>) = xs - - - [] - member inline this.ReturnFrom - ([] getAwaiter: CancellationToken -> ^Awaiter) - : CancellableTaskValidationCode<'TResult1, 'Error, 'TResult1> = - - this.Bind(getAwaiter, (fun v -> this.Return v)) - - - [] - member inline this.BindReturn - ( - [] getAwaiter: CancellationToken -> ^Awaiter, - [] f: 'a -> 'TResult1 - ) : CancellableTaskValidationCode<'TResult1, 'Error, 'TResult1> = - - this.Bind(getAwaiter, (fun v -> this.Return(f v))) + /// Contains methods to build CancellableTasks using the F# computation expression syntax type CancellableTaskValidationBuilder() = - inherit CancellableTaskValidationBuilderBase() + inherit CancellableTaskResultBuilderBase() // This is the dynamic implementation - this is not used // for statically compiled tasks. An executor (resumptionFuncExecutor) is @@ -340,17 +74,21 @@ module CancellableTaskValidationCE = // 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: CancellableTaskValidationCode<'T, 'Error, 'T>) + (code: + CancellableTaskResultBuilderBaseCode<'T, 'T, _, AsyncTaskMethodBuilder>>) : CancellableTaskValidation<'T, 'Error> = - let mutable sm = CancellableTaskValidationStateMachine<'T, 'Error>() + let mutable sm = CancellableTaskResultBuilderBaseStateMachine<'T, _, _>() let initialResumptionFunc = - CancellableTaskValidationResumptionFunc<'T, 'Error>(fun sm -> code.Invoke(&sm)) + CancellableTaskResultBuilderBaseResumptionFunc<'T, _, _>(fun sm -> code.Invoke(&sm)) let resumptionInfo = - { new CancellableTaskValidationResumptionDynamicInfo<'T, 'Error>(initialResumptionFunc) with + { new CancellableTaskResultBuilderBaseResumptionDynamicInfo<'T, _, _>(initialResumptionFunc) with member info.MoveNext(sm) = let mutable savedExn = null @@ -359,26 +97,30 @@ module CancellableTaskValidationCE = let step = info.ResumptionFunc.Invoke(&sm) if step then - sm.Data.MethodBuilder.SetResult(sm.Data.Result) + sm.Data.MethodBuilder.SetResult sm.Data.Result + // MethodBuilder.SetResult(&sm.Data.MethodBuilder, sm.Data.Result) else let mutable awaiter = sm.ResumptionDynamicInfo.ResumptionData :?> ICriticalNotifyCompletion assert not (isNull awaiter) - sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + + 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 -> - // printfn "%A" exn - sm.Data.MethodBuilder.SetException exn + | exn -> MethodBuilder.SetException(&sm.Data.MethodBuilder, exn) member _.SetStateMachine(sm, state) = - sm.Data.MethodBuilder.SetStateMachine(state) + MethodBuilder.SetStateMachine(&sm.Data.MethodBuilder, state) } fun (ct) -> @@ -387,18 +129,17 @@ module CancellableTaskValidationCE = else sm.Data.CancellationToken <- ct sm.ResumptionDynamicInfo <- resumptionInfo - - sm.Data.MethodBuilder <- - CancellableTaskValidationMethodBuilder<'T, 'Error>.Create() - + 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: CancellableTaskValidationCode<'T, 'Error, 'T>) + (code: CancellableTaskResultBuilderBaseCode<'T, 'T, _, _>) : CancellableTaskValidation<'T, 'Error> = if __useResumableCode then - __stateMachine, CancellableTaskValidation<'T, 'Error>> + __stateMachine>>, CancellableTaskValidation<'T, 'Error>> (MoveNextMethodImpl<_>(fun sm -> //-- RESUMABLE CODE START __resumeAt sm.ResumptionPoint @@ -408,19 +149,18 @@ module CancellableTaskValidationCE = let __stack_code_fin = code.Invoke(&sm) if __stack_code_fin then - sm.Data.MethodBuilder.SetResult(sm.Data.Result) + sm.Data.MethodBuilder.SetResult sm.Data.Result + // MethodBuilder.SetResult(&sm.Data.MethodBuilder, sm.Data.Result) 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 -> - // printfn "%A" exn - sm.Data.MethodBuilder.SetException exn + | exn -> MethodBuilder.SetException(&sm.Data.MethodBuilder, exn) //-- RESUMABLE CODE END )) (SetStateMachineMethodImpl<_>(fun sm state -> - sm.Data.MethodBuilder.SetStateMachine(state) + MethodBuilder.SetStateMachine(&sm.Data.MethodBuilder, state) )) (AfterCode<_, _>(fun sm -> let sm = sm @@ -433,60 +173,77 @@ module CancellableTaskValidationCE = sm.Data.CancellationToken <- ct sm.Data.MethodBuilder <- - CancellableTaskValidationMethodBuilder<'T, 'Error>.Create() + AsyncTaskMethodBuilder>.Create() sm.Data.MethodBuilder.Start(&sm) sm.Data.MethodBuilder.Task )) else - CancellableTaskValidationBuilder.RunDynamic(code) + failwith "LOL" + // CancellableTaskResultBuilder.RunDynamic(code) + + /// Specify a Source of CancellationToken -> Task<_> on the real type to allow type inference to work + member inline _.Source + (x: CancellableTaskValidation<_, _>) + : CancellationToken -> Awaiter, _> = + fun ct -> Awaitable.GetTaskAwaiter(x ct) - type BackgroundCancellableTaskValidationBuilder() = - inherit CancellableTaskValidationBuilderBase() + /// Contains methods to build CancellableTasks using the F# computation expression syntax + type BackgroundCancellableTaskResultBuilder() = + inherit CancellableTaskResultBuilderBase() + + /// + /// 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: CancellableTaskValidationCode<'T, 'Error, 'T>) - : CancellableTaskValidation<'T, 'Error> = + (code: CancellableTaskResultBuilderBaseCode<'T, 'T, 'Error, _>) + : CancellableTaskResult<'T, 'Error> = // 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 - CancellableTaskValidationBuilder.RunDynamic(code) + CancellableTaskResultBuilder.RunDynamic(code) else fun (ct) -> - Task.Run>( - (fun () -> CancellableTaskValidationBuilder.RunDynamic (code) (ct)), + Task.Run>( + (fun () -> CancellableTaskResultBuilder.RunDynamic (code) (ct)), ct ) - /// Same as CancellableTaskValidationBuilder.Run except the start is inside Task.Run if necessary + /// + /// Hosts the task code in a state machine and starts the task, executing in the ThreadPool using Task.Run + /// member inline _.Run - ([] code: CancellableTaskValidationCode<'T, 'Error, 'T>) - : CancellableTaskValidation<'T, 'Error> = + (code: CancellableTaskResultBuilderBaseCode<'T, 'T, 'Error, _>) + : CancellableTaskResult<'T, 'Error> = if __useResumableCode then - __stateMachine, CancellableTaskValidation<'T, 'Error>> + __stateMachine, CancellableTaskResult<'T, 'Error>> (MoveNextMethodImpl<_>(fun sm -> //-- RESUMABLE CODE START __resumeAt sm.ResumptionPoint + let mutable __stack_exn: Exception = null try let __stack_code_fin = code.Invoke(&sm) if __stack_code_fin then - sm.Data.MethodBuilder.SetResult(sm.Data.Result) + MethodBuilder.SetResult(&sm.Data.MethodBuilder, sm.Data.Result) with exn -> - - // printfn "%A" exn - sm.Data.MethodBuilder.SetException 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 -> - sm.Data.MethodBuilder.SetStateMachine(state) + MethodBuilder.SetStateMachine(&sm.Data.MethodBuilder, state) )) - (AfterCode<_, CancellableTaskValidation<'T, 'Error>>(fun sm -> + (AfterCode<_, CancellableTaskResult<'T, 'Error>>(fun sm -> // backgroundTask { .. } escapes to a background thread where necessary // See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/ if @@ -502,7 +259,7 @@ module CancellableTaskValidationCE = sm.Data.CancellationToken <- ct sm.Data.MethodBuilder <- - CancellableTaskValidationMethodBuilder<'T, 'Error>.Create() + AsyncTaskMethodBuilder>.Create() sm.Data.MethodBuilder.Start(&sm) sm.Data.MethodBuilder.Task @@ -513,13 +270,13 @@ module CancellableTaskValidationCE = if ct.IsCancellationRequested then Task.FromCanceled<_>(ct) else - Task.Run>( + 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 <- - CancellableTaskValidationMethodBuilder<'T, 'Error> + AsyncTaskMethodBuilder> .Create() sm.Data.MethodBuilder.Start(&sm) @@ -528,569 +285,856 @@ module CancellableTaskValidationCE = ct ) )) - else - BackgroundCancellableTaskValidationBuilder.RunDynamic(code) + else + BackgroundCancellableTaskResultBuilder.RunDynamic(code) - module CancellableTaskValidationBuilder = + /// Contains the cancellableTask computation expression builder. + [] + module CancellableTaskResultBuilder = + /// + /// Builds a cancellableTask using computation expression syntax. + /// let cancellableTaskValidation = CancellableTaskValidationBuilder() - let backgroundCancellableTaskValidation = - BackgroundCancellableTaskValidationBuilder() - - - module LowestPriority = - - type CancellableTaskValidationBuilderBase with - - // https://github.com/dotnet/fsharp/discussions/15567 - [] - member inline this.MergeSources<'TResult1, 'TResult2, ^Awaiter1, ^Awaiter2, 'Error - when ^Awaiter1 :> ICriticalNotifyCompletion - and ^Awaiter1: (member get_IsCompleted: unit -> bool) - and ^Awaiter1: (member GetResult: unit -> Validation<'TResult1, 'Error>) - and ^Awaiter2 :> ICriticalNotifyCompletion - and ^Awaiter2: (member get_IsCompleted: unit -> bool) - and ^Awaiter2: (member GetResult: unit -> Validation<'TResult2, 'Error>)> - ( - [] left: CancellationToken -> ^Awaiter1, - [] right: CancellationToken -> ^Awaiter2 - ) : CancellationToken -> TaskAwaiter> = - - (fun ct -> - let handler = - cancellableTask { - let! ct = CancellableTask.getCancellationToken () - let left' = left ct - let right' = right ct - let! leftResult = left' - let! rightResult = right' - - return Validation.zip leftResult rightResult - } - - (handler ct).GetAwaiter() + /// + /// Builds a cancellableTask using computation expression syntax which switches to execute on a background thread if not already doing so. + /// + let backgroundCancellableTaskResult = BackgroundCancellableTaskResultBuilder() + + +/// +/// A set of extension methods making it possible to bind against in async computations. +/// +[] +module AsyncExtensions = + open IcedTasks + + type AsyncExBuilder with + + member inline this.Source([] t: CancellableTask<'T>) : Async<'T> = + AsyncEx.AwaitCancellableTask t + + member inline this.Source([] t: CancellableTask) : Async = + AsyncEx.AwaitCancellableTask t + + type Microsoft.FSharp.Control.AsyncBuilder with + + member inline this.Bind + ( + [] t: CancellableTask<'T>, + [] binder: ('T -> Async<'U>) + ) : Async<'U> = + this.Bind(Async.AwaitCancellableTask t, binder) + + member inline this.ReturnFrom([] t: CancellableTask<'T>) : Async<'T> = + this.ReturnFrom(Async.AwaitCancellableTask t) + + member inline this.Bind + ( + [] t: CancellableTask, + [] binder: (unit -> Async<'U>) + ) : Async<'U> = + this.Bind(Async.AwaitCancellableTask t, binder) + + member inline this.ReturnFrom([] t: CancellableTask) : Async = + this.ReturnFrom(Async.AwaitCancellableTask t) + + + type Microsoft.FSharp.Control.Async with + + static member inline AwaitCancellableTaskValidation + ([] t: CancellableTaskValidation<'T, 'Error>) + = + async { + let! ct = Async.CancellationToken + + return! + t ct + |> Async.AwaitTask + } + + static member inline AsCancellableTaskValidation(computation: Async<'T>) = + fun ct -> Async.StartImmediateAsTask(computation, cancellationToken = ct) + + + type FsToolkit.ErrorHandling.AsyncValidationCE.AsyncValidationBuilder with + + member inline this.Source + ([] t: CancellableTaskValidation<'T, 'Error>) + : Async<_> = + Async.AwaitCancellableTaskValidation t + +// There is explicitly no Binds for `CancellableTasks` in `Microsoft.FSharp.Control.TaskBuilderBase`. +// You need to explicitly pass in a `CancellationToken`to start it, you can use `CancellationToken.None`. +// Reason is I don't want people to assume cancellation is happening without the caller being explicit about where the CancellationToken came from. +// Similar reasoning for `IcedTasks.ColdTasks.ColdTaskBuilderBase`. + +/// Contains a set of standard functional helper function + +[] +module CancellableTaskValidation = + 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 singleton (item: 'item) : CancellableTaskValidation<'item, 'Error> = + fun _ -> Task.FromResult(Ok item) + + /// Allows chaining of CancellableTasks. + /// The continuation. + /// The value. + /// The result of the binder. + let inline bind + ([] binder: 'input -> CancellableTaskValidation<'output, 'Error>) + ([] cTask: CancellableTaskValidation<'input, 'Error>) + = + cancellableTaskValidation { + let! cResult = cTask + return! binder cResult + } + + + let inline ofResult (result: Result<'ok, 'error>) : CancellableTaskValidation<'ok, 'error> = + let x = Result.mapError List.singleton result + fun _ -> Task.FromResult(x) + + /// Lifts an item to a CancellableTaskValidation. + /// The item to be the ok result of the CancellableTaskValidation. + /// A CancellableTaskValidation with the item as the result. + let inline ok (item: 'ok) : CancellableTaskValidation<'ok, 'error> = + fun _ -> Task.FromResult(Ok item) + + /// Lifts an item to a CancellableTaskValidation. + /// The item to be the error result of the CancellableTaskValidation. + /// A CancellableTaskValidation with the item as the result. + let inline error (error: 'error) : CancellableTaskValidation<'ok, 'error> = + fun _ -> Task.FromResult(Error [ error ]) + + + let inline ofChoice (choice: Choice<'ok, 'error>) : CancellableTaskValidation<'ok, 'error> = + match choice with + | Choice1Of2 x -> ok x + | Choice2Of2 x -> error x + + let inline retn (value: 'ok) : CancellableTaskValidation<'ok, 'error> = ok value + + + let inline mapError + ([] errorMapper: 'errorInput -> 'errorOutput) + ([] input: CancellableTaskValidation<'ok, 'errorInput>) + : CancellableTaskValidation<'ok, 'errorOutput> = + cancellableTask { + let! input = input + return Result.mapError (List.map errorMapper) input + } + + let inline mapErrors + ([] errorMapper: 'errorInput list -> 'errorOutput list) + ([] input: CancellableTaskValidation<'ok, 'errorInput>) + : CancellableTaskValidation<'ok, 'errorOutput> = + cancellableTask { + let! input = input + return Result.mapError errorMapper input + } + + /// Allows chaining of CancellableTaskValidation. + /// The continuation. + /// The value. + /// The result of the mapper wrapped in a CancellableTaskValidation. + let inline map + ([] mapper: 'input -> 'output) + ([] cTask: CancellableTaskValidation<'input, 'error>) + : CancellableTaskValidation<'output, 'error> = + cancellableTask { + let! cResult = cTask + return Result.map mapper cResult + } + + /// Allows chaining of CancellableTaskValidation. + /// The continuation. + /// The 1st value. + /// The 2nd value. + /// The result of the mapper wrapped in a CancellableTaskValidation. + let inline map2 + ([] mapper: 'input1 -> 'input2 -> 'output) + ([] cTask1: CancellableTaskValidation<'input1, 'error>) + ([] cTask2: CancellableTaskValidation<'input2, 'error>) + : CancellableTaskValidation<'output, 'error> = + cancellableTask { + let! cResult1 = cTask1 + let! cResult2 = cTask2 + + return + match cResult1, cResult2 with + | Ok x, Ok y -> Ok(mapper x y) + | Ok _, Error errs -> Error errs + | Error errs, Ok _ -> Error errs + | Error errs1, Error errs2 -> + Error( + errs1 + @ errs2 + ) + } + + /// Allows chaining of CancellableTaskValidation. + /// The continuation. + /// The 1st value. + /// The 2nd value. + /// The 2nd value. + /// The result of the mapper wrapped in a CancellableTaskValidation. + let inline map3 + ([] mapper: 'input1 -> 'input2 -> 'input3 -> 'output) + ([] cTask1: CancellableTaskValidation<'input1, 'error>) + ([] cTask2: CancellableTaskValidation<'input2, 'error>) + ([] cTask3: CancellableTaskValidation<'input3, 'error>) + : CancellableTaskValidation<'output, 'error> = + cancellableTask { + let! cResult1 = cTask1 + let! cResult2 = cTask2 + let! cResult3 = cTask3 + + return + match cResult1, cResult2, cResult3 with + | Ok x, Ok y, Ok z -> Ok(mapper x y z) + | Error errs, Ok _, Ok _ -> Error errs + | Ok _, Error errs, Ok _ -> Error errs + | Ok _, Ok _, Error errs -> Error errs + | Error errs1, Error errs2, Ok _ -> + Error( + errs1 + @ errs2 + ) + | Ok _, Error errs1, Error errs2 -> + Error( + errs1 + @ errs2 + ) + | Error errs1, Ok _, Error errs2 -> + Error( + errs1 + @ errs2 + ) + | Error errs1, Error errs2, Error errs3 -> + Error( + errs1 + @ errs2 + @ errs3 + ) + } + + /// Allows chaining of CancellableTaskValidation. + /// A function wrapped in a CancellableTaskValidation + /// The value. + /// The result of the applicable. + let inline apply + ([] applicable: CancellableTaskValidation<'input -> 'output, 'error>) + ([] cTask: CancellableTaskValidation<'input, 'error>) + : CancellableTaskValidation<'output, 'error> = + cancellableTask { + let! applier = applicable + let! cResult = cTask + + return + match applier, cResult with + | Ok f, Ok x -> Ok(f x) + | Error errs, Ok _ + | Ok _, Error errs -> Error errs + | Error errs1, Error errs2 -> + Error( + errs1 + @ errs2 + ) + } + + let inline orElse + ([] ifError: CancellableTaskValidation<'input, 'errorOutput>) + ([] cTask: CancellableTaskValidation<'input, 'errorInput>) + : CancellableTaskValidation<'input, 'errorOutput> = + cancellableTask { + let! result = cTask + + return! + result + |> Result.either ok (fun _ -> ifError) + } + + let inline orElseWith + ([] ifErrorFunc: + 'errorInput list -> CancellableTaskValidation<'input, 'errorOutput>) + ([] cTask: CancellableTaskValidation<'input, 'errorInput>) + : CancellableTaskValidation<'input, 'errorOutput> = + cancellableTask { + let! result = cTask + + return! + match result with + | Ok x -> ok x + | Error err -> ifErrorFunc err + } + + /// Takes two CancellableTaskValidation, 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: CancellableTaskValidation<'left, 'error>) + ([] right: CancellableTaskValidation<'right, 'error>) + : CancellableTaskValidation<('left * 'right), 'error> = + cancellableTask { + let! r1 = left + let! r2 = right + + return Validation.zip r1 r2 + } + + /// Takes two CancellableTaskValidation, 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: CancellableTaskValidation<'left, 'error>) + ([] right: CancellableTaskValidation<'right, 'error>) + : CancellableTaskValidation<('left * 'right), 'error> = + cancellableTask { + let! ct = CancellableTask.getCancellationToken () + let left = left ct + let right = right ct + let! r1 = left + let! r2 = right + + return Validation.zip r1 r2 + + } + + +[] +module CancellableTaskResultBuilderPriority1 = + open System.Threading.Tasks + + type CancellableTaskValidationBuilder with + + member inline this.Source(result: Result<'T, 'Error>) = + this.Source(ValueTask<_>(Validation.ofResult result)) + + + member inline this.Source(choice: Choice<'T, 'Error>) = + this.Source(ValueTask<_>(Validation.ofChoice choice)) + + +[] +module CancellableTaskResultBuilderPriority2 = + open System.Threading.Tasks + + type CancellableTaskValidationBuilder with + + member inline this.Source(result: Validation<'T, 'Error>) = + this.Source(ValueTask<_>(result)) + +open IcedTasks +open System.Threading +open System.Threading.Tasks +open Microsoft.FSharp.Core.CompilerServices + + +[] +module CTVMergeSourcesExtensionsCT1CT2 = + + type CancellableTaskValidationBuilder with + + [] + member inline this.MergeSources + ( + [] left: CancellationToken -> 'Awaiter1, + [] right: CancellationToken -> 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let left = left ct + let right = right ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip (Ok leftR) (Ok rightR)) + ) + )) + ) ) + ) - [] - member inline this.Source<'Awaitable, 'Awaiter, 'TResult - when Awaitable<'Awaitable, 'Awaiter, 'TResult>> - ([] t: CancellationToken -> 'Awaitable) - = - - fun ct -> - (task { - let! r = t ct - return Validation.ok r - }) - .GetAwaiter() - - - [] - member inline this.Source<'Awaitable, 'Awaiter, 'TResult - when Awaitable<'Awaitable, 'Awaiter, 'TResult>> - ([] t: unit -> 'Awaitable) - = - - fun (ct: CancellationToken) -> - (task { - let! r = t () - return Validation.ok r - }) - .GetAwaiter() - - - [] - member inline this.Source<'Awaitable, 'Awaiter, 'TResult - when Awaitable<'Awaitable, 'Awaiter, 'TResult>> - (t: 'Awaitable) - = +[] +module CTVMergeSourcesExtensionsCV1CT2 = + + type CancellableTaskValidationBuilder with - fun (ct: CancellationToken) -> - (task { - let! r = t - return Validation.ok r - }) - .GetAwaiter() - - - module LowerPriority = - - type CancellableTaskValidationBuilderBase with - - - [] - member inline this.Source([] t: CancellationToken -> 'Awaitable) = - fun ct -> - (task { - let! r = t ct - return Validation.ofResult r - }) - .GetAwaiter() - - - [] - member inline this.Source([] t: unit -> 'Awaitable) = - fun (ct: CancellationToken) -> - (task { - let! r = t () - return Validation.ofResult r - }) - .GetAwaiter() - - - [] - member inline this.Source(t: 'Awaitable) = - fun (ct: CancellationToken) -> - (task { - let! r = t - return Validation.ofResult r - }) - .GetAwaiter() - - module LowerPriority2 = - // Low priority extensions - type CancellableTaskValidationBuilderBase with - - [] - member inline this.Source<'Awaitable, ^Awaiter, 'T, 'Error - when 'Awaitable: (member GetAwaiter: unit -> ^Awaiter) - and ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> Validation<'T, 'Error>)> - ([] t: CancellationToken -> 'Awaitable) - = - - fun ct -> Awaitable.GetAwaiter(t ct) - - - [] - member inline this.Source<'Awaitable, ^Awaiter, 'T, 'Error - when 'Awaitable: (member GetAwaiter: unit -> ^Awaiter) - and ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> Validation<'T, 'Error>)> - ([] t: unit -> 'Awaitable) - = - - fun (ct: CancellationToken) -> Awaitable.GetAwaiter(t ()) - - - [] - member inline this.Source<'Awaitable, ^Awaiter, 'T, 'Error - when 'Awaitable: (member GetAwaiter: unit -> ^Awaiter) - and ^Awaiter :> ICriticalNotifyCompletion - and ^Awaiter: (member get_IsCompleted: unit -> bool) - and ^Awaiter: (member GetResult: unit -> Validation<'T, 'Error>)> - (t: 'Awaitable) - = - - fun (ct: CancellationToken) -> Awaitable.GetAwaiter(t) - - module LowPriority = - // Low priority extensions - type CancellableTaskValidationBuilderBase with - - member inline this.Source(t: Task<'T>) = - fun (ct: CancellationToken) -> (Task.map Validation.ok t).GetAwaiter() - - member inline this.Source([] t: ColdTask<'T>) = - fun (ct: CancellationToken) -> (Task.map Validation.ok (t ())).GetAwaiter() - - - member inline this.Source([] t: CancellableTask<'T>) = - fun (ct: CancellationToken) -> (Task.map Validation.ok (t ct)).GetAwaiter() - - member inline this.Source(t: Async<'T>) = - - fun (ct: CancellationToken) -> - (Task.map Validation.ok (Async.StartAsTask(t, cancellationToken = ct))) - .GetAwaiter() - - member inline _.Using<'Resource, 'TOverall, 'Error, 'T when 'Resource :> IDisposable> - ( - resource: 'Resource, - [] binder: - 'Resource -> CancellableTaskValidationCode<'TOverall, 'Error, 'T> - ) = - ResumableCode.Using( - resource, - fun resource -> - CancellableTaskValidationCode<'TOverall, 'Error, 'T>(fun sm -> - sm.Data.ThrowIfCancellationRequested() - (binder resource).Invoke(&sm) - ) + [] + member inline this.MergeSources + ( + [] left: CancellationToken -> 'Awaiter1, + [] right: CancellationToken -> 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let left = left ct + let right = right ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip leftR (Ok rightR)) + ) + )) + ) ) + ) - module MediumPriority = - type Microsoft.FSharp.Control.Async with - static member inline AwaitCancellableTaskValidation - ([] t: CancellableTaskValidation<'T, 'Error>) - = - async { - let! ct = Async.CancellationToken +[] +module CTVMergeSourcesExtensionsCT1CV2 = - return! - t ct - |> Async.AwaitTask - } + type CancellableTaskValidationBuilder with - static member inline AsCancellableTaskValidation(computation: Async<'T>) = - fun ct -> Async.StartImmediateAsTask(computation, cancellationToken = ct) + [] + member inline this.MergeSources + ( + [] left: CancellationToken -> 'Awaiter1, + [] right: CancellationToken -> 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let left = left ct + let right = right ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip (Ok leftR) rightR) + ) + )) + ) + ) + ) - type CancellableTaskValidationBuilderBase with +[] +module CTVMergeSourcesExtensionsCV1CV2 = - member inline _.Source(t: Result<'T, 'Error>) = - fun (ct: CancellationToken) -> - (t - |> Validation.ofResult - |> Task.FromResult) - .GetAwaiter() + type CancellableTaskValidationBuilder with - member inline _.Source(t: Choice<'T, 'Error>) = - fun (ct: CancellationToken) -> - (t - |> Result.ofChoice - |> Validation.ofResult - |> Task.FromResult) - .GetAwaiter() + [] + member inline this.MergeSources + ( + [] left: CancellationToken -> 'Awaiter1, + [] right: CancellationToken -> 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let left = left ct + let right = right ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip leftR rightR) + ) + )) + ) + ) + ) - member inline _.Source(t: TaskResult<'T, 'Error>) = - fun (ct: CancellationToken) -> (Task.map Validation.ofResult t).GetAwaiter() +[] +module CTVMergeSourcesExtensionsCT1T2 = + type CancellableTaskValidationBuilder with - member inline _.Source(t: Async>) = - fun ct -> - (Async.StartAsTask(t, cancellationToken = ct) - |> Task.map Validation.ofResult) - .GetAwaiter() + [] + member inline this.MergeSources + ( + [] left: CancellationToken -> 'Awaiter1, + right: 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let left = left ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip (Ok leftR) (Ok rightR)) + ) + )) + ) + ) + ) +[] +module CTVMergeSourcesExtensionsCV1T2 = - member inline this.Source(t: Async>) = - this.Source(Async.map Result.ofChoice t) + type CancellableTaskValidationBuilder with + [] + member inline this.MergeSources + ( + [] left: CancellationToken -> 'Awaiter1, + right: 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let left = left ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip leftR (Ok rightR)) + ) + )) + ) + ) + ) - member inline _.Source([] t: CancellableTaskResult<'T, 'Error>) = - CancellableTask.map Validation.ofResult t - module HighPriority = +[] +module CTVMergeSourcesExtensionsCT1TV2 = - type CancellableTaskValidationBuilder with + type CancellableTaskValidationBuilder with - member inline _.Source(t: Validation<'T, 'Error>) = - fun (ct: CancellationToken) -> (Task.FromResult t).GetAwaiter() + [] + member inline this.MergeSources + ( + [] left: CancellationToken -> 'Awaiter1, + right: 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let left = left ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip (Ok leftR) rightR) + ) + )) + ) + ) + ) - member inline _.Source([] t: CancellableTaskValidation<'T, 'Error>) = - fun ct -> (t ct).GetAwaiter() - member inline _.Source(t: Task>) = - fun (ct: CancellationToken) -> t.GetAwaiter() +[] +module CTVMergeSourcesExtensionsCV1TV2 = - member inline _.Source(t: Async>) = - fun ct -> Async.StartAsTask(t, cancellationToken = ct).GetAwaiter() + type CancellableTaskValidationBuilder with - module AsyncExtensions = - open MediumPriority + [] + member inline this.MergeSources + ( + [] left: CancellationToken -> 'Awaiter1, + right: 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let left = left ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip leftR (rightR)) + ) + )) + ) + ) + ) - type Microsoft.FSharp.Control.AsyncBuilder with +[] +module CTVMergeSourcesExtensionsT1CT2 = - member inline this.Bind - ( - [] t: CancellableTaskValidation<'T, 'Error>, - [] binder: (_ -> Async<_>) - ) : Async<_> = - this.Bind(Async.AwaitCancellableTaskValidation t, binder) + type CancellableTaskValidationBuilder with - member inline this.ReturnFrom - ([] t: CancellableTaskValidation<'T, 'Error>) - = - this.ReturnFrom(Async.AwaitCancellableTaskValidation t) + [] + member inline this.MergeSources + ( + left: 'Awaiter1, + [] right: CancellationToken -> 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let right = right ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip (Ok leftR) (Ok rightR)) + ) + )) + ) + ) + ) +[] +module CTVMergeSourcesExtensionsTV1CT2 = - type FsToolkit.ErrorHandling.AsyncValidationCE.AsyncValidationBuilder with + type CancellableTaskValidationBuilder with - member inline this.Source - ([] t: CancellableTaskValidation<'T, 'Error>) - : Async<_> = - Async.AwaitCancellableTaskValidation t + [] + member inline this.MergeSources + ( + left: 'Awaiter1, + [] right: CancellationToken -> 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let right = right ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip leftR (Ok rightR)) + ) + )) + ) + ) + ) + + +[] +module CTVMergeSourcesExtensionsT1CV2 = + + type CancellableTaskValidationBuilder with - [] - module CancellableTaskValidation = - let getCancellationToken () : CancellableTaskValidation = - CancellableTaskValidationBuilder.cancellableTaskValidation.Run( - CancellableTaskValidationCode<_, 'Error, _>(fun sm -> - sm.Data.Result <- Ok sm.Data.CancellationToken - true + [] + member inline this.MergeSources + ( + left: 'Awaiter1, + [] right: CancellationToken -> 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let right = right ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip (Ok leftR) rightR) + ) + )) + ) ) ) - /// Lifts an item to a CancellableTaskValidation. - /// The item to be the ok result of the CancellableTaskValidation. - /// A CancellableTaskValidation with the item as the result. - let inline ok (item: 'ok) : CancellableTaskValidation<'ok, 'error> = - fun _ -> Task.FromResult(Ok item) - - /// Lifts an item to a CancellableTaskValidation. - /// The item to be the error result of the CancellableTaskValidation. - /// A CancellableTaskValidation with the item as the result. - let inline error (error: 'error) : CancellableTaskValidation<'ok, 'error> = - fun _ -> Task.FromResult(Error [ error ]) - - let inline ofResult (result: Result<'ok, 'error>) : CancellableTaskValidation<'ok, 'error> = - let x = Result.mapError List.singleton result - fun _ -> Task.FromResult(x) - - let inline ofChoice (choice: Choice<'ok, 'error>) : CancellableTaskValidation<'ok, 'error> = - match choice with - | Choice1Of2 x -> ok x - | Choice2Of2 x -> error x - - let inline retn (value: 'ok) : CancellableTaskValidation<'ok, 'error> = ok value - - /// Allows chaining of CancellableTaskValidation. - /// The continuation. - /// The value. - /// The result of the binder. - let inline bind - ([] binder: 'input -> CancellableTaskValidation<'output, 'error>) - ([] cTask: CancellableTaskValidation<'input, 'error>) - = - cancellableTask { - let! cResult = cTask +[] +module CTVMergeSourcesExtensionsTV1CV2 = - match cResult with - | Ok x -> return! binder x - | Error e -> return Error e - } + type CancellableTaskValidationBuilder with - let inline mapError - ([] errorMapper: 'errorInput -> 'errorOutput) - ([] input: CancellableTaskValidation<'ok, 'errorInput>) - : CancellableTaskValidation<'ok, 'errorOutput> = - cancellableTask { - let! input = input - return Result.mapError (List.map errorMapper) input - } + [] + member inline this.MergeSources + ( + left: 'Awaiter1, + [] right: CancellationToken -> 'Awaiter2 + ) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + let right = right ct + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip leftR rightR) + ) + )) + ) + ) + ) - let inline mapErrors - ([] errorMapper: 'errorInput list -> 'errorOutput list) - ([] input: CancellableTaskValidation<'ok, 'errorInput>) - : CancellableTaskValidation<'ok, 'errorOutput> = - cancellableTask { - let! input = input - return Result.mapError errorMapper input - } - /// Allows chaining of CancellableTaskValidation. - /// The continuation. - /// The value. - /// The result of the mapper wrapped in a CancellableTaskValidation. - let inline map - ([] mapper: 'input -> 'output) - ([] cTask: CancellableTaskValidation<'input, 'error>) - : CancellableTaskValidation<'output, 'error> = - cancellableTask { - let! cResult = cTask - return Result.map mapper cResult - } +[] +module CTVMergeSourcesExtensionsT1T2 = - /// Allows chaining of CancellableTaskValidation. - /// The continuation. - /// The 1st value. - /// The 2nd value. - /// The result of the mapper wrapped in a CancellableTaskValidation. - let inline map2 - ([] mapper: 'input1 -> 'input2 -> 'output) - ([] cTask1: CancellableTaskValidation<'input1, 'error>) - ([] cTask2: CancellableTaskValidation<'input2, 'error>) - : CancellableTaskValidation<'output, 'error> = - cancellableTask { - let! cResult1 = cTask1 - let! cResult2 = cTask2 - - return - match cResult1, cResult2 with - | Ok x, Ok y -> Ok(mapper x y) - | Ok _, Error errs -> Error errs - | Error errs, Ok _ -> Error errs - | Error errs1, Error errs2 -> - Error( - errs1 - @ errs2 - ) - } + type CancellableTaskValidationBuilder with - /// Allows chaining of CancellableTaskValidation. - /// The continuation. - /// The 1st value. - /// The 2nd value. - /// The 2nd value. - /// The result of the mapper wrapped in a CancellableTaskValidation. - let inline map3 - ([] mapper: 'input1 -> 'input2 -> 'input3 -> 'output) - ([] cTask1: CancellableTaskValidation<'input1, 'error>) - ([] cTask2: CancellableTaskValidation<'input2, 'error>) - ([] cTask3: CancellableTaskValidation<'input3, 'error>) - : CancellableTaskValidation<'output, 'error> = - cancellableTask { - let! cResult1 = cTask1 - let! cResult2 = cTask2 - let! cResult3 = cTask3 - - return - match cResult1, cResult2, cResult3 with - | Ok x, Ok y, Ok z -> Ok(mapper x y z) - | Error errs, Ok _, Ok _ -> Error errs - | Ok _, Error errs, Ok _ -> Error errs - | Ok _, Ok _, Error errs -> Error errs - | Error errs1, Error errs2, Ok _ -> - Error( - errs1 - @ errs2 - ) - | Ok _, Error errs1, Error errs2 -> - Error( - errs1 - @ errs2 - ) - | Error errs1, Ok _, Error errs2 -> - Error( - errs1 - @ errs2 - ) - | Error errs1, Error errs2, Error errs3 -> - Error( - errs1 - @ errs2 - @ errs3 - ) - } + [] + member inline this.MergeSources(left: 'Awaiter1, right: 'Awaiter2) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip (Ok leftR) (Ok rightR)) + ) + )) + ) + ) + ) - /// Allows chaining of CancellableTaskValidation. - /// A function wrapped in a CancellableTaskValidation - /// The value. - /// The result of the applicable. - let inline apply - ([] applicable: CancellableTaskValidation<'input -> 'output, 'error>) - ([] cTask: CancellableTaskValidation<'input, 'error>) - : CancellableTaskValidation<'output, 'error> = - cancellableTask { - let! applier = applicable - let! cResult = cTask - - return - match applier, cResult with - | Ok f, Ok x -> Ok(f x) - | Error errs, Ok _ - | Ok _, Error errs -> Error errs - | Error errs1, Error errs2 -> - Error( - errs1 - @ errs2 - ) - } +[] +module CTVMergeSourcesExtensionsTV1T2 = - let inline orElse - ([] ifError: CancellableTaskValidation<'input, 'errorOutput>) - ([] cTask: CancellableTaskValidation<'input, 'errorInput>) - : CancellableTaskValidation<'input, 'errorOutput> = - cancellableTask { - let! result = cTask + type CancellableTaskValidationBuilder with - return! - result - |> Result.either ok (fun _ -> ifError) - } + [] + member inline this.MergeSources(left: 'Awaiter1, right: 'Awaiter2) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip leftR (Ok rightR)) + ) + )) + ) + ) + ) - let inline orElseWith - ([] ifErrorFunc: - 'errorInput list -> CancellableTaskValidation<'input, 'errorOutput>) - ([] cTask: CancellableTaskValidation<'input, 'errorInput>) - : CancellableTaskValidation<'input, 'errorOutput> = - cancellableTask { - let! result = cTask - return! - match result with - | Ok x -> ok x - | Error err -> ifErrorFunc err - } +[] +module CTVMergeSourcesExtensionsT1TV2 = - /// Takes two CancellableTaskValidation, 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: CancellableTaskValidation<'left, 'error>) - ([] right: CancellableTaskValidation<'right, 'error>) - : CancellableTaskValidation<'left * 'right, 'error> = - cancellableTask { - let! r1 = left - let! r2 = right - - return Validation.zip r1 r2 - } + type CancellableTaskValidationBuilder with + + [] + member inline this.MergeSources(left: 'Awaiter1, right: 'Awaiter2) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip (Ok leftR) rightR) + ) + )) + ) + ) + ) - /// Takes two CancellableTaskValidation, 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: CancellableTaskValidation<'left, 'error>) - ([] right: CancellableTaskValidation<'right, 'error>) - : CancellableTaskValidation<'left * 'right, 'error> = - cancellableTask { - let! ct = CancellableTask.getCancellationToken () - let left = left ct - let right = right ct - let! r1 = left - let! r2 = right - - return Validation.zip r1 r2 +[] +module CTVMergeSourcesExtensionsTV1TV2 = - } + type CancellableTaskValidationBuilder with - // What's going on here? - // - // F# method overload resolution has some weird quirks we're taking advantage of to allow - // for binding (`let!/do!/return!`) many various types (Such as Task/Async/Result/Validation) - // in a computation expression. .The gist is, any member methods attached to the type itself - // (the Builder object) will be preferred above all else when selection overloads to resolve. It - // will then use the the most recent Extension Methods that have been opened. The way we structure - // these overloads is to provide the most "concrete" overloads first, and then the more generic - // ones later. For example, `Validation` is defined as a `Result<'T, 'Error list>`, but we also - // want to be able to bind to `Result` itself and create a list of errors from it. So we need to - // have a `Validation` member method in a higher module, and then a `Result` member method - // somewhere lower. Another example is `Task>` vs `Task<'T>`. We want to be able - // to bind to both, so we need to have a `Task>` member method in a higher - // module, and then a `Task<'T>` member method somewhere lower. - - // NoEagerConstraintApplication also changes behavior of SRTP methods, read the - // TaskBuilder RFC for more info. - - // The reason we do AutoOpens here instead of using the attribute on the module itself - // is because it may restrict how the implementation is relying on other sections, such as - // The MediumPriority module may use something from the HighPriority module. If we put the - // HighPriority module after the MediumPriority module it will fail to compile. So we don't want - // the order of the code itself to determine the priority, this allows us to control that ordering - // more explicitly. - // - // Additional readings: - // - [F# Computation Expression Method Overload Resolution Ordering](https://gist.github.com/TheAngryByrd/c8b9c8ebcda3bb162f425bfb281d2e2b) - // - [F# RFC FS-1097 - Task builder](https://github.com/fsharp/fslang-design/blob/main/FSharp-6.0/FS-1097-task-builder.md#feature-noeagerconstraintapplicationattribute) - // - ["Most concrete" tiebreaker for generic overloads](https://github.com/fsharp/fslang-suggestions/issues/905) - - - [] - [] - [] - [] - [] - [] - [] - [] - do () + [] + member inline this.MergeSources(left: 'Awaiter1, right: 'Awaiter2) = + this.Source( + cancellableTask.Run( + cancellableTask.Bind( + (fun ct -> cancellableTask.Source(ValueTask<_> ct)), + fun ct -> + + (cancellableTask.Bind( + left, + fun leftR -> + cancellableTask.BindReturn( + right, + (fun rightR -> Validation.zip leftR rightR) + ) + )) + ) + ) + ) diff --git a/src/FsToolkit.ErrorHandling.IcedTasks/FsToolkit.ErrorHandling.IcedTasks.fsproj b/src/FsToolkit.ErrorHandling.IcedTasks/FsToolkit.ErrorHandling.IcedTasks.fsproj index d04c2fdb..a6a2e26a 100644 --- a/src/FsToolkit.ErrorHandling.IcedTasks/FsToolkit.ErrorHandling.IcedTasks.fsproj +++ b/src/FsToolkit.ErrorHandling.IcedTasks/FsToolkit.ErrorHandling.IcedTasks.fsproj @@ -2,17 +2,17 @@ Library - netstandard2.0;netstandard2.1 + net6.0;netstandard2.0;netstandard2.1 preview portable FS3511;FS3513 + - member inline _.Source(job: Job<_ option>) : Job<_ option> = job - /// - /// Method lets us transform data types into our internal representation. - /// - member inline _.Source(async: Async<_ option>) : Job<_ option> = - async - |> Job.fromAsync - - /// - /// Method lets us transform data types into our internal representation. - /// - member inline _.Source(task: Task<_ option>) : Job<_ option> = - task - |> Job.awaitTask let jobOption = JobOptionBuilder() @@ -173,3 +160,24 @@ module JobOptionCEExtensions = a |> Job.awaitTask |> Job.map Some + +[] +// Having members as extensions gives them lower priority in +// overload resolution and allows skipping more type annotations. +module JobOptionCEExtensions2 = + + type JobOptionBuilder with + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(async: Async<_ option>) : Job<_ option> = + async + |> Job.fromAsync + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(task: Task<_ option>) : Job<_ option> = + task + |> Job.awaitTask diff --git a/src/FsToolkit.ErrorHandling.JobResult/JobResultCE.fs b/src/FsToolkit.ErrorHandling.JobResult/JobResultCE.fs index d81191f0..f13dad76 100644 --- a/src/FsToolkit.ErrorHandling.JobResult/JobResultCE.fs +++ b/src/FsToolkit.ErrorHandling.JobResult/JobResultCE.fs @@ -123,20 +123,6 @@ module JobResultCE = /// member inline _.Source(job': Job>) : Job> = job' - /// - /// Method lets us transform data types into our internal representation. This is the identity method to recognize the self type. - /// - member inline _.Source(task: Task>) : Job> = - task - |> Job.awaitTask - - /// - /// Method lets us transform data types into our internal representation. - /// - member inline _.Source(result: Async>) : Job> = - result - |> Job.fromAsync - let jobResult = JobResultBuilder() [] @@ -194,3 +180,22 @@ module JobResultCEExtensions = t |> Job.awaitUnitTask |> Job.map Ok + + +[] +module JobResultCEExtensions2 = + type JobResultBuilder with + + /// + /// Method lets us transform data types into our internal representation. This is the identity method to recognize the self type. + /// + member inline _.Source(task: Task>) : Job> = + task + |> Job.awaitTask + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(result: Async>) : Job> = + result + |> Job.fromAsync diff --git a/src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs b/src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs index a25c4e0b..69e59823 100644 --- a/src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs +++ b/src/FsToolkit.ErrorHandling.TaskResult/TaskOptionCE.fs @@ -212,16 +212,8 @@ type TaskOptionBuilderBase() = ) ) - member inline this.Source(computation: Async<'T option>) : TaskOption<'T> = - computation - |> Async.StartImmediateAsTask - member inline this.Source(taskOption: TaskOption<'T>) : TaskOption<'T> = taskOption - member inline this.Source(taskOption: ValueTask<'T option>) : TaskOption<'T> = - taskOption.AsTask() - - type TaskOptionBuilder() = inherit TaskOptionBuilderBase() @@ -617,3 +609,17 @@ module TaskOptionCEExtensionsMediumPriority = computation |> Async.map Some |> Async.StartImmediateAsTask + + +[] +module TaskOptionCEExtensionsHighPriority2 = + + // Medium priority extensions + type TaskOptionBuilderBase with + + member inline this.Source(computation: Async<'T option>) : TaskOption<'T> = + computation + |> Async.StartImmediateAsTask + + member inline this.Source(taskOption: ValueTask<'T option>) : TaskOption<'T> = + taskOption.AsTask() diff --git a/src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs b/src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs index f6b6f38f..924914e4 100644 --- a/src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs +++ b/src/FsToolkit.ErrorHandling.TaskResult/TaskResultCE.fs @@ -218,19 +218,6 @@ type TaskResultBuilderBase() = member inline this.Source(taskResult: TaskResult<'T, 'Error>) : TaskResult<'T, 'Error> = taskResult - member inline _.Source(result: Async>) : Task> = - result - |> Async.StartImmediateAsTask - - member inline _.Source(t: ValueTask>) : Task> = task { return! t } - - member inline _.Source(result: Result<_, _>) : Task> = Task.singleton result - - member inline _.Source(result: Choice<_, _>) : Task> = - result - |> Result.ofChoice - |> Task.singleton - type TaskResultBuilder() = @@ -591,3 +578,23 @@ module TaskResultCEExtensionsMediumPriority = computation |> Async.map Ok |> Async.StartImmediateAsTask + +[] +module TaskResultCEExtensionsHighPriority2 = + + // Medium priority extensions + type TaskResultBuilderBase with + + + member inline _.Source(result: Async>) : Task> = + result + |> Async.StartImmediateAsTask + + member inline _.Source(t: ValueTask>) : Task> = task { return! t } + + member inline _.Source(result: Result<_, _>) : Task> = Task.singleton result + + member inline _.Source(result: Choice<_, _>) : Task> = + result + |> Result.ofChoice + |> Task.singleton diff --git a/src/FsToolkit.ErrorHandling.TaskResult/TaskResultOption.fs b/src/FsToolkit.ErrorHandling.TaskResult/TaskResultOption.fs index 2334190d..411c3ec9 100644 --- a/src/FsToolkit.ErrorHandling.TaskResult/TaskResultOption.fs +++ b/src/FsToolkit.ErrorHandling.TaskResult/TaskResultOption.fs @@ -21,7 +21,7 @@ module TaskResultOption = let inline map3 ([] f) xTRO yTRO zTRO = TaskResult.map3 (Option.map3 f) xTRO yTRO zTRO - let inline retn value = TaskResult.retn (Ok value) + let inline retn value = TaskResult.retn (Some value) let inline apply fTRO xTRO = map2 (fun f x -> f x) fTRO xTRO diff --git a/src/FsToolkit.ErrorHandling/AsyncOptionCE.fs b/src/FsToolkit.ErrorHandling/AsyncOptionCE.fs index 7e7f43db..ccec9801 100644 --- a/src/FsToolkit.ErrorHandling/AsyncOptionCE.fs +++ b/src/FsToolkit.ErrorHandling/AsyncOptionCE.fs @@ -100,15 +100,6 @@ module AsyncOptionCE = /// member inline _.Source(async: Async<'value option>) : Async<'value option> = async -#if !FABLE_COMPILER - /// - /// Method lets us transform data types into our internal representation. - /// - member inline _.Source(task: Task<'value option>) : Async<'value option> = - task - |> Async.AwaitTask - -#endif let asyncOption = AsyncOptionBuilder() @@ -177,4 +168,17 @@ module AsyncOptionCEExtensions = a |> Async.AwaitTask |> Async.map Some + +[] +module AsyncOptionCEExtensionsHigher = + + type AsyncOptionBuilder with + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(task: Task<'value option>) : Async<'value option> = + task + |> Async.AwaitTask + #endif diff --git a/src/FsToolkit.ErrorHandling/AsyncResultCE.fs b/src/FsToolkit.ErrorHandling/AsyncResultCE.fs index c0b0ebc8..a4cdd044 100644 --- a/src/FsToolkit.ErrorHandling/AsyncResultCE.fs +++ b/src/FsToolkit.ErrorHandling/AsyncResultCE.fs @@ -128,14 +128,6 @@ module AsyncResultCE = member inline _.Source(result: Async>) : Async> = result -#if !FABLE_COMPILER - /// - /// Method lets us transform data types into our internal representation. - /// - member inline _.Source(task: Task>) : Async> = - task - |> Async.AwaitTask -#endif let asyncResult = AsyncResultBuilder() @@ -211,3 +203,17 @@ module AsyncResultCEExtensions = |> Async.AwaitTask |> Async.map Ok #endif + +#if !FABLE_COMPILER +[] +module AsyncResultCEExtensions2 = + + type AsyncResultBuilder with + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(task: Task>) : Async> = + task + |> Async.AwaitTask +#endif diff --git a/src/FsToolkit.ErrorHandling/AsyncResultOptionCE.fs b/src/FsToolkit.ErrorHandling/AsyncResultOptionCE.fs index 18488992..3f6fbc28 100644 --- a/src/FsToolkit.ErrorHandling/AsyncResultOptionCE.fs +++ b/src/FsToolkit.ErrorHandling/AsyncResultOptionCE.fs @@ -103,19 +103,7 @@ module AsyncResultOptionCE = (result: AsyncResultOption<'ok, 'error>) : AsyncResultOption<'ok, 'error> = result -#if !FABLE_COMPILER - /// - /// Method lets us transform data types into our internal representation. This is the identity method to recognize the self type. - /// - /// See https://stackoverflow.com/questions/35286541/why-would-you-use-builder-source-in-a-custom-computation-expression-builder - /// - member inline _.Source - (result: Task, 'error>>) - : AsyncResultOption<'ok, 'error> = - result - |> Async.AwaitTask -#endif let asyncResultOption = new AsyncResultOptionBuilder() @@ -231,3 +219,22 @@ module AsyncResultOptionCEExtensionsHighPriority = |> Async.AwaitTask |> AsyncResultOption.ofAsyncOption #endif + +#if !FABLE_COMPILER +[] +module AsyncResultOptionCEExtensionsHighPriority2 = + + type AsyncResultOptionBuilder with + + + /// + /// Method lets us transform data types into our internal representation. This is the identity method to recognize the self type. + /// + /// See https://stackoverflow.com/questions/35286541/why-would-you-use-builder-source-in-a-custom-computation-expression-builder + /// + member inline _.Source + (result: Task, 'error>>) + : AsyncResultOption<'ok, 'error> = + result + |> Async.AwaitTask +#endif diff --git a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj index b69c8a8c..36a862e5 100644 --- a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj +++ b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj @@ -6,49 +6,6 @@ preview portable - $(PackageTags), fable-library, fable-dotnet, fable-javascript, fable-python - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - $(PackageTags), fable-library, fable-dotnet, fable-javascript, fable-python @@ -80,6 +37,7 @@ + diff --git a/src/FsToolkit.ErrorHandling/OptionCE.fs b/src/FsToolkit.ErrorHandling/OptionCE.fs index 29dd8e0b..5c643aba 100644 --- a/src/FsToolkit.ErrorHandling/OptionCE.fs +++ b/src/FsToolkit.ErrorHandling/OptionCE.fs @@ -184,3 +184,8 @@ module OptionExtensions = /// member inline _.Source(nullable: Nullable<'value>) : 'value option = Option.ofNullable nullable + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(vopt: 'value voption) : 'value option = Option.ofValueOption vopt diff --git a/src/FsToolkit.ErrorHandling/ValueOptionCE.fs b/src/FsToolkit.ErrorHandling/ValueOptionCE.fs index 7b7b038b..67893f16 100644 --- a/src/FsToolkit.ErrorHandling/ValueOptionCE.fs +++ b/src/FsToolkit.ErrorHandling/ValueOptionCE.fs @@ -113,13 +113,6 @@ module ValueOptionCE = member inline _.Source(result: _ voption) : _ voption = result - // /// - // /// Method lets us transform data types into our internal representation. - // /// - member inline _.Source(vopt: _ option) : _ voption = - vopt - |> ValueOption.ofOption - let voption = ValueOptionBuilder() [] @@ -156,10 +149,18 @@ module ValueOptionExtensions = /// member inline _.Source(s: #seq<_>) = s - // /// - // /// Method lets us transform data types into our internal representation. - // /// + /// + /// Method lets us transform data types into our internal representation. + /// member inline _.Source(nullable: Nullable<'a>) : 'a voption = nullable |> ValueOption.ofNullable + + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(vopt: _ option) : _ voption = + vopt + |> ValueOption.ofOption #endif diff --git a/tests/FsToolkit.ErrorHandling.AsyncSeq.Tests/FsToolkit.ErrorHandling.AsyncSeq.Tests.fsproj b/tests/FsToolkit.ErrorHandling.AsyncSeq.Tests/FsToolkit.ErrorHandling.AsyncSeq.Tests.fsproj index 364e3ec2..28bfccc1 100644 --- a/tests/FsToolkit.ErrorHandling.AsyncSeq.Tests/FsToolkit.ErrorHandling.AsyncSeq.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.AsyncSeq.Tests/FsToolkit.ErrorHandling.AsyncSeq.Tests.fsproj @@ -2,7 +2,7 @@ Exe - net6.0;net7.0 + net6.0;net7.0;net8.0 preview diff --git a/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskResultCE.fs b/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskResultCE.fs index 4c17871f..9c3f036d 100644 --- a/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskResultCE.fs +++ b/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskResultCE.fs @@ -1115,9 +1115,23 @@ module CancellableTaskResultCE = ] ] + [] + let ``CancellableTaskResultCE inference checks`` = + testList "CancellableTaskResultCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = cancellableTaskResult { return! res } + + f (CancellableTaskResult.singleton ()) + |> ignore + ] + + [] let cancellableTaskResultTests = testList "CancellableTaskResult" [ cancellableTaskResultBuilderTests functionTests + ``CancellableTaskResultCE inference checks`` ] diff --git a/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskValidationCE.fs b/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskValidationCE.fs index 04cbd6ec..1d402a8c 100644 --- a/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskValidationCE.fs +++ b/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/CancellableTaskValidationCE.fs @@ -19,11 +19,11 @@ module ValidationCompileTests = System.Console.WriteLine(dto) } - let testFunctionBCTV<'Dto> () = - backgroundCancellableTaskValidation { - let dto = Unchecked.defaultof<'Dto> - System.Console.WriteLine(dto) - } +// let testFunctionBCTV<'Dto> () = +// backgroundCancellableTaskValidation { +// let dto = Unchecked.defaultof<'Dto> +// System.Console.WriteLine(dto) +// } module CancellableTaskValidationCE = @@ -988,65 +988,336 @@ module CancellableTaskValidationCE = ] testList "applicatives" [ - testCaseTask "Happy Path Result" + testCaseTask "cancellableTaskValidation x cancellableTaskValidation" <| fun () -> task { let actual = cancellableTaskValidation { - let! a = Ok 3 - and! b = Ok 2 - and! c = Ok 1 - return a + b - c + let! a = cancellableTaskValidation { return 3 } + and! b = cancellableTaskValidation { return 3 } + return a + b } let! actual = actual CancellationToken.None - Expect.equal actual (Ok 4) "Should be ok" + Expect.equal actual (Ok 6) "Should be ok" } - testCaseTask "Happy Path Validation" + testCaseTask "cancellableTaskValidation x cancellableTask" <| fun () -> task { let actual = cancellableTaskValidation { - let! a = CancellableTaskValidation.ok 3 - and! b = CancellableTaskValidation.ok 2 - and! c = CancellableTaskValidation.ok 1 - return a + b - c + let! a = cancellableTaskValidation { return 3 } + and! b = cancellableTask { return 3 } + return a + b } let! actual = actual CancellationToken.None - Expect.equal actual (Ok 4) "Should be ok" + Expect.equal actual (Ok 6) "Should be ok" } - testCaseTask "Happy Path Result/Valiation" + testCaseTask "cancellableTaskValidation x taskResult" <| fun () -> task { let actual = cancellableTaskValidation { - let! a = CancellableTaskValidation.ok 3 - and! b = Ok 2 - and! c = CancellableTaskValidation.ok 1 - return a + b - c + let! a = cancellableTaskValidation { return 3 } + and! b = taskResult { return 3 } + return a + b } let! actual = actual CancellationToken.None - Expect.equal actual (Ok 4) "Should be ok" + Expect.equal actual (Ok 6) "Should be ok" } - testCaseTask "Happy Path Choice" + + testCaseTask "cancellableTaskValidation x taskValidation" <| fun () -> task { let actual = cancellableTaskValidation { - let! a = Choice1Of2 3 - and! b = Choice1Of2 2 - and! c = Choice1Of2 1 - return a + b - c + let! a = cancellableTaskValidation { return 3 } + and! b = task { return Validation.ok 3 } + return a + b } let! actual = actual CancellationToken.None - Expect.equal actual (Ok 4) "Should be ok" + Expect.equal actual (Ok 6) "Should be ok" + } + + testCaseTask "cancellableTaskValidation x task" + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! a = cancellableTaskValidation { return 3 } + and! b = task { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + + testCaseTask "cancellableTaskValidation x ok" + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! a = cancellableTaskValidation { return 3 } + and! b = Ok 3 + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" } + testCaseTask "cancellableTask x cancellableTaskValidation " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = cancellableTask { return 3 } + and! a = cancellableTaskValidation { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + testCaseTask "cancellableTask x cancellableTask " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = cancellableTask { return 3 } + and! a = cancellableTask { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + testCaseTask "cancellableTask x taskResult " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = cancellableTask { return 3 } + and! a = taskResult { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + + testCaseTask "cancellableTask x taskValidation " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = cancellableTask { return 3 } + and! a = task { return Validation.Ok 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + + testCaseTask "cancellableTask x task " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = cancellableTask { return 3 } + and! a = task { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + testCaseTask "cancellableTask x ok " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = cancellableTask { return 3 } + and! a = Ok 3 + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + testCaseTask "taskResult x cancellableTaskValidation " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = taskResult { return 3 } + and! a = cancellableTaskValidation { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + + testCaseTask "taskResult x cancellableTask " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = taskResult { return 3 } + and! a = cancellableTask { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + testCaseTask "taskResult x taskResult " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = taskResult { return 3 } + and! a = taskResult { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + + testCaseTask "taskResult x taskValidation " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = taskResult { return 3 } + and! a = task { return Validation.ok 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + testCaseTask "taskResult x task " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = taskResult { return 3 } + and! a = task { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + testCaseTask "taskResult x ok " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = taskResult { return 3 } + and! a = Ok 3 + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + + testCaseTask "task x cancellableTaskValidation " + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = task { return 3 } + and! a = cancellableTaskValidation { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + testCaseTask "task x cancellableTask" + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = task { return 3 } + and! a = cancellableTask { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + + testCaseTask "task x taskResult" + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = task { return 3 } + and! a = taskResult { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + + testCaseTask "task x task" + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = task { return 3 } + and! a = task { return 3 } + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + + testCaseTask "task x ok" + <| fun () -> + task { + let actual = + cancellableTaskValidation { + let! b = task { return 3 } + and! a = Ok 3 + return a + b + } + + let! actual = actual CancellationToken.None + Expect.equal actual (Ok 6) "Should be ok" + } + + testCaseTask "Happy Path Result/Choice/Validation" <| fun () -> task { @@ -1809,9 +2080,24 @@ module CancellableTaskValidationCE = ] ] + + let ``CancellableTaskValidationCE inference checks`` = + testList "CancellableTaskValidationCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = + cancellableTaskValidation { return! res } + + f (CancellableTaskValidation.ok (())) + |> ignore + ] + + [] let cancellableTaskValidationTests = testList "CancellableTaskValidation" [ cancellableTaskValidationBuilderTests functionTests + ``CancellableTaskValidationCE 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 16d3283a..ce2467bd 100644 --- a/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/FsToolkit.ErrorHandling.IcedTasks.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.IcedTasks.Tests/FsToolkit.ErrorHandling.IcedTasks.Tests.fsproj @@ -2,7 +2,8 @@ Exe - net7.0;net6.0;net8.0 + net6.0;net7.0;net8.0 + preview diff --git a/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobOptionCE.fs b/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobOptionCE.fs index 639be7f9..dce8ba7f 100644 --- a/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobOptionCE.fs +++ b/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobOptionCE.fs @@ -332,3 +332,16 @@ let ceTests = Expect.equal actual (Some data) "Should be ok" } ] + + +[] +let ``JobOptionCE inference checks`` = + testList "JobOptionCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = jobOption { return! res } + + f (JobOption.retn ()) + |> ignore + ] diff --git a/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobResultCE.fs b/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobResultCE.fs index 5049e020..50ca1e7c 100644 --- a/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobResultCE.fs +++ b/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobResultCE.fs @@ -596,3 +596,16 @@ let ``AsyncResultCE applicative tests`` = Expect.equal actual (Error errorMsg) "Should be Error" } ] + + +[] +let ``JobResultCE inference checks`` = + testList "JobResultCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = jobResult { return! res } + + f (JobResult.retn ()) + |> ignore + ] diff --git a/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobResultOption.fs b/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobResultOption.fs index 552faa24..8357f3bf 100644 --- a/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobResultOption.fs +++ b/tests/FsToolkit.ErrorHandling.JobResult.Tests/JobResultOption.fs @@ -255,3 +255,15 @@ let operatorTests = } ) ] + +[] +let ``JobResultOptionCE inference checks`` = + testList "JobResultOptionCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = jobResultOption { return! res } + + f (JobResult.retn ()) + |> ignore + ] diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskOptionCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskOptionCE.fs index 0943892d..dc5f2c4e 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskOptionCE.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskOptionCE.fs @@ -479,3 +479,15 @@ let ceTestsApplicative = Expect.equal actual None "Should be ok" } ] + +[] +let ``BackgroundTaskOptionCE inference checks`` = + testList "BackgroundTaskOptionCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = backgroundTaskOption { return! res } + + f (TaskOption.some ()) + |> ignore + ] diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskResultCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskResultCE.fs index 1979480c..3931288d 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskResultCE.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/BackgroundTaskResultCE.fs @@ -701,3 +701,16 @@ let ``BackgroundTaskResultCE applicative tests`` = Expect.equal actual (Error errorMsg) "Should be Error" } ] + + +[] +let ``BackgroundTaskResultCE inference checks`` = + testList "BackgroundTaskResultCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = backgroundTaskResult { return! res } + + f (TaskResult.ok ()) + |> ignore + ] diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj index 7cf81926..67de3104 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj @@ -11,6 +11,7 @@ + diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs index 2efc961b..2d8cc33c 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskOptionCE.fs @@ -12,10 +12,6 @@ module TestFuncs = System.Console.WriteLine(dto) } -let makeDisposable () = - { new System.IDisposable with - member this.Dispose() = () - } [] let ceTests = @@ -293,34 +289,101 @@ let ceTests = Expect.equal actual (Some data) "Should be ok" } - testCaseTask "Using disposeable" + + testCaseTask "use normal disposable" <| fun () -> task { let data = 42 + let mutable isFinished = false let! actual = taskOption { - use d = makeDisposable () + use d = TestHelpers.makeDisposable (fun () -> isFinished <- true) return data } Expect.equal actual (Some data) "Should be ok" + Expect.isTrue isFinished "" } - testCaseTask "Using bind disposeable" + testCaseTask "use! normal wrapped disposable" <| fun () -> task { let data = 42 + let mutable isFinished = false let! actual = taskOption { use! d = - (makeDisposable () - |> Some) + TestHelpers.makeDisposable (fun () -> isFinished <- true) + |> Some + + return data + } + + Expect.equal actual (Some data) "Should be ok" + Expect.isTrue isFinished "" + } + testCaseTask "use null disposable" + <| fun () -> + task { + let data = 42 + + let! actual = + taskOption { + use d = null + return data + } + + Expect.equal actual (Some data) "Should be ok" + } + testCaseTask "use sync asyncdisposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskOption { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + isFinished <- true + ValueTask() + ) + ) + + return data + } + + Expect.equal actual (Some data) "Should be ok" + Expect.isTrue isFinished "" + } + + testCaseTask "use async asyncdisposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskOption { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + task { + do! Task.Yield() + isFinished <- true + } + :> Task + |> ValueTask + ) + ) return data } Expect.equal actual (Some data) "Should be ok" + Expect.isTrue isFinished "" } yield! [ let maxIndices = [ @@ -548,3 +611,16 @@ let ceTestsApplicative = Expect.equal actual None "Should be ok" } ] + + +[] +let ``TaskOptionCE inference checks`` = + testList "TaskOptionCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = taskOption { return! res } + + f (TaskOption.some ()) + |> ignore + ] diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs index 69fe8271..ce590d29 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultCE.fs @@ -323,10 +323,6 @@ let ``TaskResultCE try Tests`` = } ] -let makeDisposable () = - { new System.IDisposable with - member this.Dispose() = () - } [] let ``TaskResultCE using Tests`` = @@ -335,30 +331,34 @@ let ``TaskResultCE using Tests`` = <| fun () -> task { let data = 42 + let mutable isFinished = false let! actual = taskResult { - use d = makeDisposable () + use d = TestHelpers.makeDisposable (fun () -> isFinished <- true) return data } Expect.equal actual (Result.Ok data) "Should be ok" + Expect.isTrue isFinished "" } testCaseTask "use! normal wrapped disposable" <| fun () -> task { let data = 42 + let mutable isFinished = false let! actual = taskResult { use! d = - makeDisposable () + TestHelpers.makeDisposable (fun () -> isFinished <- true) |> Result.Ok return data } Expect.equal actual (Result.Ok data) "Should be ok" + Expect.isTrue isFinished "" } testCaseTask "use null disposable" <| fun () -> @@ -373,6 +373,55 @@ let ``TaskResultCE using Tests`` = Expect.equal actual (Result.Ok data) "Should be ok" } + testCaseTask "use sync asyncdisposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskResult { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + isFinished <- true + ValueTask() + ) + ) + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + Expect.isTrue isFinished "" + } + + testCaseTask "use async asyncdisposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskResult { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + task { + do! Task.Yield() + isFinished <- true + } + :> Task + |> ValueTask + ) + ) + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + Expect.isTrue isFinished "" + } ] @@ -610,8 +659,7 @@ let ``TaskResultCE applicative tests`` = Expect.equal actual (Ok 5) "Should be ok" } - let specialCaseTask returnValue = - Task.FromResult returnValue + let specialCaseTask returnValue = Task.FromResult returnValue testCaseTask "Happy Path Result/Choice/AsyncResult/Ply/ValueTask" <| fun () -> @@ -690,3 +738,16 @@ let ``TaskResultCE applicative tests`` = Expect.equal actual (Error errorMsg) "Should be Error" } ] + + +[] +let ``TaskResultCE inference checks`` = + testList "TaskResultCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = taskResult { return! res () } + + f (TaskResult.retn) + |> ignore + ] diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultOption.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultOption.fs index 7415e510..860b40fa 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultOption.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskResultOption.fs @@ -255,3 +255,16 @@ let operatorTests = } ) ] + + +[] +let ``TaskResultOptionCE inference checks`` = + testList "TaskResultOption inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = taskResultOption { return! res } + + f (TaskResultOption.retn ()) + |> ignore + ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/AsyncOptionCE.fs b/tests/FsToolkit.ErrorHandling.Tests/AsyncOptionCE.fs index 5ce2bb0c..5ad963d6 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/AsyncOptionCE.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/AsyncOptionCE.fs @@ -233,17 +233,6 @@ let ``AsyncOptionCE try Tests`` = } ] -let makeDisposable (callback) = - { new System.IDisposable with - member this.Dispose() = callback () - } - - -let makeAsyncDisposable (callback) = - { new System.IAsyncDisposable with - member this.DisposeAsync() = callback () - } - let ``AsyncOptionCE using Tests`` = testList "AsyncOptionCE using Tests" [ @@ -254,7 +243,7 @@ let ``AsyncOptionCE using Tests`` = let! actual = asyncOption { - use d = makeDisposable ((fun () -> isFinished <- true)) + use d = TestHelpers.makeDisposable ((fun () -> isFinished <- true)) return data } @@ -296,7 +285,7 @@ let ``AsyncOptionCE using Tests`` = let! actual = asyncOption { use d = - makeAsyncDisposable ( + TestHelpers.makeAsyncDisposable ( (fun () -> isFinished <- true ValueTask() @@ -317,7 +306,7 @@ let ``AsyncOptionCE using Tests`` = let! actual = asyncOption { use d = - makeAsyncDisposable ( + TestHelpers.makeAsyncDisposable ( (fun () -> task { do! Task.Yield() @@ -342,7 +331,7 @@ let ``AsyncOptionCE using Tests`` = let! actual = asyncOption { use! d = - makeDisposable (id) + TestHelpers.makeDisposable (id) |> Some return data @@ -568,9 +557,20 @@ let ``AsyncOptionCE Stack Trace Tests`` = #else testList "AsyncOptionCE Stack Trace Tests" [] - #endif + +let ``AsyncOptionCE inference checks`` = + testList "AsyncOptionCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = asyncOption { return! res } + + f (AsyncOption.some ()) + |> ignore + ] + let allTests = testList "AsyncResultCETests" [ ``AsyncOptionCE return Tests`` @@ -581,4 +581,5 @@ let allTests = ``AsyncOptionCE using Tests`` ``AsyncOptionCE loop Tests`` ``AsyncOptionCE Stack Trace Tests`` + ``AsyncOptionCE inference checks`` ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/AsyncResultCE.fs b/tests/FsToolkit.ErrorHandling.Tests/AsyncResultCE.fs index 5a303f1d..93a9f0ca 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/AsyncResultCE.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/AsyncResultCE.fs @@ -253,18 +253,6 @@ let ``AsyncResultCE try Tests`` = } ] -let makeDisposable (callback) = - { new System.IDisposable with - member this.Dispose() = callback () - } - - -let makeAsyncDisposable (callback) = - { new System.IAsyncDisposable with - member this.DisposeAsync() = callback () - } - - let ``AsyncResultCE using Tests`` = testList "AsyncResultCE using Tests" [ testCaseAsync "use normal disposable" @@ -274,7 +262,7 @@ let ``AsyncResultCE using Tests`` = let! actual = asyncResult { - use d = makeDisposable ((fun () -> isFinished <- true)) + use d = TestHelpers.makeDisposable ((fun () -> isFinished <- true)) return data } @@ -290,7 +278,7 @@ let ``AsyncResultCE using Tests`` = let! actual = asyncResult { use d = - makeAsyncDisposable ( + TestHelpers.makeAsyncDisposable ( (fun () -> isFinished <- true ValueTask() @@ -311,7 +299,7 @@ let ``AsyncResultCE using Tests`` = let! actual = asyncResult { use d = - makeAsyncDisposable ( + TestHelpers.makeAsyncDisposable ( (fun () -> task { do! Task.Yield() @@ -337,7 +325,7 @@ let ``AsyncResultCE using Tests`` = let! actual = asyncResult { use! d = - makeDisposable (id) + TestHelpers.makeDisposable (id) |> Result.Ok return data @@ -759,6 +747,19 @@ let ``AsyncResultCE Stack Trace Tests`` = #endif + +let ``AsyncResultCE inference checks`` = + testList "AsyncResultCEInference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = asyncResult { return! res } + + f (AsyncResult.retn ()) + |> ignore + ] + + let allTests = testList "AsyncResultCETests" [ ``AsyncResultCE return Tests`` @@ -770,4 +771,5 @@ let allTests = ``AsyncResultCE loop Tests`` ``AsyncResultCE applicative tests`` ``AsyncResultCE Stack Trace Tests`` + ``AsyncResultCE inference checks`` ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/AsyncResultOptionCE.fs b/tests/FsToolkit.ErrorHandling.Tests/AsyncResultOptionCE.fs index 6a88319b..5997ee3c 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/AsyncResultOptionCE.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/AsyncResultOptionCE.fs @@ -438,16 +438,6 @@ let ``AsyncResultOptionCE try Tests`` = } ] -let makeDisposable callback = - { new System.IDisposable with - member this.Dispose() = callback () - } - -let makeAsyncDisposable (callback) = - { new System.IAsyncDisposable with - member this.DisposeAsync() = callback () - } - let ``AsyncResultOptionCE using Tests`` = testList "AsyncResultOptionCE using Tests" [ @@ -456,9 +446,10 @@ let ``AsyncResultOptionCE using Tests`` = let data = 42 let mutable isFinished = false + let! actual = asyncResultOption { - use d = makeDisposable (fun () -> isFinished <- true) + use d = TestHelpers.makeDisposable (fun () -> isFinished <- true) return data } @@ -520,7 +511,7 @@ let ``AsyncResultOptionCE using Tests`` = let! actual = asyncResultOption { use d = - makeAsyncDisposable ( + TestHelpers.makeAsyncDisposable ( (fun () -> task { do! Task.Yield() @@ -547,7 +538,7 @@ let ``AsyncResultOptionCE using Tests`` = let! actual = asyncResultOption { use! d = - makeDisposable (fun () -> isFinished <- true) + TestHelpers.makeDisposable (fun () -> isFinished <- true) |> Result.Ok return data @@ -715,6 +706,19 @@ let ``AsyncResultOptionCE loop Tests`` = } ] + +let ``AsyncResultOptionCE inference checks`` = + testList "AsyncResultOptionCE Inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = asyncResultOption { return! res } + + f (AsyncResultOption.retn ()) + |> ignore + ] + + let allTests = testList "AsyncResultCETests" [ ``AsyncResultOptionCE return Tests`` @@ -724,4 +728,5 @@ let allTests = ``AsyncResultOptionCE try Tests`` ``AsyncResultOptionCE using Tests`` ``AsyncResultOptionCE loop Tests`` + ``AsyncResultOptionCE inference checks`` ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj index 3033b73d..21d85591 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj @@ -1,4 +1,4 @@ - + Exe diff --git a/tests/FsToolkit.ErrorHandling.Tests/OptionCE.fs b/tests/FsToolkit.ErrorHandling.Tests/OptionCE.fs index 5fff452e..9eaca488 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/OptionCE.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/OptionCE.fs @@ -538,9 +538,20 @@ let ``OptionCE applicative tests`` = Expect.equal actual (None) "Should be None" ] +let ``OptionCE inference checks`` = + testList "OptionCE Inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = option { return! res } + + f (Some()) + |> ignore + ] let allTests = testList "Option CE tests" [ ceTests ``OptionCE applicative tests`` + ``OptionCE inference checks`` ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/ResultCE.fs b/tests/FsToolkit.ErrorHandling.Tests/ResultCE.fs index e34d0465..9d1c12b9 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/ResultCE.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/ResultCE.fs @@ -435,6 +435,17 @@ let ``ResultCE applicative tests`` = ] +let ``ResultCE inference checks`` = + testList "ResultCE Inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = result { return! res } + + f (Ok()) + |> ignore + ] + let allTests = testList "Result CE Tests" [ ``ResultCE return Tests`` @@ -445,4 +456,5 @@ let allTests = ``ResultCE using Tests`` ``ResultCE loop Tests`` ``ResultCE applicative tests`` + ``ResultCE inference checks`` ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/ResultOptionCE.fs b/tests/FsToolkit.ErrorHandling.Tests/ResultOptionCE.fs index 661bfc8b..1f05f957 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/ResultOptionCE.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/ResultOptionCE.fs @@ -511,6 +511,19 @@ let ``ResultOptionCE applicative tests`` = Expect.equal actual (Error errorMsg1) "Should be Error" ] + +let ``ResultOptionCE inference checks`` = + testList "ResultOptionCE Inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = resultOption { return! res } + + f (Ok(Some())) + |> ignore + ] + + let allTests = testList "Result CE Tests" [ ``ResultOptionCE return Tests`` @@ -520,4 +533,5 @@ let allTests = ``ResultOptionCE using Tests`` ``ResultOptionCE loop Tests`` ``ResultOptionCE applicative tests`` + ``ResultOptionCE inference checks`` ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/TestHelpers.fs b/tests/FsToolkit.ErrorHandling.Tests/TestHelpers.fs new file mode 100644 index 00000000..9aa9f25f --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/TestHelpers.fs @@ -0,0 +1,13 @@ +namespace FsToolkit.ErrorHandling + + +module TestHelpers = + let makeDisposable (callback) = + { new System.IDisposable with + member this.Dispose() = callback () + } + + let makeAsyncDisposable (callback) = + { new System.IAsyncDisposable with + member this.DisposeAsync() = callback () + } diff --git a/tests/FsToolkit.ErrorHandling.Tests/ValueOptionCE.fs b/tests/FsToolkit.ErrorHandling.Tests/ValueOptionCE.fs index 0a563257..4d743214 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/ValueOptionCE.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/ValueOptionCE.fs @@ -545,10 +545,23 @@ let ``ValueOptionCE applicative tests`` = ] +let ``ValueOptionCE inference checks`` = + testList "ValueOptionCE Inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = voption { return! res } + + f (ValueSome()) + |> ignore + ] + + let allTests = testList "ValueOption CE tests" [ ceTests ``ValueOptionCE applicative tests`` + ``ValueOptionCE inference checks`` ] #else let allTests = testList "ValueOption CE tests" []