diff --git a/gitbook/parallelAsyncResult/ce.md b/gitbook/parallelAsyncResult/ce.md new file mode 100644 index 00000000..1d997eca --- /dev/null +++ b/gitbook/parallelAsyncResult/ce.md @@ -0,0 +1,51 @@ +## ParallelAsyncResult Computation Expression + +Namespace: `FsToolkit.ErrorHandling` + +This CE operates on the same type as `asyncResult`, but it adds the `and!` operator for running workflows in parallel. + +When running concurrent workflows, fail-fast semantics are used. If any sub-task returns an `Error`, then all other tasks are cancelled and only that error is returned. To instead collect all errors, use `parallelAsyncValidation`. + + +## Examples + +### Example 1 + +Suppose we want to download 3 files. + +Here is our simulated download function: + +```fsharp +// string -> Async> +let downloadAsync stuff : Async> = async { + do! Async.Sleep 3_000 + return Ok stuff +} +``` + +This workflow will download each item in sequence: + +```fsharp +let downloadAllSequential = ayncResult { + let! x = downloadAsync (Ok "We") + let! y = downloadAsync (Ok "run") + let! z = downloadAsync (Ok "sequentially :(") + return sprintf "%s %s %s" x y z +} +``` + +It takes 9 seconds to complete. + +However, using `parallelAsyncResult`, we can download all 3 concurrently: + +```fsharp +// Async> +let downloadAll = parallelAsyncResult { + let! x = downloadAsync (Ok "We") + and! y = downloadAsync (Ok "run") + and! z = downloadAsync (Ok "concurrently!") + return sprintf "%s %s %s" x y z +} +``` + +This takes just 3 seconds. diff --git a/gitbook/parallelAsyncResult/map2.md b/gitbook/parallelAsyncResult/map2.md new file mode 100644 index 00000000..4078c806 --- /dev/null +++ b/gitbook/parallelAsyncResult/map2.md @@ -0,0 +1,53 @@ +## ParallelAsyncResult.map2 + +Namespace: `FsToolkit.ErrorHandling` + +Function Signature: + +```fsharp +('a -> 'b -> 'c) -> Async> -> Async> + -> Async> +``` + +## Examples + +Note: Many use-cases requiring `map2` operations can also be solved using [the `parallelAsyncResult` computation expression](../parallelAsyncResult/ce.md). + +### Example 1 + +Given the functions + +```fsharp +getFollowerIds : UserId -> Async> +createPost : CreatePostRequest -> Async> +``` + +And the type + +```fsharp +type NotifyNewPostRequest = + { UserIds : UserId list + NewPostId : PostId } + static member Create userIds newPostsId = + {UserIds = userIds; NewPostId = newPostsId} +``` + +We can create a `NotifyNewPostRequest` using `ParallelAsyncResult.map2` as below: + +```fsharp +let createPostAndGetNotifyRequest (req : CreatePostRequest) = + // Async> + let getFollowersResult = getFollowerIds req.UserId + + // Async> + let createPostResult = createPost req + + // Async> + let newPostRequestResult = + ParallelAsyncResult.map2 + NotifyNewPostRequest.Create getFollowersResult createPostResult + + // ... +``` + +This workflow will run the sub-tasks `getFollowersResult` and `createPostResult` concurrently, which can increase throughput. \ No newline at end of file diff --git a/gitbook/parallelAsyncResult/map3.md b/gitbook/parallelAsyncResult/map3.md new file mode 100644 index 00000000..6f2fc708 --- /dev/null +++ b/gitbook/parallelAsyncResult/map3.md @@ -0,0 +1,17 @@ +## ParallelAsyncResult.map3 + +Namespace: `FsToolkit.ErrorHandling` + +Function Signature: + +```fsharp +('a -> 'b -> 'c -> 'd) + -> Async> + -> Async> + -> Async> + -> Async> +``` + +## Examples + +Note: Many use-cases requiring `map3` operations can also be solved using [the `parallelAsyncResult` computation expression](../parallelAsyncResult/ce.md). \ No newline at end of file diff --git a/gitbook/parallelAsyncValidation/ce.md b/gitbook/parallelAsyncValidation/ce.md new file mode 100644 index 00000000..0f69efba --- /dev/null +++ b/gitbook/parallelAsyncValidation/ce.md @@ -0,0 +1,37 @@ +## ParallelAsyncValidation Computation Expression + +Namespace: `FsToolkit.ErrorHandling` + +This CE operates in the same way as `asyncValidation`, except that the `and!` operator will run workflows in parallel. + +Concurrent workflows are run with the same semantics as [`Async.Parallel`](https://fsharp.github.io/fsharp-core-docs/reference/fsharp-control-fsharpasync.html#Parallel). + + +## Examples + +See [here](../validation/ce.md) for other validation-like examples + +```fsharp +// Result -> Async> +let downloadAsync stuff = async { + return stuff +} + +// AsyncValidation +let addResult = parallelAsyncValidation { + let! x = downloadAsync (Ok "I") + and! y = downloadAsync (Ok "am") + and! z = downloadAsync (Ok "concurrent!") + return sprintf "%s %s %s" x y z +} +// async { return Ok "I am concurrent!" } + +// AsyncValidation +let addResult = parallelAsyncValidation { + let! x = downloadAsync (Error "Am") + and! y = downloadAsync (Error "I") + and! z = downloadAsync (Error "concurrent?") + return sprintf "%s %s %s" x y z +} +// async { return Error [ "Am"; "I"; "concurrent?" ] } +``` diff --git a/gitbook/parallelAsyncValidation/map2.md b/gitbook/parallelAsyncValidation/map2.md new file mode 100644 index 00000000..a1969be7 --- /dev/null +++ b/gitbook/parallelAsyncValidation/map2.md @@ -0,0 +1,14 @@ +## ParallelAsyncValidation.map2 + +Namespace: `FsToolkit.ErrorHandling` + +Function Signature: + +```fsharp +('a -> 'b -> 'c) + -> Async> + -> Async> + -> Async> +``` + +Like [ParallelAsyncResult.map2](../parallelAsyncResult/map2.md), but collects the errors from both arguments. diff --git a/gitbook/parallelAsyncValidation/map3.md b/gitbook/parallelAsyncValidation/map3.md new file mode 100644 index 00000000..debb5442 --- /dev/null +++ b/gitbook/parallelAsyncValidation/map3.md @@ -0,0 +1,16 @@ +## ParallelAsyncValidation.map3 + +Namespace: `FsToolkit.ErrorHandling` + +Function Signature: + +``` +('a -> 'b -> 'c -> 'd) + -> Async> + -> Async> + -> Async> + -> Async> +``` + +Like [ParallelAsyncResult.map3](../parallelAsyncResult/map3.md), but collects the errors from all arguments. + diff --git a/src/FsToolkit.ErrorHandling/Async.fs b/src/FsToolkit.ErrorHandling/Async.fs index 3705a91b..3e909173 100644 --- a/src/FsToolkit.ErrorHandling/Async.fs +++ b/src/FsToolkit.ErrorHandling/Async.fs @@ -114,6 +114,95 @@ module Async = let inline zip (left: Async<'left>) (right: Async<'right>) : Async<'left * 'right> = bind (fun l -> bind (fun r -> singleton (l, r)) right) left + /// + /// Executes two asyncs concurrently and returns a mapping of the values + /// + /// The function to apply to the values of the Async values. + /// The first Async to execute + /// The second Async to execute + /// The transformed Async value. + let inline parallelMap2 + ([] mapper: 'input1 -> 'input2 -> 'output) + (input1: Async<'input1>) + (input2: Async<'input2>) + : Async<'output> = + +#if FABLE_COMPILER && FABLE_COMPILER_PYTHON + Async.Parallel( + [| + map box input1 + map box input2 + |] + ) +#else + Async.Parallel( + [| + map box input1 + map box input2 + |], + maxDegreeOfParallelism = 2 + ) +#endif + |> map (fun results -> + let a = + results[0] + |> unbox<'input1> + + let b = + results[1] + |> unbox<'input2> + + mapper a b + ) + + /// + /// Executes three asyncs concurrently and returns a mapping of the values + /// + /// The function to apply to the values of the Async values. + /// The first Async to execute + /// The second Async to execute + /// The third Async value to transform. + /// The transformed Async value. + let inline parallelMap3 + ([] mapper: 'input1 -> 'input2 -> 'input3 -> 'output) + (input1: Async<'input1>) + (input2: Async<'input2>) + (input3: Async<'input3>) + : Async<'output> = +#if FABLE_COMPILER && FABLE_COMPILER_PYTHON + Async.Parallel( + [| + map box input1 + map box input2 + map box input3 + |] + ) +#else + Async.Parallel( + [| + map box input1 + map box input2 + map box input3 + |], + maxDegreeOfParallelism = 3 + ) +#endif + |> map (fun results -> + let a = + results[0] + |> unbox<'input1> + + let b = + results[1] + |> unbox<'input2> + + let c = + results[2] + |> unbox<'input3> + + mapper a b c + ) + /// /// Operators for working with the Async type. /// diff --git a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj index 3c91371c..7bca184d 100644 --- a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj +++ b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj @@ -48,6 +48,10 @@ + + + + diff --git a/src/FsToolkit.ErrorHandling/ParallelAsyncResult.fs b/src/FsToolkit.ErrorHandling/ParallelAsyncResult.fs new file mode 100644 index 00000000..0b07534e --- /dev/null +++ b/src/FsToolkit.ErrorHandling/ParallelAsyncResult.fs @@ -0,0 +1,88 @@ +namespace FsToolkit.ErrorHandling + +open System + +[] +module ParallelAsyncResult = + + [] + module InternalHelpers = + + type AsyncResultErrorException<'a>(value: 'a) = + inherit Exception() + member this.Value = value + + let toBoxedAsync (input: Async>) : Async = + async { + match! input with + | Ok x -> return box x + | Error e -> return raise (AsyncResultErrorException<'error>(e)) + } + + /// + /// Transforms two AsyncResults in one that executes them concurrently and combines the results using the specified function. + /// If either AsyncResult resolves to an error, then the other is cancelled and only the first error is returned. + /// + /// The function to apply to the values of the AsyncResult values. + /// The first AsyncResult value to transform. + /// The second AsyncResult value to transform. + /// The transformed AsyncResult value. + let inline map2 + ([] mapper: 'a -> 'b -> 'c) + (input1: Async>) + (input2: Async>) + : Async> = + async { + try + return! + Async.parallelMap2 + (fun a b -> + let a = unbox<'a> a + let b = unbox<'b> b + Ok(mapper a b) + ) + (toBoxedAsync input1) + (toBoxedAsync input2) + + with :? AsyncResultErrorException<'error> as exn -> + return Error exn.Value + } + + /// + /// Transforms three AsyncResults in one that executes them concurrently and combines the results using the specified function. + /// If any AsyncResult resolves to an error, then the others are cancelled and only the first error is returned. + /// + /// The function to apply to the values of the AsyncResult values. + /// The first AsyncResult value to transform. + /// The second AsyncResult value to transform. + /// The third AsyncResult value to transform. + /// The transformed AsyncResult value. + let inline map3 + ([] mapper: 'a -> 'b -> 'c -> 'd) + (input1: Async>) + (input2: Async>) + (input3: Async>) + : Async> = + async { + try + return! + Async.parallelMap3 + (fun a b c -> + let a = unbox<'a> a + let b = unbox<'b> b + let c = unbox<'c> c + Ok(mapper a b c) + ) + (toBoxedAsync input1) + (toBoxedAsync input2) + (toBoxedAsync input3) + + with :? AsyncResultErrorException<'error> as exn -> + return Error exn.Value + } + + let inline zip + (a: Async>) + (b: Async>) + : Async> = + map2 (fun a b -> a, b) a b diff --git a/src/FsToolkit.ErrorHandling/ParallelAsyncResultCE.fs b/src/FsToolkit.ErrorHandling/ParallelAsyncResultCE.fs new file mode 100644 index 00000000..5094ec00 --- /dev/null +++ b/src/FsToolkit.ErrorHandling/ParallelAsyncResultCE.fs @@ -0,0 +1,200 @@ +namespace FsToolkit.ErrorHandling + +open System +open System.Threading.Tasks + +[] +module ParallelAsyncResultCE = + + type ParallelAsyncResultBuilder() = + + member inline _.Return(value: 'ok) : Async> = + result.Return value + |> async.Return + + member inline _.ReturnFrom(input: Async>) : Async> = + input + + member inline _.Zero() : Async> = + result.Zero() + |> async.Return + + member inline _.Bind + ( + asyncResult: Async>, + [] binder: 'okInput -> Async> + ) : Async> = + AsyncResult.bind binder asyncResult + + member inline _.Delay + ([] generator: unit -> Async>) + : Async> = + async.Delay generator + + member inline this.Combine + (computation1: Async>, computation2: Async>) + : Async> = + this.Bind(computation1, (fun () -> computation2)) + + member inline _.TryWith + ( + computation: Async>, + [] handler: System.Exception -> Async> + ) : Async> = + async.TryWith(computation, handler) + + member inline _.TryFinally + (computation: Async>, [] compensation: unit -> unit) + : Async> = + async.TryFinally(computation, compensation) +#if !FABLE_COMPILER + member inline _.TryFinallyAsync + ( + computation: Async>, + [] compensation: unit -> ValueTask + ) : Async> = + let compensation = + async { + let vTask = compensation () + + if vTask.IsCompletedSuccessfully then + return () + else + return! + vTask.AsTask() + |> Async.AwaitTask + } + + Async.TryFinallyAsync(computation, compensation) + + + member inline this.Using + ( + resource: 'ok :> IAsyncDisposable, + [] binder: 'ok -> Async> + ) : Async> = + this.TryFinallyAsync( + binder resource, + (fun () -> + if not (isNull (box resource)) then + resource.DisposeAsync() + else + ValueTask() + ) + ) +#endif + member inline this.While + ([] guard: unit -> bool, computation: Async>) + : Async> = + if guard () then + let mutable whileAsync = Unchecked.defaultof<_> + + whileAsync <- + this.Bind(computation, (fun () -> if guard () then whileAsync else this.Zero())) + + whileAsync + else + this.Zero() + + + member inline _.BindReturn + (x: Async>, [] f: 'okInput -> 'okOutput) + : Async> = + AsyncResult.map f x + + /// + /// 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: Async>) : Async> = + result + + member inline _.MergeSources(input1, input2) : Async> = + ParallelAsyncResult.zip input1 input2 + + let parallelAsyncResult = ParallelAsyncResultBuilder() + + [] + module MediumPriority = + + type ParallelAsyncResultBuilder with + + /// + /// Needed to allow `for..in` and `for..do` functionality + /// + member inline _.Source(s: #seq<'value>) : #seq<'value> = s + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(result: Result<'ok, 'error>) : Async> = + Async.singleton result + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(choice: Choice<'ok, 'error>) : Async> = + choice + |> Result.ofChoice + |> Async.singleton + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(asyncComputation: Async<'ok>) : Async> = + asyncComputation + |> Async.map Ok + + + member inline _.Using + ( + resource: 'ok :> IDisposable, + [] binder: 'ok -> Async> + ) : Async> = + async.Using(resource, binder) + + + member inline this.For + (sequence: #seq<'ok>, [] binder: 'ok -> Async>) + : Async> = + this.Using( + sequence.GetEnumerator(), + fun enum -> + this.While( + (fun () -> enum.MoveNext()), + this.Delay(fun () -> binder enum.Current) + ) + ) + +#if !FABLE_COMPILER + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(task: Task<'ok>) : Async> = + task + |> Async.AwaitTask + |> Async.map Ok + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(task: Task) : Async> = + task + |> Async.AwaitTask + |> Async.map Ok +#endif + +#if !FABLE_COMPILER + [] + module HighPriority = + + type ParallelAsyncResultBuilder 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/ParallelAsyncValidation.fs b/src/FsToolkit.ErrorHandling/ParallelAsyncValidation.fs new file mode 100644 index 00000000..1c8c1a43 --- /dev/null +++ b/src/FsToolkit.ErrorHandling/ParallelAsyncValidation.fs @@ -0,0 +1,34 @@ +namespace FsToolkit.ErrorHandling + +[] +module ParallelAsyncValidation = + + /// + /// Execute two AsyncValidations concurrently and combines the results using the specified function. + /// Both are run to completion so that all errors are accumulated. + /// + /// The function to apply to the values of the AsyncValidation values. + /// The first AsyncValidation value to transform. + /// The second AsyncValidation value to transform. + /// The transformed AsyncValidation value. + let inline map2 + ([] mapper: 'a -> 'b -> 'c) + (input1: AsyncValidation<'a, 'error>) + (input2: AsyncValidation<'b, 'error>) + : AsyncValidation<'c, 'error> = + Async.parallelMap2 + (fun a b -> + match a, b with + | Ok a, Ok b -> Ok(mapper a b) + | Ok _, Error v -> Error v + | Error u, Ok _ -> Error u + | Error u, Error v -> Error(u @ v) + ) + input1 + input2 + + let inline zip + (a: AsyncValidation<'a, 'error>) + (b: AsyncValidation<'b, 'error>) + : AsyncValidation<'a * 'b, 'error> = + map2 (fun a b -> a, b) a b diff --git a/src/FsToolkit.ErrorHandling/ParallelAsyncValidationCE.fs b/src/FsToolkit.ErrorHandling/ParallelAsyncValidationCE.fs new file mode 100644 index 00000000..2bbe04cc --- /dev/null +++ b/src/FsToolkit.ErrorHandling/ParallelAsyncValidationCE.fs @@ -0,0 +1,244 @@ +namespace FsToolkit.ErrorHandling + +open System + +[] +module ParallelAsyncValidationCE = + + open System.Threading.Tasks + + type ParallelAsyncValidationBuilder() = + member inline _.Return(value: 'ok) : AsyncValidation<'ok, 'error> = AsyncValidation.ok value + + member inline _.ReturnFrom + (result: AsyncValidation<'ok, 'error>) + : AsyncValidation<'ok, 'error> = + result + + member inline _.Bind + ( + result: AsyncValidation<'okInput, 'error>, + [] binder: 'okInput -> AsyncValidation<'okOutput, 'error> + ) : AsyncValidation<'okOutput, 'error> = + AsyncValidation.bind binder result + + member inline this.Zero() : AsyncValidation = this.Return() + + member inline _.Delay + ([] generator: unit -> AsyncValidation<'ok, 'error>) + : AsyncValidation<'ok, 'error> = + async.Delay generator + + member inline this.Combine + (validation1: AsyncValidation, validation2: AsyncValidation<'ok, 'error>) + : AsyncValidation<'ok, 'error> = + this.Bind(validation1, (fun () -> validation2)) + + member inline _.TryWith + ( + computation: AsyncValidation<'ok, 'error>, + [] handler: exn -> AsyncValidation<'ok, 'error> + ) : AsyncValidation<'ok, 'error> = + async.TryWith(computation, handler) + + member inline _.TryFinally + ( + computation: AsyncValidation<'ok, 'error>, + [] compensation: unit -> unit + ) : AsyncValidation<'ok, 'error> = + async.TryFinally(computation, compensation) + + member inline _.Using + ( + resource: 'disposable :> IDisposable, + [] binder: 'disposable -> AsyncValidation<'okOutput, 'error> + ) : AsyncValidation<'okOutput, 'error> = + async.Using(resource, binder) + + member inline this.While + ([] guard: unit -> bool, computation: AsyncValidation) + : AsyncValidation = + if guard () then + let mutable whileAsync = Unchecked.defaultof<_> + + whileAsync <- + this.Bind(computation, (fun () -> if guard () then whileAsync else this.Zero())) + + whileAsync + else + this.Zero() + + + member inline this.For + (sequence: #seq<'ok>, [] binder: 'ok -> AsyncValidation) + : AsyncValidation = + this.Using( + sequence.GetEnumerator(), + fun enum -> this.While(enum.MoveNext, this.Delay(fun () -> binder enum.Current)) + ) + + member inline _.BindReturn + ( + input: AsyncValidation<'okInput, 'error>, + [] mapper: 'okInput -> 'okOutput + ) : AsyncValidation<'okOutput, 'error> = + AsyncValidation.map mapper input + + member inline _.MergeSources + (left: AsyncValidation<'left, 'error>, right: AsyncValidation<'right, 'error>) + : AsyncValidation<'left * 'right, 'error> = + ParallelAsyncValidation.zip left right + + let parallelAsyncValidation = ParallelAsyncValidationBuilder() + + [] + module LowPriority = + + type ParallelAsyncValidationBuilder with + + /// + /// Method lets us transform data types into our internal representation. + /// + /// + member inline _.Source(a: Async<'ok>) : AsyncValidation<'ok, 'error> = + async { + let! result = a + return! AsyncValidation.ok result + } + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(s: Result<'ok, 'error>) : AsyncValidation<'ok, 'error> = + AsyncValidation.ofResult s + + /// + /// Method lets us transform data types into our internal representation. + /// + /// + member inline _.Source(choice: Choice<'ok, 'error>) : AsyncValidation<'ok, 'error> = + AsyncValidation.ofChoice choice + + /// + /// Needed to allow `for..in` and `for..do` functionality + /// + member inline _.Source(s: #seq<_>) : #seq<_> = s + +#if !FABLE_COMPILER + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(s: Task<'ok>) : AsyncValidation<'ok, 'error> = + Async.AwaitTask s + |> Async.map Result.Ok + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(s: Task) : AsyncValidation = + Async.AwaitTask s + |> Async.map Result.Ok + + member inline _.TryFinallyAsync + ( + computation: Async>, + [] compensation: unit -> ValueTask + ) : Async> = + let compensation = + async { + let vTask = compensation () + + if vTask.IsCompletedSuccessfully then + return () + else + return! + vTask.AsTask() + |> Async.AwaitTask + } + + Async.TryFinallyAsync(computation, compensation) + + + member inline this.Using + ( + resource: 'ok :> IAsyncDisposable, + [] binder: 'ok -> AsyncValidation<'U, 'error> + ) : AsyncValidation<'U, 'error> = + this.TryFinallyAsync( + binder resource, + (fun () -> + if not (isNull (box resource)) then + resource.DisposeAsync() + else + ValueTask() + ) + ) + +#endif + + [] + module MediumPriority = + + type ParallelAsyncValidationBuilder with + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(s: Async>) : AsyncValidation<'ok, 'error> = + AsyncResult.mapError List.singleton s + +#if !FABLE_COMPILER + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(s: Task>) : AsyncValidation<'ok, 'error> = + Async.AwaitTask s + |> AsyncResult.mapError List.singleton + + +#endif + + [] + module HighPriority = + + // Having members as extensions gives them lower priority in + // overload resolution and allows skipping more type annotations. + type ParallelAsyncValidationBuilder with + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(s: Validation<'ok, 'error>) : AsyncValidation<'ok, 'error> = + Async.singleton s + +#if !FABLE_COMPILER + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source + (result: Task>) + : AsyncValidation<'ok, 'error> = + Async.AwaitTask result + +#endif + + + [] + module UltraPriority = + + type ParallelAsyncValidationBuilder 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: AsyncValidation<'ok, 'error>) + : AsyncValidation<'ok, 'error> = + result diff --git a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj index 3393091b..f6762848 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj @@ -44,6 +44,10 @@ + + + + diff --git a/tests/FsToolkit.ErrorHandling.Tests/Main.fs b/tests/FsToolkit.ErrorHandling.Tests/Main.fs index f6155bf1..d5dbe709 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/Main.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/Main.fs @@ -34,6 +34,10 @@ let allTests = ValidationCETests.allTests ValueOptionTests.allTests ValueOptionCETests.allTests + ParallelAsyncResultTests.allTests + ParallelAsyncResultCETests.allTests + ParallelAsyncValidationTests.allTests + ParallelAsyncValidationCETests.allTests #if !FABLE_COMPILER BackgroundTaskOptionCETests.allTests BackgroundTaskResultCETests.allTests diff --git a/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncResult.fs b/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncResult.fs new file mode 100644 index 00000000..2e3822c0 --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncResult.fs @@ -0,0 +1,108 @@ +module ParallelAsyncResultTests + +#if FABLE_COMPILER_PYTHON +open Fable.Pyxpecto +#endif +#if FABLE_COMPILER_JAVASCRIPT +open Fable.Mocha +#endif +#if !FABLE_COMPILER +open Expecto +#endif + +open FsToolkit.ErrorHandling + +let zipTests = + testList "ParallelAsyncResult.zip tests" [ + testCaseAsync "Ok case 1" + <| async { + let a = async { return Ok "a" } + let b = async { return Ok 1 } + + let! actual = ParallelAsyncResult.zip a b + + Expect.equal actual (Ok("a", 1)) "" + } + + testCaseAsync "Error case 1" + <| async { + let a = async { return Ok 1 } + let b = async { return Error "x" } + + let! actual = ParallelAsyncResult.zip a b + + Expect.equal actual (Error("x")) "" + } + + testCaseAsync "Error case 2" + <| async { + let a = async { return Error "x" } + let b = async { return Ok 2 } + + let! actual = ParallelAsyncResult.zip a b + + Expect.equal actual (Error("x")) "" + } + + testCaseAsync "Error result fails fast 1" + <| async { + let a = async { return Error "x" } + + let b = + async { + do! Async.never + return Error "y" + } + + let! actual = ParallelAsyncResult.zip a b + + Expect.equal actual (Error("x")) "" + } + + testCaseAsync "Error result fails fast 2" + <| async { + let a = + async { + do! Async.never + return Error "y" + } + + let b = async { return Error "x" } + + let! actual = ParallelAsyncResult.zip a b + + Expect.equal actual (Error("x")) "" + } + + testCaseAsync "Exception case 1" + <| async { + let message = "Kaboom" + + let a = async { return failwith message } + let b = async { return Ok 2 } + + try + let! _ = ParallelAsyncResult.zip a b + + Expect.isTrue false "Unreachable" + with exn -> + Expect.equal exn.Message message "" + } + + testCaseAsync "Exception case 2" + <| async { + let message = "Kaboom" + + let a = async { return Ok 1 } + let b = async { return failwith message } + + try + let! _ = ParallelAsyncResult.zip a b + + Expect.isTrue false "Unreachable" + with exn -> + Expect.equal exn.Message message "" + } + ] + +let allTests = testList "ParallelAsyncResult" [ zipTests ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncResultCE.fs b/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncResultCE.fs new file mode 100644 index 00000000..3fe475f4 --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncResultCE.fs @@ -0,0 +1,646 @@ +module ParallelAsyncResultCETests + +#if FABLE_COMPILER_PYTHON +open Fable.Pyxpecto +#endif +#if FABLE_COMPILER_JAVASCRIPT +open Fable.Mocha +#endif +#if !FABLE_COMPILER +open Expecto +#endif +open System.Threading.Tasks +open FsToolkit.ErrorHandling + +let ``return Tests`` = + testList "ParallelAsyncResultCE return tests" [ + testCaseAsync "Return string" + <| async { + let data = "Foo" + let! actual = parallelAsyncResult { return data } + Expect.equal actual (Result.Ok data) "" + } + ] + +let ``return! Tests`` = + testList "ParallelAsyncResultCE return! Tests" [ + testCaseAsync "Return Ok Result" + <| async { + let innerData = "Foo" + let data = Result.Ok innerData + let! actual = parallelAsyncResult { return! data } + + Expect.equal actual (data) "Should be ok" + } + testCaseAsync "Return Ok Choice" + <| async { + let innerData = "Foo" + let data = Choice1Of2 innerData + let! actual = parallelAsyncResult { return! data } + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + + testCaseAsync "Return Ok AsyncResult" + <| async { + let innerData = "Foo" + let data = Result.Ok innerData + let! actual = parallelAsyncResult { return! Async.singleton data } + + Expect.equal actual (data) "Should be ok" + } + + testCaseAsync "Return Async" + <| async { + let innerData = "Foo" + let! actual = parallelAsyncResult { return! Async.singleton innerData } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } +#if !FABLE_COMPILER + testCaseAsync "Return Ok TaskResult" + <| async { + let innerData = "Foo" + let data = Result.Ok innerData + let! actual = parallelAsyncResult { return! Task.FromResult data } + + Expect.equal actual (data) "Should be ok" + } + testCaseAsync "Return Task Generic" + <| async { + let innerData = "Foo" + let! actual = parallelAsyncResult { return! Task.FromResult innerData } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + testCaseAsync "Return Task" + <| async { + let innerData = "Foo" + let! actual = parallelAsyncResult { return! Task.FromResult innerData :> Task } + + Expect.equal actual (Result.Ok()) "Should be ok" + } +#endif + + + ] + + +let ``bind Tests`` = + testList "ParallelAsyncResultCE bind Tests" [ + testCaseAsync "Bind Ok Result" + <| async { + let innerData = "Foo" + let data = Result.Ok innerData + + let! actual = + parallelAsyncResult { + let! data = data + return data + } + + Expect.equal actual (data) "Should be ok" + + } + testCaseAsync "Bind Ok Choice" + <| async { + let innerData = "Foo" + let data = Choice1Of2 innerData + + let! actual = + parallelAsyncResult { + let! data = data + return data + } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + + testCaseAsync "Bind Ok AsyncResult" + <| async { + let innerData = "Foo" + + let data = + Result.Ok innerData + |> Async.singleton + + let! actual = + parallelAsyncResult { + let! data = data + return data + } + + let! data = data + Expect.equal actual (data) "Should be ok" + } + + testCaseAsync "Bind Async" + <| async { + let innerData = "Foo" + let d = Async.singleton innerData + + let! actual = + parallelAsyncResult { + let! data = d + return data + } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + + +#if !FABLE_COMPILER + testCaseAsync "Bind Ok TaskResult" + <| async { + let innerData = "Foo" + + let data = + Result.Ok innerData + |> Task.FromResult + + let! actual = + parallelAsyncResult { + let! data = data + return data + } + + Expect.equal actual (data.Result) "Should be ok" + } + testCaseAsync "Bind Task Generic" + <| async { + let innerData = "Foo" + + let! actual = + parallelAsyncResult { + let! data = Task.FromResult innerData + return data + } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + testCaseAsync "Bind Task" + <| async { + let innerData = "Foo" + let! actual = parallelAsyncResult { do! Task.FromResult innerData :> Task } + + Expect.equal actual (Result.Ok()) "Should be ok" + } +#endif + ] + +let ``combine/zero/delay/run Tests`` = + testList "ParallelAsyncResultCE combine/zero/delay/run Tests" [ + testCaseAsync "Zero/Combine/Delay/Run" + <| async { + let data = 42 + + let! actual = + parallelAsyncResult { + let result = data + + if true then + () + + return result + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + ] + + +let ``try Tests`` = + testList "ParallelAsyncResultCE try Tests" [ + testCaseAsync "Try With" + <| async { + let data = 42 + + let! actual = + parallelAsyncResult { + let data = data + + try + () + with _ -> + () + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + testCaseAsync "Try Finally" + <| async { + let data = 42 + + let! actual = + parallelAsyncResult { + let data = data + + try + () + finally + () + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + ] + +let ``using Tests`` = + testList "ParallelAsyncResultCE using Tests" [ + testCaseAsync "use normal disposable" + <| async { + let data = 42 + let mutable isFinished = false + + let! actual = + parallelAsyncResult { + use d = TestHelpers.makeDisposable ((fun () -> isFinished <- true)) + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + Expect.isTrue isFinished "Expected disposable to be disposed" + } +#if !FABLE_COMPILER + testCaseAsync "use sync asyncdisposable" + <| async { + let data = 42 + let mutable isFinished = false + + let! actual = + parallelAsyncResult { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + isFinished <- true + ValueTask() + ) + ) + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + Expect.isTrue isFinished "Expected disposable to be disposed" + } + testCaseAsync "use async asyncdisposable" + <| async { + let data = 42 + let mutable isFinished = false + + let! actual = + parallelAsyncResult { + 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 "Expected disposable to be disposed" + } +#endif + + testCaseAsync "use! normal wrapped disposable" + <| async { + let data = 42 + + let! actual = + parallelAsyncResult { + use! d = + TestHelpers.makeDisposable (id) + |> Result.Ok + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + + testCaseAsync "disposable not disposed too early" + <| async { + let mutable disposed = false + let mutable finished = false + let f1 _ = AsyncResult.ok 42 + + let! actual = + parallelAsyncResult { + use d = + TestHelpers.makeDisposable (fun () -> + disposed <- true + + if not finished then + failwith "Should not be disposed too early" + ) + + let! data = f1 d + finished <- true + return data + } + + Expect.equal actual (Ok 42) "Should be ok" + Expect.isTrue disposed "Should be disposed" + } + +#if !FABLE_COMPILER && NETSTANDARD2_1 + // Fable can't handle null disposables you get + // TypeError: Cannot read property 'Dispose' of null + testCaseAsync "use null disposable" + <| async { + let data = 42 + + let! actual = + parallelAsyncResult { + use d = null + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } +#endif + ] + +let ``loop Tests`` = + testList "ParallelAsyncResultCE loop Tests" [ + testCaseAsync "while" + <| async { + let data = 42 + let mutable index = 0 + + let! actual = + parallelAsyncResult { + while index < 10 do + index <- index + 1 + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + yield! [ + let maxIndices = [ + 10 + 1000000 + ] + + for maxIndex in maxIndices do + testCaseAsync + <| sprintf "While - %i" maxIndex + <| async { + let data = 42 + let mutable index = 0 + + let! actual = + parallelAsyncResult { + while index < maxIndex do + index <- index + 1 + + return data + } + + Expect.equal index maxIndex "Index should reach maxIndex" + Expect.equal actual (Ok data) "Should be ok" + } + ] + + testCaseAsync "while fail" + <| async { + + let mutable loopCount = 0 + let mutable wasCalled = false + + let sideEffect () = + wasCalled <- true + "ok" + + let expected = Error "NOPE" + + let data = [ + Ok "42" + Ok "1024" + expected + Ok "1M" + Ok "1M" + Ok "1M" + ] + + let! actual = + parallelAsyncResult { + 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" + } + + testCaseAsync "for in" + <| async { + let data = 42 + + let! actual = + parallelAsyncResult { + for i in [ 1..10 ] do + () + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + testCaseAsync "for to" + <| async { + let data = 42 + + let! actual = + parallelAsyncResult { + for i = 1 to 10 do + () + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + testCaseAsync "for in fail" + <| async { + let mutable loopCount = 0 + let expected = Error "error" + + let data = [ + Ok "42" + Ok "1024" + expected + Ok "1M" + ] + + let! actual = + parallelAsyncResult { + for i in data do + let! x = i + + loopCount <- + loopCount + + 1 + + () + + return "ok" + } + + Expect.equal 2 loopCount "Should only loop twice" + Expect.equal actual expected "Should be and error" + } + ] + +let ``Stack Trace Tests`` = + let failureAsync = + async { + failwith "Intentional failure" + return () + } + + let mainExecuctorAsync () = + parallelAsyncResult { + do! Ok() + let! _ = failureAsync + return 42 + } + + let failureAsyncResult = + parallelAsyncResult { + failwith "Intentional failure" + return () + } + + let mainExeuctorAsyncResult () = + parallelAsyncResult { + do! Ok() + let! _ = failureAsyncResult + return 42 + } + +#if !FABLE_COMPILER + // These are intentionally marked as pending + // This is useful for reviewing stacktrack traces but asserting against them is very brittle + // I'm open to suggestions around Assertions + ptestList "Stack Trace Tests" [ + testCaseAsync "Async Failure" + <| async { + let! r = mainExecuctorAsync () + () + } + testCaseAsync "AsyncResult Failure" + <| async { + let! r = mainExeuctorAsyncResult () + () + } + ] + +#else + testList "Stack Trace Tests" [] + +#endif + +let ``inference checks`` = + testList "Inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = parallelAsyncResult { return! res } + + f (AsyncResult.ok ()) + |> ignore + ] + +let ``mergeSources Tests`` = + testList "MergeSources Tests" [ + testCaseAsync "and! 1" + <| async { + let! actual = + parallelAsyncResult { + let! a = parallelAsyncResult { return "a" } + and! b = parallelAsyncResult { return 1 } + + return a, b + } + + Expect.equal actual (Ok("a", 1)) "" + } + + testCaseAsync "and! 2" + <| async { + let! actual = + parallelAsyncResult { + let! a = parallelAsyncResult { return "a" } + and! b = parallelAsyncResult { return 1 } + and! c = parallelAsyncResult { return true } + + return a, b, c + } + + Expect.equal actual (Ok("a", 1, true)) "" + } + + testCaseAsync "and! 3" + <| async { + let! actual = + parallelAsyncResult { + let! a = parallelAsyncResult { return "a" } + and! b = parallelAsyncResult { return 1 } + + let! c = parallelAsyncResult { return true } + and! d = parallelAsyncResult { return 7L } + + return a, b, c, d + } + + Expect.equal actual (Ok("a", 1, true, 7L)) "" + } + + testCaseAsync "and! error" + <| async { + let! actual = + parallelAsyncResult { + let! a = parallelAsyncResult { return! Error "a" } + and! b = parallelAsyncResult { return 2 } + + return a, b + } + + Expect.equal actual (Error "a") "" + } + ] + +let allTests = + testList "ParallelAsyncResultCETests" [ + ``return Tests`` + ``return! Tests`` + ``bind Tests`` + ``combine/zero/delay/run Tests`` + ``try Tests`` + ``using Tests`` + ``loop Tests`` + ``Stack Trace Tests`` + ``inference checks`` + ``mergeSources Tests`` + ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncValidation.fs b/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncValidation.fs new file mode 100644 index 00000000..c699ba04 --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncValidation.fs @@ -0,0 +1,94 @@ +module ParallelAsyncValidationTests + +#if FABLE_COMPILER_PYTHON +open Fable.Pyxpecto +#endif +#if FABLE_COMPILER_JAVASCRIPT +open Fable.Mocha +#endif +#if !FABLE_COMPILER +open Expecto +#endif + +open FsToolkit.ErrorHandling + +let zipTests = + testList "ParallelAsyncValidation.zip tests" [ + testCaseAsync "Ok case 1" + <| async { + let a = async { return Ok "a" } + let b = async { return Ok 1 } + + let! actual = ParallelAsyncValidation.zip a b + + Expect.equal actual (Ok("a", 1)) "" + } + + testCaseAsync "Error case 1" + <| async { + let a = async { return Ok 1 } + let b = async { return Error [ "x" ] } + + let! actual = ParallelAsyncValidation.zip a b + + Expect.equal actual (Error [ "x" ]) "" + } + + testCaseAsync "Error case 2" + <| async { + let a = async { return Error [ "x" ] } + let b = async { return Ok 2 } + + let! actual = ParallelAsyncValidation.zip a b + + Expect.equal actual (Error [ "x" ]) "" + } + + testCaseAsync "Error case 3" + <| async { + let a = async { return Error [ "x" ] } + let b = async { return Error [ "y" ] } + + let! actual = ParallelAsyncValidation.zip a b + + Expect.equal + actual + (Error [ + "x" + "y" + ]) + "" + } + + testCaseAsync "Exception case 1" + <| async { + let message = "Kaboom" + + let a = async { return failwith message } + let b = async { return Ok 2 } + + try + let! _ = ParallelAsyncValidation.zip a b + + Expect.isTrue false "Unreachable" + with exn -> + Expect.equal exn.Message message "" + } + + testCaseAsync "Exception case 2" + <| async { + let message = "Kaboom" + + let a = async { return Ok 1 } + let b = async { return failwith message } + + try + let! _ = ParallelAsyncValidation.zip a b + + Expect.isTrue false "Unreachable" + with exn -> + Expect.equal exn.Message message "" + } + ] + +let allTests = testList "ParallelAsyncValidation" [ zipTests ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncValidationCE.fs b/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncValidationCE.fs new file mode 100644 index 00000000..60b2b551 --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/ParallelAsyncValidationCE.fs @@ -0,0 +1,648 @@ +module ParallelAsyncValidationCETests + +#if FABLE_COMPILER_PYTHON +open Fable.Pyxpecto +#endif +#if FABLE_COMPILER_JAVASCRIPT +open Fable.Mocha +#endif +#if !FABLE_COMPILER +open Expecto +#endif +open System.Threading.Tasks +open FsToolkit.ErrorHandling + +let ``return Tests`` = + testList "ParallelAsyncValidationCE return tests" [ + testCaseAsync "Return string" + <| async { + let data = "Foo" + let! actual = parallelAsyncValidation { return data } + Expect.equal actual (Result.Ok data) "" + } + ] + +let ``return! Tests`` = + testList "ParallelAsyncValidationCE return! Tests" [ + testCaseAsync "Return Ok Result" + <| async { + let innerData = "Foo" + let data = Result.Ok innerData + let! actual = parallelAsyncValidation { return! data } + + Expect.equal actual (data) "Should be ok" + } + testCaseAsync "Return Ok Choice" + <| async { + let innerData = "Foo" + let data = Choice1Of2 innerData + let! actual = parallelAsyncValidation { return! data } + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + + testCaseAsync "Return Ok AsyncResult" + <| async { + let innerData = "Foo" + let data = Result.Ok innerData + let! actual = parallelAsyncValidation { return! Async.singleton data } + + Expect.equal actual (data) "Should be ok" + } + + testCaseAsync "Return Async" + <| async { + let innerData = "Foo" + let! actual = parallelAsyncValidation { return! Async.singleton innerData } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } +#if !FABLE_COMPILER + testCaseAsync "Return Ok TaskResult" + <| async { + let innerData = "Foo" + let data = Result.Ok innerData + let! actual = parallelAsyncValidation { return! Task.FromResult data } + + Expect.equal actual (data) "Should be ok" + } + testCaseAsync "Return Task Generic" + <| async { + let innerData = "Foo" + let! actual = parallelAsyncValidation { return! Task.FromResult innerData } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + testCaseAsync "Return Task" + <| async { + let innerData = "Foo" + let! actual = parallelAsyncValidation { return! Task.FromResult innerData :> Task } + + Expect.equal actual (Result.Ok()) "Should be ok" + } +#endif + + + ] + + +let ``bind Tests`` = + testList "ParallelAsyncValidationCE bind Tests" [ + testCaseAsync "Bind Ok Result" + <| async { + let innerData = "Foo" + let data = Result.Ok innerData + + let! actual = + parallelAsyncValidation { + let! data = data + return data + } + + Expect.equal actual (data) "Should be ok" + + } + testCaseAsync "Bind Ok Choice" + <| async { + let innerData = "Foo" + let data = Choice1Of2 innerData + + let! actual = + parallelAsyncValidation { + let! data = data + return data + } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + + testCaseAsync "Bind Ok AsyncResult" + <| async { + let innerData = "Foo" + + let data = + Result.Ok innerData + |> Async.singleton + + let! actual = + parallelAsyncValidation { + let! data = data + return data + } + + let! data = data + Expect.equal actual (data) "Should be ok" + } + + testCaseAsync "Bind Async" + <| async { + let innerData = "Foo" + let d = Async.singleton innerData + + let! actual = + parallelAsyncValidation { + let! data = d + return data + } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + + +#if !FABLE_COMPILER + testCaseAsync "Bind Ok TaskResult" + <| async { + let innerData = "Foo" + + let data = + Result.Ok innerData + |> Task.FromResult + + let! actual = + parallelAsyncValidation { + let! data = data + return data + } + + Expect.equal actual (data.Result) "Should be ok" + } + testCaseAsync "Bind Task Generic" + <| async { + let innerData = "Foo" + + let! actual = + parallelAsyncValidation { + let! data = Task.FromResult innerData + return data + } + + Expect.equal actual (Result.Ok innerData) "Should be ok" + } + testCaseAsync "Bind Task" + <| async { + let innerData = "Foo" + let! actual = parallelAsyncValidation { do! Task.FromResult innerData :> Task } + + Expect.equal actual (Result.Ok()) "Should be ok" + } +#endif + ] + +let ``combine/zero/delay/run Tests`` = + testList "ParallelAsyncValidationCE combine/zero/delay/run Tests" [ + testCaseAsync "Zero/Combine/Delay/Run" + <| async { + let data = 42 + + let! actual = + parallelAsyncValidation { + let result = data + + if true then + () + + return result + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + ] + + +let ``try Tests`` = + testList "ParallelAsyncValidationCE try Tests" [ + testCaseAsync "Try With" + <| async { + let data = 42 + + let! actual = + parallelAsyncValidation { + let data = data + + try + () + with _ -> + () + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + testCaseAsync "Try Finally" + <| async { + let data = 42 + + let! actual = + parallelAsyncValidation { + let data = data + + try + () + finally + () + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + ] + +let ``using Tests`` = + testList "ParallelAsyncValidationCE using Tests" [ + testCaseAsync "use normal disposable" + <| async { + let data = 42 + let mutable isFinished = false + + let! actual = + parallelAsyncValidation { + use d = TestHelpers.makeDisposable ((fun () -> isFinished <- true)) + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + Expect.isTrue isFinished "Expected disposable to be disposed" + } +#if !FABLE_COMPILER + testCaseAsync "use sync asyncdisposable" + <| async { + let data = 42 + let mutable isFinished = false + + let! actual = + parallelAsyncValidation { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + isFinished <- true + ValueTask() + ) + ) + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + Expect.isTrue isFinished "Expected disposable to be disposed" + } + testCaseAsync "use async asyncdisposable" + <| async { + let data = 42 + let mutable isFinished = false + + let! actual = + parallelAsyncValidation { + 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 "Expected disposable to be disposed" + } +#endif + + testCaseAsync "use! normal wrapped disposable" + <| async { + let data = 42 + + let! actual = + parallelAsyncValidation { + use! d = + TestHelpers.makeDisposable (id) + |> Result.Ok + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + + testCaseAsync "disposable not disposed too early" + <| async { + let mutable disposed = false + let mutable finished = false + let f1 _ = AsyncResult.ok 42 + + let! actual = + parallelAsyncValidation { + use d = + TestHelpers.makeDisposable (fun () -> + disposed <- true + + if not finished then + failwith "Should not be disposed too early" + ) + + let! data = f1 d + finished <- true + return data + } + + Expect.equal actual (Ok 42) "Should be ok" + Expect.isTrue disposed "Should be disposed" + } + +#if !FABLE_COMPILER && NETSTANDARD2_1 + // Fable can't handle null disposables you get + // TypeError: Cannot read property 'Dispose' of null + testCaseAsync "use null disposable" + <| async { + let data = 42 + + let! actual = + parallelAsyncValidation { + use d = null + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } +#endif + ] + +let ``loop Tests`` = + testList "ParallelAsyncValidationCE loop Tests" [ + testCaseAsync "while" + <| async { + let data = 42 + let mutable index = 0 + + let! actual = + parallelAsyncValidation { + while index < 10 do + index <- index + 1 + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + yield! [ + let maxIndices = [ + 10 + 1000000 + ] + + for maxIndex in maxIndices do + testCaseAsync + <| sprintf "While - %i" maxIndex + <| async { + let data = 42 + let mutable index = 0 + + let! actual = + parallelAsyncValidation { + while index < maxIndex do + index <- index + 1 + + return data + } + + Expect.equal index maxIndex "Index should reach maxIndex" + Expect.equal actual (Ok data) "Should be ok" + } + ] + + testCaseAsync "while fail" + <| async { + + let mutable loopCount = 0 + let mutable wasCalled = false + + let sideEffect () = + wasCalled <- true + "ok" + + let expected = Error [ "NOPE" ] + + let data = [ + Ok "42" + Ok "1024" + expected + Ok "1M" + Ok "1M" + Ok "1M" + ] + + let! actual = + parallelAsyncValidation { + 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" + } + + testCaseAsync "for in" + <| async { + let data = 42 + + let! actual = + parallelAsyncValidation { + for i in [ 1..10 ] do + () + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + testCaseAsync "for to" + <| async { + let data = 42 + + let! actual = + parallelAsyncValidation { + for i = 1 to 10 do + () + + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + } + testCaseAsync "for in fail" + <| async { + let mutable loopCount = 0 + let expected = Error [ "error" ] + + let data = [ + Ok "42" + Ok "1024" + expected + Ok "1M" + ] + + let! actual = + parallelAsyncValidation { + for i in data do + let! x = i + + loopCount <- + loopCount + + 1 + + () + + return "ok" + } + + Expect.equal 2 loopCount "Should only loop twice" + Expect.equal actual expected "Should be and error" + } + ] + +let ``Stack Trace Tests`` = + let failureAsync = + async { + failwith "Intentional failure" + return () + } + + let mainExecuctorAsync () = + parallelAsyncValidation { + do! Ok() + let! _ = failureAsync + return 42 + } + + let failureAsyncResult = + parallelAsyncValidation { + failwith "Intentional failure" + return () + } + + let mainExeuctorAsyncResult () = + parallelAsyncValidation { + do! Ok() + let! _ = failureAsyncResult + return 42 + } + +#if !FABLE_COMPILER + // These are intentionally marked as pending + // This is useful for reviewing stacktrack traces but asserting against them is very brittle + // I'm open to suggestions around Assertions + ptestList "Stack Trace Tests" [ + testCaseAsync "Async Failure" + <| async { + let! r = mainExecuctorAsync () + () + } + testCaseAsync "AsyncResult Failure" + <| async { + let! r = mainExeuctorAsyncResult () + () + } + + + ] + +#else + testList "Stack Trace Tests" [] + +#endif + +let ``inference checks`` = + testList "Inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = parallelAsyncValidation { return! res } + + f (AsyncValidation.ok ()) + |> ignore + ] + +let ``mergeSources Tests`` = + testList "MergeSources Tests" [ + testCaseAsync "and! 1" + <| async { + let! actual = + parallelAsyncValidation { + let! a = parallelAsyncValidation { return "a" } + and! b = parallelAsyncValidation { return 1 } + + return a, b + } + + Expect.equal actual (Ok("a", 1)) "" + } + + testCaseAsync "and! 2" + <| async { + let! actual = + parallelAsyncValidation { + let! a = parallelAsyncValidation { return "a" } + and! b = parallelAsyncValidation { return 1 } + and! c = parallelAsyncValidation { return true } + + return a, b, c + } + + Expect.equal actual (Ok("a", 1, true)) "" + } + + testCaseAsync "and! 3" + <| async { + let! actual = + parallelAsyncValidation { + let! a = parallelAsyncValidation { return "a" } + and! b = parallelAsyncValidation { return 1 } + + let! c = parallelAsyncValidation { return true } + and! d = parallelAsyncValidation { return 7L } + + return a, b, c, d + } + + Expect.equal actual (Ok("a", 1, true, 7L)) "" + } + + testCaseAsync "and! error" + <| async { + let! actual = + parallelAsyncValidation { + let! a = parallelAsyncValidation { return! Error "a" } + and! b = parallelAsyncValidation { return 2 } + + return a, b + } + + Expect.equal actual (Error [ "a" ]) "" + } + ] + +let allTests = + testList "ParallelAsyncValidationCETests" [ + ``return Tests`` + ``return! Tests`` + ``bind Tests`` + ``combine/zero/delay/run Tests`` + ``try Tests`` + ``using Tests`` + ``loop Tests`` + ``Stack Trace Tests`` + ``inference checks`` + ``mergeSources Tests`` + ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/TestHelpers.fs b/tests/FsToolkit.ErrorHandling.Tests/TestHelpers.fs index f26af499..a0b35000 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/TestHelpers.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/TestHelpers.fs @@ -1,5 +1,30 @@ namespace FsToolkit.ErrorHandling +[] +module Async = + + open System + +#if FABLE_COMPILER && FABLE_COMPILER_JAVASCRIPT + open Fable.Core + + /// An Async that never completes but can be cancelled + let never<'a> : Async<'a> = + Fable.Core.JS.Constructors.Promise.Create(fun _ _ -> ()) + |> Async.AwaitPromise +#else + /// An Async that never completes but can be cancelled + let never<'a> : Async<'a> = + let granularity = TimeSpan.FromSeconds 3. + + let rec loop () = + async { + do! Async.Sleep(granularity) + return! loop () + } + + loop () +#endif module TestHelpers = let makeDisposable (callback) =