From 56daa09865da5fbb6c5ac6e9a3631333f76edb05 Mon Sep 17 00:00:00 2001 From: Matthew Watt Date: Sun, 23 Feb 2025 20:47:27 -0600 Subject: [PATCH 1/8] Implement TaskValidation module --- .../FsToolkit.ErrorHandling.fsproj | 1 + src/FsToolkit.ErrorHandling/TaskValidation.fs | 292 ++++++++++++++++++ 2 files changed, 293 insertions(+) create mode 100644 src/FsToolkit.ErrorHandling/TaskValidation.fs diff --git a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj index c896dafd..fad7c78d 100644 --- a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj +++ b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj @@ -31,6 +31,7 @@ + diff --git a/src/FsToolkit.ErrorHandling/TaskValidation.fs b/src/FsToolkit.ErrorHandling/TaskValidation.fs new file mode 100644 index 00000000..c271bfac --- /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) + } From d6ce33b83ebbee1d663629e74576cb70a44ed303 Mon Sep 17 00:00:00 2001 From: Matthew Watt Date: Sun, 23 Feb 2025 20:51:04 -0600 Subject: [PATCH 2/8] Implement TaskValidationOp functions --- .../FsToolkit.ErrorHandling.fsproj | 1 + .../TaskValidationOp.fs | 35 +++++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 src/FsToolkit.ErrorHandling/TaskValidationOp.fs diff --git a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj index fad7c78d..f4d9ba83 100644 --- a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj +++ b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj @@ -33,6 +33,7 @@ + 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 From 9bf2ed6959e11c8ccf0a092c1ef9a5c91843fa7a Mon Sep 17 00:00:00 2001 From: Matthew Watt Date: Sun, 23 Feb 2025 21:23:06 -0600 Subject: [PATCH 3/8] Implement TaskValidation computation expression --- .../FsToolkit.ErrorHandling.fsproj | 5 +- .../TaskValidationCE.fs | 556 ++++++++++++++++++ 2 files changed, 559 insertions(+), 2 deletions(-) create mode 100644 src/FsToolkit.ErrorHandling/TaskValidationCE.fs diff --git a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj index f4d9ba83..3c91371c 100644 --- a/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj +++ b/src/FsToolkit.ErrorHandling/FsToolkit.ErrorHandling.fsproj @@ -31,10 +31,11 @@ - - + + + diff --git a/src/FsToolkit.ErrorHandling/TaskValidationCE.fs b/src/FsToolkit.ErrorHandling/TaskValidationCE.fs new file mode 100644 index 00000000..7016af56 --- /dev/null +++ b/src/FsToolkit.ErrorHandling/TaskValidationCE.fs @@ -0,0 +1,556 @@ +namespace FsToolkit.ErrorHandling + +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 + +[] +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 From ffa7f55c689e5dbbcf87b90d2f000ea64d98b8fd Mon Sep 17 00:00:00 2001 From: Matthew Watt Date: Sun, 23 Feb 2025 22:25:56 -0600 Subject: [PATCH 4/8] Add TaskValidation tests --- .../FsToolkit.ErrorHandling.Tests.fsproj | 7 + tests/FsToolkit.ErrorHandling.Tests/Main.fs | 2 + .../TaskValidation.fs | 393 +++++++++++ .../TaskValidationCE.fs | 615 ++++++++++++++++++ 4 files changed, 1017 insertions(+) create mode 100644 tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs create mode 100644 tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs diff --git a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj index 7b3842b1..90c52d5c 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj @@ -34,9 +34,16 @@ + + + + + 10.2.1 + + diff --git a/tests/FsToolkit.ErrorHandling.Tests/Main.fs b/tests/FsToolkit.ErrorHandling.Tests/Main.fs index 118c6472..5e0f3141 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/Main.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/Main.fs @@ -30,6 +30,8 @@ let allTests = AsyncResultOptionCETests.allTests AsyncValidationTests.allTests AsyncValidationCETests.allTests + TaskValidationTests.allTests + TaskValidationCETests.allTests ValidationTests.allTests ValidationCETests.allTests ValueOptionTests.allTests diff --git a/tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs b/tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs new file mode 100644 index 00000000..cfe85941 --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs @@ -0,0 +1,393 @@ +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" ] + } + ] + +let allTests = + testList "TaskValidationTests" [ + map2Tests + map3Tests + applyTests + operatorsTests + orElseTests + orElseWithTests + zipTests + ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs b/tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs new file mode 100644 index 00000000..4fc63bb0 --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs @@ -0,0 +1,615 @@ +module TaskValidationCETests + + +#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 ``TaskValidationCE return Tests`` = + testList "TaskValidationCE return Tests" [ + testCaseTask "Return string" + <| fun () -> task { + let data = "Foo" + let! actual = taskValidation { return data } + Expect.equal actual (Ok data) "Should be ok" + } + ] + +let ``TaskValidationCE return! Tests`` = + testList "TaskValidationCE return! Tests" [ + testCaseTask "Return Ok result" + <| fun () -> task { + let data = Ok "Foo" + let! actual = taskValidation { return! data } + Expect.equal actual (data) "Should be ok" + } + testCaseTask "Return Error result" + <| fun () -> task { + let innerData = "Foo" + let! expected = TaskValidation.error innerData + let data = Validation.Error [ innerData ] + let! actual = taskValidation { return! data } + Expect.equal actual expected "Should be error" + } + testCaseTask "Return Ok Choice" + <| fun () -> task { + let innerData = "Foo" + let data = Choice1Of2 innerData + let! actual = taskValidation { return! data } + Expect.equal actual (Ok innerData) "Should be ok" + } + testCaseTask "Return Error Choice" + <| fun () -> task { + let innerData = "Foo" + let! expected = TaskValidation.error innerData + let data = Choice2Of2 innerData + let! actual = taskValidation { return! data } + Expect.equal actual expected "Should be error" + } + testCaseTask "Return Ok Validation" + <| fun () -> task { + let innerData = "Foo" + let data = Validation.ok innerData + let! actual = taskValidation { return! data } + Expect.equal actual (Ok innerData) "Should be ok" + } + testCaseTask "Return Error Validation" + <| fun () -> task { + let innerData = "Foo" + let expected = Validation.error innerData + let data = TaskValidation.error innerData + let! actual = taskValidation { return! data } + Expect.equal actual expected "Should be ok" + } + ] + + +let ``TaskValidationCE bind Tests`` = + testList "TaskValidationCE bind Tests" [ + testCaseTask "let! Async" + <| fun () -> task { + let data = "Foo" + + let! actual = + taskValidation { + let! f = async { return data } + return f + } + + Expect.equal actual (Ok data) "Should be ok" + } + testCaseTask "let! Ok result" + <| fun () -> task { + let data = Ok "Foo" + + let! actual = + taskValidation { + let! f = data + return f + } + + Expect.equal actual data "Should be ok" + } + testCaseTask "let! Error result" + <| fun () -> task { + let innerData = "Foo" + let data = Validation.Error [ innerData ] + let! expected = TaskValidation.error innerData + + let! actual = + taskValidation { + let! f = data + return f + } + + Expect.equal actual expected "Should be ok" + } + testCaseTask "let! Ok Choice" + <| fun () -> task { + let innerData = "Foo" + let data = Choice1Of2 innerData + + let! actual = + taskValidation { + let! f = data + return f + } + + Expect.equal actual (Ok innerData) "Should be ok" + } + testCaseTask "let! Error Choice" + <| fun () -> task { + let innerData = "Foo" + let data = Choice2Of2 innerData + let! expected = TaskValidation.error innerData + + let! actual = + taskValidation { + let! f = data + return f + } + + Expect.equal actual expected "Should be ok" + } + testCaseTask "let! Ok Validation" + <| fun () -> task { + let innerData = "Foo" + + let! actual = + taskValidation { + let! f = validation { return innerData } + return f + } + + Expect.equal actual (Ok innerData) "Should be ok" + } + testCaseTask "let! Error Validation" + <| fun () -> task { + let innerData = "Foo" + let error = Error innerData + let expected = Error [ innerData ] + + let! actual = + taskValidation { + let! f = validation { return! error } + and! _ = validation { return! Ok innerData } + return f + } + + Expect.equal actual expected "Should be ok" + } + testCaseTask "do! Ok result" + <| fun () -> task { + let data = Ok() + let! actual = taskValidation { do! data } + Expect.equal actual data "Should be ok" + } + testCaseTask "do! Error result" + <| fun () -> task { + let innerData = () + let data = Validation.Error [ innerData ] + let! expected = TaskValidation.error innerData + let! actual = taskValidation { do! data } + Expect.equal actual expected "Should be error" + } + testCaseTask "do! Ok Choice" + <| fun () -> task { + let innerData = () + let! expected = TaskValidation.ok innerData + let data = Choice1Of2 innerData + let! actual = taskValidation { do! data } + Expect.equal actual expected "Should be ok" + } + testCaseTask "do! Error Choice" + <| fun () -> task { + let innerData = () + let! expected = TaskValidation.error innerData + let data = Choice2Of2 innerData + let! actual = taskValidation { do! data } + Expect.equal actual expected "Should be error" + } + testCaseTask "do! Ok Validation" + <| fun () -> task { + let innerData = () + let! expected = TaskValidation.ok innerData + let data = TaskValidation.ok innerData + let! actual = taskValidation { do! data } + Expect.equal actual expected "Should be ok" + } + testCaseTask "do! Error Validation" + <| fun () -> task { + let innerData = () + let! expected = TaskValidation.error innerData + let data = TaskValidation.error innerData + let! actual = taskValidation { do! data } + Expect.equal actual expected "Should be error" + } + ] + +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 (Ok data) "Should be ok" + } + ] + + +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 (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 (Ok data) "Should be ok" + } + ] + +let makeDisposable callback = + { new System.IDisposable with + member _.Dispose() = callback () + } + +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 _ = makeDisposable (fun () -> isFinished <- true) + return data + } + + Expect.equal actual (Result.Ok data) "Should be ok" + Expect.isTrue isFinished "Expected disposable to be disposed" + } + + testCaseTask "use! normal wrapped disposable" + <| fun () -> task { + let data = 42 + let mutable isFinished = false + + let! actual = + taskValidation { + use! d = + makeDisposable (fun () -> isFinished <- true) + |> Ok + + return data + } + + Expect.equal actual (Ok data) "Should be ok" + Expect.isTrue isFinished "Expected disposable to be disposed" + } + + testCaseTask "disposable not disposed too early" + <| fun () -> task { + let mutable disposed = false + let mutable finished = false + let f1 _ = AsyncResult.ok 42 + + let! actual = + taskValidation { + use d = + 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 + testCaseTask "use null disposable" + <| fun () -> task { + let data = 42 + + let! actual = + taskValidation { + use d = null + return data + } + + Expect.equal actual (Ok data) "Should be ok" + } +#endif + ] + +let ``TaskValidationCE loop Tests`` = + testList "TaskValidationCE loop Tests" [ + yield! [ + let maxIndices = [ + 10 + 1000000 + ] + + for maxIndex in maxIndices do + testCaseTask + <| $"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 (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 "NOPE" + + 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! _ = data[loopCount] + + loopCount <- + loopCount + + 1 + + return sideEffect () + } + + Expect.equal loopCount 2 "Should only loop twice" + Expect.equal actual (Error [ "NOPE" ]) "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 _ in [ 1..10 ] do + () + + return data + } + + Expect.equal actual (Ok data) "Should be ok" + } + testCaseTask "for to" + <| fun () -> task { + let data = 42 + + let! actual = + taskValidation { + for _ = 1 to 10 do + () + + return data + } + + Expect.equal actual (Ok data) "Should be ok" + } + ] + +let ``TaskValidationCE applicative tests`` = + testList "TaskValidationCE applicative tests" [ + testCaseTask "Happy Path Result" + <| fun () -> task { + let! actual = + taskValidation { + let! a = Ok 3 + and! b = Ok 2 + and! c = Ok 1 + return a + b - c + } + + Expect.equal actual (Ok 4) "Should be ok" + } + testCaseTask "Happy Path Valiation" + <| 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 (Ok 4) "Should be ok" + } + + testCaseTask "Happy Path Result/Validation" + <| fun () -> task { + let! actual = + taskValidation { + let! a = TaskValidation.ok 3 + and! b = Validation.ok 2 + and! c = TaskValidation.ok 1 + return a + b - c + } + + Expect.equal actual (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 (Ok 4) "Should be ok" + } + + testCaseTask "Happy Path Result/Choice/Task/Validation" + <| fun () -> task { + let! actual = + taskValidation { + let! a = Ok 3 + and! b = Choice1Of2 2 + and! c = TaskValidation.ok 1 + + return a + b - c + } + + Expect.equal actual (Ok 4) "Should be ok" + } + + testCaseTask "Sad Path Async Result/Async Result" + <| fun () -> task { + let expected = + Error [ + "Hello" + "World" + ] + + let! actual = + taskValidation { + let! _ = async { return Error "Hello" } + and! _ = async { return Error "World" } + return () + } + + Expect.equal actual expected "Should be error" + } + +#if !FABLE_COMPILER + + testCaseTask "Sad Path Task Result/Task Result" + <| fun () -> task { + let expected = + Error [ + "Hello" + "World" + ] + + let! actual = + taskValidation { + let! _ = task { return Error "Hello" } + and! _ = task { return Error "World" } + return () + } + + Expect.equal actual expected "Should be error" + } + +#endif + + 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 = Validation.error "Error 1" + and! d = Validation.error "Error 2" + + return + a + b + - c + - d + } + + Expect.equal actual expected "Should be Error" + } + + testCaseTask "Fail Path Validation" + <| fun () -> task { + let expected = TaskValidation.error "TryParse failure" + let! expected' = expected + + let! actual = + taskValidation { + let! a = TaskValidation.ok 3 + and! b = TaskValidation.ok 2 + and! c = expected + return a + b - c + } + + Expect.equal actual expected' "Should be Error" + } + ] + +let allTests = + testList "Validation CE Tests" [ + ``TaskValidationCE return Tests`` + ``TaskValidationCE return! Tests`` + ``TaskValidationCE bind Tests`` + ``TaskValidationCE combine/zero/delay/run Tests`` + ``TaskValidationCE try Tests`` + ``TaskValidationCE using Tests`` + ``TaskValidationCE loop Tests`` + ``TaskValidationCE applicative tests`` + ] From 0d1cce0c48a39ddd288f6de3c580398ef3516dbb Mon Sep 17 00:00:00 2001 From: Matthew Watt Date: Sat, 1 Mar 2025 11:58:01 -0600 Subject: [PATCH 5/8] Finish TaskValidation tests; fix formatting --- src/FsToolkit.ErrorHandling/TaskValidation.fs | 2 +- .../TaskValidationCE.fs | 47 +- .../TaskValidation.fs | 595 +++++---- .../TaskValidationCE.fs | 1172 +++++++++-------- 4 files changed, 997 insertions(+), 819 deletions(-) diff --git a/src/FsToolkit.ErrorHandling/TaskValidation.fs b/src/FsToolkit.ErrorHandling/TaskValidation.fs index c271bfac..4831dc67 100644 --- a/src/FsToolkit.ErrorHandling/TaskValidation.fs +++ b/src/FsToolkit.ErrorHandling/TaskValidation.fs @@ -96,7 +96,7 @@ module TaskValidation = /// let inline orElseWith ([] ifErrorFunc: 'errorInput list -> TaskValidation<'ok, 'errorOutput>) - (validation : TaskValidation<'ok, 'errorInput>) + (validation: TaskValidation<'ok, 'errorInput>) : TaskValidation<'ok, 'errorOutput> = task { let! validation = validation diff --git a/src/FsToolkit.ErrorHandling/TaskValidationCE.fs b/src/FsToolkit.ErrorHandling/TaskValidationCE.fs index 7016af56..dfeb9c40 100644 --- a/src/FsToolkit.ErrorHandling/TaskValidationCE.fs +++ b/src/FsToolkit.ErrorHandling/TaskValidationCE.fs @@ -67,15 +67,20 @@ type TaskValidationBuilderBase() = ResumableCode.Combine( task1, TaskValidationCode<'TOverall, 'Error, 'T>(fun sm -> - if sm.Data.IsValidationError then true else task2.Invoke(&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> = + ( + [] condition: unit -> bool, + body: TaskValidationCode<'TOverall, 'Error, unit> + ) : TaskValidationCode<'TOverall, 'Error, unit> = let mutable keepGoing = true ResumableCode.While( @@ -106,8 +111,10 @@ type TaskValidationBuilderBase() = /// 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> = + ( + body: TaskValidationCode<'TOverall, 'Error, 'T>, + [] compensation: unit -> unit + ) : TaskValidationCode<'TOverall, 'Error, 'T> = ResumableCode.TryFinally( body, @@ -127,7 +134,9 @@ type TaskValidationBuilderBase() = (fun e -> this.While( (fun () -> e.MoveNext()), - TaskValidationCode<'TOverall, 'Error, unit>(fun sm -> (body e.Current).Invoke(&sm)) + TaskValidationCode<'TOverall, 'Error, unit>(fun sm -> + (body e.Current).Invoke(&sm) + ) ) ) ) @@ -188,7 +197,9 @@ type TaskValidationBuilderBase() = ) - member inline this.Source(taskValidation: TaskValidation<'T, 'Error>) : TaskValidation<'T, 'Error> = + member inline this.Source + (taskValidation: TaskValidation<'T, 'Error>) + : TaskValidation<'T, 'Error> = taskValidation @@ -202,7 +213,9 @@ type TaskValidationBuilder() = // 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> = + static member RunDynamic + (code: TaskValidationCode<'T, 'Error, 'T>) + : TaskValidation<'T, 'Error> = let mutable sm = TaskValidationStateMachine<'T, 'Error>() let initialResumptionFunc = @@ -285,7 +298,9 @@ type BackgroundTaskValidationBuilder() = inherit TaskValidationBuilderBase() - static member RunDynamic(code: TaskValidationCode<'T, 'Error, 'T>) : TaskValidation<'T, 'Error> = + 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 @@ -327,7 +342,9 @@ type BackgroundTaskValidationBuilder() = isNull SynchronizationContext.Current && obj.ReferenceEquals(TaskScheduler.Current, TaskScheduler.Default) then - sm.Data.MethodBuilder <- AsyncTaskValidationMethodBuilder<'T, 'Error>.Create() + sm.Data.MethodBuilder <- + AsyncTaskValidationMethodBuilder<'T, 'Error>.Create() + sm.Data.MethodBuilder.Start(&sm) sm.Data.MethodBuilder.Task else @@ -515,7 +532,9 @@ module TaskValidationCEExtensionsHighPriority = 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>) = + member inline _.MergeSources + (t1: TaskValidation<'T, 'Error>, t2: TaskValidation<'T1, 'Error>) + = TaskValidation.zip t1 t2 member inline _.Source(s: #seq<_>) = s @@ -546,9 +565,11 @@ module TaskValidationCEExtensionsHighPriority2 = result |> Async.StartImmediateAsTask - member inline _.Source(t: ValueTask>) : Task> = task { return! t } + member inline _.Source(t: ValueTask>) : Task> = + task { return! t } - member inline _.Source(result: Validation<_, _>) : Task> = Task.singleton result + member inline _.Source(result: Validation<_, _>) : Task> = + Task.singleton result member inline _.Source(result: Choice<_, _>) : Task> = result diff --git a/tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs b/tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs index cfe85941..5e84e2d0 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs @@ -21,121 +21,130 @@ 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) + <| fun () -> + task { + let! result = TaskValidation.map2 location (lift validLatR) (lift validLngR) - return - result - |> Expect.hasOkValue validLocation - } + 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) + <| fun () -> + task { + let! result = TaskValidation.map2 location (lift invalidLatR) (lift validLngR) - return - result - |> Expect.hasErrorValue [ invalidLatMsg ] - } + 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) + <| fun () -> + task { + let! result = TaskValidation.map2 location (lift validLatR) (lift invalidLngR) - return - result - |> Expect.hasErrorValue [ invalidLngMsg ] - } + 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 - ] - } + <| 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 - } + <| 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 ] - } + <| 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) + <| fun () -> + task { + let! result = + TaskValidation.map3 + createPostRequest + (lift validLatR) + (lift invalidLngR) + (lift validTweetR) - return - result - |> Expect.hasErrorValue [ invalidLngMsg ] - } + 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 ] - } + <| 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 - ] - } + <| fun () -> + task { + let! result = + TaskValidation.map3 + createPostRequest + (lift invalidLatR) + (lift invalidLngR) + (lift emptyInvalidTweetR) + + return + result + |> Expect.hasErrorValue [ + invalidLatMsg + invalidLngMsg + emptyTweetErrMsg + ] + } ] @@ -143,32 +152,34 @@ 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 - } + <| 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 ] - } + <| fun () -> + task { + let! result = + TaskValidation.apply + (Ok remainingCharacters + |> Task.singleton) + (lift emptyInvalidTweetR) + + return + result + |> Expect.hasErrorValue [ emptyTweetErrMsg ] + } ] @@ -176,209 +187,223 @@ 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 - } + <| 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 - } + <| 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" - } + <| 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" - } + <| 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" - } + <| 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" - } + <| 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" - } + <| 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" - } + <| 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" - } + <| 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" ] - } + <| 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" - } + <| 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" - } + <| 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" - } + <| 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" ] - } + <| fun () -> + task { + let! result = + (Error [ "First" ] + |> Task.singleton) + |> TaskValidation.orElseWith (fun _ -> + Error [ "Second" ] + |> Task.singleton + ) + + return + result + |> Expect.hasErrorValue [ "Second" ] + } ] let allTests = diff --git a/tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs b/tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs index 4fc63bb0..42039b0f 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs @@ -1,361 +1,414 @@ module TaskValidationCETests -#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 FsToolkit.ErrorHandling +open System.Threading.Tasks let ``TaskValidationCE return Tests`` = - testList "TaskValidationCE return Tests" [ + testList "TaskValidationCE Tests" [ testCaseTask "Return string" - <| fun () -> task { - let data = "Foo" - let! actual = taskValidation { return data } - Expect.equal actual (Ok data) "Should be ok" - } + <| 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 result" - <| fun () -> task { - let data = Ok "Foo" - let! actual = taskValidation { return! data } - Expect.equal actual (data) "Should be ok" - } - testCaseTask "Return Error result" - <| fun () -> task { - let innerData = "Foo" - let! expected = TaskValidation.error innerData - let data = Validation.Error [ innerData ] - let! actual = taskValidation { return! data } - Expect.equal actual expected "Should be error" - } - testCaseTask "Return Ok Choice" - <| fun () -> task { - let innerData = "Foo" - let data = Choice1Of2 innerData - let! actual = taskValidation { return! data } - Expect.equal actual (Ok innerData) "Should be ok" - } - testCaseTask "Return Error Choice" - <| fun () -> task { - let innerData = "Foo" - let! expected = TaskValidation.error innerData - let data = Choice2Of2 innerData - let! actual = taskValidation { return! data } - Expect.equal actual expected "Should be error" - } testCaseTask "Return Ok Validation" - <| fun () -> task { - let innerData = "Foo" - let data = Validation.ok innerData - let! actual = taskValidation { return! data } - Expect.equal actual (Ok innerData) "Should be ok" - } - testCaseTask "Return Error Validation" - <| fun () -> task { - let innerData = "Foo" - let expected = Validation.error innerData - let data = TaskValidation.error innerData - let! actual = taskValidation { return! data } - Expect.equal actual expected "Should be ok" - } + <| 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 "let! Async" - <| fun () -> task { - let data = "Foo" - - let! actual = - taskValidation { - let! f = async { return data } - return f - } - - Expect.equal actual (Ok data) "Should be ok" - } - testCaseTask "let! Ok result" - <| fun () -> task { - let data = Ok "Foo" - - let! actual = - taskValidation { - let! f = data - return f - } - - Expect.equal actual data "Should be ok" - } - testCaseTask "let! Error result" - <| fun () -> task { - let innerData = "Foo" - let data = Validation.Error [ innerData ] - let! expected = TaskValidation.error innerData - - let! actual = - taskValidation { - let! f = data - return f - } - - Expect.equal actual expected "Should be ok" - } - testCaseTask "let! Ok Choice" - <| fun () -> task { - let innerData = "Foo" - let data = Choice1Of2 innerData - - let! actual = - taskValidation { - let! f = data - return f - } - - Expect.equal actual (Ok innerData) "Should be ok" - } - testCaseTask "let! Error Choice" - <| fun () -> task { - let innerData = "Foo" - let data = Choice2Of2 innerData - let! expected = TaskValidation.error innerData - - let! actual = - taskValidation { - let! f = data - return f - } - - Expect.equal actual expected "Should be ok" - } - testCaseTask "let! Ok Validation" - <| fun () -> task { - let innerData = "Foo" - - let! actual = - taskValidation { - let! f = validation { return innerData } - return f - } - - Expect.equal actual (Ok innerData) "Should be ok" - } - testCaseTask "let! Error Validation" - <| fun () -> task { - let innerData = "Foo" - let error = Error innerData - let expected = Error [ innerData ] - - let! actual = - taskValidation { - let! f = validation { return! error } - and! _ = validation { return! Ok innerData } - return f - } - - Expect.equal actual expected "Should be ok" - } - testCaseTask "do! Ok result" - <| fun () -> task { - let data = Ok() - let! actual = taskValidation { do! data } - Expect.equal actual data "Should be ok" - } - testCaseTask "do! Error result" - <| fun () -> task { - let innerData = () - let data = Validation.Error [ innerData ] - let! expected = TaskValidation.error innerData - let! actual = taskValidation { do! data } - Expect.equal actual expected "Should be error" - } - testCaseTask "do! Ok Choice" - <| fun () -> task { - let innerData = () - let! expected = TaskValidation.ok innerData - let data = Choice1Of2 innerData - let! actual = taskValidation { do! data } - Expect.equal actual expected "Should be ok" - } - testCaseTask "do! Error Choice" - <| fun () -> task { - let innerData = () - let! expected = TaskValidation.error innerData - let data = Choice2Of2 innerData - let! actual = taskValidation { do! data } - Expect.equal actual expected "Should be error" - } - testCaseTask "do! Ok Validation" - <| fun () -> task { - let innerData = () - let! expected = TaskValidation.ok innerData - let data = TaskValidation.ok innerData - let! actual = taskValidation { do! data } - Expect.equal actual expected "Should be ok" - } - testCaseTask "do! Error Validation" - <| fun () -> task { - let innerData = () - let! expected = TaskValidation.error innerData - let data = TaskValidation.error innerData - let! actual = taskValidation { do! data } - Expect.equal actual expected "Should be error" - } + 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 (Ok data) "Should be ok" - } + <| 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 + <| fun () -> + task { + let data = 42 - let! actual = - taskValidation { - let data = data + let! actual = + taskValidation { + let data = data - try - () - with _ -> - () + try + () + with _ -> + () - return data - } + return data + } - Expect.equal actual (Ok data) "Should be ok" - } + Expect.equal actual (Validation.ok data) "Should be ok" + } testCaseTask "Try Finally" - <| fun () -> task { - let data = 42 + <| fun () -> + task { + let data = 42 - let! actual = - taskValidation { - let data = data + let! actual = + taskValidation { + let data = data - try - () - finally - () + try + () + finally + () - return data - } + return data + } - Expect.equal actual (Ok data) "Should be ok" - } + Expect.equal actual (Validation.ok data) "Should be ok" + } ] -let makeDisposable callback = - { new System.IDisposable with - member _.Dispose() = callback () - } - 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 _ = makeDisposable (fun () -> isFinished <- true) - return data - } - - Expect.equal actual (Result.Ok data) "Should be ok" - Expect.isTrue isFinished "Expected disposable to be disposed" - } - + <| 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 = - makeDisposable (fun () -> isFinished <- true) - |> Ok - - return data - } - - Expect.equal actual (Ok data) "Should be ok" - Expect.isTrue isFinished "Expected disposable to be disposed" - } - - testCaseTask "disposable not disposed too early" - <| fun () -> task { - let mutable disposed = false - let mutable finished = false - let f1 _ = AsyncResult.ok 42 - - let! actual = - taskValidation { - use d = - 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 + <| 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 (Ok data) "Should be ok" - } -#endif + <| 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`` = @@ -368,242 +421,320 @@ let ``TaskValidationCE loop Tests`` = for maxIndex in maxIndices do testCaseTask - <| $"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 (Ok data) "Should be ok" - } + <| 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 + testCaseTask "while fail" + <| fun () -> + task { - let sideEffect () = - wasCalled <- true - "ok" + let mutable loopCount = 0 + let mutable wasCalled = false - let expected = Validation.error "NOPE" + let sideEffect () = + wasCalled <- true + "ok" - let data = [ - Validation.ok "42" - Validation.ok "1024" - expected - Validation.ok "1M" - Validation.ok "1M" - Validation.ok "1M" - ] + let expected = Validation.error "error" - let! actual = - taskValidation { - while loopCount < data.Length do - let! _ = data[loopCount] + let data = [ + Validation.ok "42" + Validation.ok "1024" + expected + Validation.ok "1M" + Validation.ok "1M" + Validation.ok "1M" + ] - loopCount <- - loopCount - + 1 + let! actual = + taskValidation { + while loopCount < data.Length do + let! x = data.[loopCount] - return sideEffect () - } + loopCount <- + loopCount + + 1 - Expect.equal loopCount 2 "Should only loop twice" - Expect.equal actual (Error [ "NOPE" ]) "Should be an error" - Expect.isFalse wasCalled "No additional side effects should occur" - } + 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 + <| fun () -> + task { + let data = 42 - let! actual = - taskValidation { - for _ in [ 1..10 ] do - () + let! actual = + taskValidation { + for i in [ 1..10 ] do + () - return data - } + return data + } - Expect.equal actual (Ok data) "Should be ok" - } + Expect.equal actual (Validation.ok data) "Should be ok" + } testCaseTask "for to" - <| fun () -> task { - let data = 42 + <| 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 _ = 1 to 10 do - () + let! actual = + taskValidation { + for i in data do + let! x = i - return data - } + loopCount <- + loopCount + + 1 - Expect.equal actual (Ok data) "Should be ok" - } + () + + 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 Result" - <| fun () -> task { - let! actual = - taskValidation { - let! a = Ok 3 - and! b = Ok 2 - and! c = Ok 1 - return a + b - c - } - - Expect.equal actual (Ok 4) "Should be ok" - } - testCaseTask "Happy Path Valiation" - <| 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 (Ok 4) "Should be ok" - } - - testCaseTask "Happy Path Result/Validation" - <| fun () -> task { - let! actual = - taskValidation { - let! a = TaskValidation.ok 3 - and! b = Validation.ok 2 - and! c = TaskValidation.ok 1 - return a + b - c - } - - Expect.equal actual (Ok 4) "Should be ok" - } + 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 (Ok 4) "Should be ok" - } - - testCaseTask "Happy Path Result/Choice/Task/Validation" - <| fun () -> task { - let! actual = - taskValidation { - let! a = Ok 3 - and! b = Choice1Of2 2 - and! c = TaskValidation.ok 1 - - return a + b - c - } - - Expect.equal actual (Ok 4) "Should be ok" - } - - testCaseTask "Sad Path Async Result/Async Result" - <| fun () -> task { - let expected = - Error [ - "Hello" - "World" - ] - - let! actual = - taskValidation { - let! _ = async { return Error "Hello" } - and! _ = async { return Error "World" } - return () - } - - Expect.equal actual expected "Should be error" - } - -#if !FABLE_COMPILER - - testCaseTask "Sad Path Task Result/Task Result" - <| fun () -> task { - let expected = - Error [ - "Hello" - "World" - ] - - let! actual = - taskValidation { - let! _ = task { return Error "Hello" } - and! _ = task { return Error "World" } - return () - } + <| 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" + } - Expect.equal actual expected "Should be error" - } - -#endif - - 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 = Validation.error "Error 1" - and! d = Validation.error "Error 2" - - return - a + b - - c - - d - } + 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" + } + ] - Expect.equal actual expected "Should be Error" - } +let ``TaskValidationCE inference checks`` = + testList "TaskValidationCE inference checks" [ + testCase "Inference checks" + <| fun () -> + // Compilation is success + let f res = taskValidation { return! res () } - testCaseTask "Fail Path Validation" - <| fun () -> task { - let expected = TaskValidation.error "TryParse failure" - let! expected' = expected - - let! actual = - taskValidation { - let! a = TaskValidation.ok 3 - and! b = TaskValidation.ok 2 - and! c = expected - return a + b - c - } - - Expect.equal actual expected' "Should be Error" - } + f (TaskValidation.ok) + |> ignore ] let allTests = - testList "Validation CE Tests" [ + testList "TaskValidationCETests" [ ``TaskValidationCE return Tests`` ``TaskValidationCE return! Tests`` ``TaskValidationCE bind Tests`` @@ -612,4 +743,5 @@ let allTests = ``TaskValidationCE using Tests`` ``TaskValidationCE loop Tests`` ``TaskValidationCE applicative tests`` + ``TaskValidationCE inference checks`` ] From efcab72f4d78670378b679ba6eb486a2e29fc74e Mon Sep 17 00:00:00 2001 From: Matthew Watt Date: Sat, 1 Mar 2025 14:45:22 -0600 Subject: [PATCH 6/8] Move TaskValidation tests to FsToolkit.ErrorHandling.TaskResult.Tests project --- ...lkit.ErrorHandling.TaskResult.Tests.fsproj | 2 ++ .../TaskValidation.fs | 21 ++++++---------- .../TaskValidationCE.fs | 25 +++++++------------ .../FsToolkit.ErrorHandling.Tests.fsproj | 7 ------ tests/FsToolkit.ErrorHandling.Tests/Main.fs | 2 -- 5 files changed, 18 insertions(+), 39 deletions(-) rename tests/{FsToolkit.ErrorHandling.Tests => FsToolkit.ErrorHandling.TaskResult.Tests}/TaskValidation.fs (98%) rename tests/{FsToolkit.ErrorHandling.Tests => FsToolkit.ErrorHandling.TaskResult.Tests}/TaskValidationCE.fs (97%) 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.Tests/TaskValidation.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs similarity index 98% rename from tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs rename to tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs index 5e84e2d0..36afc459 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/TaskValidation.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs @@ -18,6 +18,7 @@ open FsToolkit.ErrorHandling.Operator.TaskValidation let lift = TaskValidation.ofResult +[] let map2Tests = testList "TaskValidation.map2 Tests" [ testCaseTask "map2 with two ok parts" @@ -64,6 +65,7 @@ let map2Tests = } ] +[] let map3Tests = testList "TaskValidation.map3 Tests" [ testCaseTask "map3 with three ok parts" @@ -147,7 +149,7 @@ let map3Tests = } ] - +[] let applyTests = testList "TaskValidation.apply tests" [ @@ -182,7 +184,7 @@ let applyTests = } ] - +[] let operatorsTests = testList "TaskValidation Operators Tests" [ @@ -219,6 +221,7 @@ let operatorsTests = } ] +[] let zipTests = testList "zip tests" [ testCaseTask "Ok, Ok" @@ -271,7 +274,7 @@ let zipTests = } ] - +[] let orElseTests = testList "TaskValidation.orElseWith Tests" [ testCaseTask "Ok Ok takes first Ok" @@ -339,6 +342,7 @@ let orElseTests = } ] +[] let orElseWithTests = testList "TaskValidation.orElse Tests" [ testCaseTask "Ok Ok takes first Ok" @@ -405,14 +409,3 @@ let orElseWithTests = |> Expect.hasErrorValue [ "Second" ] } ] - -let allTests = - testList "TaskValidationTests" [ - map2Tests - map3Tests - applyTests - operatorsTests - orElseTests - orElseWithTests - zipTests - ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs similarity index 97% rename from tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs rename to tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs index 42039b0f..4d94678a 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/TaskValidationCE.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs @@ -1,12 +1,10 @@ module TaskValidationCETests - open Expecto -open SampleDomain -open TestData open FsToolkit.ErrorHandling open System.Threading.Tasks +[] let ``TaskValidationCE return Tests`` = testList "TaskValidationCE Tests" [ testCaseTask "Return string" @@ -18,6 +16,7 @@ let ``TaskValidationCE return Tests`` = } ] +[] let ``TaskValidationCE return! Tests`` = testList "TaskValidationCE return! Tests" [ testCaseTask "Return Ok Validation" @@ -97,6 +96,7 @@ let ``TaskValidationCE return! Tests`` = } ] +[] let ``TaskValidationCE bind Tests`` = testList "TaskValidationCE bind Tests" [ testCaseTask "Bind Ok Validation" @@ -233,6 +233,7 @@ let ``TaskValidationCE bind Tests`` = } ] +[] let ``TaskValidationCE combine/zero/delay/run Tests`` = testList "TaskValidationCE combine/zero/delay/run Tests" [ testCaseTask "Zero/Combine/Delay/Run" @@ -270,6 +271,7 @@ let ``TaskValidationCE combine/zero/delay/run Tests`` = } ] +[] let ``TaskValidationCE try Tests`` = testList "TaskValidationCE try Tests" [ testCaseTask "Try With" @@ -312,6 +314,7 @@ let ``TaskValidationCE try Tests`` = } ] +[] let ``TaskValidationCE using Tests`` = testList "TaskValidationCE using Tests" [ testCaseTask "use normal disposable" @@ -411,6 +414,7 @@ let ``TaskValidationCE using Tests`` = } ] +[] let ``TaskValidationCE loop Tests`` = testList "TaskValidationCE loop Tests" [ yield! [ @@ -544,6 +548,7 @@ let ``TaskValidationCE loop Tests`` = } ] +[] let ``TaskValidationCE applicative tests`` = testList "TaskValidationCE applicative tests" [ testCaseTask "Happy Path TaskValidation" @@ -722,6 +727,7 @@ let ``TaskValidationCE applicative tests`` = } ] +[] let ``TaskValidationCE inference checks`` = testList "TaskValidationCE inference checks" [ testCase "Inference checks" @@ -732,16 +738,3 @@ let ``TaskValidationCE inference checks`` = f (TaskValidation.ok) |> ignore ] - -let allTests = - testList "TaskValidationCETests" [ - ``TaskValidationCE return Tests`` - ``TaskValidationCE return! Tests`` - ``TaskValidationCE bind Tests`` - ``TaskValidationCE combine/zero/delay/run Tests`` - ``TaskValidationCE try Tests`` - ``TaskValidationCE using Tests`` - ``TaskValidationCE loop Tests`` - ``TaskValidationCE applicative tests`` - ``TaskValidationCE inference checks`` - ] diff --git a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj index 90c52d5c..7b3842b1 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.Tests/FsToolkit.ErrorHandling.Tests.fsproj @@ -34,16 +34,9 @@ - - - - - 10.2.1 - - diff --git a/tests/FsToolkit.ErrorHandling.Tests/Main.fs b/tests/FsToolkit.ErrorHandling.Tests/Main.fs index 5e0f3141..118c6472 100644 --- a/tests/FsToolkit.ErrorHandling.Tests/Main.fs +++ b/tests/FsToolkit.ErrorHandling.Tests/Main.fs @@ -30,8 +30,6 @@ let allTests = AsyncResultOptionCETests.allTests AsyncValidationTests.allTests AsyncValidationCETests.allTests - TaskValidationTests.allTests - TaskValidationCETests.allTests ValidationTests.allTests ValidationCETests.allTests ValueOptionTests.allTests From 73fc89e103aab4794c3bc82ec856f7e9bca8adab Mon Sep 17 00:00:00 2001 From: Matthew Watt Date: Sat, 1 Mar 2025 15:21:02 -0600 Subject: [PATCH 7/8] Add gitbook documentation for TaskValidation --- gitbook/SUMMARY.md | 15 ++++++ gitbook/taskValidation/apply.md | 13 ++++++ gitbook/taskValidation/ce.md | 41 ++++++++++++++++ gitbook/taskValidation/error.md | 22 +++++++++ gitbook/taskValidation/index.md | 5 ++ gitbook/taskValidation/map.md | 41 ++++++++++++++++ gitbook/taskValidation/map2.md | 16 +++++++ gitbook/taskValidation/map3.md | 17 +++++++ gitbook/taskValidation/mapError.md | 44 ++++++++++++++++++ gitbook/taskValidation/mapErrors.md | 44 ++++++++++++++++++ gitbook/taskValidation/ofChoice.md | 27 +++++++++++ gitbook/taskValidation/ofResult.md | 27 +++++++++++ gitbook/taskValidation/operators.md | 72 +++++++++++++++++++++++++++++ gitbook/taskValidation/zip.md | 32 +++++++++++++ 14 files changed, 416 insertions(+) create mode 100644 gitbook/taskValidation/apply.md create mode 100644 gitbook/taskValidation/ce.md create mode 100644 gitbook/taskValidation/error.md create mode 100644 gitbook/taskValidation/index.md create mode 100644 gitbook/taskValidation/map.md create mode 100644 gitbook/taskValidation/map2.md create mode 100644 gitbook/taskValidation/map3.md create mode 100644 gitbook/taskValidation/mapError.md create mode 100644 gitbook/taskValidation/mapErrors.md create mode 100644 gitbook/taskValidation/ofChoice.md create mode 100644 gitbook/taskValidation/ofResult.md create mode 100644 gitbook/taskValidation/operators.md create mode 100644 gitbook/taskValidation/zip.md 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" ] } +``` From ae0e031bf1395653855444d385037363b3bdcf42 Mon Sep 17 00:00:00 2001 From: Matthew Watt Date: Sun, 2 Mar 2025 15:39:25 -0600 Subject: [PATCH 8/8] Add overload for plain Result case; add test handling multiple errors case --- .../TaskValidationCE.fs | 14 +++++++++++ .../TaskValidationCE.fs | 25 +++++++++++++++++++ 2 files changed, 39 insertions(+) diff --git a/src/FsToolkit.ErrorHandling/TaskValidationCE.fs b/src/FsToolkit.ErrorHandling/TaskValidationCE.fs index dfeb9c40..7a0fbe9f 100644 --- a/src/FsToolkit.ErrorHandling/TaskValidationCE.fs +++ b/src/FsToolkit.ErrorHandling/TaskValidationCE.fs @@ -1,5 +1,6 @@ namespace FsToolkit.ErrorHandling +open System open System.Threading.Tasks open System.Runtime.CompilerServices open System.Threading @@ -554,6 +555,19 @@ module TaskValidationCEExtensionsMediumPriority = |> 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 = diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs index 4d94678a..3d567ead 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs @@ -674,6 +674,31 @@ let ``TaskValidationCE applicative tests`` = 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 {