diff --git a/gitbook/SUMMARY.md b/gitbook/SUMMARY.md index 210bd298..f56d69b8 100644 --- a/gitbook/SUMMARY.md +++ b/gitbook/SUMMARY.md @@ -228,6 +228,21 @@ * [ofChoice](asyncValidation/ofChoice.md) * [ofResult](asyncValidation/ofResult.md) + * [TaskValidation](taskValidation/index.md) + * [apply](taskValidation/apply.md) + * [Computation Expression](taskValidation/ce.md) + * [error](taskValidation/error.md) + * [map](taskValidation/map.md) + * [map2](taskValidation/map2.md) + * [map3](taskValidation/map3.md) + * [mapError](taskValidation/mapError.md) + * [mapErrors](taskValidation/mapErrors.md) + * [Operators](taskValidation/operators.md) + * [zip](taskValidation/zip.md) + * Transforms + * [ofChoice](taskValidation/ofChoice.md) + * [ofResult](taskValidation/ofResult.md) + * FsToolkit.ErrorHandling.AsyncSeq * AsyncSeq * [Computation Expression](pr.md) diff --git a/gitbook/taskValidation/apply.md b/gitbook/taskValidation/apply.md new file mode 100644 index 00000000..234dd69a --- /dev/null +++ b/gitbook/taskValidation/apply.md @@ -0,0 +1,13 @@ +## TaskValidation.apply + +Namespace: `FsToolkit.ErrorHandling` + +Function Signature: + +```fsharp +Task 'b), 'c list>> + -> Task> + -> Task> +``` + +## Examples diff --git a/gitbook/taskValidation/ce.md b/gitbook/taskValidation/ce.md new file mode 100644 index 00000000..78f145af --- /dev/null +++ b/gitbook/taskValidation/ce.md @@ -0,0 +1,41 @@ +## TaskValidation Computation Expression + +Namespace: `FsToolkit.ErrorHandling` + +The `TaskValidation` type is defined as: + +```fsharp +type TaskValidation<'a,'err> = Task> +``` + +This CE can take advantage of the [and! operator](https://github.com/fsharp/fslang-suggestions/issues/579) to join multiple error results into a list. + +## Examples + +See [here](../validation/ce.md) for other validation-like examples + +```fsharp +// Result -> Task> +let downloadTask stuff = task { + return stuff +} + +// TaskValidation +let addResult = taskValidation { + let! x = downloadTask (Ok "I") + and! y = downloadTask (Ok "am") + and! z = downloadTask (Ok "async!") + return sprintf "%s %s %s" x y z +} +// task { return Ok "I am async!" } + +// TaskValidation +let addResult = taskValidation { + let! x = downloadTask (Error "Am") + and! y = downloadTask (Error "I") + and! z = downloadTask (Error "async?") + return sprintf "%s %s %s" x y z +} + +// task { return Error [ "Am"; "I"; "async?" ] } +``` diff --git a/gitbook/taskValidation/error.md b/gitbook/taskValidation/error.md new file mode 100644 index 00000000..4a274833 --- /dev/null +++ b/gitbook/taskValidation/error.md @@ -0,0 +1,22 @@ +## TaskValidation.error + +Namespace: `FsToolkit.ErrorHandling` + +Lift an `'error` value into an `Task>` + +## Function Signature: + +```fsharp +'error -> Task> +``` + +## Examples + +### Example 1 + + +```fsharp +let result : Task> = + TaskValidation.error "Something bad happened" +``` + diff --git a/gitbook/taskValidation/index.md b/gitbook/taskValidation/index.md new file mode 100644 index 00000000..d22dec97 --- /dev/null +++ b/gitbook/taskValidation/index.md @@ -0,0 +1,5 @@ +# TaskValidation + +Namespace: `FsToolkit.ErrorHandling` + +This module provides utility functions and infix operators to work with `Task>`. diff --git a/gitbook/taskValidation/map.md b/gitbook/taskValidation/map.md new file mode 100644 index 00000000..ef4acdf6 --- /dev/null +++ b/gitbook/taskValidation/map.md @@ -0,0 +1,41 @@ +# TaskValidation.map + +Namespace: `FsToolkit.ErrorHandling` + +`map` applies a transformation to the value inside an `TaskValidation` if it represents a successful result (`Ok`). It allows you to perform a computation on the value while preserving the success/error status of the original `TaskValidation`. If the original `TaskValidation` is an `Error`, `map` does nothing and returns the same `Error` unchanged. + +## Function Signature + +```fsharp +('okInput -> 'okOutput) -> TaskValidation<'okInput, 'error> -> TaskValidation<'okOutput, 'error> +``` + +## Examples + +Take the following functions for example + +```fsharp +// string -> int +let remainingCharacters (prompt: string) = + 280 - prompt.Length +``` + +### Example 1 + +```fsharp +let validation = + TaskValidation.ok "foo" // TaskValidation + |> TaskValidation.map remainingCharacters // TaskValidation + +// task { Ok 277 } +``` + +### Example 2 + +```fsharp +let result = + TaskValidation.error "bad things happened" // TaskValidation + |> TaskValidation.map remainingCharacters // TaskValidation + +// task { Error ["bad things happened"] } +``` diff --git a/gitbook/taskValidation/map2.md b/gitbook/taskValidation/map2.md new file mode 100644 index 00000000..bd1d4af9 --- /dev/null +++ b/gitbook/taskValidation/map2.md @@ -0,0 +1,16 @@ +## TaskValidation.map2 + +Namespace: `FsToolkit.ErrorHandling` + +Function Signature: + +```fsharp +('a -> 'b -> 'c) + -> Task> + -> Task> + -> Task> +``` + +Like [Result.map2](../result/map2.md), but collects the errors from both arguments. + +## Examples diff --git a/gitbook/taskValidation/map3.md b/gitbook/taskValidation/map3.md new file mode 100644 index 00000000..728aec76 --- /dev/null +++ b/gitbook/taskValidation/map3.md @@ -0,0 +1,17 @@ +## TaskValidation.map3 + +Namespace: `FsToolkit.ErrorHandling` + +Function Signature: + +``` +('a -> 'b -> 'c -> 'd) + -> Task> + -> Task> + -> Task> + -> Task> +``` + +Like [Result.map3](../result/map3.md), but collects the errors from all arguments. + +## Examples diff --git a/gitbook/taskValidation/mapError.md b/gitbook/taskValidation/mapError.md new file mode 100644 index 00000000..a8ee404f --- /dev/null +++ b/gitbook/taskValidation/mapError.md @@ -0,0 +1,44 @@ +# TaskValidation.mapError + +Namespace: `FsToolkit.ErrorHandling` + +`mapError` takes an task validation and a normal function and returns a new task validation value based on the input error value and the function + +## Function Signature + +```fsharp +('errorInput -> 'errorOutput) -> TaskValidation<'ok, 'errorInput> + -> TaskValidation<'ok, 'errorOutput> +``` + +## Examples + +Take the following functions for example + +```fsharp +// string -> int +let getErrorCode (message: string) = + match message with + | "bad things happened" -> 1 + | _ -> 0 +``` + +### Example 1 + +```fsharp +let result = + TaskValidation.ok "all good" // TaskValidation + |> TaskValidation.mapError getErrorCode // TaskValidation + +// task { Ok "all good" } +``` + +### Example 2 + +```fsharp +let result = + TaskValidation.error "bad things happened" // TaskValidation + |> TaskValidation.mapError getErrorCode // TaskValidation + +// task { Error [1] } +``` diff --git a/gitbook/taskValidation/mapErrors.md b/gitbook/taskValidation/mapErrors.md new file mode 100644 index 00000000..6a15f8f0 --- /dev/null +++ b/gitbook/taskValidation/mapErrors.md @@ -0,0 +1,44 @@ +# TaskValidation.mapErrors + +Namespace: `FsToolkit.ErrorHandling` + +Similar to [TaskValidation.mapError](../taskValidation/mapError.md), except that the mapping function is passed the full list of errors, rather than each one individually. + +## Function Signature + +```fsharp +('errorInput list -> 'errorOutput list) -> TaskValidation<'ok, 'errorInput> + -> TaskValidation<'ok, 'errorOutput> +``` + +## Examples + +Take the following functions for example + +```fsharp +// string -> int +let getErrorCode (messages: string list) = + match messages |> List.tryFind ((=) "bad things happened") with + | Some _ -> [1] + | _ -> [0] +``` + +### Example 1 + +```fsharp +let result = + TaskValidation.ok "all good" // TaskValidation + |> TaskValidation.mapErrors getErrorCode // TaskValidation + +// task { Ok "all good" } +``` + +### Example 2 + +```fsharp +let result : TaskValidation = + TaskValidation.error "bad things happened" // TaskValidation + |> TaskValidation.mapErrors getErrorCode // TaskValidation + +// task { Error [1] } +``` diff --git a/gitbook/taskValidation/ofChoice.md b/gitbook/taskValidation/ofChoice.md new file mode 100644 index 00000000..56314d1a --- /dev/null +++ b/gitbook/taskValidation/ofChoice.md @@ -0,0 +1,27 @@ +# TaskValidation.ofChoice + +Namespace: `FsToolkit.ErrorHandling` + +Transforms a `Choice<'T, 'Error>` into a `Task>` + +## Function Signature + +```fsharp +Choice<'T, 'Error> -> Task> +``` + +## Examples + +### Example 1 + +```fsharp +let result = TaskValidation.ofChoice (Choice1Of2 42) +// task { return Ok 42 } +``` + +### Example 2 + +```fsharp +let result = TaskValidation.ofChoice (Choice2Of2 "error") +// task { return Error ["error"] } +``` diff --git a/gitbook/taskValidation/ofResult.md b/gitbook/taskValidation/ofResult.md new file mode 100644 index 00000000..38577804 --- /dev/null +++ b/gitbook/taskValidation/ofResult.md @@ -0,0 +1,27 @@ +# TaskValidation.ofResult + +Namespace: `FsToolkit.ErrorHandling` + +Transforms a `Result<'T, 'Error>` into a `Task>` + +## Function Signature + +```fsharp +Result<'T, 'Error> -> Task> +``` + +## Examples + +### Example 1 + +```fsharp +let result = TaskValidation.ofResult (Ok 42) +// task { return Ok 42 } +``` + +### Example 2 + +```fsharp +let result = TaskValidation.ofResult (Error "error") +// task { return Error ["error"] } +``` diff --git a/gitbook/taskValidation/operators.md b/gitbook/taskValidation/operators.md new file mode 100644 index 00000000..f84c69b9 --- /dev/null +++ b/gitbook/taskValidation/operators.md @@ -0,0 +1,72 @@ +## TaskValidation Infix Operators + +Namespace: `FsToolkit.ErrorHandling.Operator.TaskValidation` + +FsToolkit.ErrorHandling provides the standard infix operators for `map` (``), `apply` (`<*>`), and `bind` (`>>=`) to work with `Result<'a, 'b list>`. + +There are also variants of the `map` and `apply` operators (`` and `<*^>`) that accept `Result<'a, 'b>` (non-list) as the right-hand argument. + +## Examples + +### Example 1 + +Assume that we have following types and functions: + +```fsharp +type Latitude = private Latitude of float with + // float -> Task> + static member TryCreate (lat : float) = + // ... + +type Longitude = private Longitude of float with + // float -> Task> + static member TryCreate (lng : float) = + // ... + +type Tweet = private Tweet of string with + // string -> Task> + static member TryCreate (tweet : string) = + // ... + +// Latitude -> Longitude -> Tweet -> CreatePostRequest +let createPostRequest lat long tweet = + // ... +``` + +We can make use of the standard operators in the TaskValidation Operators module to perform the taskValidation of the incoming request and capture all the errors as shown below: + +```fsharp +open FsToolkit.ErrorHandling.Operator.TaskValidation + +// float -> float -> string -> Task> +let validateCreatePostRequest lat lng tweet = + createPostRequest + Latitude.TryCreate lat + <*> Longitude.TryCreate lng + <*> Tweet.TryCreate tweet +``` + +By using the `TaskValidation` operators instead of the `Result` operators, we collect all the errors: +```fsharp +validateCreatePostRequest 300. 400. "" +// Error + ["300.0 is a invalid latitude value" + "400.0 is a invalid longitude value" + "Tweet shouldn't be empty"] +``` + +### Example 2 + +In the above example, all the `TryCreate` functions return a string list as the error type (`Task>`). If these functions instead returned `Task>` (only a single error), we can use `<*^>` and `` to get the same result: + + +```fsharp +open FsToolkit.ErrorHandling.Operator.TaskValidation + +// float -> float -> string -> Task> +let validateCreatePostRequest lat lng tweet = + createPostRequest + Latitude.TryCreate lat + <*^> Longitude.TryCreate lng + <*^> Tweet.TryCreate tweet +``` diff --git a/gitbook/taskValidation/zip.md b/gitbook/taskValidation/zip.md new file mode 100644 index 00000000..3d3e56d5 --- /dev/null +++ b/gitbook/taskValidation/zip.md @@ -0,0 +1,32 @@ +# TaskValidation.zip + +Namespace: `FsToolkit.ErrorHandling` + +## Function Signature + +```fsharp +TaskValidation<'leftOk, 'error> -> TaskValidation<'rightOk, 'error> -> TaskValidation<'leftOk * 'rightOk, 'error> +``` + +## Examples + +### Example 1 + +```fsharp +let result = TaskValidation.zip (TaskValidation.ok 1) (TaskValidation.ok 2) +// task { Ok (1, 2) } +``` + +### Example 2 + +```fsharp +let result = TaskValidation.zip (TaskValidation.ok 1) (TaskValidation.error "Bad") +// task { Error [ "Bad" ] } +``` + +### Example 3 + +```fsharp +let result = TaskValidation.zip (TaskValidation.error "Bad1") (TaskValidation.error "Bad2") +// task { Error [ "Bad1"; "Bad2" ] } +``` diff --git a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj index c896dafd..3c91371c 100644 --- a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj +++ b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj @@ -33,6 +33,9 @@ + + + diff --git a/src/FsToolkit.ErrorHandling/TaskValidation.fs b/src/FsToolkit.ErrorHandling/TaskValidation.fs new file mode 100644 index 00000000..4831dc67 --- /dev/null +++ b/src/FsToolkit.ErrorHandling/TaskValidation.fs @@ -0,0 +1,292 @@ +namespace FsToolkit.ErrorHandling + +open System.Threading.Tasks + +/// TaskValidation<'a, 'err> is defined as Task> meaning you can use many of the functions found in the Result and Task module. +type TaskValidation<'ok, 'error> = Task> + +[] +module TaskValidation = + + let inline ok (value: 'ok) : TaskValidation<'ok, 'error> = + Ok value + |> Task.singleton + + let inline error (error: 'error) : TaskValidation<'ok, 'error> = + Error [ error ] + |> Task.singleton + + let inline ofResult (result: Result<'ok, 'error>) : TaskValidation<'ok, 'error> = + Result.mapError List.singleton result + |> Task.singleton + + let inline ofChoice (choice: Choice<'ok, 'error>) : TaskValidation<'ok, 'error> = + match choice with + | Choice1Of2 x -> ok x + | Choice2Of2 e -> error e + + let inline apply + (applier: TaskValidation<'okInput -> 'okOutput, 'error>) + (input: TaskValidation<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + task { + let! applier = applier + let! input = input + + return + match applier, input with + | Ok f, Ok x -> Ok(f x) + | Error errs, Ok _ + | Ok _, Error errs -> Error errs + | Error errs1, Error errs2 -> + Error( + errs1 + @ errs2 + ) + } + + /// + /// Returns validation if it is Ok, otherwise returns ifError + /// + /// The value to use if validation is Error + /// The input validation. + /// + /// + /// + /// + /// TaskValidation.error "First" |> TaskValidation.orElse (TaskValidation.error "Second") // evaluates to Error [ "Second" ] + /// TaskValidation.error "First" |> TaskValidation.orElse (TaskValidation.ok "Second") // evaluates to Ok ("Second") + /// TaskValidation.ok "First" |> TaskValidation.orElse (TaskValidation.error "Second") // evaluates to Ok ("First") + /// TaskValidation.ok "First" |> TaskValidation.orElse (TaskValidation.ok "Second") // evaluates to Ok ("First") + /// + /// + /// + /// The result if the validation is Ok, else returns ifError. + /// + let inline orElse + (ifError: TaskValidation<'ok, 'errorOutput>) + (validation: TaskValidation<'ok, 'errorInput>) + : TaskValidation<'ok, 'errorOutput> = + task { + let! validation = validation + + return! + validation + |> Result.either ok (fun _ -> ifError) + } + + /// + /// Returns validation if it is Ok, otherwise executes ifErrorFunc and returns the result. + /// + /// A function that provides an alternate validation when evaluated. + /// The input validation. + /// + /// is not executed unless validation is an Error. + /// + /// + /// + /// TaskValidation.error "First" |> TaskValidation.orElseWith (fun _ -> TaskValidation.error "Second") // evaluates to Error [ "Second" ] + /// TaskValidation.error "First" |> TaskValidation.orElseWith (fun _ -> TaskValidation.ok "Second") // evaluates to Ok ("Second") + /// TaskValidation.ok "First" |> TaskValidation.orElseWith (fun _ -> TaskValidation.error "Second") // evaluates to Ok ("First") + /// TaskValidation.ok "First" |> TaskValidation.orElseWith (fun _ -> TaskValidation.ok "Second") // evaluates to Ok ("First") + /// + /// + /// + /// The result if the result is Ok, else the result of executing . + /// + let inline orElseWith + ([] ifErrorFunc: 'errorInput list -> TaskValidation<'ok, 'errorOutput>) + (validation: TaskValidation<'ok, 'errorInput>) + : TaskValidation<'ok, 'errorOutput> = + task { + let! validation = validation + + return! + match validation with + | Ok x -> ok x + | Error err -> ifErrorFunc err + } + + /// + /// Applies a transformation to the value of a TaskValidation to a new value using the specified mapper function. + /// + /// Documentation is found here: https://demystifyfp.gitbook.io/fstoolkit-errorhandling/fstoolkit.errorhandling/taskvalidation/map + /// + /// The function to apply to the value of the TaskValidation if it is Ok. + /// The TaskValidation to map. + /// A new TaskValidationwith the mapped value if the input TaskValidation is Ok, otherwise the original Error. + let inline map + ([] mapper: 'okInput -> 'okOutput) + (input: TaskValidation<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + task { + let! input = input + return Result.map mapper input + } + + /// + /// Applies a mapper function to two input TaskValidations, producing a new TaskValidation. + /// + /// Documentation is found here: https://demystifyfp.gitbook.io/fstoolkit-errorhandling/fstoolkit.errorhandling/taskvalidation/map2 + /// + /// The function to apply to the inputs. + /// The first input TaskValidation. + /// The second input TaskValidation. + /// A new TaskValidationcontaining the output of the mapper function if both input TaskValidations are Ok, otherwise an Error TaskValidation. + let inline map2 + ([] mapper: 'okInput1 -> 'okInput2 -> 'okOutput) + (input1: TaskValidation<'okInput1, 'error>) + (input2: TaskValidation<'okInput2, 'error>) + : TaskValidation<'okOutput, 'error> = + task { + let! input1 = input1 + let! input2 = input2 + + return + match input1, input2 with + | Ok x, Ok y -> Ok(mapper x y) + | Ok _, Error errs -> Error errs + | Error errs, Ok _ -> Error errs + | Error errs1, Error errs2 -> + Error( + errs1 + @ errs2 + ) + } + + /// + /// Applies a mapper function to three input TaskValidations, producing a new TaskValidation. + /// + /// Documentation is found here: https://demystifyfp.gitbook.io/fstoolkit-errorhandling/fstoolkit.errorhandling/taskvalidation/map3 + /// + /// The function to apply to the input TaskValidations. + /// The first input TaskValidation. + /// The second input TaskValidation. + /// The third input TaskValidation. + /// A new TaskValidation with the output of the mapper function applied to the input validations, if all TaskValidations are Ok, otherwise returns the original Error + let inline map3 + ([] mapper: 'okInput1 -> 'okInput2 -> 'okInput3 -> 'okOutput) + (input1: TaskValidation<'okInput1, 'error>) + (input2: TaskValidation<'okInput2, 'error>) + (input3: TaskValidation<'okInput3, 'error>) + : TaskValidation<'okOutput, 'error> = + task { + let! input1 = input1 + let! input2 = input2 + let! input3 = input3 + + return + match input1, input2, input3 with + | Ok x, Ok y, Ok z -> Ok(mapper x y z) + | Error errs, Ok _, Ok _ -> Error errs + | Ok _, Error errs, Ok _ -> Error errs + | Ok _, Ok _, Error errs -> Error errs + | Error errs1, Error errs2, Ok _ -> + Error( + errs1 + @ errs2 + ) + | Ok _, Error errs1, Error errs2 -> + Error( + errs1 + @ errs2 + ) + | Error errs1, Ok _, Error errs2 -> + Error( + errs1 + @ errs2 + ) + | Error errs1, Error errs2, Error errs3 -> + Error( + errs1 + @ errs2 + @ errs3 + ) + } + + /// + /// Maps the error value of a TaskValidationto a new error value using the specified error mapper function. + /// + /// Documentation is found here: https://demystifyfp.gitbook.io/fstoolkit-errorhandling/fstoolkit.errorhandling/taskvalidation/maperror + /// + /// The function that maps the input error value to the output error value. + /// The TaskValidationvalue to map the error value of. + /// A new TaskValidationwith the same Ok value and the mapped error value. + let inline mapError + ([] errorMapper: 'errorInput -> 'errorOutput) + (input: TaskValidation<'ok, 'errorInput>) + : TaskValidation<'ok, 'errorOutput> = + task { + let! input = input + return Result.mapError (List.map errorMapper) input + } + + /// + /// Maps the error values of a TaskValidationto a new error value using the specified error mapper function. + /// + /// Documentation is found here: https://demystifyfp.gitbook.io/fstoolkit-errorhandling/fstoolkit.errorhandling/taskvalidation/maperror + /// + /// + /// Similar to TaskValidation.mapError, except that the mapping function is passed the full list of errors, rather than each one individually. + /// + /// The function that maps the input errors to the output errors. + /// The TaskValidationvalue to map the errors of. + /// A new TaskValidationwith the same Ok value and the mapped errors. + let inline mapErrors + ([] errorMapper: 'errorInput list -> 'errorOutput list) + (input: TaskValidation<'ok, 'errorInput>) + : TaskValidation<'ok, 'errorOutput> = + task { + let! input = input + return Result.mapError errorMapper input + } + + /// + /// Takes a transformation function and applies it to the TaskValidation if it is Ok. + /// + /// Documentation is found here: https://demystifyfp.gitbook.io/fstoolkit-errorhandling/fstoolkit.errorhandling/taskvalidation/bind + /// + /// The transformation function + /// The input validation + /// The type of the successful validation. + /// The type of the validation after binding. + /// The type of the error. + /// Returns a new TaskValidation if the input is Ok, otherwise returns the original TaskValidation + let inline bind + ([] binder: 'okInput -> TaskValidation<'okOutput, 'error>) + (input: TaskValidation<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + task { + let! input = input + + match input with + | Ok x -> return! binder x + | Error e -> return Error e + } + + /// + /// Takes two TaskValidations and returns a tuple of the pair or Error if either of them are Error + /// + /// Documentation is found here: https://demystifyfp.gitbook.io/fstoolkit-errorhandling/fstoolkit.errorhandling/taskvalidation/zip + /// + /// + /// If both validations are Error, the returned Error contains the concatenated lists of errors + /// + /// The first input validation. + /// The second input validation. + /// A tuple of the pair of the input validation. + let inline zip + (left: TaskValidation<'left, 'error>) + (right: TaskValidation<'right, 'error>) + : TaskValidation<'left * 'right, 'error> = + task { + let! left = left + let! right = right + + return + match left, right with + | Ok x1res, Ok x2res -> Ok(x1res, x2res) + | Error e, Ok _ -> Error e + | Ok _, Error e -> Error e + | Error e1, Error e2 -> Error(e1 @ e2) + } diff --git a/src/FsToolkit.ErrorHandling/TaskValidationCE.fs b/src/FsToolkit.ErrorHandling/TaskValidationCE.fs new file mode 100644 index 00000000..7a0fbe9f --- /dev/null +++ b/src/FsToolkit.ErrorHandling/TaskValidationCE.fs @@ -0,0 +1,591 @@ +namespace FsToolkit.ErrorHandling + +open System +open System.Threading.Tasks +open System.Runtime.CompilerServices +open System.Threading +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 + +[] +type TaskValidationStateMachineData<'T, 'Error> = + + [] + val mutable Validation: Validation<'T, 'Error> + + [] + val mutable MethodBuilder: AsyncTaskValidationMethodBuilder<'T, 'Error> + + member this.IsValidationError = Result.isError this.Validation + member this.IsTaskCompleted = this.MethodBuilder.Task.IsCompleted + +and AsyncTaskValidationMethodBuilder<'TOverall, 'Error> = + AsyncTaskMethodBuilder> + +and TaskValidationStateMachine<'TOverall, 'Error> = + ResumableStateMachine> + +and TaskValidationResumptionFunc<'TOverall, 'Error> = + ResumptionFunc> + +and TaskValidationResumptionDynamicInfo<'TOverall, 'Error> = + ResumptionDynamicInfo> + +and TaskValidationCode<'TOverall, 'Error, 'T> = + ResumableCode, 'T> + + +type TaskValidationBuilderBase() = + member inline _.Delay + (generator: unit -> TaskValidationCode<'TOverall, 'Error, 'T>) + : TaskValidationCode<'TOverall, 'Error, 'T> = + TaskValidationCode<'TOverall, 'Error, '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, 'Error>() : TaskValidationCode<'TOverall, 'Error, unit> = + ResumableCode.Zero() + + member inline _.Return(value: 'T) : TaskValidationCode<'T, 'Error, 'T> = + TaskValidationCode<'T, 'Error, _>(fun sm -> + sm.Data.Validation <- Ok value + true + ) + + /// Chains together a step with its following step. + /// Note that this requires that the first step has no result. + /// This prevents constructs like `task { return 1; return 2; }`. + member inline _.Combine + ( + task1: TaskValidationCode<'TOverall, 'Error, unit>, + task2: TaskValidationCode<'TOverall, 'Error, 'T> + ) : TaskValidationCode<'TOverall, 'Error, 'T> = + + ResumableCode.Combine( + task1, + TaskValidationCode<'TOverall, 'Error, 'T>(fun sm -> + if sm.Data.IsValidationError 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: TaskValidationCode<'TOverall, 'Error, unit> + ) : TaskValidationCode<'TOverall, 'Error, unit> = + let mutable keepGoing = true + + ResumableCode.While( + (fun () -> + keepGoing + && condition () + ), + TaskValidationCode<_, _, _>(fun sm -> + if sm.Data.IsValidationError then + keepGoing <- false + sm.Data.MethodBuilder.SetResult sm.Data.Validation + 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: TaskValidationCode<'TOverall, 'Error, 'T>, + catch: exn -> TaskValidationCode<'TOverall, 'Error, 'T> + ) : TaskValidationCode<'TOverall, 'Error, '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: TaskValidationCode<'TOverall, 'Error, 'T>, + [] compensation: unit -> unit + ) : TaskValidationCode<'TOverall, 'Error, 'T> = + + ResumableCode.TryFinally( + body, + ResumableCode<_, _>(fun _sm -> + compensation () + true + ) + ) + + member inline this.For + (sequence: seq<'T>, body: 'T -> TaskValidationCode<'TOverall, 'Error, unit>) + : TaskValidationCode<'TOverall, 'Error, unit> = + // A for loop is just a using statement on the sequence's enumerator... + 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()), + TaskValidationCode<'TOverall, 'Error, unit>(fun sm -> + (body e.Current).Invoke(&sm) + ) + ) + ) + ) + + member inline internal this.TryFinallyAsync + (body: TaskValidationCode<'TOverall, 'Error, 'T>, compensation: unit -> ValueTask) + : TaskValidationCode<'TOverall, 'Error, '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 = + TaskValidationResumptionFunc<'TOverall, 'Error>(fun sm -> + awaiter.GetResult() + + 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, 'Error when 'Resource :> IAsyncDisposableNull> + (resource: 'Resource, body: 'Resource -> TaskValidationCode<'TOverall, 'Error, 'T>) + : TaskValidationCode<'TOverall, 'Error, 'T> = + this.TryFinallyAsync( + (fun sm -> (body resource).Invoke(&sm)), + (fun () -> + if not (isNull (box resource)) then + resource.DisposeAsync() + else + ValueTask() + ) + ) + + + member inline this.Source + (taskValidation: TaskValidation<'T, 'Error>) + : TaskValidation<'T, 'Error> = + taskValidation + + +type TaskValidationBuilder() = + + inherit TaskValidationBuilderBase() + + // 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: TaskValidationCode<'T, 'Error, 'T>) + : TaskValidation<'T, 'Error> = + let mutable sm = TaskValidationStateMachine<'T, 'Error>() + + let initialResumptionFunc = + TaskValidationResumptionFunc<'T, 'Error>(fun sm -> code.Invoke(&sm)) + + let resumptionInfo = + { new TaskValidationResumptionDynamicInfo<_, _>(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 + () + elif step then + sm.Data.MethodBuilder.SetResult(sm.Data.Validation) + else + let mutable awaiter = + sm.ResumptionDynamicInfo.ResumptionData + :?> ICriticalNotifyCompletion + + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + + with exn -> + savedExn <- exn + // Run SetException outside the stack unwind, see https://github.com/dotnet/roslyn/issues/26567 + match savedExn with + | null -> () + | exn -> sm.Data.MethodBuilder.SetException exn + + member _.SetStateMachine(sm, state) = + sm.Data.MethodBuilder.SetStateMachine(state) + } + + sm.ResumptionDynamicInfo <- resumptionInfo + sm.Data.MethodBuilder <- AsyncTaskValidationMethodBuilder<'T, 'Error>.Create() + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + + member inline _.Run(code: TaskValidationCode<'T, 'Error, 'T>) : TaskValidation<'T, 'Error> = + if __useResumableCode then + __stateMachine, TaskValidation<'T, 'Error>> + (MoveNextMethodImpl<_>(fun sm -> + //-- RESUMABLE CODE START + __resumeAt sm.ResumptionPoint + + let mutable __stack_exn: ExceptionNull = null + + try + let __stack_code_fin = code.Invoke(&sm) + // If the `sm.Data.MethodBuilder` has already been set somewhere else (like While/WhileDynamic), we shouldn't continue + if + __stack_code_fin + && not sm.Data.IsTaskCompleted + then + sm.Data.MethodBuilder.SetResult(sm.Data.Validation) + 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 <- AsyncTaskValidationMethodBuilder<'T, 'Error>.Create() + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + )) + else + TaskValidationBuilder.RunDynamic(code) + +type BackgroundTaskValidationBuilder() = + + inherit TaskValidationBuilderBase() + + static member RunDynamic + (code: TaskValidationCode<'T, 'Error, 'T>) + : TaskValidation<'T, 'Error> = + // backgroundTask { .. } escapes to a background thread where necessary + // See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/ + if + isNull SynchronizationContext.Current + && obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default) + then + TaskValidationBuilder.RunDynamic(code) + else + Task.Run>(fun () -> TaskValidationBuilder.RunDynamic(code)) + + + /// Same as TaskBuilder.Run except the start is inside Task.Run if necessary + member inline _.Run(code: TaskValidationCode<'T, 'Error, 'T>) : TaskValidation<'T, 'Error> = + if __useResumableCode then + __stateMachine, TaskValidation<'T, 'Error>> + (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.Validation) + with exn -> + sm.Data.MethodBuilder.SetException exn + //-- RESUMABLE CODE END + )) + (SetStateMachineMethodImpl<_>(fun sm state -> + sm.Data.MethodBuilder.SetStateMachine(state) + )) + (AfterCode<_, TaskValidation<'T, 'Error>>(fun sm -> + // backgroundTask { .. } escapes to a background thread where necessary + // See spec of ConfigureAwait(false) at https://devblogs.microsoft.com/dotnet/configureawait-faq/ + if + isNull SynchronizationContext.Current + && obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default) + then + sm.Data.MethodBuilder <- + AsyncTaskValidationMethodBuilder<'T, 'Error>.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>(fun () -> + let mutable sm = sm // host local mutable copy of contents of state machine on this thread pool thread + + sm.Data.MethodBuilder <- + AsyncTaskValidationMethodBuilder<'T, 'Error>.Create() + + sm.Data.MethodBuilder.Start(&sm) + sm.Data.MethodBuilder.Task + ) + )) + else + BackgroundTaskValidationBuilder.RunDynamic(code) + +[] +module TaskValidationBuilder = + + let taskValidation = TaskValidationBuilder() + let backgroundTaskValidation = BackgroundTaskValidationBuilder() + +[] +module TaskValidationCEExtensionsLowPriority = + // Low priority extensions + type TaskValidationBuilderBase with + + + [] + static member inline BindDynamic<'TResult1, 'TResult2, ^Awaiter, 'TOverall, 'Error + when ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> Validation<'TResult1, 'Error>)> + ( + sm: byref<_>, + awaiter: ^Awaiter, + continuation: 'TResult1 -> TaskValidationCode<'TOverall, 'Error, 'TResult2> + ) : bool = + + let mutable awaiter = awaiter + + let cont = + TaskValidationResumptionFunc<'TOverall, 'Error>(fun sm -> + + let result = + (^Awaiter: (member GetResult: unit -> Validation<'TResult1, 'Error>) awaiter) + + match result with + | Ok result -> (continuation result).Invoke(&sm) + | Error e -> + sm.Data.Validation <- Error e + true + + ) + + // shortcut to continue immediately + if (^Awaiter: (member get_IsCompleted: unit -> bool) awaiter) then + cont.Invoke(&sm) + else + sm.ResumptionDynamicInfo.ResumptionData <- (awaiter :> ICriticalNotifyCompletion) + sm.ResumptionDynamicInfo.ResumptionFunc <- cont + false + + [] + member inline _.Bind<'TResult1, 'TResult2, ^Awaiter, 'TOverall, 'Error + when ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> Validation<'TResult1, 'Error>)> + ( + awaiter: ^Awaiter, + continuation: 'TResult1 -> TaskValidationCode<'TOverall, 'Error, 'TResult2> + ) : TaskValidationCode<'TOverall, 'Error, 'TResult2> = + + TaskValidationCode<'TOverall, 'Error, _>(fun sm -> + if __useResumableCode then + //-- RESUMABLE CODE START + // Get an awaiter from the awaitable + + let mutable awaiter = awaiter + + 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 -> Validation<'TResult1, 'Error>) awaiter) + + match result with + | Ok result -> (continuation result).Invoke(&sm) + | Error e -> + sm.Data.Validation <- Error e + true + else + sm.Data.MethodBuilder.AwaitUnsafeOnCompleted(&awaiter, &sm) + false + else + TaskValidationBuilderBase.BindDynamic< + 'TResult1, + 'TResult2, + ^Awaiter, + 'TOverall, + 'Error + >( + &sm, + awaiter, + continuation + ) + //-- RESUMABLE CODE END + ) + + [] + member inline this.ReturnFrom< ^TaskLike, ^Awaiter, 'T, 'Error + when ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> Validation<'T, 'Error>)> + (awaiter: ^Awaiter) + : TaskValidationCode<'T, 'Error, 'T> = + + this.Bind(awaiter, (fun v -> this.Return v)) + + + [] + member inline this.Source< ^TaskLike, ^Awaiter, 'T, 'Error + when ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> Validation<'T, 'Error>)> + (t: ^Awaiter) + : ^Awaiter = + t + + + [] + member inline this.Source< ^TaskLike, ^Awaiter, 'T, 'Error + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> Validation<'T, 'Error>)> + (t: ^TaskLike) + : ^Awaiter = + (^TaskLike: (member GetAwaiter: unit -> ^Awaiter) t) + + [] + member inline this.Source< ^TaskLike, ^Awaiter, 'T, 'Error + when ^TaskLike: (member GetAwaiter: unit -> ^Awaiter) + and ^Awaiter :> ICriticalNotifyCompletion + and ^Awaiter: (member get_IsCompleted: unit -> bool) + and ^Awaiter: (member GetResult: unit -> 'T)> + (t: ^TaskLike) + : TaskValidation<'T, 'Error> = + task { + let! r = t + return Ok r + } + + member inline _.Using<'Resource, 'TOverall, 'T, 'Error when 'Resource :> IDisposableNull> + (resource: 'Resource, body: 'Resource -> TaskValidationCode<'TOverall, 'Error, 'T>) + = + ResumableCode.Using(resource, body) + +[] +module TaskValidationCEExtensionsHighPriority = + // High priority extensions + type TaskValidationBuilderBase with + + + member inline this.Bind + ( + task: TaskValidation<'TResult1, 'Error>, + continuation: ('TResult1 -> TaskValidationCode<'TOverall, 'Error, 'TResult2>) + ) : TaskValidationCode<'TOverall, 'Error, 'TResult2> = + this.Bind(task.GetAwaiter(), continuation) + + member inline this.ReturnFrom + (task: TaskValidation<'T, 'Error>) + : TaskValidationCode<'T, 'Error, 'T> = + this.Bind(task.GetAwaiter(), (fun v -> this.Return v)) + + member inline this.BindReturn(x: TaskValidation<'T, 'Error>, f) = + this.Bind(x.GetAwaiter(), (fun x -> this.Return(f x))) + + member inline _.MergeSources + (t1: TaskValidation<'T, 'Error>, t2: TaskValidation<'T1, 'Error>) + = + TaskValidation.zip t1 t2 + + member inline _.Source(s: #seq<_>) = s + +[] +module TaskValidationCEExtensionsMediumPriority = + + // Medium priority extensions + type TaskValidationBuilderBase with + + member inline this.Source(t: Task<'T>) : TaskValidation<'T, 'Error> = + t + |> Task.map Ok + + member inline this.Source(computation: Async<'T>) : TaskValidation<'T, 'Error> = + computation + |> Async.map Ok + |> Async.StartImmediateAsTask + + member inline _.Source(s: Async>) : TaskValidation<'ok, 'error> = + s + |> AsyncResult.mapError List.singleton + |> Async.StartImmediateAsTask + + member inline _.Source(s: Task>) : TaskValidation<'ok, 'error> = + TaskResult.mapError List.singleton s + + member inline _.Source(result: Result<_, _>) : Task> = + result + |> Validation.ofResult + |> Task.singleton + +[] +module TaskValidationCEExtensionsHighPriority2 = + + // Medium priority extensions + type TaskValidationBuilderBase with + + + member inline _.Source(result: Async>) : Task> = + result + |> Async.StartImmediateAsTask + + member inline _.Source(t: ValueTask>) : Task> = + task { return! t } + + member inline _.Source(result: Validation<_, _>) : Task> = + Task.singleton result + + member inline _.Source(result: Choice<_, _>) : Task> = + result + |> Validation.ofChoice + |> Task.singleton diff --git a/src/FsToolkit.ErrorHandling/TaskValidationOp.fs b/src/FsToolkit.ErrorHandling/TaskValidationOp.fs new file mode 100644 index 00000000..3f36e0a7 --- /dev/null +++ b/src/FsToolkit.ErrorHandling/TaskValidationOp.fs @@ -0,0 +1,35 @@ +namespace FsToolkit.ErrorHandling.Operator.TaskValidation + +open FsToolkit.ErrorHandling + +[] +module TaskValidation = + let inline () + ([] mapper: 'okInput -> 'okOutput) + (input: TaskValidation<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.map mapper input + + let inline () + ([] mapper: 'okInput -> 'okOutput) + (input: Result<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.map mapper (TaskValidation.ofResult input) + + let inline (<*>) + (applier: TaskValidation<('okInput -> 'okOutput), 'error>) + (input: TaskValidation<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.apply applier input + + let inline (<*^>) + (applier: TaskValidation<('okInput -> 'okOutput), 'error>) + (input: Result<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.apply applier (TaskValidation.ofResult input) + + let inline (>>=) + (input: TaskValidation<'okInput, 'error>) + ([] binder: 'okInput -> TaskValidation<'okOutput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.bind binder input diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj index 76f948d5..9e2b6da2 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj @@ -22,6 +22,8 @@ + + diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs new file mode 100644 index 00000000..36afc459 --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs @@ -0,0 +1,411 @@ +module TaskValidationTests + +#if FABLE_COMPILER_PYTHON +open Fable.Pyxpecto +#endif +#if FABLE_COMPILER_JAVASCRIPT +open Fable.Mocha +#endif +#if !FABLE_COMPILER +open Expecto +#endif + +open SampleDomain +open TestData +open TestHelpers +open FsToolkit.ErrorHandling +open FsToolkit.ErrorHandling.Operator.TaskValidation + +let lift = TaskValidation.ofResult + +[] +let map2Tests = + testList "TaskValidation.map2 Tests" [ + testCaseTask "map2 with two ok parts" + <| fun () -> + task { + let! result = TaskValidation.map2 location (lift validLatR) (lift validLngR) + + return + result + |> Expect.hasOkValue validLocation + } + + testCaseTask "map2 with one Error and one Ok parts" + <| fun () -> + task { + let! result = TaskValidation.map2 location (lift invalidLatR) (lift validLngR) + + return + result + |> Expect.hasErrorValue [ invalidLatMsg ] + } + + testCaseTask "map2 with one Ok and one Error parts" + <| fun () -> + task { + let! result = TaskValidation.map2 location (lift validLatR) (lift invalidLngR) + + return + result + |> Expect.hasErrorValue [ invalidLngMsg ] + } + + testCaseTask "map2 with two Error parts" + <| fun () -> + task { + let! result = TaskValidation.map2 location (lift invalidLatR) (lift invalidLngR) + + return + result + |> Expect.hasErrorValue [ + invalidLatMsg + invalidLngMsg + ] + } + ] + +[] +let map3Tests = + testList "TaskValidation.map3 Tests" [ + testCaseTask "map3 with three ok parts" + <| fun () -> + task { + let! result = + TaskValidation.map3 + createPostRequest + (lift validLatR) + (lift validLngR) + (lift validTweetR) + + return + result + |> Expect.hasOkValue validCreatePostRequest + } + + testCaseTask "map3 with (Error, Ok, Ok)" + <| fun () -> + task { + let! result = + TaskValidation.map3 + createPostRequest + (lift invalidLatR) + (lift validLngR) + (lift validTweetR) + + return + result + |> Expect.hasErrorValue [ invalidLatMsg ] + } + + testCaseTask "map3 with (Ok, Error, Ok)" + <| fun () -> + task { + let! result = + TaskValidation.map3 + createPostRequest + (lift validLatR) + (lift invalidLngR) + (lift validTweetR) + + return + result + |> Expect.hasErrorValue [ invalidLngMsg ] + } + + + testCaseTask "map3 with (Ok, Ok, Error)" + <| fun () -> + task { + let! result = + TaskValidation.map3 + createPostRequest + (lift validLatR) + (lift validLngR) + (lift emptyInvalidTweetR) + + return + result + |> Expect.hasErrorValue [ emptyTweetErrMsg ] + } + + testCaseTask "map3 with (Error, Error, Error)" + <| fun () -> + task { + let! result = + TaskValidation.map3 + createPostRequest + (lift invalidLatR) + (lift invalidLngR) + (lift emptyInvalidTweetR) + + return + result + |> Expect.hasErrorValue [ + invalidLatMsg + invalidLngMsg + emptyTweetErrMsg + ] + } + ] + +[] +let applyTests = + + testList "TaskValidation.apply tests" [ + testCaseTask "apply with Ok" + <| fun () -> + task { + let! result = + Tweet.TryCreate "foobar" + |> lift + |> TaskValidation.apply ( + Ok remainingCharacters + |> Task.singleton + ) + + return + result + |> Expect.hasOkValue 274 + } + + testCaseTask "apply with Error" + <| fun () -> + task { + let! result = + TaskValidation.apply + (Ok remainingCharacters + |> Task.singleton) + (lift emptyInvalidTweetR) + + return + result + |> Expect.hasErrorValue [ emptyTweetErrMsg ] + } + ] + +[] +let operatorsTests = + + testList "TaskValidation Operators Tests" [ + testCaseTask "map, apply & bind operators" + <| fun () -> + task { + let! result = + createPostRequest + (lift validLatR) + <*> (lift validLngR) + <*> (lift validTweetR) + >>= (fun tweet -> + Ok tweet + |> Task.singleton + ) + + return + result + |> Expect.hasOkValue validCreatePostRequest + } + + testCaseTask "map^ & apply^ operators" + <| fun () -> + task { + let! result = + createPostRequest + validLatR + <*^> validLngR + <*^> validTweetR + + return + result + |> Expect.hasOkValue validCreatePostRequest + } + ] + +[] +let zipTests = + testList "zip tests" [ + testCaseTask "Ok, Ok" + <| fun () -> + task { + let! actual = + TaskValidation.zip + (Ok 1 + |> Task.singleton) + (Ok 2 + |> Task.singleton) + + Expect.equal actual (Ok(1, 2)) "Should be ok" + } + testCaseTask "Ok, Error" + <| fun () -> + task { + let! actual = + TaskValidation.zip + (Ok 1 + |> Task.singleton) + (TaskValidation.error "Bad") + + Expect.equal actual (Error [ "Bad" ]) "Should be Error" + } + testCaseTask "Error, Ok" + <| fun () -> + task { + let! actual = + TaskValidation.zip + (TaskValidation.error "Bad") + (Ok 1 + |> Task.singleton) + + Expect.equal actual (Error [ "Bad" ]) "Should be Error" + } + testCaseTask "Error, Error" + <| fun () -> + task { + let! actual = + TaskValidation.zip (TaskValidation.error "Bad1") (TaskValidation.error "Bad2") + + Expect.equal + actual + (Error [ + "Bad1" + "Bad2" + ]) + "Should be Error" + } + ] + +[] +let orElseTests = + testList "TaskValidation.orElseWith Tests" [ + testCaseTask "Ok Ok takes first Ok" + <| fun () -> + task { + let! result = + (Ok "First" + |> Task.singleton) + |> TaskValidation.orElse ( + Ok "Second" + |> Task.singleton + ) + + return + result + |> Expect.hasOkValue "First" + } + + testCaseTask "Ok Error takes first Ok" + <| fun () -> + task { + let! result = + (Ok "First" + |> Task.singleton) + |> TaskValidation.orElse ( + Error [ "Second" ] + |> Task.singleton + ) + + return + result + |> Expect.hasOkValue "First" + } + + testCaseTask "Error Ok takes second Ok" + <| fun () -> + task { + let! result = + (Error [ "First" ] + |> Task.singleton) + |> TaskValidation.orElse ( + Ok "Second" + |> Task.singleton + ) + + return + result + |> Expect.hasOkValue "Second" + } + + testCaseTask "Error Error takes second error" + <| fun () -> + task { + let! result = + (Error [ "First" ] + |> Task.singleton) + |> TaskValidation.orElse ( + Error [ "Second" ] + |> Task.singleton + ) + + return + result + |> Expect.hasErrorValue [ "Second" ] + } + ] + +[] +let orElseWithTests = + testList "TaskValidation.orElse Tests" [ + testCaseTask "Ok Ok takes first Ok" + <| fun () -> + task { + let! result = + (Ok "First" + |> Task.singleton) + |> TaskValidation.orElseWith (fun _ -> + Ok "Second" + |> Task.singleton + ) + + return + result + |> Expect.hasOkValue "First" + } + + testCaseTask "Ok Error takes first Ok" + <| fun () -> + task { + let! result = + (Ok "First" + |> Task.singleton) + |> TaskValidation.orElseWith (fun _ -> + Error [ "Second" ] + |> Task.singleton + ) + + return + result + |> Expect.hasOkValue "First" + } + + testCaseTask "Error Ok takes second Ok" + <| fun () -> + task { + let! result = + (Error [ "First" ] + |> Task.singleton) + |> TaskValidation.orElseWith (fun _ -> + Ok "Second" + |> Task.singleton + ) + + return + result + |> Expect.hasOkValue "Second" + } + + testCaseTask "Error Error takes second error" + <| fun () -> + task { + let! result = + (Error [ "First" ] + |> Task.singleton) + |> TaskValidation.orElseWith (fun _ -> + Error [ "Second" ] + |> Task.singleton + ) + + return + result + |> Expect.hasErrorValue [ "Second" ] + } + ] diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs new file mode 100644 index 00000000..3d567ead --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs @@ -0,0 +1,765 @@ +module TaskValidationCETests + +open Expecto +open FsToolkit.ErrorHandling +open System.Threading.Tasks + +[] +let ``TaskValidationCE return Tests`` = + testList "TaskValidationCE Tests" [ + testCaseTask "Return string" + <| fun () -> + task { + let data = "Foo" + let! actual = taskValidation { return data } + Expect.equal actual (Validation.ok data) "Should be ok" + } + ] + +[] +let ``TaskValidationCE return! Tests`` = + testList "TaskValidationCE return! Tests" [ + testCaseTask "Return Ok Validation" + <| fun () -> + task { + let innerData = "Foo" + let data = Validation.ok innerData + let! actual = taskValidation { return! data } + + Expect.equal actual (data) "Should be ok" + } + testCaseTask "Return Ok Choice" + <| fun () -> + task { + let innerData = "Foo" + let data = Choice1Of2 innerData + let! actual = taskValidation { return! data } + Expect.equal actual (Validation.ok innerData) "Should be ok" + } + + testCaseTask "Return Ok AsyncValidation" + <| fun () -> + task { + let innerData = "Foo" + let data = Validation.ok innerData + let! actual = taskValidation { return! Async.singleton data } + + Expect.equal actual (data) "Should be ok" + } + testCaseTask "Return Ok TaskValidation" + <| fun () -> + task { + let innerData = "Foo" + let data = Validation.ok innerData + let! actual = taskValidation { return! Task.FromResult data } + + Expect.equal actual (data) "Should be ok" + } + testCaseTask "Return Async" + <| fun () -> + task { + let innerData = "Foo" + let! actual = taskValidation { return! Async.singleton innerData } + + Expect.equal actual (Validation.ok innerData) "Should be ok" + } + testCaseTask "Return Task Generic" + <| fun () -> + task { + let innerData = "Foo" + let! actual = taskValidation { return! Task.singleton innerData } + + Expect.equal actual (Validation.ok innerData) "Should be ok" + } + testCaseTask "Return Task" + <| fun () -> + task { + let innerData = "Foo" + let! actual = taskValidation { return! Task.FromResult innerData :> Task } + + Expect.equal actual (Validation.ok ()) "Should be ok" + } + testCaseTask "Return ValueTask Generic" + <| fun () -> + task { + let innerData = "Foo" + let! actual = taskValidation { return! ValueTask.FromResult innerData } + + Expect.equal actual (Validation.ok innerData) "Should be ok" + } + testCaseTask "Return ValueTask" + <| fun () -> + task { + let! actual = taskValidation { return! ValueTask.CompletedTask } + + Expect.equal actual (Validation.ok ()) "Should be ok" + } + ] + +[] +let ``TaskValidationCE bind Tests`` = + testList "TaskValidationCE bind Tests" [ + testCaseTask "Bind Ok Validation" + <| fun () -> + task { + let innerData = "Foo" + let data = Validation.ok innerData + + let! actual = + taskValidation { + let! data = data + return data + } + + Expect.equal actual (data) "Should be ok" + + } + testCaseTask "Bind Ok Choice" + <| fun () -> + task { + let innerData = "Foo" + let data = Choice1Of2 innerData + + let! actual = + taskValidation { + let! data = data + return data + } + + Expect.equal actual (Validation.ok innerData) "Should be ok" + } + + + testCaseTask "Bind Ok AsyncValidation" + <| fun () -> + task { + let innerData = "Foo" + + let data = + Validation.ok innerData + |> Async.singleton + + let! actual = + taskValidation { + let! data = data + return data + } + + Expect.equal + actual + (data + |> Async.RunSynchronously) + "Should be ok" + } + testCaseTask "Bind Ok TaskValidation" + <| fun () -> + task { + let innerData = "Foo" + + let data = + Validation.ok innerData + |> Task.singleton + + let! actual = + taskValidation { + let! data = data + return data + } + + Expect.equal actual (data.Result) "Should be ok" + } + testCaseTask "Bind Async" + <| fun () -> + task { + let innerData = "Foo" + + let! actual = + taskValidation { + let! data = Async.singleton innerData + return data + } + + Expect.equal actual (Validation.ok innerData) "Should be ok" + } + testCaseTask "Bind Task Generic" + <| fun () -> + task { + let innerData = "Foo" + + let! actual = + taskValidation { + let! data = Task.FromResult innerData + return data + } + + Expect.equal actual (Validation.ok innerData) "Should be ok" + } + testCaseTask "Bind Task" + <| fun () -> + task { + let innerData = "Foo" + let! actual = taskValidation { do! Task.FromResult innerData :> Task } + + Expect.equal actual (Validation.ok ()) "Should be ok" + } + testCaseTask "Bind ValueTask Generic" + <| fun () -> + task { + let innerData = "Foo" + + let! actual = + taskValidation { + let! data = ValueTask.FromResult innerData + return data + } + + Expect.equal actual (Validation.ok innerData) "Should be ok" + } + testCaseTask "Bind ValueTask" + <| fun () -> + task { + let! actual = taskValidation { do! ValueTask.CompletedTask } + + Expect.equal actual (Validation.ok ()) "Should be ok" + } + + testCaseTask "Task.Yield" + <| fun () -> + task { + + let! actual = taskValidation { do! Task.Yield() } + + Expect.equal actual (Validation.ok ()) "Should be ok" + } + ] + +[] +let ``TaskValidationCE combine/zero/delay/run Tests`` = + testList "TaskValidationCE combine/zero/delay/run Tests" [ + testCaseTask "Zero/Combine/Delay/Run" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValidation { + let result = data + + if true then + () + + return result + } + + Expect.equal actual (Validation.ok data) "Should be ok" + } + testCaseTask "If do!" + <| fun () -> + task { + let data = 42 + + let taskVal (call: unit -> Task) maybeCall : Task> = + taskValidation { + if true then + do! call () + + let! (res: string) = maybeCall (): Task> + return data + } + + () + } + ] + +[] +let ``TaskValidationCE try Tests`` = + testList "TaskValidationCE try Tests" [ + testCaseTask "Try With" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValidation { + let data = data + + try + () + with _ -> + () + + return data + } + + Expect.equal actual (Validation.ok data) "Should be ok" + } + testCaseTask "Try Finally" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValidation { + let data = data + + try + () + finally + () + + return data + } + + Expect.equal actual (Validation.ok data) "Should be ok" + } + ] + +[] +let ``TaskValidationCE using Tests`` = + testList "TaskValidationCE using Tests" [ + testCaseTask "use normal disposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskValidation { + use d = TestHelpers.makeDisposable (fun () -> isFinished <- true) + return data + } + + Expect.equal actual (Validation.ok data) "Should be ok" + Expect.isTrue isFinished "" + } + testCaseTask "use! normal wrapped disposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskValidation { + use! d = + TestHelpers.makeDisposable (fun () -> isFinished <- true) + |> Validation.ok + + return data + } + + Expect.equal actual (Validation.ok data) "Should be ok" + Expect.isTrue isFinished "" + } + testCaseTask "use null disposable" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValidation { + use d = null + return data + } + + Expect.equal actual (Validation.ok data) "Should be ok" + } + testCaseTask "use sync asyncdisposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskValidation { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + isFinished <- true + ValueTask() + ) + ) + + return data + } + + Expect.equal actual (Validation.ok data) "Should be ok" + Expect.isTrue isFinished "" + } + + testCaseTask "use async asyncdisposable" + <| fun () -> + task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskValidation { + use d = + TestHelpers.makeAsyncDisposable ( + (fun () -> + task { + do! Task.Yield() + isFinished <- true + } + :> Task + |> ValueTask + ) + ) + + return data + } + + Expect.equal actual (Validation.ok data) "Should be ok" + Expect.isTrue isFinished "" + } + ] + +[] +let ``TaskValidationCE loop Tests`` = + testList "TaskValidationCE loop Tests" [ + 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 = + taskValidation { + while index < maxIndex do + index <- index + 1 + + return data + } + + Expect.equal index maxIndex "Index should reach maxIndex" + Expect.equal actual (Validation.ok data) "Should be ok" + } + ] + + + testCaseTask "while fail" + <| fun () -> + task { + + let mutable loopCount = 0 + let mutable wasCalled = false + + let sideEffect () = + wasCalled <- true + "ok" + + let expected = Validation.error "error" + + let data = [ + Validation.ok "42" + Validation.ok "1024" + expected + Validation.ok "1M" + Validation.ok "1M" + Validation.ok "1M" + ] + + let! actual = + taskValidation { + 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 = + taskValidation { + for i in [ 1..10 ] do + () + + return data + } + + Expect.equal actual (Validation.ok data) "Should be ok" + } + testCaseTask "for to" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValidation { + for i = 1 to 10 do + () + + return data + } + + Expect.equal actual (Validation.ok data) "Should be ok" + } + testCaseTask "for in fail" + <| fun () -> + task { + + let mutable loopCount = 0 + let expected = Validation.error "error" + + let data = [ + Validation.ok "42" + Validation.ok "1024" + expected + Validation.ok "1M" + Validation.ok "1M" + Validation.ok "1M" + ] + + let! actual = + taskValidation { + for i in data do + let! x = i + + loopCount <- + loopCount + + 1 + + () + + return "ok" + } + + Expect.equal loopCount 2 "Should only loop twice" + Expect.equal actual expected "Should be an error" + } + ] + +[] +let ``TaskValidationCE applicative tests`` = + testList "TaskValidationCE applicative tests" [ + testCaseTask "Happy Path TaskValidation" + <| fun () -> + task { + let! actual = + taskValidation { + let! a = TaskValidation.ok 3 + and! b = TaskValidation.ok 2 + and! c = TaskValidation.ok 1 + return a + b - c + } + + Expect.equal actual (Validation.ok 4) "Should be ok" + } + + testCaseTask "Happy Path AsyncValidation" + <| fun () -> + task { + let! actual = + taskValidation { + let! a = AsyncValidation.ok 3 + and! b = AsyncValidation.ok 2 + and! c = AsyncValidation.ok 1 + return a + b - c + } + + Expect.equal actual (Validation.ok 4) "Should be ok" + } + + + testCaseTask "Happy Path Validation" + <| fun () -> + task { + let! actual = + taskValidation { + let! a = Validation.ok 3 + and! b = Validation.ok 2 + and! c = Validation.ok 1 + return a + b - c + } + + Expect.equal actual (Validation.ok 4) "Should be ok" + } + + testCaseTask "Happy Path Choice" + <| fun () -> + task { + let! actual = + taskValidation { + let! a = Choice1Of2 3 + and! b = Choice1Of2 2 + and! c = Choice1Of2 1 + return a + b - c + } + + Expect.equal actual (Validation.ok 4) "Should be ok" + } + + testCaseTask "Happy Path Async" + <| fun () -> + task { + let! actual = + taskValidation { + let! a = Async.singleton 3 //: Async + and! b = Async.singleton 2 //: Async + and! c = Async.singleton 1 //: Async + return a + b - c + } + + Expect.equal actual (Validation.ok 4) "Should be ok" + } + + testCaseTask "Happy Path 2 Async" + <| fun () -> + task { + let! actual = + taskValidation { + let! a = Async.singleton 3 //: Async + and! b = Async.singleton 2 //: Async + return a + b + } + + Expect.equal actual (Validation.ok 5) "Should be ok" + } + + testCaseTask "Happy Path 2 Task" + <| fun () -> + task { + let! actual = + taskValidation { + let! a = Task.FromResult 3 + and! b = Task.FromResult 2 + return a + b + } + + Expect.equal actual (Validation.ok 5) "Should be ok" + } + let specialCaseTask returnValue = Task.FromResult returnValue + + testCaseTask "Happy Path Validation/Choice/AsyncValidation/Ply/ValueTask" + <| fun () -> + task { + let! actual = + taskValidation { + let! a = Validation.ok 3 + and! b = Choice1Of2 2 + + and! c = + Validation.ok 1 + |> Async.singleton + + and! d = specialCaseTask (Validation.ok 3) + and! e = ValueTask.FromResult(Validation.ok 5) + + return + a + b + - c + - d + + e + } + + Expect.equal actual (Validation.ok 6) "Should be ok" + } + + testCaseTask "Fail Path Result" + <| fun () -> + task { + let expected = + Error [ + "Error 1" + "Error 2" + ] + + let! actual = + taskValidation { + let! a = Ok 3 + and! b = Ok 2 + and! c = Error "Error 1" + and! d = Error "Error 2" + + return + a + b + - c + - d + } + + Expect.equal actual expected "Should be Error" + } + + testCaseTask "Fail Path Validation" + <| fun () -> + task { + let expected = Validation.error "TryParse failure" + + let! actual = + taskValidation { + let! a = Validation.ok 3 + and! b = Validation.ok 2 + and! c = expected + return a + b - c + } + + Expect.equal actual expected "Should be Error" + } + + testCaseTask "Fail Path Choice" + <| fun () -> + task { + let errorMsg = "TryParse failure" + + let! actual = + taskValidation { + let! a = Choice1Of2 3 + and! b = Choice1Of2 2 + and! c = Choice2Of2 errorMsg + return a + b - c + } + + Expect.equal actual (Validation.error errorMsg) "Should be Error" + } + + testCaseTask "Fail Path Validation/Choice/AsyncValidation" + <| fun () -> + task { + let errorMsg = "TryParse failure" + + let! actual = + taskValidation { + let! a = Choice1Of2 3 + + and! b = + Validation.ok 2 + |> Async.singleton + + and! c = Validation.error errorMsg + return a + b - c + } + + Expect.equal actual (Validation.error errorMsg) "Should be Error" + } + ] + +[] +let ``TaskValidationCE inference checks`` = + testList "TaskValidationCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = taskValidation { return! res () } + + f (TaskValidation.ok) + |> ignore + ]