diff --git a/gitbook/SUMMARY.md b/gitbook/SUMMARY.md index 8dec8899..cbf563ce 100644 --- a/gitbook/SUMMARY.md +++ b/gitbook/SUMMARY.md @@ -166,6 +166,15 @@ * [map](taskOption/map.md) * [Other Functions](taskOption/others.md) * [zip](taskOption/zip.md) + + * TaskValueOption + * [apply](taskValueOption/apply.md) + * [bind](taskValueOption/bind.md) + * [Computation Expression](taskValueOption/ce.md) + * [either](taskValueOption/either.md) + * [map](taskValueOption/map.md) + * [Other Functions](taskValueOption/others.md) + * [zip](taskValueOption/zip.md) * TaskResult * [apply](taskResult/apply.md) diff --git a/gitbook/taskValueOption/apply.md b/gitbook/taskValueOption/apply.md new file mode 100644 index 00000000..165e054b --- /dev/null +++ b/gitbook/taskValueOption/apply.md @@ -0,0 +1,48 @@ +# TaskValueOption.apply + +Namespace: `FsToolkit.ErrorHandling` + +Function Signature: + +```fsharp +Task<('a -> 'b) voption> -> Task<'a voption> -> Task<'b voption> +``` + +## Examples + +Take the following function for example + +```fsharp +// string -> int +let characterCount (s: string) = s.Length +``` + +### Example 1 + +```fsharp +let result = + TaskValueOption.valueSome "foo" // Task + |> TaskValueOption.apply (TaskValueOption.valueSome characterCount) // Task + +// task { ValueSome 3 } +``` + +### Example 2 + +```fsharp +let result = + Task.singleton ValueNone // Task + |> TaskValueOption.apply (TaskValueOption.valueSome characterCount) // Task + +// task { ValueNone } +``` + +### Example 3 + +```fsharp +let result : Task = + TaskValueOption.valueSome "foo" // Task + |> TaskValueOption.apply (Task.singleton ValueNone) // Task + +// task { ValueNone } +``` diff --git a/gitbook/taskValueOption/bind.md b/gitbook/taskValueOption/bind.md new file mode 100644 index 00000000..c0f8338c --- /dev/null +++ b/gitbook/taskValueOption/bind.md @@ -0,0 +1,68 @@ +# TaskValueOption.bind + +Namespace: `FsToolkit.ErrorHandling` + +## Function Signature + +```fsharp +('input -> Task<'output voption>) -> Task<'input voption> -> Task<'output voption> +``` + +## Examples + +Take the following function for example + +```fsharp +type Account = + { EmailAddress : string + Name : string } + +// string -> Task +let lookupAccountByEmail email = task { + let john = { EmailAddress = "john@test.com"; Name = "John Johnson" } + let jeff = { EmailAddress = "jeff@test.com"; Name = "Jeff Jefferson" } + let jack = { EmailAddress = "jack@test.com"; Name = "Jack Jackson" } + + // Just a map lookup, but imagine we look up an account in our database + let accounts = Map.ofList [ + ("john@test.com", john) + ("jeff@test.com", jeff) + ("jack@test.com", jack) + ] + + return + accounts + |> Map.tryFind email + |> Option.toValueOption +} +``` + +### Example 1 + +```fsharp +let taskOpt : Task = + TaskValueOption.valueSome "john@test.com" // Task + |> TaskValueOption.bind lookupAccountByEmail // Task + +// task { ValueSome { EmailAddress = "john@test.com"; Name = "John Johnson" } } +``` + +### Example 2 + +```fsharp +let taskVOpt : Task = + TaskValueOption.some "jerry@test.com" // Task + |> TaskValueOption.bind lookupAccountByEmail // Task + +// task { ValueNone } +``` + +### Example 3 + +```fsharp +let taskVOpt : Task = + Task.singleton ValueNone // Task + |> TaskValueOption.bind lookupAccountByEmail // Task + +// task { ValueNone } +``` diff --git a/gitbook/taskValueOption/ce.md b/gitbook/taskValueOption/ce.md new file mode 100644 index 00000000..b470c5fc --- /dev/null +++ b/gitbook/taskValueOption/ce.md @@ -0,0 +1,26 @@ +## TaskValueOption Computation Expression + +Namespace: `FsToolkit.ErrorHandling` + +## Examples: + +### Example 1 + +Given a personId and an age, find a person and update their age. + +```fsharp +tryParseInt : string -> int voption +tryFindPersonById : int -> Task +updatePerson : Person -> Task +``` + +```fsharp +// Task +let addResult = taskValueOption { + let! personId = tryParseInt "3001" + let! age = tryParseInt "35" + let! person = tryFindPersonById personId + let person = { person with Age = age } + do! updatePerson person +} +``` diff --git a/gitbook/taskValueOption/either.md b/gitbook/taskValueOption/either.md new file mode 100644 index 00000000..d9dc8ad6 --- /dev/null +++ b/gitbook/taskValueOption/either.md @@ -0,0 +1,33 @@ +# TaskValueOption.either + +Namespace: `FsToolkit.ErrorHandling` + +## Function Signature + +Provide two functions to execute depending on the value of the voption. If the voption is `ValueSome`, the first function will be executed. If the voption is `ValueNone`, the second function will be executed. + +```fsharp +(onValueSome : 'T -> Task<'output>) + -> (onValueNone : Task<'output>) + -> (input : Task<'T voption>) + -> Task<'output> +``` + +## Examples + +### Example 1 + +```fsharp +TaskValueOption.either (fun x -> task { x * 2 }) (task { 0 }) (TaskValueOption.valueSome 5) + +// task { 10 } +``` + +### Example 2 + +```fsharp +TaskValueOption.either (fun x -> task { x * 2 }) (task { 0 }) ValueNone + +// task { 0 } +``` + diff --git a/gitbook/taskValueOption/map.md b/gitbook/taskValueOption/map.md new file mode 100644 index 00000000..3583b8c8 --- /dev/null +++ b/gitbook/taskValueOption/map.md @@ -0,0 +1,30 @@ +# TaskValueOption.map + +Namespace: `FsToolkit.ErrorHandling` + +Apply a function to the value of a task voption if it is `ValueSome`. If the option is `ValueNone`, return `ValueNone`. + +## Function Signature + +```fsharp +('input -> 'output) -> Task<'input voption> -> Task<'output voption> +``` + +## Examples + +### Example 1 + +```fsharp +TaskValueOption.map (fun x -> x + 1) (TaskValueOption.valueSome 1) + +// task { ValueSome 2 } +``` + +### Example 2 + +```fsharp +TaskValueOption.map (fun x -> x + 1) (Task.singleton ValueNone) + +// task { ValueNone } +``` + diff --git a/gitbook/taskValueOption/others.md b/gitbook/taskValueOption/others.md new file mode 100644 index 00000000..efd78fda --- /dev/null +++ b/gitbook/taskValueOption/others.md @@ -0,0 +1,33 @@ +# Other TaskValueOption Functions + +## defaultValue + +Returns the contained value if ValueSome, otherwise returns the provided value + +### Function Signature + +```fsharp +'a -> Task<'a voption> -> Task<'a> +``` + +## defaultWith + +Returns the contained value if ValueSome, otherwise evaluates the given function and returns the result. + +### Function Signature + +```fsharp +(unit -> 'a) -> Task<'a voption> -> Task<'a> +``` + +## valueSome + +Wraps the provided value in an Task<'a voption> + +### Function Signature + +```fsharp +'a -> Task<'a voption> +``` + + diff --git a/gitbook/taskValueOption/zip.md b/gitbook/taskValueOption/zip.md new file mode 100644 index 00000000..eeb8d36c --- /dev/null +++ b/gitbook/taskValueOption/zip.md @@ -0,0 +1,33 @@ +# TaskValueOption.zip + +Namespace: `FsToolkit.ErrorHandling` + +Takes two voptions and returns a tuple of the pair or ValueNone if either are ValueNone + +## Function Signature + +```fsharp +Task<'left voption> -> Task<'right voption> -> Task<('left * 'right) voption> +``` + +## Examples + +### Example 1 + +```fsharp +let left = TaskValueOption.valueSome 123 +let right = TaskValueOption.valueSome "abc" + +TaskValueOption.zip left right +// task { ValueSome (123, "abc") } +``` + +### Example 2 + +```fsharp +let left = TaskValueOption.valueSome 123 +let right = Task.singleton ValueNone + +TaskValueOption.zip left right +// task { ValueNone } +``` diff --git a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj index 783edf07..563ef414 100644 --- a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj +++ b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj @@ -40,8 +40,11 @@ + + + diff --git a/src/FsToolkit.ErrorHandling/TaskValueOption.fs b/src/FsToolkit.ErrorHandling/TaskValueOption.fs new file mode 100644 index 00000000..e7ecdf1a --- /dev/null +++ b/src/FsToolkit.ErrorHandling/TaskValueOption.fs @@ -0,0 +1,79 @@ +namespace FsToolkit.ErrorHandling + +open System.Threading.Tasks + + +[] +module TaskValueOption = + + let inline map ([] f) ar = Task.map (ValueOption.map f) ar + + let inline bind ([] f) (ar: Task<_>) = + task { + let! opt = ar + + let t = + match opt with + | ValueSome x -> f x + | ValueNone -> task { return ValueNone } + + return! t + } + + let inline valueSome x = task { return ValueSome x } + + let inline apply f x = + bind (fun f' -> bind (fun x' -> valueSome (f' x')) x) f + + let inline zip x1 x2 = + Task.zip x1 x2 + |> Task.map (fun (r1, r2) -> ValueOption.zip r1 r2) + + + /// + /// Returns result of running if it is ValueSome, otherwise returns result of running + /// + /// The function to run if is ValueSome + /// The function to run if is ValueNone + /// The input voption. + /// + /// The result of running if the input is ValueSome, else returns result of running . + /// + let inline either + ([] onValueSome: 'input -> Task<'output>) + ([] onValueNone: unit -> Task<'output>) + (input: Task<'input voption>) + : Task<'output> = + input + |> Task.bind ( + function + | ValueSome v -> onValueSome v + | ValueNone -> onValueNone () + ) + + /// + /// Gets the value of the option if the option is Some, otherwise returns the specified default value. + /// + /// The specified default value. + /// The input option. + /// + /// The option if the option is Some, else the default value. + /// + let inline defaultValue (value: 'value) (taskValueOption: Task<'value voption>) = + taskValueOption + |> Task.map (ValueOption.defaultValue value) + + /// + /// Gets the value of the voption if the voption is ValueSome, otherwise evaluates and returns the result. + /// + /// A thunk that provides a default value when evaluated. + /// The input voption. + /// + /// The voption if the option is ValueSome, else the result of evaluating . + /// + let inline defaultWith + ([] defThunk: unit -> 'value) + (taskValueOption: Task<'value voption>) + : Task<'value> = + taskValueOption + |> Task.map (ValueOption.defaultWith defThunk) diff --git a/src/FsToolkit.ErrorHandling/TaskValueOptionCE.fs b/src/FsToolkit.ErrorHandling/TaskValueOptionCE.fs new file mode 100644 index 00000000..51f63a69 --- /dev/null +++ b/src/FsToolkit.ErrorHandling/TaskValueOptionCE.fs @@ -0,0 +1,626 @@ +namespace FsToolkit.ErrorHandling + +open System +open System.Threading.Tasks + + +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.Control +open Microsoft.FSharp.Collections + +/// Task<'T voption> +type TaskValueOption<'T> = Task<'T voption> + +[] +type TaskValueOptionStateMachineData<'T> = + + [] + val mutable Result: 'T voption voption + + [] + val mutable MethodBuilder: AsyncTaskValueOptionMethodBuilder<'T> + + member this.IsResultNone = + match this.Result with + | ValueNone -> false + | ValueSome(ValueNone) -> true + | ValueSome _ -> false + + member this.SetResult() = + match this.Result with + | ValueNone -> this.MethodBuilder.SetResult ValueNone + | ValueSome x -> this.MethodBuilder.SetResult x + + + member this.IsTaskCompleted = this.MethodBuilder.Task.IsCompleted + +and AsyncTaskValueOptionMethodBuilder<'TOverall> = AsyncTaskMethodBuilder<'TOverall voption> + +and TaskValueOptionStateMachine<'TOverall> = + ResumableStateMachine> + +and TaskValueOptionResumptionFunc<'TOverall> = + ResumptionFunc> + +and TaskValueOptionResumptionDynamicInfo<'TOverall> = + ResumptionDynamicInfo> + +and TaskValueOptionCode<'TOverall, 'T> = + ResumableCode, 'T> + +type TaskValueOptionBuilderBase() = + + member inline _.Delay + (generator: unit -> TaskValueOptionCode<'TOverall, 'T>) + : TaskValueOptionCode<'TOverall, 'T> = + TaskValueOptionCode<'TOverall, 'T>(fun sm -> (generator ()).Invoke(&sm)) + + /// Used to represent no-ops like the implicit empty "else" branch of an "if" expression. + [] + member inline _.Zero<'TOverall>() : TaskValueOptionCode<'TOverall, unit> = + TaskValueOptionCode<_, _>(fun sm -> + sm.Data.Result <- ValueSome(ValueSome Unchecked.defaultof<'TOverall>) + true + ) + + member inline _.Return(value: 'T) : TaskValueOptionCode<'T, 'T> = + TaskValueOptionCode<'T, _>(fun sm -> + sm.Data.Result <- ValueSome(ValueSome 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: TaskValueOptionCode<'TOverall, unit>, task2: TaskValueOptionCode<'TOverall, 'T>) + : TaskValueOptionCode<'TOverall, 'T> = + + ResumableCode.Combine( + task1, + TaskValueOptionCode<'TOverall, 'T>(fun sm -> + if sm.Data.IsResultNone 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: TaskValueOptionCode<'TOverall, unit>) + : TaskValueOptionCode<'TOverall, unit> = + let mutable keepGoing = true + + ResumableCode.While( + (fun () -> + keepGoing + && condition () + ), + TaskValueOptionCode<_, _>(fun sm -> + if sm.Data.IsResultNone then + keepGoing <- false + sm.Data.SetResult() + 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 + (body: TaskValueOptionCode<'TOverall, 'T>, catch: exn -> TaskValueOptionCode<'TOverall, 'T>) + : TaskValueOptionCode<'TOverall, 'T> = + ResumableCode.TryWith(body, catch) + + /// 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 + (body: TaskValueOptionCode<'TOverall, 'T>, [] compensation: unit -> unit) + : TaskValueOptionCode<'TOverall, 'T> = + ResumableCode.TryFinally( + body, + ResumableCode<_, _>(fun _sm -> + compensation () + true + ) + ) + + member inline this.For + (sequence: seq<'T>, body: 'T -> TaskValueOptionCode<'TOverall, unit>) + : TaskValueOptionCode<'TOverall, unit> = + ResumableCode.Using( + sequence.GetEnumerator(), + // ... and its body is a while loop that advances the enumerator and runs the body on each element. + (fun e -> + this.While( + (fun () -> e.MoveNext()), + TaskValueOptionCode<'TOverall, unit>(fun sm -> (body e.Current).Invoke(&sm)) + ) + ) + ) + + member inline internal this.TryFinallyAsync + (body: TaskValueOptionCode<'TOverall, 'T>, compensation: unit -> ValueTask) + : TaskValueOptionCode<'TOverall, 'T> = + ResumableCode.TryFinallyAsync( + body, + ResumableCode<_, _>(fun sm -> + 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 = + TaskValueOptionResumptionFunc<'TOverall>(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, 'T when 'Resource :> IAsyncDisposableNull> + (resource: 'Resource, body: 'Resource -> TaskValueOptionCode<'TOverall, 'T>) + : TaskValueOptionCode<'TOverall, 'T> = + this.TryFinallyAsync( + (fun sm -> (body resource).Invoke(&sm)), + (fun () -> + if not (isNull (box resource)) then + resource.DisposeAsync() + else + ValueTask() + ) + ) + + member inline this.Source(taskValueOption: TaskValueOption<'T>) : TaskValueOption<'T> = + taskValueOption + +type TaskValueOptionBuilder() = + + inherit TaskValueOptionBuilderBase() + + // This is the dynamic implementation - this is not used + // for statically compiled tasks. An executor (resumptionFuncExecutor) is + // registered with the state machine, plus the initial resumption. + // The executor stays constant throughout the execution, it wraps each step + // of the execution in a try/with. The resumption is changed at each step + // to represent the continuation of the computation. + static member RunDynamic(code: TaskValueOptionCode<'T, 'T>) : TaskValueOption<'T> = + let mutable sm = TaskValueOptionStateMachine<'T>() + + let initialResumptionFunc = + TaskValueOptionResumptionFunc<'T>(fun sm -> code.Invoke(&sm)) + + let resumptionInfo = + { new TaskValueOptionResumptionDynamicInfo<_>(initialResumptionFunc) with + member info.MoveNext(sm) = + let mutable savedExn = null + + try + sm.ResumptionDynamicInfo.ResumptionData <- null + let step = info.ResumptionFunc.Invoke(&sm) + + // If the `sm.Data.MethodBuilder` has already been set somewhere else (like While/WhileDynamic), we shouldn't continue + if sm.Data.IsTaskCompleted then + () + + if step then + sm.Data.SetResult() + else + match sm.ResumptionDynamicInfo.ResumptionData with + | :? ICriticalNotifyCompletion as awaiter -> + let mutable awaiter = awaiter + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + | awaiter -> assert not (isNull awaiter) + + with exn -> + savedExn <- exn + // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 + match savedExn with + | null -> () + | exn -> sm.Data.MethodBuilder.SetException exn + + member _.SetStateMachine(sm, state) = + sm.Data.MethodBuilder.SetStateMachine(state) + } + + sm.ResumptionDynamicInfo <- resumptionInfo + sm.Data.MethodBuilder <- AsyncTaskValueOptionMethodBuilder<'T>.Create() + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + + member inline _.Run(code: TaskValueOptionCode<'T, 'T>) : TaskValueOption<'T> = + if __useResumableCode then + __stateMachine, TaskValueOption<'T>> + (MoveNextMethodImpl<_>(fun sm -> + //-- RESUMABLE CODE START + __resumeAt sm.ResumptionPoint + let mutable __stack_exn: ExceptionNull = null + + try + let __stack_code_fin = code.Invoke(&sm) + + if + __stack_code_fin + && not sm.Data.IsTaskCompleted + then + sm.Data.SetResult() + with exn -> + __stack_exn <- exn + // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 + match __stack_exn with + | null -> () + | exn -> sm.Data.MethodBuilder.SetException exn + //-- RESUMABLE CODE END + )) + (SetStateMachineMethodImpl<_>(fun sm state -> + sm.Data.MethodBuilder.SetStateMachine(state) + )) + (AfterCode<_, _>(fun sm -> + sm.Data.MethodBuilder <- AsyncTaskValueOptionMethodBuilder<'T>.Create() + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + )) + else + TaskValueOptionBuilder.RunDynamic(code) + +type BackgroundTaskValueOptionBuilder() = + + inherit TaskValueOptionBuilderBase() + + static member RunDynamic(code: TaskValueOptionCode<'T, 'T>) : TaskValueOption<'T> = + // backgroundTask { .. } escapes to a background thread where necessary + // See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/ + if + isNull SynchronizationContext.Current + && obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default) + then + TaskValueOptionBuilder.RunDynamic(code) + else + Task.Run<'T voption>(fun () -> TaskValueOptionBuilder.RunDynamic(code)) + + + //// Same as TaskBuilder.Run except the start is inside Task.Run if necessary + member inline _.Run(code: TaskValueOptionCode<'T, 'T>) : TaskValueOption<'T> = + if __useResumableCode then + __stateMachine, TaskValueOption<'T>> + (MoveNextMethodImpl<_>(fun sm -> + //-- RESUMABLE CODE START + __resumeAt sm.ResumptionPoint + + try + let __stack_code_fin = code.Invoke(&sm) + + if + __stack_code_fin + && not sm.Data.IsTaskCompleted + then + sm.Data.MethodBuilder.SetResult(sm.Data.Result.Value) + with exn -> + sm.Data.MethodBuilder.SetException exn + //-- RESUMABLE CODE END + )) + (SetStateMachineMethodImpl<_>(fun sm state -> + sm.Data.MethodBuilder.SetStateMachine(state) + )) + (AfterCode<_, TaskValueOption<'T>>(fun sm -> + // backgroundTask { .. } escapes to a background thread where necessary + // See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/ + if + isNull SynchronizationContext.Current + && obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default) + then + sm.Data.MethodBuilder <- AsyncTaskValueOptionMethodBuilder<'T>.Create() + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + else + let sm = sm // copy contents of state machine so we can capture it + + Task.Run<'T voption>(fun () -> + let mutable sm = sm // host local mutable copy of contents of state machine on this thread pool thread + + sm.Data.MethodBuilder <- + AsyncTaskValueOptionMethodBuilder<'T>.Create() + + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + ) + )) + else + BackgroundTaskValueOptionBuilder.RunDynamic(code) + +[] +module TaskValueOptionBuilder = + + let taskValueOption = TaskValueOptionBuilder() + let backgroundTaskValueOption = BackgroundTaskValueOptionBuilder() + + +open Microsoft.FSharp.Control +open System +open System.Runtime.CompilerServices +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 + +[] +module TaskValueOptionCEExtensionsLowPriority = + // Low priority extensions + type TaskValueOptionBuilderBase with + + [] + static member inline BindDynamic< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'TResult1 voption)> + ( + sm: byref<_>, + task: ^TaskLike, + continuation: ('TResult1 -> TaskValueOptionCode<'TOverall, 'TResult2>) + ) : bool = + + let mutable awaiter = (^TaskLike: (member GetAwaiter: unit -> ^Awaiter) (task)) + + let cont = + (TaskValueOptionResumptionFunc<'TOverall>(fun sm -> + let result = + (^Awaiter: (member GetResult: unit -> 'TResult1 voption) (awaiter)) + + match result with + | ValueSome result -> (continuation result).Invoke(&sm) + | ValueNone -> + sm.Data.Result <- ValueSome ValueNone + 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< ^TaskLike, 'TResult1, 'TResult2, ^Awaiter, 'TOverall + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'TResult1 voption)> + (task: ^TaskLike, continuation: ('TResult1 -> TaskValueOptionCode<'TOverall, 'TResult2>)) : TaskValueOptionCode< + 'TOverall, + 'TResult2 + > + = + + TaskValueOptionCode<'TOverall, _>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + // Get an awaiter from the awaitable + let mutable awaiter = (^TaskLike: (member GetAwaiter: unit -> ^Awaiter) (task)) + + 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 -> 'TResult1 voption) (awaiter)) + + match result with + | ValueSome result -> (continuation result).Invoke(&sm) + | ValueNone -> + sm.Data.Result <- ValueSome ValueNone + true + else + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + false + else + TaskValueOptionBuilderBase.BindDynamic< + ^TaskLike, + 'TResult1, + 'TResult2, + ^Awaiter, + 'TOverall + >( + &sm, + task, + continuation + ) + //-- RESUMABLE CODE END + ) + + [] + member inline this.ReturnFrom< ^TaskLike, ^Awaiter, 'T + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'T voption)> + (task: ^TaskLike) + : TaskValueOptionCode<'T, 'T> = + + this.Bind(task, (fun v -> this.Return v)) + + [] + member inline this.Source< ^TaskLike, ^Awaiter, 'T + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'T)> + (t: ^TaskLike) + : TaskValueOption<'T> = + + task { + let! r = t + return ValueSome r + } + + member inline _.Using<'Resource, 'TOverall, 'T when 'Resource :> IDisposableNull> + (resource: 'Resource, body: 'Resource -> TaskValueOptionCode<'TOverall, 'T>) + = + ResumableCode.Using(resource, body) + +[] +module TaskValueOptionCEExtensionsHighPriority = + // High priority extensions + type TaskValueOptionBuilderBase with + + static member BindDynamic + ( + sm: byref<_>, + task: TaskValueOption<'TResult1>, + continuation: ('TResult1 -> TaskValueOptionCode<'TOverall, 'TResult2>) + ) : bool = + let mutable awaiter = task.GetAwaiter() + + let cont = + (TaskValueOptionResumptionFunc<'TOverall>(fun sm -> + let result = awaiter.GetResult() + + match result with + | ValueSome result -> (continuation result).Invoke(&sm) + | ValueNone -> + sm.Data.Result <- ValueSome ValueNone + true + )) + + // shortcut to continue immediately + if awaiter.IsCompleted then + cont.Invoke(&sm) + else + sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion) + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + + member inline _.Bind + ( + task: TaskValueOption<'TResult1>, + continuation: ('TResult1 -> TaskValueOptionCode<'TOverall, 'TResult2>) + ) : TaskValueOptionCode<'TOverall, 'TResult2> = + + TaskValueOptionCode<'TOverall, _>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + // Get an awaiter from the task + let mutable awaiter = task.GetAwaiter() + + let mutable __stack_fin = true + + if not awaiter.IsCompleted 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() + + match result with + | ValueSome result -> (continuation result).Invoke(&sm) + | ValueNone -> + sm.Data.Result <- ValueSome ValueNone + true + + else + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + false + + else + TaskValueOptionBuilderBase.BindDynamic(&sm, task, continuation) + //-- RESUMABLE CODE END + ) + + member inline this.BindReturn(x: TaskValueOption<'T>, [] f) = + this.Bind(x, (fun x -> this.Return(f x))) + + member inline _.MergeSources(t1: TaskValueOption<'T>, t2: TaskValueOption<'T1>) = + TaskValueOption.zip t1 t2 + + member inline this.ReturnFrom(task: TaskValueOption<'T>) : TaskValueOptionCode<'T, 'T> = + this.Bind(task, (fun v -> this.Return v)) + + member inline _.Source(s: #seq<_>) = s + +[] +module TaskValueOptionCEExtensionsMediumPriority = + + // Medium priority extensions + type TaskValueOptionBuilderBase with + + member inline this.Source(t: Task<'T>) : TaskValueOption<'T> = + t + |> Task.map ValueSome + + member inline this.Source(t: Task) : TaskValueOption = + task { + do! t + return ValueSome() + } + + member inline this.Source(t: ValueTask<'T>) : TaskValueOption<'T> = + t + |> Task.mapV ValueSome + + member inline this.Source(t: ValueTask) : TaskValueOption = + task { + do! t + return ValueSome() + } + + member inline this.Source(opt: ValueOption<'T>) : TaskValueOption<'T> = Task.FromResult opt + + member inline this.Source(computation: Async<'T>) : TaskValueOption<'T> = + computation + |> Async.map ValueSome + |> Async.StartImmediateAsTask + + +[] +module TaskValueOptionCEExtensionsHighPriority2 = + + // Medium priority extensions + type TaskValueOptionBuilderBase with + + member inline this.Source(computation: Async<'T voption>) : TaskValueOption<'T> = + computation + |> Async.StartImmediateAsTask + + member inline this.Source(taskOption: ValueTask<'T voption>) : TaskValueOption<'T> = + taskOption.AsTask() diff --git a/src/FsToolkit.ErrorHandling/TaskValueOptionOp.fs b/src/FsToolkit.ErrorHandling/TaskValueOptionOp.fs new file mode 100644 index 00000000..320a867e --- /dev/null +++ b/src/FsToolkit.ErrorHandling/TaskValueOptionOp.fs @@ -0,0 +1,10 @@ +namespace FsToolkit.ErrorHandling.Operator.TaskValueOption + +open FsToolkit.ErrorHandling + +[] +module TaskValueOption = + + let inline () ([] f) x = TaskValueOption.map f x + let inline (<*>) f x = TaskValueOption.apply f x + let inline (>>=) x ([] f) = TaskValueOption.bind f x diff --git a/tests/FsToolkit.ErrorHandling.Tests/BackgroundTaskValueOptionCE.fs b/tests/FsToolkit.ErrorHandling.Tests/BackgroundTaskValueOptionCE.fs new file mode 100644 index 00000000..054699ee --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/BackgroundTaskValueOptionCE.fs @@ -0,0 +1,498 @@ +module BackgroundTaskValueOptionCETests + +open Expecto +open FsToolkit.ErrorHandling +open System.Threading.Tasks + +let makeDisposable () = + { new System.IDisposable with + member this.Dispose() = () + } + +let ceTests = + testList "Background TaskValueOption CE" [ + testCaseTask "Return value" + <| fun () -> + backgroundTask { + let expected = ValueSome 42 + let! actual = backgroundTaskValueOption { return 42 } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom ValueSome" + <| fun () -> + backgroundTask { + let expected = ValueSome 42 + let! actual = backgroundTaskValueOption { return! (ValueSome 42) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom ValueNone" + <| fun () -> + backgroundTask { + let expected = ValueNone + let! actual = backgroundTaskValueOption { return! ValueNone } + Expect.equal actual expected "Should return value wrapped in voption" + } + + testCaseTask "ReturnFrom Async ValueNone" + <| fun () -> + backgroundTask { + let expected = ValueNone + let! actual = backgroundTaskValueOption { return! (async.Return ValueNone) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom Async" + <| fun () -> + backgroundTask { + let expected = ValueSome 42 + let! actual = backgroundTaskValueOption { return! (async.Return 42) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom Task ValueNone" + <| fun () -> + backgroundTask { + let expected = ValueNone + let! actual = backgroundTaskValueOption { return! (Task.FromResult ValueNone) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom Task Generic" + <| fun () -> + backgroundTask { + let expected = ValueSome 42 + let! actual = backgroundTaskValueOption { return! (Task.FromResult 42) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom Task" + <| fun () -> + backgroundTask { + let expected = ValueSome() + let! actual = backgroundTaskValueOption { return! Task.CompletedTask } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom ValueTask Generic" + <| fun () -> + backgroundTask { + let expected = ValueSome 42 + let! actual = backgroundTaskValueOption { return! (ValueTask.FromResult 42) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom ValueTask" + <| fun () -> + backgroundTask { + let expected = ValueSome() + let! actual = backgroundTaskValueOption { return! ValueTask.CompletedTask } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "Bind ValueSome" + <| fun () -> + backgroundTask { + let expected = ValueSome 42 + + let! actual = + backgroundTaskValueOption { + let! value = ValueSome 42 + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind ValueNone" + <| fun () -> + backgroundTask { + let expected = ValueNone + + let! actual = + backgroundTaskValueOption { + let! value = ValueNone + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Async ValueNone" + <| fun () -> + backgroundTask { + let expected = ValueNone + + let! actual = + backgroundTaskValueOption { + let! value = async.Return(ValueNone) + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Async" + <| fun () -> + backgroundTask { + let expected = ValueSome 42 + + let! actual = + backgroundTaskValueOption { + let! value = async.Return 42 + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Task ValueNone" + <| fun () -> + backgroundTask { + let expected = ValueNone + + let! actual = + backgroundTaskValueOption { + let! value = Task.FromResult ValueNone + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Task Generic" + <| fun () -> + backgroundTask { + let expected = ValueSome 42 + + let! actual = + backgroundTaskValueOption { + let! value = Task.FromResult 42 + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Task" + <| fun () -> + backgroundTask { + let expected = ValueSome() + + let! actual = + backgroundTaskValueOption { + let! value = Task.CompletedTask + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind ValueTask Generic" + <| fun () -> + backgroundTask { + let expected = ValueSome 42 + + let! actual = + backgroundTaskValueOption { + let! value = ValueTask.FromResult 42 + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind ValueTask" + <| fun () -> + backgroundTask { + let expected = ValueSome() + + let! actual = + backgroundTaskValueOption { + let! value = ValueTask.CompletedTask + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + + testCaseTask "Task.Yield" + <| fun () -> + backgroundTask { + + let! actual = backgroundTaskValueOption { do! Task.Yield() } + + Expect.equal actual (ValueSome()) "Should be ok" + } + testCaseTask "Zero/Combine/Delay/Run" + <| fun () -> + backgroundTask { + let data = 42 + + let! actual = + backgroundTaskValueOption { + let result = data + + if true then + () + + return result + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "Try With" + <| fun () -> + backgroundTask { + let data = 42 + + let! actual = + backgroundTaskValueOption { + try + return data + with e -> + return raise e + } + + Expect.equal actual (ValueSome data) "Try with failed" + } + testCaseTask "Try Finally" + <| fun () -> + backgroundTask { + let data = 42 + + let! actual = + backgroundTaskValueOption { + try + return data + finally + () + } + + Expect.equal actual (ValueSome data) "Try with failed" + } + testCaseTask "Using null" + <| fun () -> + backgroundTask { + let data = 42 + + let! actual = + backgroundTaskValueOption { + use d = null + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "Using disposeable" + <| fun () -> + backgroundTask { + let data = 42 + + let! actual = + backgroundTaskValueOption { + use d = makeDisposable () + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "Using bind disposeable" + <| fun () -> + backgroundTask { + let data = 42 + + let! actual = + backgroundTaskValueOption { + use! d = + (makeDisposable () + |> ValueSome) + + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "While" + <| fun () -> + backgroundTask { + let data = 42 + let mutable index = 0 + + let! actual = + backgroundTaskValueOption { + while index < 10 do + index <- index + 1 + + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "while fail" + <| fun () -> + backgroundTask { + + let mutable loopCount = 0 + let mutable wasCalled = false + + let sideEffect () = + wasCalled <- true + "ok" + + let expected = ValueNone + + let data = [ + ValueSome "42" + ValueSome "1024" + expected + ValueSome "1M" + ValueSome "1M" + ValueSome "1M" + ] + + let! actual = + backgroundTaskValueOption { + while loopCount < data.Length do + let! x = data.[loopCount] + + loopCount <- + loopCount + + 1 + + return sideEffect () + } + + Expect.equal loopCount 2 "Should only loop twice" + Expect.equal actual expected "Should be an error" + Expect.isFalse wasCalled "No additional side effects should occur" + } + testCaseTask "For in" + <| fun () -> + backgroundTask { + let data = 42 + + let! actual = + backgroundTaskValueOption { + for i in [ 1..10 ] do + () + + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "For to" + <| fun () -> + backgroundTask { + let data = 42 + + let! actual = + backgroundTaskValueOption { + for i = 1 to 10 do + () + + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "for in fail" + <| fun () -> + backgroundTask { + + let mutable loopCount = 0 + let mutable wasCalled = false + + let sideEffect () = + wasCalled <- true + "ok" + + let expected = ValueNone + + let data = [ + ValueSome "42" + ValueSome "1024" + expected + ValueSome "1M" + ValueSome "1M" + ValueSome "1M" + ] + + let! actual = + backgroundTaskValueOption { + for i in data do + let! x = i + + loopCount <- + loopCount + + 1 + + () + + return sideEffect () + } + + Expect.equal loopCount 2 "Should only loop twice" + Expect.equal actual expected "Should be an error" + Expect.isFalse wasCalled "No additional side effects should occur" + } + ] + +let specialCaseTask returnValue = +#if NETSTANDARD2_0 + Unsafe.uply { return returnValue } +#else + Task.FromResult returnValue +#endif + +let ceTestsApplicative = + testList "BackgroundTaskValueOptionCE applicative tests" [ + testCaseTask "Happy Path Option/AsyncOption/Ply/ValueTask" + <| fun () -> + backgroundTask { + let! actual = + backgroundTaskValueOption { + let! a = ValueSome 3 + + let! b = + ValueSome 1 + |> Async.singleton + + let! c = specialCaseTask (ValueSome 3) + let! d = ValueTask.FromResult(ValueSome 5) + + return + a + b + - c + - d + } + + Expect.equal actual (ValueSome -4) "Should be ok" + } + testCaseTask "Fail Path Option/AsyncOption/Ply/ValueTask" + <| fun () -> + backgroundTask { + let! actual = + backgroundTaskValueOption { + let! a = ValueSome 3 + + and! b = + ValueSome 1 + |> Async.singleton + + and! c = specialCaseTask (ValueNone) + and! d = ValueTask.FromResult(ValueSome 5) + + return + a + b + - c + - d + } + + Expect.equal actual ValueNone "Should be ok" + } + ] + +let ``BackgroundTaskValueOptionCE inference checks`` = + testList "BackgroundTaskValueOptionCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = + backgroundTaskValueOption { return! res } + + f (TaskValueOption.valueSome ()) + |> ignore + ] + +let allTests = + testList "BackgroundTaskValueOptionCE CE Tests" [ + ceTests + ceTestsApplicative + ``BackgroundTaskValueOptionCE inference checks`` + ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/Expect.fs b/tests/FsToolkit.ErrorHandling.Tests/Expect.fs index 6d9bb02d..9e63be5f 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/Expect.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/Expect.fs @@ -49,6 +49,12 @@ module Expect = | Some x -> Tests.failtestf "Expected Some(%A), was Some(%A)." v x | None -> Tests.failtestf "Expected Some, was None." + let hasValueSomeValue v x = + match x with + | ValueSome x when x = v -> () + | ValueSome x -> Tests.failtestf "Expected ValueSome(%A), was ValueSome(%A)." v x + | ValueNone -> Tests.failtestf "Expected ValueSome, was ValueNone." + let hasSomeSeqValue v x = match x with | Some x -> @@ -63,6 +69,11 @@ module Expect = | None -> () | Some _ -> Tests.failtestf "Expected None, was Some." + let hasValueNoneValue x = + match x with + | ValueNone -> () + | ValueSome v -> Tests.failtestf "Expected ValueNone, was ValueSome(%A)." v + let hasAsyncValue v asyncX = async { let! x = asyncX @@ -144,6 +155,14 @@ module Expect = hasNoneValue x + let hasTaskValueNoneValue taskX = + let x = + taskX + |> Async.AwaitTask + |> Async.RunSynchronously + + hasValueNoneValue x + let hasTaskErrorValue v (taskX: Task<_>) = task { let! x = taskX @@ -166,6 +185,14 @@ module Expect = hasSomeValue v x + let hasTaskValueSomeValue v taskX = + let x = + taskX + |> Async.AwaitTask + |> Async.RunSynchronously + + hasValueSomeValue v x + #endif let inline same expected actual = diff --git a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj index 64f38363..eedf2526 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj @@ -14,9 +14,12 @@ + + + diff --git a/tests/FsToolkit.ErrorHandling.Tests/Main.fs b/tests/FsToolkit.ErrorHandling.Tests/Main.fs index ee15b191..590fc32d 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/Main.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/Main.fs @@ -37,9 +37,12 @@ let allTests = ParallelAsyncValidationCETests.allTests #if !FABLE_COMPILER BackgroundTaskOptionCETests.allTests + BackgroundTaskValueOptionCETests.allTests BackgroundTaskResultCETests.allTests TaskOptionTests.allTests TaskOptionCETests.allTests + TaskValueOptionTests.allTests + TaskValueOptionCETests.allTests TaskResultTests.allTests TaskResultCETests.allTests TaskResultOptionTests.allTests diff --git a/tests/FsToolkit.ErrorHandling.Tests/TaskValueOption.fs b/tests/FsToolkit.ErrorHandling.Tests/TaskValueOption.fs new file mode 100644 index 00000000..9b2c5bb2 --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/TaskValueOption.fs @@ -0,0 +1,204 @@ +module TaskValueOptionTests + +open Expecto + +open System +open System.Threading.Tasks + +open TestData +open TestHelpers +open SampleDomain +open FsToolkit.ErrorHandling +open FsToolkit.ErrorHandling.Operator.TaskValueOption + +let runTaskSync (task: Task<_>) = task.Result + +let createPostValueSome = + createPostSome + >> Async.map Option.toValueOption + >> Async.StartImmediateAsTask + +let getFollowersValueSome = + getFollowersSome + >> Async.map Option.toValueOption + >> Async.StartImmediateAsTask + +let allowedToPostOptional = + allowedToPostOptional + >> Async.map Option.toValueOption + >> Async.StartImmediateAsTask + + +let mapTests = + testList "TaskValueOption.map Tests" [ + testCase "map with Task(ValueSome x)" + <| fun _ -> + Task.singleton (ValueSome validTweet) + |> TaskValueOption.map remainingCharacters + |> Expect.hasTaskValueSomeValue 267 + + testCase "map with Task(ValueNone)" + <| fun _ -> + Task.singleton ValueNone + |> TaskValueOption.map remainingCharacters + |> Expect.hasTaskValueNoneValue + ] + +let bindTests = + testList "TaskValueOption.bind tests" [ + testCase "bind with Task(ValueSome x)" + <| fun _ -> + allowedToPostOptional sampleUserId + |> TaskValueOption.bind (fun isAllowed -> + task { + if isAllowed then + return! createPostValueSome validCreatePostRequest + else + return ValueNone + } + ) + |> Expect.hasTaskValueSomeValue (PostId newPostId) + + testCase "bind with Task(ValueNone)" + <| fun _ -> + allowedToPostOptional (UserId(Guid.NewGuid())) + |> TaskValueOption.bind (fun isAllowed -> task { return ValueSome isAllowed }) + |> Expect.hasTaskValueNoneValue + + testCase "bind with Task(Ok x) that returns Task (None)" + <| fun _ -> + allowedToPostOptional sampleUserId + |> TaskValueOption.bind (fun _ -> task { return ValueNone }) + |> Expect.hasTaskValueNoneValue + ] + +let applyTests = + testList "TaskValueOption.apply Tests" [ + testCase "apply with Task(ValueSome x)" + <| fun _ -> + Task.singleton (ValueSome validTweet) + |> TaskValueOption.apply (Task.singleton (ValueSome remainingCharacters)) + |> Expect.hasTaskValueSomeValue (267) + + testCase "apply with Task(ValueNone)" + <| fun _ -> + Task.singleton ValueNone + |> TaskValueOption.apply (Task.singleton (ValueSome remainingCharacters)) + |> Expect.hasTaskValueNoneValue + ] + +let valueSomeTests = + testList "TaskValueOption.valueSome Tests" [ + testCase "valueSome with x" + <| fun _ -> + TaskValueOption.valueSome 267 + |> Expect.hasTaskValueSomeValue 267 + ] + +let taskValueOptionOperatorTests = + testList "TaskValueOption Operators Tests" [ + testCase "map & apply operators" + <| fun _ -> + let getFollowersResult = getFollowersValueSome sampleUserId + let createPostResult = createPostValueSome validCreatePostRequest + + newPostRequest + getFollowersResult + <*> createPostResult + |> Expect.hasTaskValueSomeValue { + NewPostId = PostId newPostId + UserIds = followerIds + } + + testCase "bind operator" + <| fun _ -> + allowedToPostOptional sampleUserId + >>= (fun isAllowed -> + if isAllowed then + createPostValueSome validCreatePostRequest + else + Task.singleton ValueNone + ) + |> Expect.hasTaskValueSomeValue (PostId newPostId) + ] + + +let eitherTests = + testList "TaskValueOption.either Tests" [ + testCaseTask "ValueSome" + <| fun () -> + task { + let value1 = TaskValueOption.valueSome 5 + let f () = Task.FromResult 42 + let add2 x = task { return x + 2 } + let! result = (TaskValueOption.either add2 f value1) + Expect.equal result 7 "" + } + testCaseTask "ValueNone" + <| fun () -> + task { + let value1 = Task.FromResult ValueNone + let f () = Task.FromResult 42 + let add2 x = task { return x + 2 } + let! result = (TaskValueOption.either add2 f value1) + Expect.equal result 42 "" + } + ] + +let defaultValueTests = + testList "TaskValueOption.defaultValue Tests" [ + testCaseTask "ValueSome" + <| fun () -> + task { + let defaultValue = 10 + let expectedValue = 5 + + let taskValueOption = TaskValueOption.valueSome expectedValue + let! result = TaskValueOption.defaultValue defaultValue taskValueOption + Expect.equal result expectedValue "" + } + + testCaseTask "ValueNone" + <| fun () -> + task { + let expectedValue = 10 + let taskValueOption = Task.singleton ValueNone + let! result = TaskValueOption.defaultValue expectedValue taskValueOption + Expect.equal result expectedValue "" + } + ] + +let defaultWithTests = + testList "TaskValueOption.defaultWith Tests" [ + testCaseTask "ValueSome" + <| fun () -> + task { + let defaultValue = 10 + let expectedValue = 5 + + let taskValueOption = TaskValueOption.valueSome expectedValue + let! result = TaskValueOption.defaultWith (fun () -> defaultValue) taskValueOption + Expect.equal result expectedValue "" + } + + testCaseTask "ValueNone" + <| fun () -> + task { + let expectedValue = 10 + let taskValueOption = Task.singleton ValueNone + let! result = TaskValueOption.defaultWith (fun () -> expectedValue) taskValueOption + Expect.equal result expectedValue "" + } + ] + +let allTests = + testList "Task ValueOption Tests" [ + mapTests + bindTests + applyTests + valueSomeTests + taskValueOptionOperatorTests + eitherTests + defaultValueTests + defaultWithTests + ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/TaskValueOptionCE.fs b/tests/FsToolkit.ErrorHandling.Tests/TaskValueOptionCE.fs new file mode 100644 index 00000000..3aa7595e --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/TaskValueOptionCE.fs @@ -0,0 +1,628 @@ +module TaskValueOptionCETests + +open Expecto +open FsToolkit.ErrorHandling +open System.Threading.Tasks + + +module TestFuncs = + let testFunctionTO<'Dto> () = + taskValueOption { + let dto = Unchecked.defaultof<'Dto> + System.Console.WriteLine(dto) + } + +let ceTests = + testList "TaskValueOption CE" [ + testCaseTask "Return value" + <| fun () -> + task { + let expected = ValueSome 42 + let! actual = taskValueOption { return 42 } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom ValueSome" + <| fun () -> + task { + let expected = ValueSome 42 + let! actual = taskValueOption { return! (ValueSome 42) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom ValueNone" + <| fun () -> + task { + let expected = ValueNone + let! actual = taskValueOption { return! ValueNone } + Expect.equal actual expected "Should return value wrapped in voption" + } + + testCaseTask "ReturnFrom Async ValueNone" + <| fun () -> + task { + let expected = ValueNone + let! actual = taskValueOption { return! (async.Return ValueNone) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom Async" + <| fun () -> + task { + let expected = ValueSome 42 + let! actual = taskValueOption { return! (async.Return 42) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom Task ValueNone" + <| fun () -> + task { + let expected = ValueNone + let! actual = taskValueOption { return! (Task.FromResult ValueNone) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom Task Generic" + <| fun () -> + task { + let expected = ValueSome 42 + let! actual = taskValueOption { return! (Task.FromResult 42) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom Task" + <| fun () -> + task { + let expected = ValueSome() + let! actual = taskValueOption { return! Task.CompletedTask } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom ValueTask Generic" + <| fun () -> + task { + let expected = ValueSome 42 + let! actual = taskValueOption { return! (ValueTask.FromResult 42) } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "ReturnFrom ValueTask" + <| fun () -> + task { + let expected = ValueSome() + let! actual = taskValueOption { return! ValueTask.CompletedTask } + Expect.equal actual expected "Should return value wrapped in voption" + } + testCaseTask "Bind ValueSome" + <| fun () -> + task { + let expected = ValueSome 42 + + let! actual = + taskValueOption { + let! value = ValueSome 42 + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind ValueNone" + <| fun () -> + task { + let expected = ValueNone + + let! actual = + taskValueOption { + let! value = ValueNone + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Async ValueNone" + <| fun () -> + task { + let expected = ValueNone + + let! actual = + taskValueOption { + let! value = async.Return(ValueNone) + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Async" + <| fun () -> + task { + let expected = ValueSome 42 + + let! actual = + taskValueOption { + let! value = async.Return 42 + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Task ValueNone" + <| fun () -> + task { + let expected = ValueNone + + let! actual = + taskValueOption { + let! value = Task.FromResult ValueNone + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Task Generic" + <| fun () -> + task { + let expected = ValueSome 42 + + let! actual = + taskValueOption { + let! value = Task.FromResult 42 + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind Task" + <| fun () -> + task { + let expected = ValueSome() + + let! actual = + taskValueOption { + let! value = Task.CompletedTask + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind ValueTask Generic" + <| fun () -> + task { + let expected = ValueSome 42 + + let! actual = + taskValueOption { + let! value = ValueTask.FromResult 42 + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + testCaseTask "Bind ValueTask" + <| fun () -> + task { + let expected = ValueSome() + + let! actual = + taskValueOption { + let! value = ValueTask.CompletedTask + return value + } + + Expect.equal actual expected "Should bind value wrapped in voption" + } + + testCaseTask "Task.Yield" + <| fun () -> + task { + + let! actual = taskValueOption { do! Task.Yield() } + + Expect.equal actual (ValueSome()) "Should be ok" + } + testCaseTask "Zero/Combine/Delay/Run" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValueOption { + let result = data + + if true then + () + + return result + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "If do!" + <| fun () -> + task { + let data = 42 + + let taskRes (call: unit -> Task) maybeCall : Task> = + taskValueOption { + if true then + do! call () + + let! (res: string) = maybeCall (): Task> + return data + } + + () + } + testCaseTask "Try With" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValueOption { + try + return data + with e -> + return raise e + } + + Expect.equal actual (ValueSome data) "Try with failed" + } + testCaseTask "Try Finally" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValueOption { + try + return data + finally + () + } + + Expect.equal actual (ValueSome data) "Try with failed" + } + testCaseTask "Using null" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValueOption { + use d = null + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + + testCaseTask "use normal disposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskValueOption { + use d = TestHelpers.makeDisposable (fun () -> isFinished <- true) + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + Expect.isTrue isFinished "" + } + testCaseTask "use! normal wrapped disposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskValueOption { + use! d = + TestHelpers.makeDisposable (fun () -> isFinished <- true) + |> ValueSome + + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + Expect.isTrue isFinished "" + } + testCaseTask "use null disposable" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValueOption { + use d = null + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "use sync asyncdisposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskValueOption { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + isFinished <- true + ValueTask() + ) + ) + + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + Expect.isTrue isFinished "" + } + + testCaseTask "use async asyncdisposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskValueOption { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + task { + do! Task.Yield() + isFinished <- true + } + :> Task + |> ValueTask + ) + ) + + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + Expect.isTrue isFinished "" + } + yield! [ + let maxIndices = [ + 10 + 1000000 + ] + + for maxIndex in maxIndices do + testCaseTask + <| sprintf "While - %i" maxIndex + <| fun () -> + task { + let data = 42 + let mutable index = 0 + + let! actual = + taskValueOption { + while index < maxIndex do + index <- index + 1 + + return data + } + + Expect.equal index maxIndex "Index should reach maxIndex" + Expect.equal actual (ValueSome data) "Should be ok" + } + ] + + testCaseTask "while bind error" + <| fun () -> + task { + let items = [ + TaskValueOption.valueSome 3 + TaskValueOption.valueSome 4 + Task.singleton ValueNone + ] + + let mutable index = 0 + + let! actual = + taskValueOption { + while index < items.Length do + let! _ = items[index] + index <- index + 1 + + return index + } + + Expect.equal + index + (items.Length + - 1) + "Index should reach maxIndex" + + Expect.equal actual ValueNone "Should be NOPE" + } + testCaseTask "while fail" + <| fun () -> + task { + + let mutable loopCount = 0 + let mutable wasCalled = false + + let sideEffect () = + wasCalled <- true + "ok" + + let expected = ValueNone + + let data = [ + ValueSome "42" + ValueSome "1024" + expected + ValueSome "1M" + ValueSome "1M" + ValueSome "1M" + ] + + let! actual = + taskValueOption { + while loopCount < data.Length do + let! x = data.[loopCount] + + loopCount <- + loopCount + + 1 + + return sideEffect () + } + + Expect.equal loopCount 2 "Should only loop twice" + Expect.equal actual expected "Should be an error" + Expect.isFalse wasCalled "No additional side effects should occur" + } + testCaseTask "For in" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValueOption { + for i in [ 1..10 ] do + () + + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "For to" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValueOption { + for i = 1 to 10 do + () + + return data + } + + Expect.equal actual (ValueSome data) "Should be ok" + } + testCaseTask "for in fail" + <| fun () -> + task { + + let mutable loopCount = 0 + let mutable wasCalled = false + + let sideEffect () = + wasCalled <- true + "ok" + + let expected = ValueNone + + let data = [ + ValueSome "42" + ValueSome "1024" + expected + ValueSome "1M" + ValueSome "1M" + ValueSome "1M" + ] + + let! actual = + taskValueOption { + for i in data do + let! x = i + + loopCount <- + loopCount + + 1 + + () + + return sideEffect () + } + + Expect.equal loopCount 2 "Should only loop twice" + Expect.equal actual expected "Should be an error" + Expect.isFalse wasCalled "No additional side effects should occur" + } + testCaseTask "Empty result" + <| fun () -> + task { + let! _ = TestFuncs.testFunctionTO () + () + } + ] + +let specialCaseTask returnValue = +#if NETSTANDARD2_0 + Unsafe.uply { return returnValue } +#else + Task.FromResult returnValue +#endif + +let ceTestsApplicative = + testList "TaskValueOptionCE applicative tests" [ + testCaseTask "Happy Path Option/AsyncOption/Ply/ValueTask" + <| fun () -> + task { + let! actual = + taskValueOption { + let! a = ValueSome 3 + + let! b = + ValueSome 1 + |> Async.singleton + + let! c = specialCaseTask (ValueSome 3) + let! d = ValueTask.FromResult(ValueSome 5) + + return + a + b + - c + - d + } + + Expect.equal actual (ValueSome -4) "Should be ok" + } + testCaseTask "Fail Path Option/AsyncOption/Ply/ValueTask" + <| fun () -> + task { + let! actual = + taskValueOption { + let! a = ValueSome 3 + + and! b = + ValueSome 1 + |> Async.singleton + + and! c = specialCaseTask ValueNone + and! d = ValueTask.FromResult(ValueSome 5) + + return + a + b + - c + - d + } + + Expect.equal actual ValueNone "Should be ok" + } + ] + +let ``TaskValueOptionCE inference checks`` = + testList "TaskValueOptionCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = taskValueOption { return! res } + + f (TaskValueOption.valueSome ()) + |> ignore + ] + +let allTests = + testList "TaskValueOption CE Tests" [ + ceTests + ceTestsApplicative + ``TaskValueOptionCE inference checks`` + ]