From 2ec82b5e8916a7140a0fc72f41d5be8e2de8d8e3 Mon Sep 17 00:00:00 2001 From: Victor Freire Date: Mon, 13 Nov 2023 18:11:49 -0300 Subject: [PATCH] Add TaskValidation module --- .../FsToolkit.ErrorHandling.TaskResult.fsproj | 5 +- .../TaskValidation.fs | 193 ++++++ .../TaskValidationCE.fs | 191 ++++++ .../TaskValidationOp.fs | 35 ++ ...lkit.ErrorHandling.TaskResult.Tests.fsproj | 4 +- .../TaskValidation.fs | 412 +++++++++++++ .../TaskValidationCE.fs | 575 ++++++++++++++++++ 7 files changed, 1413 insertions(+), 2 deletions(-) create mode 100644 src/FsToolkit.ErrorHandling.TaskResult/TaskValidation.fs create mode 100644 src/FsToolkit.ErrorHandling.TaskResult/TaskValidationCE.fs create mode 100644 src/FsToolkit.ErrorHandling.TaskResult/TaskValidationOp.fs create mode 100644 tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs create mode 100644 tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs diff --git a/src/FsToolkit.ErrorHandling.TaskResult/FsToolkit.ErrorHandling.TaskResult.fsproj b/src/FsToolkit.ErrorHandling.TaskResult/FsToolkit.ErrorHandling.TaskResult.fsproj index 751f1117..4ef24225 100644 --- a/src/FsToolkit.ErrorHandling.TaskResult/FsToolkit.ErrorHandling.TaskResult.fsproj +++ b/src/FsToolkit.ErrorHandling.TaskResult/FsToolkit.ErrorHandling.TaskResult.fsproj @@ -22,6 +22,9 @@ + + + @@ -29,4 +32,4 @@ - \ No newline at end of file + diff --git a/src/FsToolkit.ErrorHandling.TaskResult/TaskValidation.fs b/src/FsToolkit.ErrorHandling.TaskResult/TaskValidation.fs new file mode 100644 index 00000000..9511588e --- /dev/null +++ b/src/FsToolkit.ErrorHandling.TaskResult/TaskValidation.fs @@ -0,0 +1,193 @@ +namespace FsToolkit.ErrorHandling + +open System.Threading.Tasks + +/// TaskValidation<'a, 'err> is defined as Async> meaning you can use many of the functions found in the Result and Async module. +type TaskValidation<'ok, 'error> = Task> + +[] +module TaskValidation = + let inline ok (value: 'ok) : TaskValidation<'ok, 'error> = + Ok value + |> Task.FromResult + + let inline error (error: 'error) : TaskValidation<'ok, 'error> = + Error [ error ] + |> Task.FromResult + + let inline ofResult (result: Result<'ok, 'error>) : TaskValidation<'ok, 'error> = + Result.mapError List.singleton result + |> Task.FromResult + + + 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 + ) + } + + let inline retn (value: 'ok) : TaskValidation<'ok, 'error> = ok value + + let inline returnError (error: 'error) : TaskValidation<'ok, 'error> = + Error [ error ] + |> Task.FromResult + + let inline orElse + (ifError: TaskValidation<'ok, 'errorOutput>) + (result: TaskValidation<'ok, 'errorInput>) + : TaskValidation<'ok, 'errorOutput> = + task { + let! result = result + + return! + result + |> Result.either ok (fun _ -> ifError) + } + + let inline orElseWith + ([] ifErrorFunc: 'errorInput list -> TaskValidation<'ok, 'errorOutput>) + (result: TaskValidation<'ok, 'errorInput>) + : TaskValidation<'ok, 'errorOutput> = + task { + let! result = result + + return! + match result with + | Ok x -> ok x + | Error err -> ifErrorFunc err + } + + let inline map + ([] mapper: 'okInput -> 'okOutput) + (input: TaskValidation<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + task { + let! input = input + return Result.map mapper input + } + + 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 + ) + } + + 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 + ) + } + + let inline mapError + ([] errorMapper: 'errorInput -> 'errorOutput) + (input: TaskValidation<'ok, 'errorInput>) + : TaskValidation<'ok, 'errorOutput> = + task { + let! input = input + return Result.mapError (List.map errorMapper) input + } + + let inline mapErrors + ([] errorMapper: 'errorInput list -> 'errorOutput list) + (input: TaskValidation<'ok, 'errorInput>) + : TaskValidation<'ok, 'errorOutput> = + task { + let! input = input + return Result.mapError errorMapper input + } + + 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 + } + + let inline zip + (left: TaskValidation<'left, 'error>) + (right: TaskValidation<'right, 'error>) + : TaskValidation<'left * 'right, 'error> = + task { + let! left = left + let! right = right + + return + match left, right with + | Ok x1res, Ok x2res -> Ok(x1res, x2res) + | Error e, Ok _ -> Error e + | Ok _, Error e -> Error e + | Error e1, Error e2 -> Error(e1 @ e2) + } diff --git a/src/FsToolkit.ErrorHandling.TaskResult/TaskValidationCE.fs b/src/FsToolkit.ErrorHandling.TaskResult/TaskValidationCE.fs new file mode 100644 index 00000000..a42e817f --- /dev/null +++ b/src/FsToolkit.ErrorHandling.TaskResult/TaskValidationCE.fs @@ -0,0 +1,191 @@ +namespace FsToolkit.ErrorHandling + +open System +open System.Threading.Tasks + +[] +module TaskValidationCE = + + type TaskValidationBuilder() = + member inline _.Return(value: 'ok) : TaskValidation<'ok, 'error> = TaskValidation.ok value + + member inline _.ReturnFrom + (result: TaskValidation<'ok, 'error>) + : TaskValidation<'ok, 'error> = + result + + member inline _.Bind + ( + result: TaskValidation<'okInput, 'error>, + [] binder: 'okInput -> TaskValidation<'okOutput, 'error> + ) : TaskValidation<'okOutput, 'error> = + TaskValidation.bind binder result + + member inline this.Zero() : TaskValidation = this.Return() + + member inline _.Delay + ([] generator: unit -> TaskValidation<'ok, 'error>) + : unit -> TaskValidation<'ok, 'error> = + generator + + member inline _.Run + ([] generator: unit -> TaskValidation<'ok, 'error>) + : TaskValidation<'ok, 'error> = + generator () + + member inline this.Combine + ( + result: TaskValidation, + [] binder: unit -> TaskValidation<'ok, 'error> + ) : TaskValidation<'ok, 'error> = + this.Bind(result, binder) + + member inline this.TryWith + ( + [] generator: unit -> TaskValidation<'ok, 'error>, + [] handler: exn -> TaskValidation<'ok, 'error> + ) : TaskValidation<'ok, 'error> = + task { + return! + try + this.Run generator + with e -> + handler e + } + + member inline this.TryFinally + ( + [] generator: unit -> TaskValidation<'ok, 'error>, + [] compensation: unit -> unit + ) : TaskValidation<'ok, 'error> = + task { + return! + try + this.Run generator + finally + compensation () + } + + member inline this.Using + ( + resource: 'disposable :> IDisposable, + [] binder: 'disposable -> TaskValidation<'okOutput, 'error> + ) : TaskValidation<'okOutput, 'error> = + this.TryFinally( + (fun () -> binder resource), + (fun () -> + if not (obj.ReferenceEquals(resource, null)) then + resource.Dispose() + ) + ) + + member inline this.While + ( + [] guard: unit -> bool, + [] generator: unit -> TaskValidation + ) : TaskValidation = + let mutable doContinue = true + let mutable result = Ok() + + task { + while doContinue + && guard () do + let! x = generator () + + match x with + | Ok() -> () + | Error e -> + doContinue <- false + result <- Error e + + return result + } + + member inline this.For + ( + sequence: #seq<'ok>, + [] binder: 'ok -> TaskValidation + ) : TaskValidation = + this.Using( + sequence.GetEnumerator(), + fun enum -> this.While(enum.MoveNext, this.Delay(fun () -> binder enum.Current)) + ) + + member inline _.BindReturn + ( + input: TaskValidation<'okInput, 'error>, + [] mapper: 'okInput -> 'okOutput + ) : TaskValidation<'okOutput, 'error> = + TaskValidation.map mapper input + + member inline _.MergeSources + ( + left: TaskValidation<'left, 'error>, + right: TaskValidation<'right, 'error> + ) : TaskValidation<'left * 'right, 'error> = + TaskValidation.zip left right + + /// + /// Method lets us transform data types into our internal representation. This is the identity method to recognize the self type. + /// + /// See https://stackoverflow.com/questions/35286541/why-would-you-use-builder-source-in-a-custom-computation-expression-builder + /// + /// + /// + member inline _.Source(result: TaskValidation<'ok, 'error>) : TaskValidation<'ok, 'error> = + result + + let taskValidation = TaskValidationBuilder() + +[] +module HighPriority = + + // Having members as extensions gives them lower priority in + // overload resolution and allows skipping more type annotations. + type TaskValidationBuilder with + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(s: Task>) : TaskValidation<_, 'error> = + s + |> TaskResult.mapError (fun e -> [ e ]) + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(s: Result<'ok, 'error>) : TaskValidation<'ok, 'error> = + TaskValidation.ofResult s + + /// + /// Method lets us transform data types into our internal representation. + /// + /// + member inline _.Source(a: Task<'ok>) : TaskValidation<'ok, 'error> = + task { + let! result = a + return! TaskValidation.ok result + } + + /// + /// Method lets us transform data types into our internal representation. + /// + /// + member inline _.Source(choice: Choice<'ok, 'error>) : TaskValidation<'ok, 'error> = + TaskValidation.ofChoice choice + + /// + /// Needed to allow `for..in` and `for..do` functionality + /// + member inline _.Source(s: #seq<_>) : #seq<_> = s + +[] +module LowPriority = + + type TaskValidationBuilder with + + /// + /// Method lets us transform data types into our internal representation. + /// + member inline _.Source(s: Validation<'ok, 'error>) : TaskValidation<'ok, 'error> = + Task.FromResult s diff --git a/src/FsToolkit.ErrorHandling.TaskResult/TaskValidationOp.fs b/src/FsToolkit.ErrorHandling.TaskResult/TaskValidationOp.fs new file mode 100644 index 00000000..3f36e0a7 --- /dev/null +++ b/src/FsToolkit.ErrorHandling.TaskResult/TaskValidationOp.fs @@ -0,0 +1,35 @@ +namespace FsToolkit.ErrorHandling.Operator.TaskValidation + +open FsToolkit.ErrorHandling + +[] +module TaskValidation = + let inline () + ([] mapper: 'okInput -> 'okOutput) + (input: TaskValidation<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.map mapper input + + let inline () + ([] mapper: 'okInput -> 'okOutput) + (input: Result<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.map mapper (TaskValidation.ofResult input) + + let inline (<*>) + (applier: TaskValidation<('okInput -> 'okOutput), 'error>) + (input: TaskValidation<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.apply applier input + + let inline (<*^>) + (applier: TaskValidation<('okInput -> 'okOutput), 'error>) + (input: Result<'okInput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.apply applier (TaskValidation.ofResult input) + + let inline (>>=) + (input: TaskValidation<'okInput, 'error>) + ([] binder: 'okInput -> TaskValidation<'okOutput, 'error>) + : TaskValidation<'okOutput, 'error> = + TaskValidation.bind binder input diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj index 154963c0..2023dfe7 100644 --- a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/FsToolkit.ErrorHandling.TaskResult.Tests.fsproj @@ -28,6 +28,8 @@ + + @@ -35,4 +37,4 @@ - \ No newline at end of file + diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs new file mode 100644 index 00000000..3797057a --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidation.fs @@ -0,0 +1,412 @@ +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 +open System.Threading.Tasks + +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.FromResult + ) + + return + result + |> Expect.hasOkValue 274 + } + + testCaseTask "apply with Error" + <| fun () -> + task { + let! result = + TaskValidation.apply + (Ok remainingCharacters + |> Task.FromResult) + (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.FromResult + ) + + 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.FromResult) + (Ok 2 + |> Task.FromResult) + + Expect.equal actual (Ok(1, 2)) "Should be ok" + } + testCaseTask "Ok, Error" + <| fun () -> + task { + let! actual = + TaskValidation.zip + (Ok 1 + |> Task.FromResult) + (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.FromResult) + + 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.FromResult) + |> TaskValidation.orElse ( + Ok "Second" + |> Task.FromResult + ) + + return + result + |> Expect.hasOkValue "First" + } + testCaseTask "Ok Error takes first Ok" + <| fun () -> + task { + let! result = + (Ok "First" + |> Task.FromResult) + |> TaskValidation.orElse ( + Error [ "Second" ] + |> Task.FromResult + ) + + return + result + |> Expect.hasOkValue "First" + } + testCaseTask "Error Ok takes second Ok" + <| fun () -> + task { + let! result = + (Error [ "First" ] + |> Task.FromResult) + |> TaskValidation.orElse ( + Ok "Second" + |> Task.FromResult + ) + + return + result + |> Expect.hasOkValue "Second" + } + testCaseTask "Error Error takes second error" + <| fun () -> + task { + let! result = + (Error [ "First" ] + |> Task.FromResult) + |> TaskValidation.orElse ( + Error [ "Second" ] + |> Task.FromResult + ) + + return + result + |> Expect.hasErrorValue [ "Second" ] + } + ] + +let orElseWithTests = + testList "TaskValidation.orElse Tests" [ + testCaseTask "Ok Ok takes first Ok" + <| fun () -> + task { + let! result = + (Ok "First" + |> Task.FromResult) + |> TaskValidation.orElseWith (fun _ -> + Ok "Second" + |> Task.FromResult + ) + + return + result + |> Expect.hasOkValue "First" + } + testCaseTask "Ok Error takes first Ok" + <| fun () -> + task { + let! result = + (Ok "First" + |> Task.FromResult) + |> TaskValidation.orElseWith (fun _ -> + Error [ "Second" ] + |> Task.FromResult + ) + + return + result + |> Expect.hasOkValue "First" + } + testCaseTask "Error Ok takes second Ok" + <| fun () -> + task { + let! result = + (Error [ "First" ] + |> Task.FromResult) + |> TaskValidation.orElseWith (fun _ -> + Ok "Second" + |> Task.FromResult + ) + + return + result + |> Expect.hasOkValue "Second" + } + testCaseTask "Error Error takes second error" + <| fun () -> + task { + let! result = + (Error [ "First" ] + |> Task.FromResult) + |> TaskValidation.orElseWith (fun _ -> + Error [ "Second" ] + |> Task.FromResult + ) + + return + result + |> Expect.hasErrorValue [ "Second" ] + } + ] + +let allTests = + testList "TaskValidationTests" [ + map2Tests + map3Tests + applyTests + operatorsTests + orElseTests + orElseWithTests + zipTests + ] diff --git a/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs new file mode 100644 index 00000000..f8b709fa --- /dev/null +++ b/tests/FsToolkit.ErrorHandling.TaskResult.Tests/TaskValidationCE.fs @@ -0,0 +1,575 @@ +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 TestHelpers +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 = 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! Task" + <| fun () -> + task { + let data = "Foo" + + let! actual = + taskValidation { + let! f = fun () -> task { 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 = 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 expected = Error [ innerData ] + + let! actual = + taskValidation { + let! f = validation { return! expected } + 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 = 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 () = + { new System.IDisposable with + member this.Dispose() = () + } + +let ``TaskValidationCE using Tests`` = + testList "TaskValidationCE using Tests" [ + testCaseTask "use normal disposable" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValidation { + use d = makeDisposable () + return data + } + + Expect.equal actual (Ok data) "Should be ok" + } + testCaseTask "use! normal wrapped disposable" + <| fun () -> + task { + let data = 42 + + let! actual = + taskValidation { + use! d = + makeDisposable () + |> Ok + + return data + } + + Expect.equal actual (Ok data) "Should be ok" + } + 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" + } + ] + +let ``TaskValidationCE loop Tests`` = + testList "TaskValidationCE loop Tests" [ + yield! [ + let maxIndices = [ + 10 + 1000000 + ] + + for maxIndex in maxIndices do + testCaseTask + <| sprintf "While - %i" maxIndex + <| fun () -> + task { + let data = 42 + let mutable index = 0 + + let! actual = + taskValidation { + while index < maxIndex do + index <- index + 1 + + return data + } + + Expect.equal index maxIndex "Index should reach maxIndex" + Expect.equal actual (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 = Error "NOPE" + + let data = [ + Ok "42" + Ok "1024" + expected + Ok "1M" + Ok "1M" + Ok "1M" + ] + + let! actual = + taskValidation { + while loopCount < data.Length do + let! x = data.[loopCount] + + loopCount <- + loopCount + + 1 + + return sideEffect () + } + + Expect.equal loopCount 2 "Should only loop twice" + Expect.equal actual (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 i 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 i = 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/Valiation" + <| fun () -> + task { + let! actual = + taskValidation { + let! a = TaskValidation.ok 3 + and! b = 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/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 "Fail Path Result" + <| fun () -> + task { + let expected = + Error [ + "Error 1" + "Error 2" + ] + + let! actual = + taskValidation { + let! a = Ok 3 + and! b = Ok 2 + and! c = Error "Error 1" + and! d = Error "Error 2" + + return + a + b + - c + - d + } + + Expect.equal actual expected "Should be Error" + } + + testCaseTask "Fail Path Validation" + <| fun () -> + task { + let expected = 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`` + ]