diff --git a/README.md b/README.md index e797c4b..c65c8b7 100644 --- a/README.md +++ b/README.md @@ -31,6 +31,8 @@ - [`refuteWithProof`](#refutewithproof) - [`refuteEachWith`](#refuteeachwith) - [`refuteEachWithProof`](#refuteeachwithproof) + - [`refuteWithValidation` **(New)**](#refutewithvalidation-new) + - [`refuteEachWithValidation` **(New)**](#refuteeachwithvalidation-new) - [`dispute*` Operations](#dispute-operations) - [`dispute`](#dispute) - [`disputeMany`](#disputemany) @@ -63,6 +65,28 @@ - [The `isGreaterThan` Helper](#the-isgreaterthan-helper) - [The `isLessThanOrEqual` Helper](#the-islessthanorequal-helper) - [The `isGreaterThanOrEqual` Helper](#the-isgreaterthanorequal-helper) + - [The `matchesRegex` Helper **(New)**](#the-matchesregex-helper-new) + - [The `containsAny` Helper **(New)**](#the-containsany-helper-new) + - [The `containsAll` Helper **(New)**](#the-containsall-helper-new) + - [The `startsWith` Helper **(New)**](#the-startswith-helper-new) + - [The `endsWith` Helper **(New)**](#the-endswith-helper-new) + - [The `isAlphanumeric` Helper **(New)**](#the-isalphanumeric-helper-new) + - [The `isAlpha` Helper **(New)**](#the-isalpha-helper-new) + - [The `isNumeric` Helper **(New)**](#the-isnumeric-helper-new) + - [The `inRange` Helper **(New)**](#the-inrange-helper-new) + - [The `inRangeExclusive` Helper **(New)**](#the-inrangeexclusive-helper-new) + - [The `isPositive` Helper **(New)**](#the-ispositive-helper-new) + - [The `isNegative` Helper **(New)**](#the-isnegative-helper-new) + - [The `isNonZero` Helper **(New)**](#the-isnonzero-helper-new) + - [The `isDistinct` Helper **(New)**](#the-isdistinct-helper-new) + - [The `containsAllElems` Helper **(New)**](#the-containsallelems-helper-new) + - [The `containsAnyElem` Helper **(New)**](#the-containsanyelem-helper-new) + - [The `allMatch` Helper **(New)**](#the-allmatch-helper-new) + - [The `anyMatch` Helper **(New)**](#the-anymatch-helper-new) + - [The `noneMatch` Helper **(New)**](#the-nonematch-helper-new) + - [The `isBefore` Helper **(New)**](#the-isbefore-helper-new) + - [The `isAfter` Helper **(New)**](#the-isafter-helper-new) + - [The `isBetween` Helper **(New)**](#the-isbetween-helper-new) - [The `isValid` Helper](#the-isvalid-helper) - [The `isInvalid` Helper](#the-isinvalid-helper) - [The `flattenProofs` Helper](#the-flattenproofs-helper) @@ -70,6 +94,11 @@ - [Proof Helpers](#proof-helpers) - [`toResult` Helper](#toresult-helper) - [`toValidationFailures` Helper](#tovalidationfailures-helper) + - [`Proof.sequence` Combinator **(New)**](#proofsequence-combinator-new) + - [`Proof.traverse` Combinator **(New)**](#prooftraverse-combinator-new) + - [`Proof.bind` Combinator **(New)**](#proofbind-combinator-new) + - [`Proof.apply` Combinator **(New)**](#proofapply-combinator-new) + - [`Proof.choose` Combinator **(New)**](#proofchoose-combinator-new) - [Data-Validation Library for Haskell](#data-validation-library-for-haskell) ## Getting Started @@ -1207,7 +1236,6 @@ validation { #### `refuteEachWithProof` - Similar to `refuteWithProof` but used for validating list like types. ```fsharp @@ -1219,6 +1247,65 @@ validation { } ``` +#### `refuteWithValidation` **(New)** + +This custom operation runs a proof-returning validator and maps its failure type into your validation context's failure type. +It ends validation immediately if the proof is invalid. + +**Example:** + +```fsharp +type AppFailure = + | ValidationError + | OtherError + +type InnerFailure = InvalidFormat + +let validate (str: string) : Proof = + match System.Int32.TryParse(str) with + | (true, num) -> Valid num + | (false, _) -> Invalid ([InvalidFormat], Map.empty) + +validation { + withValue "42" + refuteWithValidation validate (fun _ -> ValidationError) + qed id +} |> fromVCtx +// Result: Valid 42 + +validation { + withValue "invalid" + refuteWithValidation validate (fun _ -> ValidationError) + qed id +} |> fromVCtx +// Result: Invalid ([ValidationError], Map.empty) +``` + +#### `refuteEachWithValidation` **(New)** + +Similar to `refuteWithValidation` but applies the validation to each element in a collection. +Failures from the inner proof are mapped and collected per element. + +**Example:** + +```fsharp +type AppFailure = ValidationError + +type InnerFailure = InvalidFormat + +let validate (str: string) : Proof = + match System.Int32.TryParse(str) with + | (true, num) -> Valid num + | (false, _) -> Invalid ([InvalidFormat], Map.empty) + +validation { + withValue ["1"; "2"; "invalid"] + refuteEachWithValidation validate (fun _ -> ValidationError) + qed id +} |> fromVCtx +// Result: Invalid - element at index 2 failed +``` + ### `dispute*` Operations It is always good to collect as many validation failures as possible before ending validation. @@ -1265,7 +1352,7 @@ validation { then Some InvalidString else None ) - // value is of type `string` here + // value is still of type `string option` here (dispute does not transform) ... } ``` @@ -1422,8 +1509,9 @@ There is an overload to the operator that takes a function with the signature `i #### `validateEach` -This function accepts a function with a signature of `'A -> VCtx<'F, 'B>` that validates each element. -The result is created from the `validation` computation expression. +This function accepts a function with a signature of `'A -> VCtx<'F, ValueCtx<'B>>` that validates each element. +The function should be contained in the `validation` computation expression, which returns the appropriate `VCtx` type wrapping a `ValueCtx`. +The result accumulates all validation failures across elements while preserving valid transformed values. ```fsharp validation { @@ -1434,6 +1522,8 @@ validation { } ``` +There is also an overload that takes a function with the signature `int -> 'A -> VCtx<'F, ValueCtx<'B>>` where the first parameter is the index of the element. + ## Validation Helpers ### The `isRequired` Helper @@ -1526,6 +1616,630 @@ This function checks that a value is less or equal to than another value. This function is used with the `dispute*` family of validation operations. This function checks that a value is greater than or equal to another value. +### The `matchesRegex` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a string value matches the given regular expression pattern. + +**Example:** + +```fsharp +type Failure = InvalidFormat + +let email = "user@example.com" + +validation { + withValue email + disputeWithFact InvalidFormat (matchesRegex @"^[^@]+@[^@]+\.[^@]+$") + qed id +} |> fromVCtx +// Result: Valid "user@example.com" + +let email = "invalid-email" +validation { + withValue email + disputeWithFact InvalidFormat (matchesRegex @"^[^@]+@[^@]+\.[^@]+$") + qed id +} |> fromVCtx +// Result: Invalid ([InvalidFormat], Map.empty) +``` + +### The `containsAny` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a string contains at least one character from a given set. + +**Example:** + +```fsharp +type Failure = NoSpecialChar + +let password = "password@123" + +validation { + withValue password + disputeWithFact NoSpecialChar (containsAny "!@#$%^&*") + qed id +} |> fromVCtx +// Result: Valid "password@123" + +let password = "password123" +validation { + withValue password + disputeWithFact NoSpecialChar (containsAny "!@#$%^&*") + qed id +} |> fromVCtx +// Result: Invalid ([NoSpecialChar], Map.empty) +``` + +### The `containsAll` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a string contains all characters from a given set. + +**Example:** + +```fsharp +type Failure = MissingRequiredChar + +let password = "P@ssw0rd!" + +validation { + withValue password + disputeWithFact MissingRequiredChar (containsAll "aA0!") + qed id +} |> fromVCtx +// Result: Valid "P@ssw0rd!" - has lowercase 'a', uppercase 'A', digit '0', and '!' + +let password = "P@ssword" +validation { + withValue password + disputeWithFact MissingRequiredChar (containsAll "aA0!") + qed id +} |> fromVCtx +// Result: Invalid ([MissingRequiredChar], Map.empty) - missing digit +``` + +### The `startsWith` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a string value starts with a given prefix. + +**Example:** + +```fsharp +type Failure = InvalidPrefix + +let skuCode = "PROD-12345" + +validation { + withValue skuCode + disputeWithFact InvalidPrefix (startsWith "PROD-") + qed id +} |> fromVCtx +// Result: Valid "PROD-12345" + +let skuCode = "INV-12345" +validation { + withValue skuCode + disputeWithFact InvalidPrefix (startsWith "PROD-") + qed id +} |> fromVCtx +// Result: Invalid ([InvalidPrefix], Map.empty) +``` + +### The `endsWith` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a string value ends with a given suffix. + +**Example:** + +```fsharp +type Failure = InvalidFileType + +let fileName = "document.pdf" + +validation { + withValue fileName + disputeWithFact InvalidFileType (endsWith ".pdf") + qed id +} |> fromVCtx +// Result: Valid "document.pdf" + +let fileName = "document.txt" +validation { + withValue fileName + disputeWithFact InvalidFileType (endsWith ".pdf") + qed id +} |> fromVCtx +// Result: Invalid ([InvalidFileType], Map.empty) +``` + +### The `isAlphanumeric` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a string contains only alphanumeric characters (letters and digits). + +**Example:** + +```fsharp +type Failure = InvalidCharacters + +let code = "ABC123" + +validation { + withValue code + disputeWithFact InvalidCharacters isAlphanumeric + qed id +} |> fromVCtx +// Result: Valid "ABC123" + +let code = "ABC-123" +validation { + withValue code + disputeWithFact InvalidCharacters isAlphanumeric + qed id +} |> fromVCtx +// Result: Invalid ([InvalidCharacters], Map.empty) +``` + +### The `isAlpha` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a string contains only alphabetic characters (letters only). + +**Example:** + +```fsharp +type Failure = ContainsNumbers + +let name = "JohnDoe" + +validation { + withValue name + disputeWithFact ContainsNumbers isAlpha + qed id +} |> fromVCtx +// Result: Valid "JohnDoe" + +let name = "John123" +validation { + withValue name + disputeWithFact ContainsNumbers isAlpha + qed id +} |> fromVCtx +// Result: Invalid ([ContainsNumbers], Map.empty) +``` + +### The `isNumeric` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a string contains only numeric characters (digits only). + +**Example:** + +```fsharp +type Failure = NotAllNumbers + +let pinCode = "1234" + +validation { + withValue pinCode + disputeWithFact NotAllNumbers isNumeric + qed id +} |> fromVCtx +// Result: Valid "1234" + +let pinCode = "12A4" +validation { + withValue pinCode + disputeWithFact NotAllNumbers isNumeric + qed id +} |> fromVCtx +// Result: Invalid ([NotAllNumbers], Map.empty) +``` + +### The `inRange` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a numeric value is within an inclusive range (min ≤ value ≤ max). + +**Example:** + +```fsharp +type Failure = OutOfRange + +let age = 25 + +validation { + withValue age + disputeWithFact OutOfRange (inRange 18 65) + qed id +} |> fromVCtx +// Result: Valid 25 + +let age = 10 +validation { + withValue age + disputeWithFact OutOfRange (inRange 18 65) + qed id +} |> fromVCtx +// Result: Invalid ([OutOfRange], Map.empty) +``` + +### The `inRangeExclusive` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a numeric value is within an exclusive range (min < value < max). + +**Example:** + +```fsharp +type Failure = OutOfRange + +let temperature = 25.5 + +validation { + withValue temperature + disputeWithFact OutOfRange (inRangeExclusive 0.0 100.0) + qed id +} |> fromVCtx +// Result: Valid 25.5 + +let temperature = 0.0 +validation { + withValue temperature + disputeWithFact OutOfRange (inRangeExclusive 0.0 100.0) // 0 is not included + qed id +} |> fromVCtx +// Result: Invalid ([OutOfRange], Map.empty) +``` + +### The `isPositive` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a numeric value is positive (greater than zero). + +**Example:** + +```fsharp +type Failure = MustBePositive + +let price = 29.99m + +validation { + withValue price + disputeWithFact MustBePositive isPositive + qed id +} |> fromVCtx +// Result: Valid 29.99m + +let price = -10.0m +validation { + withValue price + disputeWithFact MustBePositive isPositive + qed id +} |> fromVCtx +// Result: Invalid ([MustBePositive], Map.empty) +``` + +### The `isNegative` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a numeric value is negative (less than zero). + +**Example:** + +```fsharp +type Failure = MustBeNegative + +let temperature = -5 + +validation { + withValue temperature + disputeWithFact MustBeNegative isNegative + qed id +} |> fromVCtx +// Result: Valid -5 + +let temperature = 10 +validation { + withValue temperature + disputeWithFact MustBeNegative isNegative + qed id +} |> fromVCtx +// Result: Invalid ([MustBeNegative], Map.empty) +``` + +### The `isNonZero` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a numeric value is not equal to zero. + +**Example:** + +```fsharp +type Failure = CannotBeZero + +let divisor = 5 + +validation { + withValue divisor + disputeWithFact CannotBeZero isNonZero + qed id +} |> fromVCtx +// Result: Valid 5 + +let divisor = 0 +validation { + withValue divisor + disputeWithFact CannotBeZero isNonZero + qed id +} |> fromVCtx +// Result: Invalid ([CannotBeZero], Map.empty) +``` + +### The `isDistinct` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a collection contains no duplicate elements. + +**Example:** + +```fsharp +type Failure = DuplicateItems + +let tags = ["tech"; "programming"; "fsharp"] + +validation { + withValue tags + disputeWithFact DuplicateItems isDistinct + qed id +} |> fromVCtx +// Result: Valid ["tech"; "programming"; "fsharp"] + +let tags = ["tech"; "programming"; "tech"] +validation { + withValue tags + disputeWithFact DuplicateItems isDistinct + qed id +} |> fromVCtx +// Result: Invalid ([DuplicateItems], Map.empty) +``` + +### The `containsAllElems` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a collection contains all elements from another collection. + +**Example:** + +```fsharp +type Failure = MissingRequiredRoles + +let userRoles = ["admin"; "moderator"; "user"] +let requiredRoles = ["admin"; "user"] + +validation { + withValue userRoles + disputeWithFact MissingRequiredRoles (containsAllElems requiredRoles) + qed id +} |> fromVCtx +// Result: Valid ["admin"; "moderator"; "user"] + +let userRoles = ["moderator"; "user"] +validation { + withValue userRoles + disputeWithFact MissingRequiredRoles (containsAllElems requiredRoles) + qed id +} |> fromVCtx +// Result: Invalid ([MissingRequiredRoles], Map.empty) +``` + +### The `containsAnyElem` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a collection contains at least one element from another collection. + +**Example:** + +```fsharp +type Failure = NoValidOption + +let selectedOptions = ["optionA"; "optionB"] +let validOptions = ["optionA"; "optionC"] + +validation { + withValue selectedOptions + disputeWithFact NoValidOption (containsAnyElem validOptions) + qed id +} |> fromVCtx +// Result: Valid ["optionA"; "optionB"] + +let selectedOptions = ["optionB"; "optionD"] +validation { + withValue selectedOptions + disputeWithFact NoValidOption (containsAnyElem validOptions) + qed id +} |> fromVCtx +// Result: Invalid ([NoValidOption], Map.empty) +``` + +### The `allMatch` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that all elements in a collection satisfy a predicate. + +**Example:** + +```fsharp +type Failure = NotAllPositive + +let numbers = [1; 2; 3; 4; 5] + +validation { + withValue numbers + disputeWithFact NotAllPositive (allMatch (fun n -> n > 0)) + qed id +} |> fromVCtx +// Result: Valid [1; 2; 3; 4; 5] + +let numbers = [1; -2; 3; 4; 5] +validation { + withValue numbers + disputeWithFact NotAllPositive (allMatch (fun n -> n > 0)) + qed id +} |> fromVCtx +// Result: Invalid ([NotAllPositive], Map.empty) +``` + +### The `anyMatch` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that at least one element in a collection satisfies a predicate. + +**Example:** + +```fsharp +type Failure = NoAdminFound + +let users = [{ Name = "John"; Role = "user" }; { Name = "Jane"; Role = "admin" }] + +validation { + withValue users + disputeWithFact NoAdminFound (anyMatch (fun u -> u.Role = "admin")) + qed id +} |> fromVCtx +// Result: Valid [...] + +let users = [{ Name = "John"; Role = "user" }; { Name = "Jane"; Role = "user" }] +validation { + withValue users + disputeWithFact NoAdminFound (anyMatch (fun u -> u.Role = "admin")) + qed id +} |> fromVCtx +// Result: Invalid ([NoAdminFound], Map.empty) +``` + +### The `noneMatch` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that no elements in a collection satisfy a predicate. + +**Example:** + +```fsharp +type Failure = InvalidContentFound + +let words = ["hello"; "world"; "peaceful"] + +validation { + withValue words + disputeWithFact InvalidContentFound (noneMatch (fun w -> w.Contains("bad"))) + qed id +} |> fromVCtx +// Result: Valid ["hello"; "world"; "peaceful"] + +let words = ["hello"; "badword"; "peaceful"] +validation { + withValue words + disputeWithFact InvalidContentFound (noneMatch (fun w -> w.Contains("bad"))) + qed id +} |> fromVCtx +// Result: Invalid ([InvalidContentFound], Map.empty) +``` + +### The `isBefore` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a comparable value is before another value. +Works with any type that implements `IComparable` (e.g., `DateTime`). + +**Example:** + +```fsharp +type Failure = DateNotBefore + +let deadline = System.DateTime(2024, 12, 31) +let submissionDate = System.DateTime(2024, 12, 25) + +validation { + withValue submissionDate + disputeWithFact DateNotBefore (isBefore deadline) + qed id +} |> fromVCtx +// Result: Valid (DateTime 2024-12-25) + +let submissionDate = System.DateTime(2025, 1, 5) +validation { + withValue submissionDate + disputeWithFact DateNotBefore (isBefore deadline) + qed id +} |> fromVCtx +// Result: Invalid ([DateNotBefore], Map.empty) +``` + +### The `isAfter` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a comparable value is after another value. +Works with any type that implements `IComparable` (e.g., `DateTimeOffset`). + +**Example:** + +```fsharp +type Failure = TooEarly + +let eventStart = System.DateTime(2024, 12, 25) +let registrationDate = System.DateTime(2024, 12, 20) + +validation { + withValue registrationDate + disputeWithFact TooEarly (isAfter eventStart) |> not // Should be before + qed id +} |> fromVCtx +// Result: Valid - registration is before event + +let registrationDate = System.DateTime(2024, 12, 26) +validation { + withValue registrationDate + disputeWithFact TooEarly (isAfter eventStart) + qed id +} |> fromVCtx +// Result: Valid (DateTime 2024-12-26) - after event start +``` + +### The `isBetween` Helper **(New)** + +This function is used with the `dispute*` family of validation operations. +This function checks that a comparable value is between two other comparable values (inclusive). +Works with any type that implements `IComparable` (e.g., `DateTime`). +**Example:** + +```fsharp +type Failure = OutOfDateRange + +let startDate = System.DateTime(2024, 1, 1) +let endDate = System.DateTime(2024, 12, 31) +let checkDate = System.DateTime(2024, 6, 15) + +validation { + withValue checkDate + disputeWithFact OutOfDateRange (isBetween startDate endDate) + qed id +} |> fromVCtx +// Result: Valid (DateTime 2024-06-15) + +let checkDate = System.DateTime(2025, 1, 1) +validation { + withValue checkDate + disputeWithFact OutOfDateRange (isBetween startDate endDate) + qed id +} |> fromVCtx +// Result: Invalid ([OutOfDateRange], Map.empty) +``` + ### The `isValid` Helper This function is used with the `dispute*` family of validation operations. @@ -1559,6 +2273,174 @@ The `toResult` helper converts a `Proof<'F,'A>` value to a `Result<'A,Validation If you are only interested in the failures, you can use the `toValidationFailures` function to convert a `Proof<'F,'A>` to a `Option>`. +### `Proof.sequence` Combinator **(New)** + +The `Proof.sequence` combinator transforms a `Proof<'F, 'A> list` into a `Proof<'F, 'A list>`. +This is useful when you have a list of independent validations and want to collect them into a single proof with all failures aggregated. + +**Example:** + +```fsharp +type Failure = InvalidEmail + +let emailAddresses = + ["user1@example.com"; "invalid-email"; "user2@example.com"] + +let proofs = + emailAddresses + |> List.map (fun email -> + validation { + withValue email + disputeWithFact InvalidEmail (fun s -> s.Contains("@")) + qed id + } |> fromVCtx + ) + +let result = Proof.sequence proofs + +match result with +| Valid emails -> + printfn "All valid: %A" emails +| Invalid (failures, _) -> + printfn "Some failed: %A" failures + // Result: Invalid with list of failures +``` + +### `Proof.traverse` Combinator **(New)** + +The `Proof.traverse` combinator applies a validation function to each element in a list and sequences the results. +It's equivalent to `List.map` followed by `sequence`. + +**Example:** + +```fsharp +type Failure = InvalidNumber + +let validateNumber (str: string) : Proof = + match System.Int32.TryParse(str) with + | (true, num) -> Valid num + | (false, _) -> Invalid ([InvalidNumber], Map.empty) + +let inputs = ["1"; "abc"; "3"] + +let result = Proof.traverse validateNumber inputs + +match result with +| Valid numbers -> + printfn "All valid: %A" numbers +| Invalid (failures, _) -> + printfn "Some failed: %A" failures + // Result: Invalid ([InvalidNumber], ...) +``` + +### `Proof.bind` Combinator **(New)** + +The `Proof.bind` combinator provides monadic binding for the `Proof` type. +Use it to chain validations where the success of one validation depends on the value of another. + +**Example:** + +```fsharp +type Failure = InvalidFormat | OutOfRange + +let parseAndValidate (str: string) : Proof = + match System.Int32.TryParse(str) with + | (true, num) -> Valid num + | (false, _) -> Invalid ([InvalidFormat], Map.empty) + +let checkRange (num: int) : Proof = + if num >= 0 && num <= 100 then + Valid num + else + Invalid ([OutOfRange], Map.empty) + +let str = "50" +let result = Proof.bind checkRange (parseAndValidate str) + +match result with +| Valid num -> + printfn "Valid: %d" num // Output: Valid: 50 +| Invalid (failures, _) -> + printfn "Failed: %A" failures +``` + +### `Proof.apply` Combinator **(New)** + +The `Proof.apply` combinator provides applicative application for the `Proof` type. +Use it to apply a proof-wrapped function to a proof-wrapped value, combining all failures. + +**Example:** + +```fsharp +type Failure = InvalidNumber | InvalidOperation + +let makeAdder (x: string) : Proof int> = + match System.Int32.TryParse(x) with + | (true, num) -> Valid (fun y -> num + y) + | (false, _) -> Invalid ([InvalidNumber], Map.empty) + +let makeNumber (y: string) : Proof = + match System.Int32.TryParse(y) with + | (true, num) -> Valid num + | (false, _) -> Invalid ([InvalidNumber], Map.empty) + +let str1 = "10" +let str2 = "20" + +let adderProof = makeAdder str1 +let numProof = makeNumber str2 + +let result = Proof.apply adderProof numProof + +match result with +| Valid sum -> + printfn "Result: %d" sum // Output: Result: 30 +| Invalid (failures, _) -> + printfn "Failed: %A" failures +``` + +### `Proof.choose` Combinator **(New)** + +The `Proof.choose` combinator provides left-biased choice between two proofs. +If the first proof is valid, it's returned; otherwise, the second proof is returned. + +**Example:** + +```fsharp +type Failure = NotEmail | NotPhone + +let validateEmail (str: string) : Proof = + if str.Contains("@") then + Valid str + else + Invalid ([NotEmail], Map.empty) + +let validatePhone (str: string) : Proof = + if System.Char.IsDigit(str.[0]) then + Valid str + else + Invalid ([NotPhone], Map.empty) + +let contact = "user@example.com" +let result = Proof.choose (validateEmail contact) (validatePhone contact) + +match result with +| Valid contact -> + printfn "Valid contact: %s" contact +| Invalid (failures, _) -> + printfn "No valid contact: %A" failures + +// Try with invalid email but valid phone +let contact = "1234567890" +let result = Proof.choose (validateEmail contact) (validatePhone contact) + +match result with +| Valid contact -> + printfn "Valid contact: %s" contact // Fallback to phone validation +| Invalid (failures, _) -> + printfn "No valid contact: %A" failures +``` + ## Data-Validation Library for Haskell This library is based on our original library for [Haskell](https://www.haskell.org/). diff --git a/src/FSharp.Data.Validation/FSharp.Data.Validation.fsproj b/src/FSharp.Data.Validation/FSharp.Data.Validation.fsproj index 48649c5..dedd743 100644 --- a/src/FSharp.Data.Validation/FSharp.Data.Validation.fsproj +++ b/src/FSharp.Data.Validation/FSharp.Data.Validation.fsproj @@ -14,7 +14,11 @@ - + + + + + True \ diff --git a/src/FSharp.Data.Validation/Library.fs b/src/FSharp.Data.Validation/Library.fs deleted file mode 100644 index 20b2696..0000000 --- a/src/FSharp.Data.Validation/Library.fs +++ /dev/null @@ -1,121 +0,0 @@ -[] -module FSharp.Data.Validation.Default - -open System.Collections.Generic -open System.Linq -open System.Text.RegularExpressions - -let fromVCtx<'F, 'A> (ctx:VCtx<'F, 'A>): Proof<'F, 'A> = - match ctx with - | ValidCtx a -> Valid a - | DisputedCtx (gfs, lfs, _) -> Invalid (gfs, lfs) - | RefutedCtx (gfs, lfs) -> Invalid (gfs, lfs) - -/// Checks that an `Option` value is a `Some`. -/// If not, it adds the given failure to the result and validation end. -let isRequired (f:'F) (ma:'A option): Result<'A, 'F> = - match ma with - | None -> Error f - | Some a -> Ok a - -/// Checks that a `Option` value is a `Some` when some condition is true. -/// If the condition is met and the value is `None`, -/// it adds the given failure to the result and validation continues. -let isRequiredWhen f b (ma:'A option): 'F option = - match b with - | false -> None - | true -> - match ma with - | None -> Some f - | Some _ -> None - -/// Checks that a `Option` value is a `Some` when some condition is false. -/// If the condition is not met and the value is `Some`, -/// it adds the given failure to the result and validation continues. -let isRequiredUnless f b v = isRequiredWhen f (not b) v - -/// Checks that a `Result` value is a `Error`. -/// If not, it adds the given failure to the result and validation end. -let isError e = - match e with - | Error _ -> true - | Ok _ -> false - -/// Checks that a `Result` value is a `Ok`. -/// If not, it adds the given failure to the result and validation end. -let isOk e = - match e with - | Error _ -> false - | Ok _ -> true - -/// Checks that the `IEnumerable` is empty. -/// If not, it adds the given failure to the result and validation continues. -let isNull (a:#seq<_>) = not (a.Any()) - -/// Checks that the `IEnumerable` is not empty. -/// If empty, it adds the given failure to the result and validation continues. -let isNotNull (a:#seq<_>) = a.Any() - -/// Checks that a `IEnumerable` has a length equal to or greater than the given value. -/// If not, it adds the given failure to the result and validation continues. -let minLength l (a:#seq<_>) = a.Count() >= l - -/// Checks that a `IEnumerable` has a length equal to or less than the given value. -/// If not, it adds the given failure to the result and validation continues. -let maxLength l (a:#seq<_>) = a.Count() <= l - -/// Checks that a `IEnumerable` has a length equal to the given value. -/// If not, it adds the given failure to the result and validation continues. -let isLength l (a:#seq<_>) = a.Count() = l - -/// Checks that a value is equal to another. -/// If not, it adds the given failure to the result and validation continues. -let isEqual = (=) - -/// Checks that a value is not equal to another. -/// If equal, it adds the given failure to the result and validation continues. -let isNotEqual a b = a = b |> not - -/// Checks that b is less than a, as b is our validation input. -/// If not, it adds the given failure to the result and validation continues. -let isLessThan = (>) - -/// Checks that b is greater than a, as b is our validation input. -/// If not, it adds the given failure to the result and validation continues. -let isGreaterThan = (<) - -/// Checks that b is less than or equal to a, as b is our validation input. -/// If not, it adds the given failure to the result and validation continues. -let isLessThanOrEqual = (>=) - -/// Checks that b is greater than or equal to a, as b is our validation input. -/// If not, it adds the given failure to the result and validation continues. -let isGreaterThanOrEqual = (<=) - -/// Checks that a `IEnumerable` has a given element. -/// If not, it adds the given failure to the result and validation continues. -let hasElem e (a:#seq<_>) = a.Contains(e) - -/// Checks that a `IEnumerable` does not have a given element. -/// If it has element, it adds the given failure to the result and validation continues. -let doesNotHaveElem e (a:#seq<_>) = a.Contains(e) |> not - -/// tests if a 'Proof' is valid. -let isValid p = - match p with - | Valid _ -> true - | Invalid _ -> false - -/// tests if a 'Proof' is invalid. -let isInvalid p = isValid p |> not - -/// Flatten a list of proofs into a proof of the list -let flattenProofs ps = - let ps' = ps |> List.map (Proof.map (fun a -> [a])) - (Valid [], ps') ||> List.fold (Proof.combine (@)) - -/// Raises an `InvalidProofException` if the the given proof is `Invalid`. -let raiseIfInvalid msg p = - match p with - | Invalid (gfs,lfs) -> raise (InvalidProofException(msg, gfs, lfs)) - | Valid a -> a diff --git a/src/FSharp.Data.Validation/Proof.fs b/src/FSharp.Data.Validation/Proof.fs index 17d80a1..855d00d 100644 --- a/src/FSharp.Data.Validation/Proof.fs +++ b/src/FSharp.Data.Validation/Proof.fs @@ -8,95 +8,121 @@ open System.Text.Json.Serialization type ValidationFailures<'F> = { Failures: 'F list Fields: FailureMap<'F> } + and ValidationFailuresConverter<'F>() = inherit JsonConverter>() - member private this.mkName(ns:Name list) = - let rec mk (ns:Name list) (acc:string) = - match ns with - | [] -> acc - | n::ns' -> mk ns' (sprintf "%s.%s" acc (this.toCamelCase n.Value)) + + member private this.mkName(ns: Name list) = + let rec mk (ns: Name list) (acc: string) = match ns with - | [] -> String.Empty - | n::ns' -> mk ns' (this.toCamelCase n.Value) - member private this.toCamelCase (str:string) = - match str.Length with - | 0 -> str - | 1 -> str.ToLower() - | _ -> sprintf "%c%s" (Char.ToLowerInvariant(str[0])) (str.Substring(1)) - override this.Read(reader: byref, typ, opts) = - JsonSerializer.Deserialize>(&reader, opts) - override this.Write(writer, fs, opts) = - writer.WriteStartObject() - - writer.WriteStartArray("failures") - for f in fs.Failures do + | [] -> acc + | n :: ns' -> mk ns' (sprintf "%s.%s" acc (this.toCamelCase n.Value)) + + match ns with + | [] -> String.Empty + | n :: ns' -> mk ns' (this.toCamelCase n.Value) + + member private this.toCamelCase(str: string) = + match str.Length with + | 0 -> str + | 1 -> str.ToLower() + | _ -> sprintf "%c%s" (Char.ToLowerInvariant(str[0])) (str.Substring(1)) + + override this.Read(reader: byref, typ, opts) = + JsonSerializer.Deserialize>(&reader, opts) + + override this.Write(writer, fs, opts) = + writer.WriteStartObject() + + writer.WriteStartArray("failures") + + for f in fs.Failures do + writer.WriteStringValue(f.ToString()) + + writer.WriteEndArray() + + writer.WriteStartObject("fields") + + for (ns, fs) in Map.toSeq (fs.Fields) do + writer.WriteStartArray(this.mkName ns) + + for f in fs do writer.WriteStringValue(f.ToString()) + writer.WriteEndArray() - writer.WriteStartObject("fields") - for (ns,fs) in Map.toSeq(fs.Fields) do - writer.WriteStartArray(this.mkName ns) - for f in fs do - writer.WriteStringValue(f.ToString()) - writer.WriteEndArray() - writer.WriteEndObject() + writer.WriteEndObject() + + writer.WriteEndObject() + writer.Flush() - writer.WriteEndObject() - writer.Flush() and ValidationFailuresConverterFactory() = inherit JsonConverterFactory() - override this.CanConvert(typ) = - typ.GetGenericTypeDefinition() = typedefof> - override this.CreateConverter(typ, opts) = - let tArgs = typ.GetGenericArguments() - let t = typedefof>.MakeGenericType(tArgs) - Activator.CreateInstance(t) :?> JsonConverter + + override this.CanConvert(typ) = + typ.GetGenericTypeDefinition() = typedefof> + + override this.CreateConverter(typ, opts) = + let tArgs = typ.GetGenericArguments() + let t = typedefof>.MakeGenericType(tArgs) + Activator.CreateInstance(t) :?> JsonConverter [)>] type Proof<'F, 'A> = + /// Represents a successful validation with the valid value. | Valid of 'A + /// Represents a failed validation with global and field-specific failures. | Invalid of 'F list * FailureMap<'F> + and ProofConverter<'F, 'A>() = inherit JsonConverter>() - member private this.mkName(ns:Name list) = - let rec mk (ns:Name list) (acc:string) = - match ns with - | [] -> acc - | n::ns' -> mk ns' (sprintf "%s.%s" acc (this.toCamelCase n.Value)) + + member private this.mkName(ns: Name list) = + let rec mk (ns: Name list) (acc: string) = match ns with - | [] -> String.Empty - | n::ns' -> mk ns' (this.toCamelCase n.Value) - member private this.toCamelCase (str:string) = - match str.Length with - | 0 -> str - | 1 -> str.ToLower() - | _ -> sprintf "%c%s" (Char.ToLowerInvariant(str[0])) (str.Substring(1)) - override this.Read(reader: byref, typ, opts) = - JsonSerializer.Deserialize>(&reader, opts) - override this.Write(writer, proof, opts) = - match proof with - | Valid a -> JsonSerializer.Serialize(writer, a, opts) - | Invalid (gfs,lfs) -> JsonSerializer.Serialize(writer, { Failures = gfs; Fields = lfs }, opts) + | [] -> acc + | n :: ns' -> mk ns' (sprintf "%s.%s" acc (this.toCamelCase n.Value)) + + match ns with + | [] -> String.Empty + | n :: ns' -> mk ns' (this.toCamelCase n.Value) + + member private this.toCamelCase(str: string) = + match str.Length with + | 0 -> str + | 1 -> str.ToLower() + | _ -> sprintf "%c%s" (Char.ToLowerInvariant(str[0])) (str.Substring(1)) + + override this.Read(reader: byref, typ, opts) = + JsonSerializer.Deserialize>(&reader, opts) + + override this.Write(writer, proof, opts) = + match proof with + | Valid a -> JsonSerializer.Serialize(writer, a, opts) + | Invalid(gfs, lfs) -> JsonSerializer.Serialize(writer, { Failures = gfs; Fields = lfs }, opts) + and ProofConverterFactory() = inherit JsonConverterFactory() - override this.CanConvert(typ) = - typ.GetGenericTypeDefinition() = typedefof> - override this.CreateConverter(typ, opts) = - let tArgs = typ.GetGenericArguments() - let t = typedefof>.MakeGenericType(tArgs) - Activator.CreateInstance(t) :?> JsonConverter + + override this.CanConvert(typ) = + typ.GetGenericTypeDefinition() = typedefof> + + override this.CreateConverter(typ, opts) = + let tArgs = typ.GetGenericArguments() + let t = typedefof>.MakeGenericType(tArgs) + Activator.CreateInstance(t) :?> JsonConverter module Proof = /// Applies function to the proof value let map fn p = match p with - | Invalid (gfs, lfs) -> Invalid (gfs, lfs) - | Valid a -> Valid (fn a) + | Invalid(gfs, lfs) -> Invalid(gfs, lfs) + | Valid a -> Valid(fn a) /// Applies function to failure type let mapInvalid fn p = match p with - | Invalid (gfs, lfs) -> Invalid (List.map fn gfs, Map.map (fun _ s -> List.map fn s) lfs) + | Invalid(gfs, lfs) -> Invalid(List.map fn gfs, Map.map (fun _ s -> List.map fn s) lfs) | Valid a -> Valid a /// Combines two proofs using the provided function @@ -105,19 +131,69 @@ module Proof = match p1 with | Valid a1 -> match p2 with - | Valid a2 -> Valid (fn a1 a2) - | Invalid (gfs', lfs') -> Invalid (gfs', lfs') - | Invalid (gfs, lfs) -> + | Valid a2 -> Valid(fn a1 a2) + | Invalid(gfs', lfs') -> Invalid(gfs', lfs') + | Invalid(gfs, lfs) -> match p2 with - | Valid _ -> Invalid (gfs, lfs) - | Invalid (gfs', lfs') -> Invalid (gfs @ gfs', Utilities.mergeFailures lfs lfs') + | Valid _ -> Invalid(gfs, lfs) + | Invalid(gfs', lfs') -> Invalid(gfs @ gfs', Utilities.mergeFailures lfs lfs') + + /// Sequences a list of proofs into a proof of a list. + /// If all proofs are Valid, returns Valid with list of values. + /// If any are Invalid, aggregates all failures. + let sequence (proofs: Proof<'F, 'A> list) : Proof<'F, 'A list> = + let folder state proof = + combine (fun xs x -> xs @ [ x ]) state proof + + List.fold folder (Valid []) proofs + + /// Applies a function returning a proof to each element in a list and sequences the results. + /// If all applications are Valid, returns Valid with list of transformed values. + /// If any are Invalid, aggregates all failures. + let traverse (fn: 'A -> Proof<'F, 'B>) (items: 'A list) : Proof<'F, 'B list> = items |> List.map fn |> sequence + + /// Monadic bind for Proof. Chains proof-returning computations. + /// If the first proof is Invalid, returns it unchanged. + /// If the first proof is Valid, applies the function to the value. + let bind (fn: 'A -> Proof<'F, 'B>) (proof: Proof<'F, 'A>) : Proof<'F, 'B> = + match proof with + | Valid a -> fn a + | Invalid(gfs, lfs) -> Invalid(gfs, lfs) + + /// Applicative apply for Proof. Applies a proof of a function to a proof of a value. + /// If both are Valid, returns Valid with the function applied to the value. + /// If either is Invalid, aggregates failures. + let apply (fnProof: Proof<'F, ('A -> 'B)>) (valueProof: Proof<'F, 'A>) : Proof<'F, 'B> = + match fnProof with + | Valid fn -> + match valueProof with + | Valid a -> Valid(fn a) + | Invalid(gfs, lfs) -> Invalid(gfs, lfs) + | Invalid(gfs, lfs) -> + match valueProof with + | Valid _ -> Invalid(gfs, lfs) + | Invalid(gfs', lfs') -> Invalid(gfs @ gfs', Utilities.mergeFailures lfs lfs') + + /// Chooses the first Valid proof from two proofs. + /// If the first is Valid, returns it. + /// If the first is Invalid and second is Valid, returns the second. + /// If both are Invalid, returns the first. + let choose (first: Proof<'F, 'A>) (second: Proof<'F, 'A>) : Proof<'F, 'A> = + match first with + | Valid _ -> first + | Invalid _ -> + match second with + | Valid _ -> second + | Invalid _ -> first + /// Extracts the validation failures from a Proof, if any. let toValidationFailures p = match p with - | Valid a -> None - | Invalid (gfs,lfs) -> Some { Failures = gfs; Fields= lfs; } + | Valid a -> None + | Invalid(gfs, lfs) -> Some { Failures = gfs; Fields = lfs } + /// Converts a Proof to a Result, where Valid becomes Ok and Invalid becomes Error with ValidationFailures. let toResult p = match p with - | Valid a -> Ok a - | Invalid (gfs,lfs) -> Error { Failures = gfs; Fields= lfs; } + | Valid a -> Ok a + | Invalid(gfs, lfs) -> Error { Failures = gfs; Fields = lfs } diff --git a/src/FSharp.Data.Validation/Types.fs b/src/FSharp.Data.Validation/Types.fs index 5ccd1f6..c39ff6c 100644 --- a/src/FSharp.Data.Validation/Types.fs +++ b/src/FSharp.Data.Validation/Types.fs @@ -3,18 +3,21 @@ module FSharp.Data.Validation.Types open System -type Name = private { _value: string } with +type Name = + private + { _value: string } + member public this.Value = this._value -let mkName (n:string): Name option = +let mkName (n: string) : Name option = if String.IsNullOrEmpty(n.Trim()) then None else - Some { _value = n.Trim()} + Some { _value = n.Trim() } type FailureMap<'F> = Map -type InvalidProofException<'F>(msg, gfs : 'F list, lfs : FailureMap<'F>) = +type InvalidProofException<'F>(msg, gfs: 'F list, lfs: FailureMap<'F>) = inherit Exception(msg) member this.GlobalFailures = gfs member this.FieldFailures = lfs diff --git a/src/FSharp.Data.Validation/Utilities.fs b/src/FSharp.Data.Validation/Utilities.fs index d1e6dac..1471c20 100644 --- a/src/FSharp.Data.Validation/Utilities.fs +++ b/src/FSharp.Data.Validation/Utilities.fs @@ -1,39 +1,46 @@ module FSharp.Data.Validation.Utilities -// Given a sequence of options, return list of Some +/// Given a sequence of options, return list of Some let catOptions l = Seq.choose id l +/// Given a sequence of Result values, return list of Ok values. let oks l = - (Seq.empty, l) ||> Seq.fold (fun acc v -> + (Seq.empty, l) + ||> Seq.fold (fun acc v -> match v with | Error _ -> acc - | Ok a -> Seq.append acc [a] - ) + | Ok a -> Seq.append acc [ a ]) +/// Given a sequence of Result values, return list of Error values. let errors l = - (Seq.empty, l) ||> Seq.fold (fun acc v -> + (Seq.empty, l) + ||> Seq.fold (fun acc v -> match v with - | Error a -> Seq.append acc [a] - | Ok _ -> acc - ) + | Error a -> Seq.append acc [ a ] + | Ok _ -> acc) -let mergeFailures (a:FailureMap<'F>) (b:FailureMap<'F>): FailureMap<'F> = +/// Merges two FailureMaps by concatenating failure lists for matching keys. +let mergeFailures (a: FailureMap<'F>) (b: FailureMap<'F>) : FailureMap<'F> = let bs = Map.toList b - let rec mergeInto (am:FailureMap<'F>) (bs':(Name list * 'F list) list) = + + let rec mergeInto (am: FailureMap<'F>) (bs': (Name list * 'F list) list) = match bs' with - | [] -> am - | (ns, fs)::bs2 -> + | [] -> am + | (ns, fs) :: bs2 -> if Map.containsKey ns am then let vs = am[ns] @ fs mergeInto (Map.add ns vs am) bs2 else mergeInto (Map.add ns fs am) bs2 + mergeInto a bs -let mapKeys (fn:'K -> 'L) (m:Map<'K, 'T>): Map<'L, 'T> = +/// Maps the keys of a Map using the provided function. +let mapKeys (fn: 'K -> 'L) (m: Map<'K, 'T>) : Map<'L, 'T> = Map.toSeq m |> Seq.map (fun (k, v) -> (fn k, v)) |> Map.ofSeq +/// Tests if two values are equal and returns an option with the provided failure if not. let testMatch f a1 a2 = match a1 = a2 with - | true -> None + | true -> None | false -> Some f diff --git a/src/FSharp.Data.Validation/VCtx.fs b/src/FSharp.Data.Validation/VCtx.fs index a0fed30..a6fe1b5 100644 --- a/src/FSharp.Data.Validation/VCtx.fs +++ b/src/FSharp.Data.Validation/VCtx.fs @@ -5,43 +5,65 @@ open System.Linq.Expressions open FSharpPlus.Data +/// Represents the validation context, which can be valid, disputed, or refuted, along with any associated failures and +/// values. type VCtx<'F, 'A> = + /// Represents a valid context with the valid value. | ValidCtx of 'A + /// Represents a disputed context with global and field-specific failures, along with the value that is being + /// validated. | DisputedCtx of 'F list * FailureMap<'F> * 'A + /// Represents a refuted context with global and field-specific failures. | RefutedCtx of 'F list * FailureMap<'F> module VCtx = + /// Converts a VCtx to a Proof, where ValidCtx becomes Valid and both DisputedCtx and RefutedCtx become Invalid with + /// their respective failures. let bind fn c = match c with - | ValidCtx a -> fn a - | RefutedCtx (gfs,lfs) -> RefutedCtx (gfs,lfs) - | DisputedCtx (gfs,lfs,a) -> + | ValidCtx a -> fn a + | RefutedCtx(gfs, lfs) -> RefutedCtx(gfs, lfs) + | DisputedCtx(gfs, lfs, a) -> match fn a with - | ValidCtx b -> DisputedCtx (gfs,lfs,b) - | DisputedCtx (gfs',lfs',b) -> DisputedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs', b) - | RefutedCtx (gfs',lfs') -> RefutedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs') + | ValidCtx b -> DisputedCtx(gfs, lfs, b) + | DisputedCtx(gfs', lfs', b) -> DisputedCtx(gfs @ gfs', Utilities.mergeFailures lfs lfs', b) + | RefutedCtx(gfs', lfs') -> RefutedCtx(gfs @ gfs', Utilities.mergeFailures lfs lfs') + /// Maps a function over the value contained in the VCtx, preserving the validation context and any associated + /// failures. let map fn c = match c with - | ValidCtx a -> ValidCtx (fn a) - | DisputedCtx (gfs,lfs,a) -> DisputedCtx (gfs,lfs,fn a) - | RefutedCtx (gfs,lfs) -> RefutedCtx (gfs,lfs) + | ValidCtx a -> ValidCtx(fn a) + | DisputedCtx(gfs, lfs, a) -> DisputedCtx(gfs, lfs, fn a) + | RefutedCtx(gfs, lfs) -> RefutedCtx(gfs, lfs) let internal mkElementName i = match mkName (sprintf "[%i]" i) with - | None -> raise (InvalidOperationException()) - | Some n -> n + | None -> raise (InvalidOperationException()) + | Some n -> n - let applyFailures (v:ValueCtx<'A>) (gfs:'F list,lfs:FailureMap<'F>) (gfs':'F list,lfs':FailureMap<'F>): 'F list * FailureMap<'F> = + /// + /// Applies validation failures to a value context, adjusting the failure locations based on the context of the + /// value being validated (element index, field name, or global). + /// + /// The value context to which the failures should be applied. + /// The existing global and field-specific failures to be combined with the new failures. + /// The new global and field-specific failures to be applied to the value context. + /// A tuple containing the combined global failures and the combined field-specific failures, adjusted for the context of the value. + let applyFailures + (v: ValueCtx<'A>) + (gfs: 'F list, lfs: FailureMap<'F>) + (gfs': 'F list, lfs': FailureMap<'F>) + : 'F list * FailureMap<'F> = match v with - | Element (i, _a) -> + | Element(i, _a) -> let n = mkElementName i let lfs2 = Utilities.mapKeys (fun ns -> n :: ns) lfs' - let lfs3 = Map.add [n] gfs' Map.empty + let lfs3 = Map.add [ n ] gfs' Map.empty (gfs, Utilities.mergeFailures lfs <| Utilities.mergeFailures lfs3 lfs2) - | Field (n, _a) -> + | Field(n, _a) -> let lfs2 = Utilities.mapKeys (fun ns -> n :: ns) lfs' - let lfs3 = Map.add [n] gfs' Map.empty + let lfs3 = Map.add [ n ] gfs' Map.empty (gfs, Utilities.mergeFailures lfs <| Utilities.mergeFailures lfs3 lfs2) | Global _a -> (gfs @ gfs', Utilities.mergeFailures lfs lfs') @@ -57,408 +79,524 @@ module VCtx = /// This function takes two validation contexts v1 and v2 and returns a tupled validation context. /// Prioritizes refuted contexts over disputed contexts and disputed contexts over valid contexts. /// - let mergeSources (v1: VCtx<'F, 'A>) (v2: VCtx<'F, 'B>): VCtx<'F, 'A * 'B> = + let mergeSources (v1: VCtx<'F, 'A>) (v2: VCtx<'F, 'B>) : VCtx<'F, 'A * 'B> = match (v1, v2) with - | ValidCtx a, ValidCtx b -> ValidCtx (a, b) - | ValidCtx a, DisputedCtx (gfs', lfs', b) -> DisputedCtx (gfs', lfs', (a, b)) - | ValidCtx _, RefutedCtx (gfs', lfs') -> RefutedCtx (gfs', lfs') - | DisputedCtx (gfs, lfs, a), ValidCtx b -> DisputedCtx (gfs, lfs, (a, b)) - | DisputedCtx (gfs, lfs, a), DisputedCtx (gfs', lfs', b) -> DisputedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs', (a, b)) - | DisputedCtx (gfs, lfs, _), RefutedCtx (gfs', lfs') -> RefutedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs') - | RefutedCtx (gfs, lfs), ValidCtx _ -> RefutedCtx (gfs, lfs) - | RefutedCtx (gfs, lfs), DisputedCtx (gfs', lfs', _) -> RefutedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs') - | RefutedCtx (gfs, lfs), RefutedCtx (gfs', lfs') -> RefutedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs') + | ValidCtx a, ValidCtx b -> ValidCtx(a, b) + | ValidCtx a, DisputedCtx(gfs', lfs', b) -> DisputedCtx(gfs', lfs', (a, b)) + | ValidCtx _, RefutedCtx(gfs', lfs') -> RefutedCtx(gfs', lfs') + | DisputedCtx(gfs, lfs, a), ValidCtx b -> DisputedCtx(gfs, lfs, (a, b)) + | DisputedCtx(gfs, lfs, a), DisputedCtx(gfs', lfs', b) -> + DisputedCtx(gfs @ gfs', Utilities.mergeFailures lfs lfs', (a, b)) + | DisputedCtx(gfs, lfs, _), RefutedCtx(gfs', lfs') -> RefutedCtx(gfs @ gfs', Utilities.mergeFailures lfs lfs') + | RefutedCtx(gfs, lfs), ValidCtx _ -> RefutedCtx(gfs, lfs) + | RefutedCtx(gfs, lfs), DisputedCtx(gfs', lfs', _) -> RefutedCtx(gfs @ gfs', Utilities.mergeFailures lfs lfs') + | RefutedCtx(gfs, lfs), RefutedCtx(gfs', lfs') -> RefutedCtx(gfs @ gfs', Utilities.mergeFailures lfs lfs') type VCtxBuilder() = - member this.Bind(v:VCtx<'F, 'A>, fn:'A -> VCtx<'F, 'B>): VCtx<'F, 'B> = - VCtx.bind fn v + member this.Bind(v: VCtx<'F, 'A>, fn: 'A -> VCtx<'F, 'B>) : VCtx<'F, 'B> = VCtx.bind fn v - member this.MergeSources(v1: VCtx<'F, 'A>, v2: VCtx<'F, 'B>) = - VCtx.mergeSources v1 v2 + member this.MergeSources(v1: VCtx<'F, 'A>, v2: VCtx<'F, 'B>) = VCtx.mergeSources v1 v2 - member this.For(v:VCtx<'F, 'A>, fn:'A -> VCtx<'F, 'B>): VCtx<'F, 'B> = this.Bind(v, fn) + member this.For(v: VCtx<'F, 'A>, fn: 'A -> VCtx<'F, 'B>) : VCtx<'F, 'B> = this.Bind(v, fn) - member this.Return(a:'A): VCtx<'F, 'A> = ValidCtx a + member this.Return(a: 'A) : VCtx<'F, 'A> = ValidCtx a - member this.ReturnFrom(ctx:VCtx<'F, 'A>): VCtx<'F, 'A> = ctx + member this.ReturnFrom(ctx: VCtx<'F, 'A>) : VCtx<'F, 'A> = ctx - member this.Yield(a:'A) = this.Return(a) + member this.Yield(a: 'A) = this.Return(a) - member this.Delay(fn:unit -> VCtx<'F, 'A>): unit -> VCtx<'F, 'A> = fn + member this.Delay(fn: unit -> VCtx<'F, 'A>) : unit -> VCtx<'F, 'A> = fn - member this.Run(fn:unit -> VCtx<'F, 'A>): VCtx<'F, 'A> = fn() + member this.Run(fn: unit -> VCtx<'F, 'A>) : VCtx<'F, 'A> = fn () - member this.Zero() = ValidCtx () + member this.Zero() = ValidCtx() /// Performs some given validation using a 'Field' with a given name and value. - [] - member this.WithField(c:VCtx<'F, 'A>, n:Name, b:'B) = this.Bind(c, fun _ -> ValidCtx (Field (n, b))) + [] + member this.WithField(c: VCtx<'F, 'A>, n: Name, b: 'B) = + this.Bind(c, (fun _ -> ValidCtx(Field(n, b)))) /// Performs some given validation using a 'Field' with a given name and value. - [] - member this.WithField(c:VCtx<'F, 'A>, mn:Name option, b:'B) = + [] + member this.WithField(c: VCtx<'F, 'A>, mn: Name option, b: 'B) = match mn with | None -> this.WithValue(c, b) | Some n -> this.WithField(c, n, b) /// Performs some given validation using a 'Field' from a given selector. - [] - member this.WithField(c:VCtx<'F, 'A>, selector:Expression>) = + [] + member this.WithField(c: VCtx<'F, 'A>, selector: Expression>) = let exp = selector.Body :?> MemberExpression let mn = mkName exp.Member.Name let v = selector.Compile().Invoke() this.WithField(c, mn, v) /// Performs some given validation using a 'Field' from a given selector and value. - [] - member this.WithField(c:VCtx<'F, 'A>, selector:Expression>, b:'B) = + [] + member this.WithField(c: VCtx<'F, 'A>, selector: Expression>, b: 'B) = let exp = selector.Body :?> MemberExpression let mn = mkName exp.Member.Name this.WithField(c, mn, b) /// Performs some given validation using a 'Global' with a given value. - [] - member this.WithValue(c, b) = this.Bind(c, fun _ -> ValidCtx (Global b)) + [] + member this.WithValue(c, b) = + this.Bind(c, (fun _ -> ValidCtx(Global b))) /// Maps a proven value with a given function. - [] - member this.Optional(c:VCtx<'F, ValueCtx<'A option>>, fn:'A -> VCtx<'F, ValueCtx<'B>>): VCtx<'F, ValueCtx<'B option>> = + [] + member this.Optional + (c: VCtx<'F, ValueCtx<'A option>>, fn: 'A -> VCtx<'F, ValueCtx<'B>>) + : VCtx<'F, ValueCtx<'B option>> = match c with - | ValidCtx v -> + | ValidCtx v -> match ValueCtx.getValue v with - | None -> ValidCtx (ValueCtx.setValue v None) + | None -> ValidCtx(ValueCtx.setValue v None) | Some a -> match fn a with - | ValidCtx b -> ValidCtx (ValueCtx.map Some b) - | DisputedCtx (gfs,lfs,b) -> - let gfs',lfs' = VCtx.applyFailures v ([], Map.empty) (gfs,lfs) - DisputedCtx (gfs',lfs',ValueCtx.map Some b) - | RefutedCtx (gfs,lfs) -> RefutedCtx (VCtx.applyFailures v ([], Map.empty) (gfs,lfs)) - | DisputedCtx (gfs,lfs,v) -> + | ValidCtx b -> ValidCtx(ValueCtx.map Some b) + | DisputedCtx(gfs, lfs, b) -> + let gfs', lfs' = VCtx.applyFailures v ([], Map.empty) (gfs, lfs) + DisputedCtx(gfs', lfs', ValueCtx.map Some b) + | RefutedCtx(gfs, lfs) -> RefutedCtx(VCtx.applyFailures v ([], Map.empty) (gfs, lfs)) + | DisputedCtx(gfs, lfs, v) -> match ValueCtx.getValue v with - | None -> DisputedCtx (gfs,lfs,ValueCtx.setValue v None) + | None -> DisputedCtx(gfs, lfs, ValueCtx.setValue v None) | Some a -> match fn a with - | ValidCtx b -> DisputedCtx (gfs,lfs,ValueCtx.map Some b) - | DisputedCtx (gfs',lfs',b) -> - let gfs2,lfs2 = VCtx.applyFailures v (gfs,lfs) (gfs',lfs') - DisputedCtx (gfs2,lfs2,ValueCtx.map Some b) - | RefutedCtx (gfs',lfs') -> RefutedCtx (VCtx.applyFailures v (gfs,lfs) (gfs',lfs')) - | RefutedCtx (gfs,lfs) -> RefutedCtx (gfs,lfs) + | ValidCtx b -> DisputedCtx(gfs, lfs, ValueCtx.map Some b) + | DisputedCtx(gfs', lfs', b) -> + let gfs2, lfs2 = VCtx.applyFailures v (gfs, lfs) (gfs', lfs') + DisputedCtx(gfs2, lfs2, ValueCtx.map Some b) + | RefutedCtx(gfs', lfs') -> RefutedCtx(VCtx.applyFailures v (gfs, lfs) (gfs', lfs')) + | RefutedCtx(gfs, lfs) -> RefutedCtx(gfs, lfs) /// Performs a validation on each member of a list using a given function and handles the validation. - [] - member this.ValidateEach(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:int -> 'A -> VCtx<'F, ValueCtx<'B>>): VCtx<'F, ValueCtx>> = - this.Bind(c, fun v1 -> - let xs = ValueCtx.getValue v1 - let ys = xs |> Seq.mapi (fun i x -> - match fn i x with - | ValidCtx v2 -> ValidCtx (Element (i, (ValueCtx.getValue v2))) - | DisputedCtx (gfs,lfs,v2) -> - let v2' = Element (i, ValueCtx.getValue v2) - let gfs',lfs' = VCtx.applyFailures v2' (List.empty, Map.empty) (gfs, lfs) - DisputedCtx (gfs', lfs', v2') - | RefutedCtx (gfs,lfs) -> - let v2' = Element (i, ()) - let gfs',lfs' = VCtx.applyFailures v2' (List.empty, Map.empty) (gfs, lfs) - RefutedCtx (gfs', lfs') - ) - let appendToCtx d d' = d |> ValueCtx.map (fun zs -> Seq.append zs [ValueCtx.getValue d']) - (ValidCtx (ValueCtx.setValue v1 Seq.empty), ys) ||> Seq.fold (fun acc x -> - match (acc, x) with - | ValidCtx a, ValidCtx b -> - ValidCtx (appendToCtx a b) - | ValidCtx a, DisputedCtx (gfs',lfs',b) -> - let gfs2,lfs2 = VCtx.applyFailures v1 (List.empty, Map.empty) (gfs',lfs') - DisputedCtx (gfs2,lfs2,appendToCtx a b) - | ValidCtx a, RefutedCtx (gfs',lfs') -> - RefutedCtx (VCtx.applyFailures v1 (List.empty, Map.empty) (gfs',lfs')) - | DisputedCtx (gfs,lfs,a), ValidCtx b -> - DisputedCtx (gfs,lfs,appendToCtx a b) - | DisputedCtx (gfs,lfs,a), DisputedCtx (gfs',lfs',b) -> - let gfs2,lfs2 = VCtx.applyFailures v1 (gfs,lfs) (gfs',lfs') - DisputedCtx (gfs2,lfs2,appendToCtx a b) - | DisputedCtx (gfs,lfs,_), RefutedCtx (gfs',lfs') -> - RefutedCtx (VCtx.applyFailures v1 (gfs,lfs) (gfs',lfs')) - | RefutedCtx (gfs,lfs), ValidCtx _ -> - RefutedCtx (gfs,lfs) - | RefutedCtx (gfs,lfs), DisputedCtx (gfs',lfs',b) -> - RefutedCtx (VCtx.applyFailures v1 (gfs,lfs) (gfs',lfs')) - | RefutedCtx (gfs,lfs), RefutedCtx (gfs',lfs') -> - RefutedCtx (VCtx.applyFailures v1 (gfs,lfs) (gfs',lfs')) - ) + [] + member this.ValidateEach + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: int -> 'A -> VCtx<'F, ValueCtx<'B>>) + : VCtx<'F, ValueCtx>> = + this.Bind( + c, + fun v1 -> + let xs = ValueCtx.getValue v1 + + let ys = + xs + |> Seq.mapi (fun i x -> + match fn i x with + | ValidCtx v2 -> ValidCtx(Element(i, (ValueCtx.getValue v2))) + | DisputedCtx(gfs, lfs, v2) -> + let v2' = Element(i, ValueCtx.getValue v2) + let gfs', lfs' = VCtx.applyFailures v2' (List.empty, Map.empty) (gfs, lfs) + DisputedCtx(gfs', lfs', v2') + | RefutedCtx(gfs, lfs) -> + let v2' = Element(i, ()) + let gfs', lfs' = VCtx.applyFailures v2' (List.empty, Map.empty) (gfs, lfs) + RefutedCtx(gfs', lfs')) + + let appendToCtx d d' = + d |> ValueCtx.map (fun zs -> Seq.append zs [ ValueCtx.getValue d' ]) + + (ValidCtx(ValueCtx.setValue v1 Seq.empty), ys) + ||> Seq.fold (fun acc x -> + match (acc, x) with + | ValidCtx a, ValidCtx b -> ValidCtx(appendToCtx a b) + | ValidCtx a, DisputedCtx(gfs', lfs', b) -> + let gfs2, lfs2 = VCtx.applyFailures v1 (List.empty, Map.empty) (gfs', lfs') + DisputedCtx(gfs2, lfs2, appendToCtx a b) + | ValidCtx a, RefutedCtx(gfs', lfs') -> + RefutedCtx(VCtx.applyFailures v1 (List.empty, Map.empty) (gfs', lfs')) + | DisputedCtx(gfs, lfs, a), ValidCtx b -> DisputedCtx(gfs, lfs, appendToCtx a b) + | DisputedCtx(gfs, lfs, a), DisputedCtx(gfs', lfs', b) -> + let gfs2, lfs2 = VCtx.applyFailures v1 (gfs, lfs) (gfs', lfs') + DisputedCtx(gfs2, lfs2, appendToCtx a b) + | DisputedCtx(gfs, lfs, _), RefutedCtx(gfs', lfs') -> + RefutedCtx(VCtx.applyFailures v1 (gfs, lfs) (gfs', lfs')) + | RefutedCtx(gfs, lfs), ValidCtx _ -> RefutedCtx(gfs, lfs) + | RefutedCtx(gfs, lfs), DisputedCtx(gfs', lfs', b) -> + RefutedCtx(VCtx.applyFailures v1 (gfs, lfs) (gfs', lfs')) + | RefutedCtx(gfs, lfs), RefutedCtx(gfs', lfs') -> + RefutedCtx(VCtx.applyFailures v1 (gfs, lfs) (gfs', lfs'))) ) - /// Performs a validation on each member of a list using a given function and handles the validation. - [] - member this.ValidateEach(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:'A -> VCtx<'F, ValueCtx<'B>>): VCtx<'F, ValueCtx>> = - this.ValidateEach(c, fun _ a -> fn a) + /// Performs a validation on each member of a list using a given function and handles the validation. + [] + member this.ValidateEach + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: 'A -> VCtx<'F, ValueCtx<'B>>) + : VCtx<'F, ValueCtx>> = + this.ValidateEach(c, (fun _ a -> fn a)) /// Maps a proven value with a given function. - [] - member this.Proven(c:VCtx<'F, ValueCtx<'A>>, fn:'A -> 'B): VCtx<'F, 'B> = + [] + member this.Proven(c: VCtx<'F, ValueCtx<'A>>, fn: 'A -> 'B) : VCtx<'F, 'B> = c |> VCtx.map (fun a -> ValueCtx.getValue a |> fn) /// Unwraps a proven value. - [] - member this.Proven(c:VCtx<'F, ValueCtx<'A>>): VCtx<'F, 'A> = - c |> VCtx.map ValueCtx.getValue + [] + member this.Proven(c: VCtx<'F, ValueCtx<'A>>) : VCtx<'F, 'A> = c |> VCtx.map ValueCtx.getValue /// Adds a validation failure to the result and ends validation. - [] - member this.Refute(c: VCtx<'F, ValueCtx<'A>>, f) = this.Bind(c, fun v -> this.Refute(v, f)) + [] + member this.Refute(c: VCtx<'F, ValueCtx<'A>>, f) = + this.Bind(c, (fun v -> this.Refute(v, f))) - member private this.Refute(v: ValueCtx<'A>, f) = this.RefuteMany(v, NonEmptyList.singleton f) + member private this.Refute(v: ValueCtx<'A>, f) = + this.RefuteMany(v, NonEmptyList.singleton f) /// Adds validation failures to the result and ends validation. - [] - member this.RefuteMany(c: VCtx<'F, ValueCtx<'A>>, fs:NonEmptyList<'F>) = this.Bind(c, fun v -> this.RefuteMany(v, fs)) + [] + member this.RefuteMany(c: VCtx<'F, ValueCtx<'A>>, fs: NonEmptyList<'F>) = + this.Bind(c, (fun v -> this.RefuteMany(v, fs))) - member private this.RefuteMany(v: ValueCtx<'A>, fs:NonEmptyList<'F>) = + member private this.RefuteMany(v: ValueCtx<'A>, fs: NonEmptyList<'F>) = let fs' = NonEmptyList.toList fs + match v with - | Element (i, _) -> RefutedCtx (List.empty, (Map.add [VCtx.mkElementName i] fs' Map.empty)) - | Field (n, _) -> RefutedCtx (List.empty, (Map.add [n] fs' Map.empty)) - | Global _ -> RefutedCtx (fs', Map.empty) + | Element(i, _) -> RefutedCtx(List.empty, (Map.add [ VCtx.mkElementName i ] fs' Map.empty)) + | Field(n, _) -> RefutedCtx(List.empty, (Map.add [ n ] fs' Map.empty)) + | Global _ -> RefutedCtx(fs', Map.empty) /// Performs a validation using a given function and handles the result. /// If the result is `Error f`, a validation failure is added to the result and validation ends. /// If the result is `Ok b`, validation continues with the new value. - [] - member this.RefuteWith(c:VCtx<'F, ValueCtx<'A>>, fn:'A -> Result<'B, 'F>): VCtx<'F, ValueCtx<'B>> = - this.Bind(c, fun v -> - match fn (ValueCtx.getValue v) with - | Error f -> this.Refute(v, f) - | Ok b -> this.Return(ValueCtx.setValue v b) + [] + member this.RefuteWith(c: VCtx<'F, ValueCtx<'A>>, fn: 'A -> Result<'B, 'F>) : VCtx<'F, ValueCtx<'B>> = + this.Bind( + c, + fun v -> + match fn (ValueCtx.getValue v) with + | Error f -> this.Refute(v, f) + | Ok b -> this.Return(ValueCtx.setValue v b) ) /// Performs a validation using a given function and handles the result. /// If the result is `Error fs`, a validation failure is added to the result and validation ends. /// If the result is `Ok b`, validation continues with the new value. - [] - member this.RefuteWith(c:VCtx<'F, ValueCtx<'A>>, fn:'A -> Result<'B, NonEmptyList<'F>>): VCtx<'F, ValueCtx<'B>> = - this.Bind(c, fun v -> - match fn (ValueCtx.getValue v) with - | Error fs -> this.RefuteMany(v, fs) - | Ok b -> this.Return(ValueCtx.setValue v b) + [] + member this.RefuteWith(c: VCtx<'F, ValueCtx<'A>>, fn: 'A -> Result<'B, NonEmptyList<'F>>) : VCtx<'F, ValueCtx<'B>> = + this.Bind( + c, + fun v -> + match fn (ValueCtx.getValue v) with + | Error fs -> this.RefuteMany(v, fs) + | Ok b -> this.Return(ValueCtx.setValue v b) ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `Error f`, a validation failure is added to the result and validation ends. /// If the result of all elements are `Ok b`, validation continues with the new value. - [] - member this.RefuteEachWith(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:int -> 'A -> Result<'B, 'F>): VCtx<'F, ValueCtx>> = - this.ValidateEach(c, fun i a -> - match fn i a with - | Ok b -> ValidCtx (Global b) - | Error f -> RefutedCtx ([f], Map.empty) + [] + member this.RefuteEachWith + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: int -> 'A -> Result<'B, 'F>) + : VCtx<'F, ValueCtx>> = + this.ValidateEach( + c, + fun i a -> + match fn i a with + | Ok b -> ValidCtx(Global b) + | Error f -> RefutedCtx([ f ], Map.empty) ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `Error f`, a validation failure is added to the result and validation ends. /// If the result of all elements are `Ok b`, validation continues with the new value. - [] - member this.RefuteEachWith(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:'A -> Result<'B, 'F>): VCtx<'F, ValueCtx>> = - this.RefuteEachWith(c, fun _ a -> fn a) + [] + member this.RefuteEachWith + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: 'A -> Result<'B, 'F>) + : VCtx<'F, ValueCtx>> = + this.RefuteEachWith(c, (fun _ a -> fn a)) /// Performs a validation using a given function and handles the result. /// If the result is 'Invalid', the validation failures are added to the result and validation ends. /// If the result is `Valid b`, validation continues with the new value. - [] - member this.RefuteWithProof(c:VCtx<'F, ValueCtx<'A>>, fn:'A -> Proof<'F, 'B>) = - this.Bind(c, fun v -> - match v with - | Element (i, a) -> - match fn a with - | Invalid (gfs, lfs) -> RefutedCtx ([], Map.add [VCtx.mkElementName i] gfs lfs) - | Valid b -> this.Return(Element (i, b)) - | Field (n, a) -> - match fn a with - | Invalid (gfs, lfs) -> RefutedCtx ([], Map.add [n] gfs lfs) - | Valid b -> this.Return(Field (n, b)) - | Global a -> - match fn a with - | Invalid (gfs, lfs) -> RefutedCtx (gfs, lfs) - | Valid b -> this.Return(Global b) + [] + member this.RefuteWithProof(c: VCtx<'F, ValueCtx<'A>>, fn: 'A -> Proof<'F, 'B>) = + this.Bind( + c, + fun v -> + match v with + | Element(i, a) -> + match fn a with + | Invalid(gfs, lfs) -> RefutedCtx([], Map.add [ VCtx.mkElementName i ] gfs lfs) + | Valid b -> this.Return(Element(i, b)) + | Field(n, a) -> + match fn a with + | Invalid(gfs, lfs) -> RefutedCtx([], Map.add [ n ] gfs lfs) + | Valid b -> this.Return(Field(n, b)) + | Global a -> + match fn a with + | Invalid(gfs, lfs) -> RefutedCtx(gfs, lfs) + | Valid b -> this.Return(Global b) ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `Invalid`, a validation failures are added to the result and validation ends. /// If the result of all elements are `Valid b`, validation continues with the new value. - [] - member this.RefuteEachWithProof(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:int -> 'A -> Proof<'F, 'B>): VCtx<'F, ValueCtx>> = - this.ValidateEach(c, fun i a -> - match fn i a with - | Valid b -> ValidCtx (Global b) - | Invalid (gfs,lfs) -> RefutedCtx (gfs,lfs) + [] + member this.RefuteEachWithProof + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: int -> 'A -> Proof<'F, 'B>) + : VCtx<'F, ValueCtx>> = + this.ValidateEach( + c, + fun i a -> + match fn i a with + | Valid b -> ValidCtx(Global b) + | Invalid(gfs, lfs) -> RefutedCtx(gfs, lfs) ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `Error f`, a validation failure is added to the result and validation ends. /// If the result of all elements are `Ok b`, validation continues with the new value. - [] - member this.RefuteEachWithProof(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:'A -> Proof<'F, 'B>): VCtx<'F, ValueCtx>> = - this.RefuteEachWithProof(c, fun _ a -> fn a) + [] + member this.RefuteEachWithProof + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: 'A -> Proof<'F, 'B>) + : VCtx<'F, ValueCtx>> = + this.RefuteEachWithProof(c, (fun _ a -> fn a)) + + /// Convenience alias: Performs a validation using a given proof-returning function with failure mapping. + /// If the result is 'Invalid', maps the failures with the given function and adds them to the result, ending validation. + /// If the result is `Valid b`, validation continues with the new value. + [] + member this.RefuteWithValidation + (c: VCtx<'F, ValueCtx<'A>>, fn: 'A -> Proof<'F2, 'B>, mapFailure: 'F2 -> 'F) + : VCtx<'F, ValueCtx<'B>> = + this.Bind( + c, + fun v -> + let proof = fn (ValueCtx.getValue v) + let mappedProof = Proof.mapInvalid mapFailure proof + + match v with + | Element(i, _) -> + match mappedProof with + | Invalid(gfs, lfs) -> RefutedCtx([], Map.add [ VCtx.mkElementName i ] gfs lfs) + | Valid b -> this.Return(Element(i, b)) + | Field(n, _) -> + match mappedProof with + | Invalid(gfs, lfs) -> RefutedCtx([], Map.add [ n ] gfs lfs) + | Valid b -> this.Return(Field(n, b)) + | Global _ -> + match mappedProof with + | Invalid(gfs, lfs) -> RefutedCtx(gfs, lfs) + | Valid b -> this.Return(Global b) + ) + + /// Convenience alias: Performs a validation on each member using a given proof-returning function with failure mapping. + /// If any result is 'Invalid', maps the failures and adds them to the result, ending validation. + /// If all results are `Valid b`, validation continues with the new values. + [] + member this.RefuteEachWithValidation + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: 'A -> Proof<'F2, 'B>, mapFailure: 'F2 -> 'F) + : VCtx<'F, ValueCtx>> = + this.ValidateEach( + c, + fun i a -> + let proof = fn a |> Proof.mapInvalid mapFailure + + match proof with + | Valid b -> ValidCtx(Global b) + | Invalid(gfs, lfs) -> RefutedCtx(gfs, lfs) + ) // Adds a validation failure to the result and continues validation. - [] - member this.Dispute(c:VCtx<'F, ValueCtx<'A>>, f) = this.Bind(c, fun v -> this.Dispute(v, f)) + [] + member this.Dispute(c: VCtx<'F, ValueCtx<'A>>, f) = + this.Bind(c, (fun v -> this.Dispute(v, f))) - member private this.Dispute(v, f) = this.DisputeMany(v, NonEmptyList.singleton f) + member private this.Dispute(v, f) = + this.DisputeMany(v, NonEmptyList.singleton f) /// Adds validation failures to the result and continues validation. - [] - member this.DisputeMany(c:VCtx<'F, ValueCtx<'A>>, fs:NonEmptyList<'F>) = this.Bind(c, fun v -> this.DisputeMany(v, fs)) + [] + member this.DisputeMany(c: VCtx<'F, ValueCtx<'A>>, fs: NonEmptyList<'F>) = + this.Bind(c, (fun v -> this.DisputeMany(v, fs))) - member private this.DisputeMany(v, fs:NonEmptyList<'F>) = + member private this.DisputeMany(v, fs: NonEmptyList<'F>) = let fs' = NonEmptyList.toList fs + match v with - | Element (i, _) -> DisputedCtx (List.empty, (Map.add [VCtx.mkElementName i] fs' Map.empty), v) - | Field (n, _) -> DisputedCtx (List.empty, (Map.add [n] fs' Map.empty), v) - | Global _ -> DisputedCtx (fs', Map.empty, v) + | Element(i, _) -> DisputedCtx(List.empty, (Map.add [ VCtx.mkElementName i ] fs' Map.empty), v) + | Field(n, _) -> DisputedCtx(List.empty, (Map.add [ n ] fs' Map.empty), v) + | Global _ -> DisputedCtx(fs', Map.empty, v) /// Performs a validation using a given function and handles the result. /// If the result is `Some f`, a validation failure is added to the result and validation continues. /// If the result is `None`, validation continues with no failure. - [] - member this.DisputeWith (c:VCtx<'F, ValueCtx<'A>>, fn:'A -> 'F option): VCtx<'F, ValueCtx<'A>> = - this.DisputeWithMany(c, fun a -> - match fn a with - | None -> [] - | Some f -> [f] + [] + member this.DisputeWith(c: VCtx<'F, ValueCtx<'A>>, fn: 'A -> 'F option) : VCtx<'F, ValueCtx<'A>> = + this.DisputeWithMany( + c, + fun a -> + match fn a with + | None -> [] + | Some f -> [ f ] ) /// Performs a validation using a given function and handles the result. /// If the result has one or more elements, the validation failures are added to the result and validation continues. /// Otherwise, validation continues normally. - [] - member this.DisputeWithMany (c:VCtx<'F, ValueCtx<'A>>, fn:'A -> 'F list): VCtx<'F, ValueCtx<'A>> = - this.Bind(c, fun v -> - match fn (ValueCtx.getValue v) with - | [] -> this.Return(v) - | xs -> this.DisputeMany(v, NonEmptyList.ofList xs) + [] + member this.DisputeWithMany(c: VCtx<'F, ValueCtx<'A>>, fn: 'A -> 'F list) : VCtx<'F, ValueCtx<'A>> = + this.Bind( + c, + fun v -> + match fn (ValueCtx.getValue v) with + | [] -> this.Return(v) + | xs -> this.DisputeMany(v, NonEmptyList.ofList xs) ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `Some f`, a validation failure is added to the result and validation continues. /// Otherwise, validation continues normally. - [] - member this.DisputeAnyWith(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:int -> 'A -> 'F option): VCtx<'F, ValueCtx>> = - this.DisputeAnyWithMany(c, fun i a -> - match fn i a with - | None -> [] - | Some f -> [f] + [] + member this.DisputeAnyWith + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: int -> 'A -> 'F option) + : VCtx<'F, ValueCtx>> = + this.DisputeAnyWithMany( + c, + fun i a -> + match fn i a with + | None -> [] + | Some f -> [ f ] ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `Some f`, a validation failure is added to the result and validation continues. /// Otherwise, validation continues normally. - [] - member this.DisputeAnyWith(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:'A -> 'F option): VCtx<'F, ValueCtx>> = - this.DisputeAnyWith(c, fun _ a -> fn a) + [] + member this.DisputeAnyWith(c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: 'A -> 'F option) : VCtx<'F, ValueCtx>> = + this.DisputeAnyWith(c, (fun _ a -> fn a)) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `Some f`, a validation failure is added to the result and validation continues. /// Otherwise, validation continues normally. - [] - member this.DisputeAnyWithMany(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:int -> 'A -> 'F list): VCtx<'F, ValueCtx>> = - this.ValidateEach(c, fun i a -> - match fn i a with - | [] -> ValidCtx (Global a) - | fs -> DisputedCtx (fs,Map.empty,Global a) + [] + member this.DisputeAnyWithMany + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: int -> 'A -> 'F list) + : VCtx<'F, ValueCtx>> = + this.ValidateEach( + c, + fun i a -> + match fn i a with + | [] -> ValidCtx(Global a) + | fs -> DisputedCtx(fs, Map.empty, Global a) ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `Some f`, a validation failure is added to the result and validation continues. /// Otherwise, validation continues normally. - [] - member this.DisputeAnyWithMany(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:'A -> 'F list): VCtx<'F, ValueCtx>> = - this.DisputeAnyWithMany(c, fun _ a -> fn a) + [] + member this.DisputeAnyWithMany(c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: 'A -> 'F list) : VCtx<'F, ValueCtx>> = + this.DisputeAnyWithMany(c, (fun _ a -> fn a)) /// Performs a validation on each member of a list using a given function and handles the result. /// If every element fails validation, all unique validation failure are added to the result and validation continues. /// Otherwise, no failures are added and validation continues normally. - [] - member this.DisputeAllWith(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:int -> 'A -> 'F option): VCtx<'F, ValueCtx<#seq<'A>>> = - this.DisputeAllWithMany(c, fun i a -> - match fn i a with - | None -> [] - | Some f -> [f] + [] + member this.DisputeAllWith + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: int -> 'A -> 'F option) + : VCtx<'F, ValueCtx<#seq<'A>>> = + this.DisputeAllWithMany( + c, + fun i a -> + match fn i a with + | None -> [] + | Some f -> [ f ] ) /// Performs a validation on each member of a list using a given function and handles the result. /// If every element fails validation, all unique validation failure are added to the result and validation continues. /// Otherwise, no failures are added and validation continues normally. - [] - member this.DisputeAllWith(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:'A -> 'F option): VCtx<'F, ValueCtx<#seq<'A>>> = - this.DisputeAllWith(c, fun _ a -> fn a) + [] + member this.DisputeAllWith(c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: 'A -> 'F option) : VCtx<'F, ValueCtx<#seq<'A>>> = + this.DisputeAllWith(c, (fun _ a -> fn a)) /// Performs a validation on each member of a list using a given function and handles the result. /// If every element fails validation, all unique validation failure are added to the result and validation continues. /// Otherwise, no failures are added and validation continues normally. - [] - member this.DisputeAllWithMany(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:int -> 'A -> 'F list): VCtx<'F, ValueCtx<#seq<'A>>> = - this.Bind(c, fun v -> - let xs = Seq.mapi fn (ValueCtx.getValue v) - let fs = xs |> Seq.filter (List.isEmpty) - if Seq.length xs = Seq.length fs then // if every element fails validation - let fs' = fs |> Seq.collect id |> Seq.distinct - DisputedCtx (Seq.toList fs',Map.empty,v) - else - ValidCtx v + [] + member this.DisputeAllWithMany + (c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: int -> 'A -> 'F list) + : VCtx<'F, ValueCtx<#seq<'A>>> = + this.Bind( + c, + fun v -> + let xs = Seq.mapi fn (ValueCtx.getValue v) + let failedElements = xs |> Seq.filter (fun x -> not (List.isEmpty x)) + + if Seq.length xs = Seq.length failedElements then // if every element fails validation + let fs' = failedElements |> Seq.collect id |> Seq.distinct + DisputedCtx(Seq.toList fs', Map.empty, v) + else + ValidCtx v ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of all of the elements is `Some f`, all validation failure are added to the result and validation continues. /// Otherwise, no failures are added and validation continues normally. - [] - member this.DisputeAllWithMany(c:VCtx<'F, ValueCtx<#seq<'A>>>, fn:'A -> 'F list): VCtx<'F, ValueCtx<#seq<'A>>> = - this.DisputeAllWithMany(c, fun _ a -> fn a) + [] + member this.DisputeAllWithMany(c: VCtx<'F, ValueCtx<#seq<'A>>>, fn: 'A -> 'F list) : VCtx<'F, ValueCtx<#seq<'A>>> = + this.DisputeAllWithMany(c, (fun _ a -> fn a)) /// Similar to 'disputeWith' except that the given failure is added if the given function returns False. - [] - member this.DisputeWithFact(c:VCtx<'F, ValueCtx<'A>>, f:'F, fn:'A -> bool): VCtx<'F, ValueCtx<'A>> = - this.DisputeWith(c, fun a -> - match fn a with - | true -> None - | false -> Some f + [] + member this.DisputeWithFact(c: VCtx<'F, ValueCtx<'A>>, f: 'F, fn: 'A -> bool) : VCtx<'F, ValueCtx<'A>> = + this.DisputeWith( + c, + fun a -> + match fn a with + | true -> None + | false -> Some f ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `false`, the given validation failure is added to the result and validation continues. /// Otherwise, validation continues normally. - [] - member this.DisputeAnyWithFact(c:VCtx<'F, ValueCtx<#seq<'A>>>, f:'F, fn:int -> 'A -> bool): VCtx<'F, ValueCtx>> = - this.DisputeAnyWith(c, fun i a -> - match fn i a with - | true -> None - | false -> Some f + [] + member this.DisputeAnyWithFact + (c: VCtx<'F, ValueCtx<#seq<'A>>>, f: 'F, fn: int -> 'A -> bool) + : VCtx<'F, ValueCtx>> = + this.DisputeAnyWith( + c, + fun i a -> + match fn i a with + | true -> None + | false -> Some f ) /// Performs a validation on each member of a list using a given function and handles the result. /// If the result of any element is `false`, the given validation failure is added to the result and validation continues. /// Otherwise, validation continues normally. - [] - member this.DisputeAnyWithFact(c:VCtx<'F, ValueCtx<#seq<'A>>>, f:'F, fn:'A -> bool): VCtx<'F, ValueCtx>> = - this.DisputeAnyWithFact(c, f, fun _ a -> fn a) + [] + member this.DisputeAnyWithFact + (c: VCtx<'F, ValueCtx<#seq<'A>>>, f: 'F, fn: 'A -> bool) + : VCtx<'F, ValueCtx>> = + this.DisputeAnyWithFact(c, f, (fun _ a -> fn a)) /// Performs a validation on each member of a list using a given function and handles the result. /// If every element fails validation, all unique validation failure are added to the result and validation continues. /// Otherwise, no failures are added and validation continues normally. - [] - member this.DisputeAllWithFact(c:VCtx<'F, ValueCtx<#seq<'A>>>, f:'F, fn:int -> 'A -> bool): VCtx<'F, ValueCtx<#seq<'A>>> = - this.DisputeAllWith(c, fun i v -> - match fn i v with - | true -> None - | false -> Some f + [] + member this.DisputeAllWithFact + (c: VCtx<'F, ValueCtx<#seq<'A>>>, f: 'F, fn: int -> 'A -> bool) + : VCtx<'F, ValueCtx<#seq<'A>>> = + this.DisputeAllWith( + c, + fun i v -> + match fn i v with + | true -> None + | false -> Some f ) /// Performs a validation on each member of a list using a given function and handles the result. /// If every element fails validation, all unique validation failure are added to the result and validation continues. /// Otherwise, no failures are added and validation continues normally. - [] - member this.DisputeAllWithFact(c:VCtx<'F, ValueCtx<#seq<'A>>>, f:'F, fn:'A -> bool): VCtx<'F, ValueCtx<#seq<'A>>> = - this.DisputeAllWithFact(c, f, fun _ a -> fn a) + [] + member this.DisputeAllWithFact + (c: VCtx<'F, ValueCtx<#seq<'A>>>, f: 'F, fn: 'A -> bool) + : VCtx<'F, ValueCtx<#seq<'A>>> = + this.DisputeAllWithFact(c, f, (fun _ a -> fn a)) [] module Validation = diff --git a/src/FSharp.Data.Validation/Validators/Collection.fs b/src/FSharp.Data.Validation/Validators/Collection.fs new file mode 100644 index 0000000..a0f1e1a --- /dev/null +++ b/src/FSharp.Data.Validation/Validators/Collection.fs @@ -0,0 +1,45 @@ +[] +module FSharp.Data.Validation.Collection + +open System.Linq + +/// Checks that a `IEnumerable` is empty. +let isNull (a: #seq<_>) = not (a.Any()) + +/// Checks that a `IEnumerable` is not empty. +let isNotNull (a: #seq<_>) = a.Any() + +/// Checks that a `IEnumerable` has a length equal to or greater than the given value. +let minLength l (a: #seq<_>) = a.Count() >= l + +/// Checks that a `IEnumerable` has a length equal to or less than the given value. +let maxLength l (a: #seq<_>) = a.Count() <= l + +/// Checks that a `IEnumerable` has a length equal to the given value. +let isLength l (a: #seq<_>) = a.Count() = l + +/// Checks that a `IEnumerable` has a given element. +let hasElem e (a: #seq<_>) = a.Contains(e) + +/// Checks that a `IEnumerable` does not have a given element. +let doesNotHaveElem e (a: #seq<_>) = a.Contains(e) |> not + +/// Checks that all elements in a sequence are distinct (no duplicates). +let isDistinct (a: #seq<'a>) = a.Distinct().Count() = a.Count() + +/// Checks that a sequence contains all of the given elements. +let containsAllElems (elements: 'a seq) (a: #seq<'a>) = + elements |> Seq.forall (fun e -> a.Contains(e)) + +/// Checks that a sequence contains any of the given elements. +let containsAnyElem (elements: 'a seq) (a: #seq<'a>) = + elements |> Seq.exists (fun e -> a.Contains(e)) + +/// Checks that all elements in a sequence match the given predicate. +let allMatch (predicate: 'a -> bool) (a: #seq<'a>) = a |> Seq.forall predicate + +/// Checks that at least one element in a sequence matches the given predicate. +let anyMatch (predicate: 'a -> bool) (a: #seq<'a>) = a |> Seq.exists predicate + +/// Checks that no elements in a sequence match the given predicate. +let noneMatch (predicate: 'a -> bool) (a: #seq<'a>) = a |> Seq.exists predicate |> not diff --git a/src/FSharp.Data.Validation/Validators/Core.fs b/src/FSharp.Data.Validation/Validators/Core.fs new file mode 100644 index 0000000..49490c3 --- /dev/null +++ b/src/FSharp.Data.Validation/Validators/Core.fs @@ -0,0 +1,49 @@ +[] +module FSharp.Data.Validation.Core + +/// Converts a `VCtx` to a `Proof`, where `ValidCtx` becomes `Valid` and both `DisputedCtx` and `RefutedCtx` become +/// `Invalid` with their respective failures. +let fromVCtx<'F, 'A> (ctx: FSharp.Data.Validation.VCtx<'F, 'A>) : FSharp.Data.Validation.Proof<'F, 'A> = + match ctx with + | FSharp.Data.Validation.ValidCtx a -> FSharp.Data.Validation.Valid a + | FSharp.Data.Validation.DisputedCtx(gfs, lfs, _) -> FSharp.Data.Validation.Invalid(gfs, lfs) + | FSharp.Data.Validation.RefutedCtx(gfs, lfs) -> FSharp.Data.Validation.Invalid(gfs, lfs) + +/// Checks that a `Result` value is a `Error`. +let isError e = Result.isError e + +/// Checks that a `Result` value is a `Ok`. +let isOk e = Result.isOk e + +/// tests if a 'Proof' is valid. +let isValid p = + match p with + | FSharp.Data.Validation.Valid _ -> true + | FSharp.Data.Validation.Invalid _ -> false + +/// tests if a 'Proof' is invalid. +let isInvalid p = isValid p |> not + +/// Flatten a list of proofs into a proof of the list. +let flattenProofs ps = + let ps' = ps |> List.map (FSharp.Data.Validation.Proof.map (fun a -> [ a ])) + + (FSharp.Data.Validation.Valid [], ps') + ||> List.fold (FSharp.Data.Validation.Proof.combine (@)) + +/// Raises an `InvalidProofException` if the the given proof is `Invalid`. +let raiseIfInvalid msg p = + match p with + | FSharp.Data.Validation.Invalid(gfs, lfs) -> + raise (FSharp.Data.Validation.Types.InvalidProofException<_>(msg, gfs, lfs)) + | FSharp.Data.Validation.Valid a -> a + +/// Checks that a comparable value is before the given threshold. +let isBefore (threshold: 'T :> System.IComparable<'T>) (value: 'T) = value.CompareTo(threshold) < 0 + +/// Checks that a comparable value is after the given threshold. +let isAfter (threshold: 'T :> System.IComparable<'T>) (value: 'T) = value.CompareTo(threshold) > 0 + +/// Checks that a comparable value is between the given start and end values (inclusive). +let isBetween (start: 'T :> System.IComparable<'T>) (end': 'T) (value: 'T) = + value.CompareTo(start) >= 0 && value.CompareTo(end') <= 0 \ No newline at end of file diff --git a/src/FSharp.Data.Validation/Validators/Numeric.fs b/src/FSharp.Data.Validation/Validators/Numeric.fs new file mode 100644 index 0000000..51a7c99 --- /dev/null +++ b/src/FSharp.Data.Validation/Validators/Numeric.fs @@ -0,0 +1,35 @@ +[] +module FSharp.Data.Validation.Numeric + +/// Checks that a value is equal to another. +let isEqual = (=) + +/// Checks that a value is not equal to another. +let isNotEqual a b = a = b |> not + +/// Checks that b is less than a, as b is our validation input. +let isLessThan = (>) + +/// Checks that b is greater than a, as b is our validation input. +let isGreaterThan = (<) + +/// Checks that b is less than or equal to a, as b is our validation input. +let isLessThanOrEqual = (>=) + +/// Checks that b is greater than or equal to a, as b is our validation input. +let isGreaterThanOrEqual = (<=) + +/// Checks that a value is within the given inclusive range [min, max]. +let inRange (min: 'a) (max: 'a) (value: 'a) = value >= min && value <= max + +/// Checks that a value is within the given exclusive range (min, max). +let inRangeExclusive (min: 'a) (max: 'a) (value: 'a) = value > min && value < max + +/// Checks that a numeric value is positive (greater than zero). +let inline isPositive value = value > LanguagePrimitives.GenericZero + +/// Checks that a numeric value is negative (less than zero). +let inline isNegative value = value < LanguagePrimitives.GenericZero + +/// Checks that a numeric value is not zero. +let inline isNonZero value = value <> LanguagePrimitives.GenericZero diff --git a/src/FSharp.Data.Validation/Validators/Required.fs b/src/FSharp.Data.Validation/Validators/Required.fs new file mode 100644 index 0000000..53c00c9 --- /dev/null +++ b/src/FSharp.Data.Validation/Validators/Required.fs @@ -0,0 +1,20 @@ +[] +module FSharp.Data.Validation.Required + +/// Checks that an `Option` value is a `Some`. +let isRequired (f: 'F) (ma: 'A option) : Result<'A, 'F> = + match ma with + | None -> Error f + | Some a -> Ok a + +/// Checks that a `Option` value is a `Some` when some condition is true. +let isRequiredWhen f b (ma: 'A option) : 'F option = + match b with + | false -> None + | true -> + match ma with + | None -> Some f + | Some _ -> None + +/// Checks that a `Option` value is a `Some` when some condition is false. +let isRequiredUnless f b v = isRequiredWhen f (not b) v diff --git a/src/FSharp.Data.Validation/Validators/String.fs b/src/FSharp.Data.Validation/Validators/String.fs new file mode 100644 index 0000000..a46cfa8 --- /dev/null +++ b/src/FSharp.Data.Validation/Validators/String.fs @@ -0,0 +1,31 @@ +[] +module FSharp.Data.Validation.String + +open System.Text.RegularExpressions + +/// Checks that a string matches the given regular expression pattern. +let matchesRegex (pattern: Regex) (str: string) = pattern.IsMatch str + +/// Checks that a string contains any of the given characters. +let containsAny (chars: char seq) (str: string) = + chars |> Seq.exists str.Contains + +/// Checks that a string contains all of the given characters. +let containsAll (chars: char seq) (str: string) = + chars |> Seq.forall str.Contains + +/// Checks that a string starts with the given prefix. +let startsWith (prefix: string) (str: string) = str.StartsWith prefix + +/// Checks that a string ends with the given suffix. +let endsWith (suffix: string) (str: string) = str.EndsWith suffix + +/// Checks that a string contains only alphanumeric characters (letters and digits). +let isAlphanumeric (str: string) = + str |> Seq.forall System.Char.IsLetterOrDigit + +/// Checks that a string contains only alphabetic characters (letters). +let isAlpha (str: string) = str |> Seq.forall System.Char.IsLetter + +/// Checks that a string contains only numeric characters (digits). +let isNumeric (str: string) = str |> Seq.forall System.Char.IsDigit diff --git a/src/FSharp.Data.Validation/ValueCtx.fs b/src/FSharp.Data.Validation/ValueCtx.fs index 3a45f1e..4d4967b 100644 --- a/src/FSharp.Data.Validation/ValueCtx.fs +++ b/src/FSharp.Data.Validation/ValueCtx.fs @@ -1,25 +1,33 @@ namespace FSharp.Data.Validation +/// Represents the context of a value being validated, including its location (element index, field name, or global) and +/// the value itself. type ValueCtx<'a> = + /// Represents a value that is part of a collection, with its index and the value. | Element of int * 'a + /// Represents a value that is part of a record or object, with its field name and the value. | Field of Name * 'a + /// Represents a global value that is not associated with a specific field or element. | Global of 'a module ValueCtx = - let getValue<'A> (v:ValueCtx<'A>): 'A = + /// Extracts the value from a ValueCtx, regardless of its context. + let getValue<'A> (v: ValueCtx<'A>) : 'A = match v with - | Element (_, a) -> a - | Field (_, a) -> a - | Global a -> a + | Element(_, a) -> a + | Field(_, a) -> a + | Global a -> a - let setValue<'A, 'B> (v:ValueCtx<'A>) (b:'B): ValueCtx<'B> = + /// Sets a new value in the ValueCtx while preserving its context (element index, field name, or global). + let setValue<'A, 'B> (v: ValueCtx<'A>) (b: 'B) : ValueCtx<'B> = match v with - | Element (i, _a) -> Element (i, b) - | Field (n, _a) -> Field (n, b) - | Global _a -> Global b + | Element(i, _a) -> Element(i, b) + | Field(n, _a) -> Field(n, b) + | Global _a -> Global b - let map (fn:'A -> 'B) (v:ValueCtx<'A>): ValueCtx<'B> = - getValue v |> fn |> setValue v + /// Maps a function over the value contained in the ValueCtx, preserving its context. + let map (fn: 'A -> 'B) (v: ValueCtx<'A>) : ValueCtx<'B> = getValue v |> fn |> setValue v - let bind (fn:'A -> ValueCtx<'B>) (v:ValueCtx<'A>): ValueCtx<'B> = - getValue v |> fn + /// Binds a function that returns a ValueCtx to the value contained in the original ValueCtx, allowing for chaining + /// of operations while preserving context. + let bind (fn: 'A -> ValueCtx<'B>) (v: ValueCtx<'A>) : ValueCtx<'B> = getValue v |> fn diff --git a/tests/FSharp.Data.Validation.Tests/FSharp.Data.Validation.Tests.fsproj b/tests/FSharp.Data.Validation.Tests/FSharp.Data.Validation.Tests.fsproj index 0118172..48155de 100644 --- a/tests/FSharp.Data.Validation.Tests/FSharp.Data.Validation.Tests.fsproj +++ b/tests/FSharp.Data.Validation.Tests/FSharp.Data.Validation.Tests.fsproj @@ -12,8 +12,12 @@ - + + + + + diff --git a/tests/FSharp.Data.Validation.Tests/Tests/Fixtures.fs b/tests/FSharp.Data.Validation.Tests/Tests/Fixtures.fs index 91b95af..b25a73e 100644 --- a/tests/FSharp.Data.Validation.Tests/Tests/Fixtures.fs +++ b/tests/FSharp.Data.Validation.Tests/Tests/Fixtures.fs @@ -11,8 +11,7 @@ open FSharp.Data.Validation // Type that is required to be greater than 1 type UserId = UserId of int -type UserIdFailures = - | LessThanOneFailure +type UserIdFailures = | LessThanOneFailure module UserId = let make s = @@ -20,19 +19,20 @@ module UserId = withValue s disputeWithFact LessThanOneFailure (isGreaterThanOrEqual 1) qed UserId - } |> fromVCtx + } + |> fromVCtx [] let ``UserId.make: Returns Valid when value is greater than or equal to 1`` (PositiveInt a) = - Assert.Equal(Valid (UserId a), UserId.make a) + Assert.Equal(Valid(UserId a), UserId.make a) [] let ``UserId.make: Returns LessThanOneFailure when value is negative`` (NegativeInt a) = - Assert.Equal(Invalid ([LessThanOneFailure], Map.empty), UserId.make a) + Assert.Equal(Invalid([ LessThanOneFailure ], Map.empty), UserId.make a) [] let ``UserId.make: Returns LessThanOneFailure when value is zero`` () = - Assert.Equal(Invalid ([LessThanOneFailure], Map.empty), UserId.make 0) + Assert.Equal(Invalid([ LessThanOneFailure ], Map.empty), UserId.make 0) // Type that is required to be 7 length and only contain numbers type PhoneNumber = PhoneNumber of string @@ -48,47 +48,48 @@ module PhoneNumber = disputeWithFact LengthFailure (isLength 7) disputeWithFact NonDigitFailure (fun a -> Regex.IsMatch(a, "^[0-9]*$")) qed PhoneNumber - } |> fromVCtx + } + |> fromVCtx [] let ``PhoneNumber.make: Returns Valid when value passes criteria`` () = let a = "1231234" - Assert.Equal(Valid (PhoneNumber a), PhoneNumber.make "1231234") + Assert.Equal(Valid(PhoneNumber a), PhoneNumber.make "1231234") [] let ``PhoneNumber.make: Returns LengthFailure when value is too short`` () = - Assert.Equal(Invalid ([LengthFailure], Map.empty), PhoneNumber.make "1") + Assert.Equal(Invalid([ LengthFailure ], Map.empty), PhoneNumber.make "1") [] let ``PhoneNumber.make: Returns NonDigitFailure when value contains non-numeric characters`` () = - Assert.Equal(Invalid ([NonDigitFailure], Map.empty), PhoneNumber.make "123134!") + Assert.Equal(Invalid([ NonDigitFailure ], Map.empty), PhoneNumber.make "123134!") [] let ``PhoneNumber.make: Returns both failures when wrong length and contains non-numeric characters`` () = - Assert.Equal(Invalid ([LengthFailure; NonDigitFailure], Map.empty), PhoneNumber.make "-12312345678!") + Assert.Equal(Invalid([ LengthFailure; NonDigitFailure ], Map.empty), PhoneNumber.make "-12312345678!") // Type that has no requirements beyond meeting a specific regex type EmailAddress = EmailAddress of string -type EmailAddressFailures = - | InvalidEmail +type EmailAddressFailures = | InvalidEmail module EmailAddress = - let make (s : string) = + let make (s: string) = validation { withValue s disputeWithFact InvalidEmail (fun s -> Regex.IsMatch(s, "^[a-zA-Z0-9+._-]+@[a-zA-Z-]+\\.[a-z]+$")) qed EmailAddress - } |> fromVCtx + } + |> fromVCtx [] let ``EmailAddress.make: Returns Valid when value passes criteria`` () = let a = "test@test.com" - Assert.Equal(Valid (EmailAddress a), EmailAddress.make a) + Assert.Equal(Valid(EmailAddress a), EmailAddress.make a) [] let ``EmailAddress.make: Returns InvalidEmail when invalid`` () = - Assert.Equal(Invalid ([InvalidEmail], Map.empty), EmailAddress.make "test@test") + Assert.Equal(Invalid([ InvalidEmail ], Map.empty), EmailAddress.make "test@test") // Record that must include a userid and a phone number type ContactPreference = @@ -96,10 +97,10 @@ type ContactPreference = | Phone type UserContact = - { UserId : UserId - PhoneNumber : PhoneNumber option - EmailAddress : EmailAddress option - ContactPreference : ContactPreference } + { UserId: UserId + PhoneNumber: PhoneNumber option + EmailAddress: EmailAddress option + ContactPreference: ContactPreference } type RecordFailures = | UserIdFailure of UserIdFailures @@ -112,164 +113,196 @@ type RecordFailures = | OtherFailure type UserContactDTO = - { UserId : int option - PhoneNumber : string option - EmailAddress : string option - ContactPreference : ContactPreference option } + { UserId: int option + PhoneNumber: string option + EmailAddress: string option + ContactPreference: ContactPreference option } + module UserContactDTO = - let makeUserContact(vm:UserContactDTO) = + let makeUserContact (vm: UserContactDTO) = validation { - let! uid = validation { - withField (fun () -> vm.UserId) - refuteWith (isRequired MissingUserId) - refuteWithProof (Proof.mapInvalid UserIdFailure << UserId.make) - qed - } - and! cp = validation { - withField (fun () -> vm.ContactPreference) - refuteWith (isRequired MissingContractPreference) - qed - } - and! pn = validation { - withField (fun () -> vm.PhoneNumber) - disputeWith (isRequiredWhen MissingConditionalPhone (vm.ContactPreference = Some Phone)) - optional (fun v -> validation { - withValue v - refuteWithProof (Proof.mapInvalid PhoneNumberFailure << PhoneNumber.make) - }) - qed - } - and! ea = validation { - withField (fun () -> vm.EmailAddress) - disputeWith (isRequiredUnless MissingConditionalEmail (vm.ContactPreference <> Some Email)) - optional (fun v -> validation { - withValue v - refuteWithProof (Proof.mapInvalid EmailAddressFailure << EmailAddress.make) - }) - qed - } - and! _ = validation { - withValue vm - disputeWithFact OtherFailure (fun a -> a.UserId <> Some 0) - qed - } - return { UserContact.UserId = uid; PhoneNumber = pn; EmailAddress = ea; ContactPreference = cp } - } |> fromVCtx + let! uid = + validation { + withField (fun () -> vm.UserId) + refuteWith (isRequired MissingUserId) + refuteWithProof (Proof.mapInvalid UserIdFailure << UserId.make) + qed + } + + and! cp = + validation { + withField (fun () -> vm.ContactPreference) + refuteWith (isRequired MissingContractPreference) + qed + } + + and! pn = + validation { + withField (fun () -> vm.PhoneNumber) + disputeWith (isRequiredWhen MissingConditionalPhone (vm.ContactPreference = Some Phone)) + + optional (fun v -> + validation { + withValue v + refuteWithProof (Proof.mapInvalid PhoneNumberFailure << PhoneNumber.make) + }) + + qed + } + + and! ea = + validation { + withField (fun () -> vm.EmailAddress) + disputeWith (isRequiredUnless MissingConditionalEmail (vm.ContactPreference <> Some Email)) + + optional (fun v -> + validation { + withValue v + refuteWithProof (Proof.mapInvalid EmailAddressFailure << EmailAddress.make) + }) + + qed + } + + and! _ = + validation { + withValue vm + disputeWithFact OtherFailure (fun a -> a.UserId <> Some 0) + qed + } + + return + { UserContact.UserId = uid + PhoneNumber = pn + EmailAddress = ea + ContactPreference = cp } + } + |> fromVCtx [] let ``UserContactDTO: Validated when all values pass criteria`` (PositiveInt uid) = let phone = None let email = "test@test.com" let cp = Email - let input = { - UserContactDTO.UserId = Some uid - PhoneNumber = phone - EmailAddress = Some email - ContactPreference = Some cp - } - let expected = Valid { - UserContact.UserId = UserId uid - PhoneNumber = phone - EmailAddress = Some (EmailAddress email) - ContactPreference = cp - } - Assert.Equal(expected, UserContactDTO.makeUserContact(input)) + + let input = + { UserContactDTO.UserId = Some uid + PhoneNumber = phone + EmailAddress = Some email + ContactPreference = Some cp } + + let expected = + Valid + { UserContact.UserId = UserId uid + PhoneNumber = phone + EmailAddress = Some(EmailAddress email) + ContactPreference = cp } + + Assert.Equal(expected, UserContactDTO.makeUserContact (input)) [] let ``UserContactDTO: Returns single failure when email is invalid`` (PositiveInt uid) = let phone = None let email = "test@test" let cp = Email - let input = { - UserContactDTO.UserId = Some uid - PhoneNumber = phone - EmailAddress = Some email - ContactPreference = Some cp - } + + let input = + { UserContactDTO.UserId = Some uid + PhoneNumber = phone + EmailAddress = Some email + ContactPreference = Some cp } + let expected = - Invalid ( - [], - Map.ofList [ - ([mkName "EmailAddress" |> Option.get], [EmailAddressFailure InvalidEmail]) - ]) - Assert.Equal(expected, UserContactDTO.makeUserContact(input)) + Invalid([], Map.ofList [ ([ mkName "EmailAddress" |> Option.get ], [ EmailAddressFailure InvalidEmail ]) ]) + + Assert.Equal(expected, UserContactDTO.makeUserContact (input)) [] let ``UserContactDTO: Returns multiple failures when email and userid are invalid`` (NegativeInt uid) = let phone = None let email = "test@test" let cp = Email - let input = { - UserContactDTO.UserId = Some uid - PhoneNumber = phone - EmailAddress = Some email - ContactPreference = Some cp - } + + let input = + { UserContactDTO.UserId = Some uid + PhoneNumber = phone + EmailAddress = Some email + ContactPreference = Some cp } + let expected = - Invalid ( + Invalid( [], - Map.ofList [ - ([mkName "UserId" |> Option.get], [UserIdFailure LessThanOneFailure]) - ([mkName "EmailAddress" |> Option.get], [EmailAddressFailure InvalidEmail]) - ]) - Assert.Equal(expected, UserContactDTO.makeUserContact(input)) + Map.ofList + [ ([ mkName "UserId" |> Option.get ], [ UserIdFailure LessThanOneFailure ]) + ([ mkName "EmailAddress" |> Option.get ], [ EmailAddressFailure InvalidEmail ]) ] + ) + + Assert.Equal(expected, UserContactDTO.makeUserContact (input)) [] let ``UserContactDTO: Returns multiple failures when email is invalid and userid is missing`` () = let phone = None let email = "test@test" let cp = Email - let input = { - UserContactDTO.UserId = None - PhoneNumber = phone - EmailAddress = Some email - ContactPreference = Some cp - } + + let input = + { UserContactDTO.UserId = None + PhoneNumber = phone + EmailAddress = Some email + ContactPreference = Some cp } + let expected = - Invalid ( + Invalid( [], - Map.ofList [ - ([mkName "UserId" |> Option.get], [MissingUserId]) - ([mkName "EmailAddress" |> Option.get], [EmailAddressFailure InvalidEmail]) - ]) - Assert.Equal(expected, UserContactDTO.makeUserContact(input)) + Map.ofList + [ ([ mkName "UserId" |> Option.get ], [ MissingUserId ]) + ([ mkName "EmailAddress" |> Option.get ], [ EmailAddressFailure InvalidEmail ]) ] + ) + + Assert.Equal(expected, UserContactDTO.makeUserContact (input)) [] let ``UserContactDTO: Returns multiple failures and global when email is invalid and userid is 0`` () = let phone = None let email = "test@test" let cp = Email - let input = { - UserContactDTO.UserId = Some 0 - PhoneNumber = phone - EmailAddress = Some email - ContactPreference = Some cp - } + + let input = + { UserContactDTO.UserId = Some 0 + PhoneNumber = phone + EmailAddress = Some email + ContactPreference = Some cp } + let expected = - Invalid ( - [OtherFailure], - Map.ofList [ - ([mkName "UserId" |> Option.get], [UserIdFailure LessThanOneFailure]) - ([mkName "EmailAddress" |> Option.get], [EmailAddressFailure InvalidEmail]) - ]) - Assert.Equal(expected, UserContactDTO.makeUserContact(input)) + Invalid( + [ OtherFailure ], + Map.ofList + [ ([ mkName "UserId" |> Option.get ], [ UserIdFailure LessThanOneFailure ]) + ([ mkName "EmailAddress" |> Option.get ], [ EmailAddressFailure InvalidEmail ]) ] + ) + + Assert.Equal(expected, UserContactDTO.makeUserContact (input)) [] -let ``UserContactDTO: Returns multiple failures when email is invalid and contact preference is phone`` (PositiveInt uid) = +let ``UserContactDTO: Returns multiple failures when email is invalid and contact preference is phone`` + (PositiveInt uid) + = let phone = None let email = "test@test" let cp = Phone - let input = { - UserContactDTO.UserId = Some uid - PhoneNumber = phone - EmailAddress = Some email - ContactPreference = Some cp - } + + let input = + { UserContactDTO.UserId = Some uid + PhoneNumber = phone + EmailAddress = Some email + ContactPreference = Some cp } + let expected = - Invalid ( + Invalid( [], - Map.ofList [ - ([mkName "EmailAddress" |> Option.get], [EmailAddressFailure InvalidEmail]) - ([mkName "PhoneNumber" |> Option.get], [MissingConditionalPhone]) - ]) - Assert.Equal(expected, UserContactDTO.makeUserContact(input)) + Map.ofList + [ ([ mkName "EmailAddress" |> Option.get ], [ EmailAddressFailure InvalidEmail ]) + ([ mkName "PhoneNumber" |> Option.get ], [ MissingConditionalPhone ]) ] + ) + + Assert.Equal(expected, UserContactDTO.makeUserContact (input)) diff --git a/tests/FSharp.Data.Validation.Tests/Tests/Library.fs b/tests/FSharp.Data.Validation.Tests/Tests/Library.fs deleted file mode 100644 index dc56cdf..0000000 --- a/tests/FSharp.Data.Validation.Tests/Tests/Library.fs +++ /dev/null @@ -1,329 +0,0 @@ -module FSharp.Data.Validation.Tests.Library - -open Xunit -open FsCheck -open FsCheck.Xunit -open FsUnit.Xunit - -open FSharp.Data.Validation - -[] -let ``fromVCTx: Transforms a ValidCtx to a Valid Proof`` - (a : int) - = - let input = ValidCtx a - let result = fromVCtx input - Assert.Equal(Valid a, result) - -[] -let ``fromVCTx: Transforms a DisputedCtx to an Invalid Proof`` - (a : int, NonWhiteSpaceString n1, lf1 : int, gf1: int) - = - let field1 = mkName n1 |> Option.get - // Todo: make failures of arbitrary length - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] - - let input = DisputedCtx (gfs, lfs, a) - let result = fromVCtx input - Assert.Equal(Invalid (gfs, lfs), result) - -[] -let ``fromVCTx: Transforms a RefutedCtx to an Invalid Proof`` - (NonWhiteSpaceString n1, lf1 : int, gf1: int) - = - let field1 = mkName n1 |> Option.get - // Todo: make failures of arbitrary length - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] - - let input = RefutedCtx (gfs, lfs) - let result = fromVCtx input - Assert.Equal(Invalid (gfs, lfs), result) - -[] -let ``isRequired: Adds a failure to the context if the value is None`` - (NonWhiteSpaceString f1) - = - let input : int option = None - let result = isRequired f1 input - Assert.Equal(Error f1, result) - -[] -let ``isRequired: Returns the value if Some`` - (a : int, NonWhiteSpaceString f1) - = - let input : int option = Some a - let result = isRequired f1 input - Assert.Equal(Ok a, result) - - -[] -let ``isRequiredWhen: Returns None when the value is Some`` - (a : int, NonWhiteSpaceString f1, b : bool) - = - let input : int option = Some a - let result = isRequiredWhen f1 b input - Assert.Equal(None, result) - -[] -let ``isRequiredWhen: Returns None when the value is None and condition is false`` - (NonWhiteSpaceString f1) - = - let input : int option = None - let result = isRequiredWhen f1 false input - Assert.Equal(None, result) - -[] -let ``isRequiredWhen: Returns Some error when the value is None and condition is true`` - (NonWhiteSpaceString f1) - = - let input : int option = None - let result = isRequiredWhen f1 true input - Assert.Equal(Some f1, result) - -[] -let ``isRequiredUnless: Returns None when the value is Some`` - (a : int, NonWhiteSpaceString f1, b : bool) - = - let input : int option = Some a - let result = isRequiredUnless f1 b input - Assert.Equal( None, result) - -[] -let ``isRequiredUnless: Returns Some Error when the value is None and condition is false`` - (NonWhiteSpaceString f1) - = - let input : int option = None - let result = isRequiredUnless f1 false input - Assert.Equal(Some f1, result) - -[] -let ``isRequiredUnless: Returns None when the value is None and condition is true`` - (NonWhiteSpaceString f1) - = - let input : int option = None - let result = isRequiredUnless f1 true input - Assert.Equal(None, result) - -[] -let ``isError: Returns true when Result is Error`` (NonWhiteSpaceString a) = - Assert.True(isError (Error a)) - -[] -let ``isError: Returns false when Result is Ok`` (NonWhiteSpaceString a) = - Assert.False(isError (Ok a)) - -[] -let ``isOk: Returns true when Result is OK`` (NonWhiteSpaceString a) = - Assert.True(isOk (Ok a)) - -[] -let ``isOk: Returns false when Result is Error`` (NonWhiteSpaceString a) = - Assert.False(isOk (Error a)) - -[] -let ``isNull: Returns true when empty`` () = - Assert.True(isNull "") - -[] -let ``isNull: Returns false when not empty`` (NonWhiteSpaceString a) = - Assert.False(isNull a) - -[] -let ``isNotNull: Returns false when empty`` () = - Assert.False(isNotNull "") - -[] -let ``isNotNull: Returns true when not empty`` (NonWhiteSpaceString a) = - Assert.True(isNotNull a) - -[] -let ``minLength: false when too short`` (NonWhiteSpaceString a, PositiveInt b) = - Assert.False(minLength (a.Length + b) a) - -[] -let ``minLength: true when correct length`` (NonWhiteSpaceString a) = - Assert.True(minLength a.Length a) - -[] -let ``minLength: true when greater than required length`` (NonWhiteSpaceString a) = - Assert.True(minLength (a.Length - 1) a) - -[] -let ``maxLength: false when too long`` (NonWhiteSpaceString a) = - Assert.False(maxLength (a.Length - 1) a) - -[] -let ``maxLength: true when correct length`` (NonWhiteSpaceString a) = - Assert.True(maxLength a.Length a) - -[] -let ``maxLength: true when less than required length`` (NonWhiteSpaceString a, PositiveInt b) = - Assert.True(maxLength (a.Length + b) a) - -[] -let ``isLength: false when too long`` (NonWhiteSpaceString a) = - Assert.False(isLength (a.Length - 1) a) - -[] -let ``isLength: true when correct length`` (NonWhiteSpaceString a) = - Assert.True(isLength a.Length a) - -[] -let ``isLength: false when less than required length`` (NonWhiteSpaceString a, PositiveInt b) = - Assert.False(isLength (a.Length + b) a) - -[] -let ``isEqual: true when equal`` (a : int) = - Assert.True(isEqual a a ) - -[] -let ``isEqual: false when not equal, less than`` (a : int) = - Assert.False(isEqual a (a - 1)) - -[] -let ``isEqual: false when not equal, greater`` (a : int) = - Assert.False(isEqual a (a + 1)) - -[] -let ``isNotEqual: false when equal`` (a : int) = - Assert.False(isNotEqual a a ) - -[] -let ``isNotEqual: true when not equal, less than`` (a : int) = - Assert.True(isNotEqual a (a - 1)) - -[] -let ``isNotEqual: true when not equal, greater`` (a : int) = - Assert.True(isNotEqual a (a + 1)) - -// For comparative operators, our validation input is b, so these may seem logically reversed -[] -let ``isLessThan: true when b is less than a`` (NegativeInt b, NonNegativeInt a) = - Assert.True(isLessThan a b) - -[] -let ``isLessThan: false when equal`` (a : int) = - Assert.False(isLessThan a a) - -[] -let ``isLessThan: false when b is greater than a`` (NonNegativeInt b, NegativeInt a) = - Assert.False(isLessThan a b) - -[] -let ``isGreaterThan: false when b is less than a`` (NegativeInt b, NonNegativeInt a) = - Assert.False(isGreaterThan a b) - -[] -let ``isGreaterThan: false when equal`` (a : int) = - Assert.False(isGreaterThan a a) - -[] -let ``isGreaterThan: true when b is greater than a`` (NonNegativeInt b, NegativeInt a) = - Assert.True(isGreaterThan a b) - -[] -let ``isLessThanOrEqual: true when b is less than a`` (NegativeInt b, NonNegativeInt a) = - Assert.True(isLessThanOrEqual a b) - -[] -let ``isLessThanOrEqual: true when equal`` (a : int) = - Assert.True(isLessThanOrEqual a a) - -[] -let ``isLessThanOrEqual: false when b is greater than a`` (NonNegativeInt b, NegativeInt a) = - Assert.False(isLessThanOrEqual a b) - -[] -let ``isGreaterThanOrEqual: false when b is less than a`` (NegativeInt b, NonNegativeInt a) = - Assert.False(isGreaterThanOrEqual a b) - -[] -let ``isGreaterThanOrEqual: false when equal`` (a : int) = - Assert.True(isGreaterThanOrEqual a a) - -[] -let ``isGreaterThanOrEqual: true when b is greater than a`` (NonNegativeInt b, NegativeInt a) = - Assert.True(isGreaterThanOrEqual a b) - -[] -let ``hasElem: true when collection includes element`` () = - let input = [1;2;5;7] - Assert.True(hasElem 5 input) - -[] -let ``hasElem: false when collection is missing element`` () = - let input = [1;2;5;7] - Assert.False(hasElem 3 input) - -[] -let ``doesNotHaveElem: true when collection is missing element`` () = - let input = [1;2;5;7] - Assert.False(hasElem 3 input) - -[] -let ``doesNotHaveElem: false when collection includes element`` () = - let input = [1;2;5;7] - Assert.True(hasElem 5 input) - -type Five = Five -type NotFiveError = NotFiveError - -let mk5 i = - validation { - withValue i - disputeWithFact NotFiveError (isEqual 5) - qed (fun _ -> Five) - } |> fromVCtx - -let is5 i = - if i = 5 then Ok 5 else Error NotFiveError - -[] -let ``isValid: Returns true when Result is Valid`` (NonWhiteSpaceString a) = - Assert.True(isValid (Valid a)) - -[] -let ``isValid: Returns false when Result is Invalid`` () = - Assert.False(isValid (Invalid ([], Map.empty))) - -[] -let ``isInvalid: Returns false when Result is Valid`` (NonWhiteSpaceString a) = - Assert.False(isInvalid (Valid a)) - -[] -let ``isInvalid: Returns true when Result is Invalid`` () = - Assert.True(isInvalid (Invalid ([], Map.empty))) - -[] -let ``flattenProofs: Returns valid list when all proofs are valid`` () = - let input = [Valid 1; Valid 2; Valid 3] - let expected = Valid [1; 2; 3] - Assert.Equal(expected, flattenProofs input) - -[] -let ``flattenProofs: Returns invalid proof when some proofs are invalid`` () = - let input = [Valid 1; Invalid (["Failure"], Map.empty); Valid 3] - let expected = Invalid (["Failure"], Map.empty) - Assert.Equal(expected, flattenProofs input) - -[] -let ``flattenProofs: Returns invalid proof when all proofs are invalid`` () = - let field1 = mkName "Field1" |> Option.get - let input = [ - Invalid (["GFailure1"], Map.ofList [([field1], ["Failure1"])]) - Invalid (["GFailure2"], Map.empty) - Invalid ([], Map.ofList [([field1], ["Failure2"])]) - ] - let expected = Invalid (["GFailure1"; "GFailure2"], Map.ofList [([field1], ["Failure1"; "Failure2"])]) - Assert.Equal(expected, flattenProofs input) - -[] -let ``raiseIfInvalid: Returns value when result is Valid`` (a : int) = - raiseIfInvalid "test" (Valid a) |> should equal a - -[] -let ``raiseIfInvalid: Raises InvalidProofException if Invalid`` () = - (fun () -> raiseIfInvalid "test" (Invalid (["test"], Map.empty)) |> ignore) - |> should (throwWithMessage "test") typeof> diff --git a/tests/FSharp.Data.Validation.Tests/Tests/Proof.fs b/tests/FSharp.Data.Validation.Tests/Tests/Proof.fs index a6aaba3..e0f79f7 100644 --- a/tests/FSharp.Data.Validation.Tests/Tests/Proof.fs +++ b/tests/FSharp.Data.Validation.Tests/Tests/Proof.fs @@ -3,91 +3,89 @@ module FSharp.Data.Validation.Tests.Proof open Xunit open FsCheck open FsCheck.Xunit +open FsUnit.Xunit open System.Text.Json open FSharp.Data.Validation [] -let ``map: Does not change the contents of an invalid proof`` - (gf1, NonWhiteSpaceString n1, lf1) - = +let ``map: Does not change the contents of an invalid proof`` (gf1, NonWhiteSpaceString n1, lf1) = let field1 = mkName n1 |> Option.get - let input : Proof = Invalid ([gf1], Map.ofList [([field1], [lf1])]) + + let input: Proof = + Invalid([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]) ]) + let result = Proof.map (fun a -> a + 1) input Assert.Equal(input, result) [] -let ``map: Converts a Proof to a Proof`` - (n : int) - = +let ``map: Converts a Proof to a Proof`` (n: int) = let input = Valid n let result = Proof.map (fun a -> a.ToString()) input - Assert.Equal(Valid (n.ToString()), result) + Assert.Equal(Valid(n.ToString()), result) [] -let ``mapInvalid: Does not change the contents of a valid proof`` - (n : int) - = +let ``mapInvalid: Does not change the contents of a valid proof`` (n: int) = let input = Valid n let result = Proof.mapInvalid (fun a -> a + 1) input Assert.Equal(input, result) [] -let ``mapInvalid: Converts a Proof to a Proof`` - (gf1 : int, lf1 : int, NonWhiteSpaceString n1) - = +let ``mapInvalid: Converts a Proof to a Proof`` (gf1: int, lf1: int, NonWhiteSpaceString n1) = let field1 = mkName n1 |> Option.get - let input : Proof = Invalid ([gf1], Map.ofList [([field1], [lf1])]) + let input: Proof = Invalid([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]) ]) let result = Proof.mapInvalid (fun a -> a.ToString()) input - let expected : Proof = Invalid ([gf1.ToString()], Map.ofList [([field1], [lf1.ToString()])]) + + let expected: Proof = + Invalid([ gf1.ToString() ], Map.ofList [ ([ field1 ], [ lf1.ToString() ]) ]) + Assert.Equal(expected, result) [] -let ``combine: two valid proof results in valid proof`` (a : int, b : int) = +let ``combine: two valid proof results in valid proof`` (a: int, b: int) = let input1 = Valid a let input2 = Valid b let result = Proof.combine (+) input1 input2 - Assert.Equal(Valid (a + b), result) + Assert.Equal(Valid(a + b), result) [] let ``combine: one valid and one invalid proof results in invalid proof`` - (a : int, b : string, NonWhiteSpaceString c, d : string) + (a: int, b: string, NonWhiteSpaceString c, d: string) = let field1 = mkName c |> Option.get let input1 = Valid a - let input2 = - Invalid ([b], Map.ofList [([field1], [d])]) + let input2 = Invalid([ b ], Map.ofList [ ([ field1 ], [ d ]) ]) let result = Proof.combine (+) input1 input2 Assert.Equal(input2, result) [] let ``combine: one invalid and one valid proof results in invalid proof`` - (a : string, NonWhiteSpaceString b, c : string, d: int) + (a: string, NonWhiteSpaceString b, c: string, d: int) = let field1 = mkName b |> Option.get - let input1 = - Invalid ([a], Map.ofList [([field1], [c])]) + let input1 = Invalid([ a ], Map.ofList [ ([ field1 ], [ c ]) ]) let input2 = Valid d let result = Proof.combine (+) input1 input2 Assert.Equal(input1, result) [] -let ``combine: two invalid proofs results in concatenated errors`` - (gf1, gf2, lf1 : string, lf2 : string, lf3 : string) - = +let ``combine: two invalid proofs results in concatenated errors`` (gf1, gf2, lf1: string, lf2: string, lf3: string) = let field1 = mkName "Field1" |> Option.get let field2 = mkName "Field2" |> Option.get - let input1 = - Invalid ([gf1], Map.ofList [([field1], [lf1])]) + let input1 = Invalid([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]) ]) + let input2 = - Invalid ([gf2], Map.ofList [([field1], [lf2]); ([field2], [lf3])]) + Invalid([ gf2 ], Map.ofList [ ([ field1 ], [ lf2 ]); ([ field2 ], [ lf3 ]) ]) + let result = Proof.combine (+) input1 input2 + let expected = - Invalid ([gf1; gf2], Map.ofList [([field1], [lf1; lf2]); ([field2], [lf3])]) + Invalid([ gf1; gf2 ], Map.ofList [ ([ field1 ], [ lf1; lf2 ]); ([ field2 ], [ lf3 ]) ]) + Assert.Equal(expected, result) -type MyRecord = { MyName: string; MyInt: int; } +type MyRecord = { MyName: string; MyInt: int } [] let ``serialize: valid proof of type T should result in JSON representing T`` () = @@ -98,17 +96,18 @@ let ``serialize: valid proof of type T should result in JSON representing T`` () let json = JsonSerializer.Serialize(sot) //Assert - Assert.Equal("{\"MyName\":\"John Smith\",\"MyInt\":42}", json) + json |> should equal "{\"MyName\":\"John Smith\",\"MyInt\":42}" type MyFailures = | EmptyName | IntToSmall | NameAndNumberDoNotMatch of string * int + override this.ToString() = match this with - | EmptyName -> "MyName cannot be empty." - | IntToSmall -> "MyInt cannot be less than 42." - | NameAndNumberDoNotMatch (n,i) -> sprintf "%s's number can only be 42, not %i." n i + | EmptyName -> "MyName cannot be empty." + | IntToSmall -> "MyInt cannot be less than 42." + | NameAndNumberDoNotMatch(n, i) -> sprintf "%s's number can only be 42, not %i." n i [] let ``serialize: invalid proof of type T should result in JSON representing the failures`` () = @@ -116,12 +115,210 @@ let ``serialize: invalid proof of type T should result in JSON representing the let myName = (mkName "MyName").Value let myObj = (mkName "MyObj").Value let myInt = (mkName "MyInt").Value - let gfs = [NameAndNumberDoNotMatch ("John Smith", 41)] - let lfs = Map.ofList [([myName], [EmptyName]); ([myObj; myInt], [IntToSmall])] - let sot = Invalid (gfs, lfs) + let gfs = [ NameAndNumberDoNotMatch("John Smith", 41) ] + + let lfs = + Map.ofList [ ([ myName ], [ EmptyName ]); ([ myObj; myInt ], [ IntToSmall ]) ] + + let sot = Invalid(gfs, lfs) // Act let json = JsonSerializer.Serialize(sot) //Assert - Assert.Equal("{\"failures\":[\"John Smith\\u0027s number can only be 42, not 41.\"],\"fields\":{\"myName\":[\"MyName cannot be empty.\"],\"myObj.myInt\":[\"MyInt cannot be less than 42.\"]}}", json) + json + |> should + equal + "{\"failures\":[\"John Smith\\u0027s number can only be 42, not 41.\"],\"fields\":{\"myName\":[\"MyName cannot be empty.\"],\"myObj.myInt\":[\"MyInt cannot be less than 42.\"]}}" + +[] +let ``toResult: Valid proof becomes Ok`` (a: int) = + let input = Valid a + let result = Proof.toResult input + Assert.Equal(Ok a, result) + +[] +let ``toResult: Invalid proof becomes Error with both global and field failures`` + (gf1: string, gf2: string, lf1: string, NonWhiteSpaceString field1Name) + = + let field1 = mkName field1Name |> Option.get + + let input: Proof = + Invalid([ gf1; gf2 ], Map.ofList [ ([ field1 ], [ lf1 ]) ]) + + let result = Proof.toResult input + + match result with + | Error vf -> + Assert.Equal([ gf1; gf2 ], vf.Failures) + Assert.True(Map.containsKey [ field1 ] vf.Fields) + | _ -> failwith "Expected Error result" + +[] +let ``toValidationFailures: Valid proof returns None`` (a: int) = + let input = Valid a + let result = Proof.toValidationFailures input + Assert.Null(result) + +[] +let ``toValidationFailures: Invalid proof with only global failures`` (gf1: string, gf2: string) = + let input: Proof = Invalid([ gf1; gf2 ], Map.empty) + let result = Proof.toValidationFailures input + + match result with + | Some vf -> Assert.Equal([ gf1; gf2 ], vf.Failures) + | None -> failwith "Expected Some result" + +[] +let ``toValidationFailures: Invalid proof with field and global failures`` + (gf1: string, lf1: string, NonWhiteSpaceString field1Name) + = + let field1 = mkName field1Name |> Option.get + + let input: Proof = + Invalid([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]) ]) + + let result = Proof.toValidationFailures input + // Should include both global and field failures + match result with + | Some vf -> + Assert.Equal([ gf1 ], vf.Failures) + Assert.True(Map.containsKey [ field1 ] vf.Fields) + | None -> failwith "Expected Some result" + +// New Proof combinator tests + +[] +let ``sequence: Returns Valid list when all proofs are Valid`` () = + let proofs = [ Valid 1; Valid 2; Valid 3 ] + let result = Proof.sequence proofs + result |> should equal (Valid [ 1; 2; 3 ]) + +[] +let ``sequence: Returns Invalid when any proof is Invalid`` () = + let field1 = mkName "Field1" |> Option.get + + let proofs = + [ Valid 1 + Invalid([ "Error" ], Map.ofList [ ([ field1 ], [ "FieldError" ]) ]) + Valid 3 ] + + match Proof.sequence proofs with + | Invalid(gfs, lfs) -> + gfs |> should equal [ "Error" ] + Map.containsKey [ field1 ] lfs |> should be True + | _ -> failwith "Expected Invalid result" + +[] +let ``sequence: Aggregates failures from multiple Invalid proofs`` () = + let field1 = mkName "Field1" |> Option.get + let field2 = mkName "Field2" |> Option.get + + let proofs = + [ Invalid([ "Error1" ], Map.ofList [ ([ field1 ], [ "FieldError1" ]) ]) + Invalid([ "Error2" ], Map.ofList [ ([ field2 ], [ "FieldError2" ]) ]) ] + + match Proof.sequence proofs with + | Invalid(gfs, lfs) -> + gfs |> should equal [ "Error1"; "Error2" ] + Map.count lfs |> should equal 2 + | _ -> failwith "Expected Invalid result" + +[] +let ``traverse: Maps and sequences valid proofs`` () = + let items = [ 1; 2; 3 ] + let fn x = Valid(x * 2) + let result = Proof.traverse fn items + result |> should equal (Valid [ 2; 4; 6 ]) + +[] +let ``traverse: Returns Invalid when any mapping fails`` () = + let items = [ 1; 2; 3 ] + + let fn x = + if x = 2 then + Invalid([ "Error" ], Map.empty) + else + Valid(x * 2) + + match Proof.traverse fn items with + | Invalid(gfs, _) -> gfs |> should equal [ "Error" ] + | _ -> failwith "Expected Invalid result" + +[] +let ``bind: Chains Valid proofs`` (a: int) = + let proof = Valid a + let fn x = Valid(x + 1) + let result = Proof.bind fn proof + Assert.Equal(Valid(a + 1), result) + +[] +let ``bind: Returns Invalid when first proof is Invalid`` (gf: string) = + let proof: Proof = Invalid([ gf ], Map.empty) + let fn x = Valid(x + 1) + let result = Proof.bind fn proof + Assert.Equal(proof, result) + +[] +let ``bind: Returns Invalid when function returns Invalid`` (a: int, gf: string) = + let proof = Valid a + let fn _ = Invalid([ gf ], Map.empty) + + match Proof.bind fn proof with + | Invalid(gfs, _) -> Assert.Equal([ gf ], gfs) + | _ -> failwith "Expected Invalid result" + +[] +let ``apply: Applies function to value when both are Valid`` (a: int) = + let fnProof = Valid(fun x -> x + 1) + let valueProof = Valid a + let result = Proof.apply fnProof valueProof + Assert.Equal(Valid(a + 1), result) + +[] +let ``apply: Returns Invalid when function proof is Invalid`` (a: int, gf: string) = + let fnProof: Proof int> = Invalid([ gf ], Map.empty) + let valueProof = Valid a + + match Proof.apply fnProof valueProof with + | Invalid(gfs, _) -> Assert.Equal([ gf ], gfs) + | _ -> failwith "Expected Invalid result" + +[] +let ``apply: Returns Invalid when value proof is Invalid`` (gf: string) = + let fnProof = Valid(fun x -> x + 1) + let valueProof: Proof = Invalid([ gf ], Map.empty) + + match Proof.apply fnProof valueProof with + | Invalid(gfs, _) -> Assert.Equal([ gf ], gfs) + | _ -> failwith "Expected Invalid result" + +[] +let ``apply: Aggregates failures when both are Invalid`` (gf1: string, gf2: string) = + let fnProof: Proof int> = Invalid([ gf1 ], Map.empty) + let valueProof: Proof = Invalid([ gf2 ], Map.empty) + + match Proof.apply fnProof valueProof with + | Invalid(gfs, _) -> Assert.Equal([ gf1; gf2 ], gfs) + | _ -> failwith "Expected Invalid result" + +[] +let ``choose: Returns first proof when Valid`` (a: int, b: int) = + let first = Valid a + let second = Valid b + let result = Proof.choose first second + Assert.Equal(first, result) + +[] +let ``choose: Returns second proof when first is Invalid and second is Valid`` (a: int, gf: string) = + let first: Proof = Invalid([ gf ], Map.empty) + let second = Valid a + let result = Proof.choose first second + Assert.Equal(second, result) + +[] +let ``choose: Returns first proof when both are Invalid`` (gf1: string, gf2: string) = + let first: Proof = Invalid([ gf1 ], Map.empty) + let second: Proof = Invalid([ gf2 ], Map.empty) + let result = Proof.choose first second + Assert.Equal(first, result) diff --git a/tests/FSharp.Data.Validation.Tests/Tests/Utilities.fs b/tests/FSharp.Data.Validation.Tests/Tests/Utilities.fs index 7d6a3db..a52c17d 100644 --- a/tests/FSharp.Data.Validation.Tests/Tests/Utilities.fs +++ b/tests/FSharp.Data.Validation.Tests/Tests/Utilities.fs @@ -3,57 +3,63 @@ open Xunit open FsCheck open FsCheck.Xunit +open FsUnit.Xunit open FSharp.Data.Validation open FSharp.Data.Validation.Utilities [] let ``catOptions: empty list results in empty list`` () = - Assert.Equal([], catOptions []) + catOptions [] |> Seq.toList |> should equal [] [] let ``catOptions: all Some list results in all elements`` () = - Assert.Equal([1; 2], catOptions [Some 1; Some 2]) + catOptions [ Some 1; Some 2 ] |> Seq.toList |> should equal [ 1; 2 ] [] let ``catOptions: all None list results in empty list`` () = - Assert.Equal([], catOptions [None; None]) + catOptions [ None; None ] |> Seq.toList |> should equal [] [] let ``catOptions: mixed list results in only Somes`` () = - Assert.Equal([1; 2], catOptions [Some 1; None; Some 2; None]) + catOptions [ Some 1; None; Some 2; None ] |> Seq.toList |> should equal [ 1; 2 ] [] -let ``oks: empty list results in empty list`` () = - Assert.Equal([], oks []) +let ``oks: empty list results in empty list`` () = oks [] |> Seq.toList |> should equal [] [] let ``oks: all Ok list results in all elements`` () = - Assert.Equal([1; 2], oks [Ok 1; Ok 2]) + oks [ Ok 1; Ok 2 ] |> Seq.toList |> should equal [ 1; 2 ] [] let ``oks: all Error list results in empty list`` () = - Assert.Equal([], oks [Error "String 1"; Error "String 2"]) + oks [ Error "String 1"; Error "String 2" ] |> Seq.toList |> should equal [] [] let ``oks: mixed list results in only Oks`` () = - Assert.Equal([1; 2], oks [Ok 1; Error "String 1"; Ok 2; Error "String 2"]) + oks [ Ok 1; Error "String 1"; Ok 2; Error "String 2" ] + |> Seq.toList + |> should equal [ 1; 2 ] [] let ``errors: empty list results in empty list`` () = - Assert.Equal([], errors []) + errors [] |> Seq.toList |> should equal [] [] let ``errors: all Ok list results in empty list`` () = - Assert.Equal([], errors [Ok 1; Ok 2]) + errors [ Ok 1; Ok 2 ] |> Seq.toList |> should equal [] [] let ``errors: all Error list results in all elements`` () = - Assert.Equal(["String 1"; "String 2"], errors [Error "String 1"; Error "String 2"]) + errors [ Error "String 1"; Error "String 2" ] + |> Seq.toList + |> should equal [ "String 1"; "String 2" ] [] let ``errors: mixed list results in only Errors`` () = - Assert.Equal(["String 1"; "String 2"], errors [Ok 1; Error "String 1"; Ok 2; Error "String 2"]) + errors [ Ok 1; Error "String 1"; Ok 2; Error "String 2" ] + |> Seq.toList + |> should equal [ "String 1"; "String 2" ] [] let ``mergeFailures: two empty FailureMap results in empty FailureMap`` () = @@ -65,58 +71,57 @@ let ``mergeFailures: two empty FailureMap results in empty FailureMap`` () = [] let ``mergeFailures: an empty FailureMap and populated FailureMap result in the populated`` - (NonWhiteSpaceString n1, e1 : string) + (NonWhiteSpaceString n1, e1: string) = let name1 = mkName n1 |> Option.get let input1 = Map.ofList [] - let input2 = Map.ofList [([name1], [e1])] + let input2 = Map.ofList [ ([ name1 ], [ e1 ]) ] let result = mergeFailures input1 input2 result = input2 [] let ``mergeFailures: a populated FailureMap and an empty FailureMap result in the populated`` - (NonWhiteSpaceString n1, e1 : string) + (NonWhiteSpaceString n1, e1: string) = let name1 = mkName n1 |> Option.get - let input1 = Map.ofList [([name1], [e1])] + let input1 = Map.ofList [ ([ name1 ], [ e1 ]) ] let input2 = Map.ofList [] let result = mergeFailures input1 input2 result = input1 [] -let ``mergeFailures: two single element FailureMaps of different names merge properly`` - (e1 : string, e2 : string) - = +let ``mergeFailures: two single element FailureMaps of different names merge properly`` (e1: string, e2: string) = // Need to ensure names are distinct let name1 = mkName "Name1" |> Option.get let name2 = mkName "Name2" |> Option.get - let input1 = Map.ofList [([name1], [e1])] - let input2 = Map.ofList [([name2], [e2])] + let input1 = Map.ofList [ ([ name1 ], [ e1 ]) ] + let input2 = Map.ofList [ ([ name2 ], [ e2 ]) ] let result = mergeFailures input1 input2 - let expected = Map.ofList [([name1], [e1]); ([name2], [e2])] + let expected = Map.ofList [ ([ name1 ], [ e1 ]); ([ name2 ], [ e2 ]) ] result = expected [] let ``mergeFailures: two single element FailureMaps of the same name merge properly`` - (NonWhiteSpaceString n1, e1 : string, e2 : string) + (NonWhiteSpaceString n1, e1: string, e2: string) = let name1 = mkName n1 |> Option.get - let input1 = Map.ofList [([name1], [e1])] - let input2 = Map.ofList [([name1], [e2])] + let input1 = Map.ofList [ ([ name1 ], [ e1 ]) ] + let input2 = Map.ofList [ ([ name1 ], [ e2 ]) ] let result = mergeFailures input1 input2 - let expected = Map.ofList [([name1], [e1; e2])] + let expected = Map.ofList [ ([ name1 ], [ e1; e2 ]) ] result = expected [] -let ``mergeFailures: two multi element FailureMaps merge properly`` - (e1 : string, e2 : string, e3 : string, e4 : string) - = +let ``mergeFailures: two multi element FailureMaps merge properly`` (e1: string, e2: string, e3: string, e4: string) = // Need to ensure names are distinct let name1 = mkName "Name1" |> Option.get let name2 = mkName "Name2" |> Option.get let name3 = mkName "Name3" |> Option.get - let input1 = Map.ofList [([name1], [e1]); ([name2], [e2])] - let input2 = Map.ofList [([name2], [e3]); ([name3], [e4])] + let input1 = Map.ofList [ ([ name1 ], [ e1 ]); ([ name2 ], [ e2 ]) ] + let input2 = Map.ofList [ ([ name2 ], [ e3 ]); ([ name3 ], [ e4 ]) ] let result = mergeFailures input1 input2 - let expected = Map.ofList [([name1], [e1]); ([name2], [e2; e3]); ([name3], [e4])] + + let expected = + Map.ofList [ ([ name1 ], [ e1 ]); ([ name2 ], [ e2; e3 ]); ([ name3 ], [ e4 ]) ] + result = expected diff --git a/tests/FSharp.Data.Validation.Tests/Tests/VCtx.fs b/tests/FSharp.Data.Validation.Tests/Tests/VCtx.fs index 8ee732a..c1c99d0 100644 --- a/tests/FSharp.Data.Validation.Tests/Tests/VCtx.fs +++ b/tests/FSharp.Data.Validation.Tests/Tests/VCtx.fs @@ -8,112 +8,100 @@ open FsUnit.Xunit open FSharp.Data.Validation [] -let ``map: Transforms a ValidCtx`` - (a : int) - = +let ``map: Transforms a ValidCtx`` (a: int) = let input = ValidCtx a let result = VCtx.map (fun b -> b.ToString()) input - Assert.Equal(ValidCtx (a.ToString()), result) + Assert.Equal(ValidCtx(a.ToString()), result) [] -let ``map: Transforms a DisputedCtx while preserving failures`` - (a : int, NonWhiteSpaceString n1, lf1 : int, gf1: int) - = +let ``map: Transforms a DisputedCtx while preserving failures`` (a: int, NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get // Todo: make failures of arbitrary length - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] - let input = DisputedCtx (gfs, lfs, a) + let input = DisputedCtx(gfs, lfs, a) let result = VCtx.map (fun b -> b.ToString()) input - Assert.Equal(DisputedCtx (gfs, lfs, a.ToString()), result) + Assert.Equal(DisputedCtx(gfs, lfs, a.ToString()), result) [] -let ``map: Makes no changes to a RefutedCtx`` - (NonWhiteSpaceString n1, lf1 : int, gf1: int) - = +let ``map: Makes no changes to a RefutedCtx`` (NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get // Todo: make failures of arbitrary length - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] - let input = RefutedCtx (gfs, lfs) + let input = RefutedCtx(gfs, lfs) let result = VCtx.map (fun b -> b.ToString()) input Assert.Equal(input, result) [] -let ``bind: Transforms a ValidCtx`` - (a : int) - = +let ``bind: Transforms a ValidCtx`` (a: int) = let input = ValidCtx a let result = VCtx.bind (fun b -> ValidCtx(b.ToString())) input - Assert.Equal(ValidCtx (a.ToString()), result) + Assert.Equal(ValidCtx(a.ToString()), result) [] -let ``bind: Makes no changes to a RefutedCtx`` - (NonWhiteSpaceString n1, lf1 : int, gf1: int) - = +let ``bind: Makes no changes to a RefutedCtx`` (NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get // Todo: make failures of arbitrary length - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] - let input = RefutedCtx (gfs, lfs) - let result = VCtx.bind (fun a -> ValidCtx (a + 1)) input + let input = RefutedCtx(gfs, lfs) + let result = VCtx.bind (fun a -> ValidCtx(a + 1)) input Assert.Equal(input, result) [] let ``bind: Bind a DisputedCtx with a ValidCtx properly, results in DisputedCtx with same failures`` - (a : int, NonWhiteSpaceString n1, lf1 : int, gf1: int) + (a: int, NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get // Todo: make failures of arbitrary length - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] - let input = DisputedCtx (gfs, lfs, a) - let result = VCtx.bind (fun a -> ValidCtx (a + 1)) input - Assert.Equal(DisputedCtx (gfs, lfs, a + 1), result) + let input = DisputedCtx(gfs, lfs, a) + let result = VCtx.bind (fun a -> ValidCtx(a + 1)) input + Assert.Equal(DisputedCtx(gfs, lfs, a + 1), result) [] let ``bind: Bind a DisputedCtx with a DisputedCtx properly, results in DisputedCtx with merged failures`` - (a : int, NonWhiteSpaceString n1, lf1 : int, lf2 : int, gf1 : int, gf2 : int) + (a: int, NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get // Todo: make failures of arbitrary length - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] let lfsResult = Utilities.mergeFailures lfs lfs2 - let input = DisputedCtx (gfs, lfs, a) - let result = VCtx.bind (fun a -> DisputedCtx (gfs2, lfs2, a + 1)) input - Assert.Equal(DisputedCtx ([gf1; gf2], lfsResult, a + 1), result) + let input = DisputedCtx(gfs, lfs, a) + let result = VCtx.bind (fun a -> DisputedCtx(gfs2, lfs2, a + 1)) input + Assert.Equal(DisputedCtx([ gf1; gf2 ], lfsResult, a + 1), result) [] let ``bind: Bind a DisputedCtx with a RefutedCtx properly, results in RefutedCtx with merged failures`` - (a : int, NonWhiteSpaceString n1, lf1 : int, lf2 : int, gf1 : int, gf2 : int) + (a: int, NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get // Todo: make failures of arbitrary length - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] let lfsResult = Utilities.mergeFailures lfs lfs2 - let input = DisputedCtx (gfs, lfs, a) - let result = VCtx.bind (fun _ -> RefutedCtx (gfs2, lfs2)) input - Assert.Equal(RefutedCtx ([gf1; gf2], lfsResult), result) + let input = DisputedCtx(gfs, lfs, a) + let result = VCtx.bind (fun _ -> RefutedCtx(gfs2, lfs2)) input + Assert.Equal(RefutedCtx([ gf1; gf2 ], lfsResult), result) [] -let ``mergeSources with two ValidCtx should return ValidCtx with tuple`` - (a: int, b: int) - = +let ``mergeSources with two ValidCtx should return ValidCtx with tuple`` (a: int, b: int) = let input1 = ValidCtx a let input2 = ValidCtx b - let expected = ValidCtx (a, b) + let expected = ValidCtx(a, b) Assert.Equal(expected, VCtx.mergeSources input1 input2) [] @@ -121,11 +109,11 @@ let ``mergeSources: Merging one ValidCtx and one DisputedCtx results in Disputed (a: int, b: int, NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] let input1 = ValidCtx a - let input2 = DisputedCtx (gfs, lfs, b) - let expected = DisputedCtx (gfs, lfs, (a, b)) + let input2 = DisputedCtx(gfs, lfs, b) + let expected = DisputedCtx(gfs, lfs, (a, b)) Assert.Equal(expected, VCtx.mergeSources input1 input2) [] @@ -133,11 +121,11 @@ let ``mergeSources: Merging one ValidCtx and one RefutedCtx results in RefutedCt (a: int, NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] let input1 = ValidCtx a - let input2 = RefutedCtx (gfs, lfs) - let expected = RefutedCtx (gfs, lfs) + let input2 = RefutedCtx(gfs, lfs) + let expected = RefutedCtx(gfs, lfs) Assert.Equal(expected, VCtx.mergeSources input1 input2) [] @@ -145,14 +133,14 @@ let ``mergeSources: Merging two DisputedCtx results in DisputedCtx`` (a: int, b: int, NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get - let gfs1 = [gf1] - let lfs1 = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs1 = [ gf1 ] + let lfs1 = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] let lfsResult = Utilities.mergeFailures lfs1 lfs2 - let input1 = DisputedCtx (gfs1, lfs1, a) - let input2 = DisputedCtx (gfs2, lfs2, b) - let expected = DisputedCtx (gfs1 @ gfs2, lfsResult, (a, b)) + let input1 = DisputedCtx(gfs1, lfs1, a) + let input2 = DisputedCtx(gfs2, lfs2, b) + let expected = DisputedCtx(gfs1 @ gfs2, lfsResult, (a, b)) Assert.Equal(expected, VCtx.mergeSources input1 input2) [] @@ -160,14 +148,14 @@ let ``mergeSources: Merging one DisputedCtx and one RefutedCtx results in Refute (a: int, NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get - let gfs1 = [gf1] - let lfs1 = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs1 = [ gf1 ] + let lfs1 = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] let lfsResult = Utilities.mergeFailures lfs1 lfs2 - let input1 = DisputedCtx (gfs1, lfs1, a) - let input2 = RefutedCtx (gfs2, lfs2) - let expected = RefutedCtx (gfs1 @ gfs2, lfsResult) + let input1 = DisputedCtx(gfs1, lfs1, a) + let input2 = RefutedCtx(gfs2, lfs2) + let expected = RefutedCtx(gfs1 @ gfs2, lfsResult) Assert.Equal(expected, VCtx.mergeSources input1 input2) [] @@ -175,100 +163,92 @@ let ``mergeSources: Merging two RefutedCtx results in RefutedCtx`` (NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get - let gfs1 = [gf1] - let lfs1 = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs1 = [ gf1 ] + let lfs1 = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] let lfsResult = Utilities.mergeFailures lfs1 lfs2 - let input1 = RefutedCtx (gfs1, lfs1) - let input2 = RefutedCtx (gfs2, lfs2) - let expected = RefutedCtx (gfs1 @ gfs2, lfsResult) + let input1 = RefutedCtx(gfs1, lfs1) + let input2 = RefutedCtx(gfs2, lfs2) + let expected = RefutedCtx(gfs1 @ gfs2, lfsResult) Assert.Equal(expected, VCtx.mergeSources input1 input2) [] let ``VCtxBuilder.Zero: Returns ValidCtx unit`` () = - VCtxBuilder().Zero() |> should equal (ValidCtx ()) + VCtxBuilder().Zero() |> should equal (ValidCtx()) [] -let ``VCtxBuilder.Bind: Transforms a ValidCtx`` - (a : int) - = +let ``VCtxBuilder.Bind: Transforms a ValidCtx`` (a: int) = let input = ValidCtx a - VCtxBuilder().Bind(input, fun b -> ValidCtx(b.ToString())) - |> should equal (ValidCtx (a.ToString())) + Assert.Equal(ValidCtx(a.ToString()), VCtxBuilder().Bind(input, (fun b -> ValidCtx(b.ToString())))) [] -let ``VCtxBuilder.Bind: Makes no changes to a RefutedCtx`` - (NonWhiteSpaceString n1, lf1 : int, gf1: int) - = +let ``VCtxBuilder.Bind: Makes no changes to a RefutedCtx`` (NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] - let input = RefutedCtx (gfs, lfs) + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let input = RefutedCtx(gfs, lfs) // TODO: FsUnit should equal fails to match maps it seems - Assert.Equal(input, VCtxBuilder().Bind(input, fun a -> ValidCtx (a + 1))) + Assert.Equal(input, VCtxBuilder().Bind(input, (fun a -> ValidCtx(a + 1)))) [] let ``VCtxBuilder.Bind: Bind a DisputedCtx with a ValidCtx properly, results in DisputedCtx with same failures`` - (a : int, NonWhiteSpaceString n1, lf1 : int, gf1: int) + (a: int, NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] - let input = DisputedCtx (gfs, lfs, a) - let result = VCtxBuilder().Bind(input, fun a -> ValidCtx (a + 1)) - Assert.Equal(DisputedCtx (gfs, lfs, a + 1), result) + let input = DisputedCtx(gfs, lfs, a) + let result = VCtxBuilder().Bind(input, (fun a -> ValidCtx(a + 1))) + Assert.Equal(DisputedCtx(gfs, lfs, a + 1), result) [] let ``VCtxBuilder.Bind: Bind a DisputedCtx with a DisputedCtx properly, results in DisputedCtx with merged failures`` - (a : int, NonWhiteSpaceString n1, lf1 : int, lf2 : int, gf1 : int, gf2 : int) + (a: int, NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] let lfsResult = Utilities.mergeFailures lfs lfs2 - let input = DisputedCtx (gfs, lfs, a) - let result = VCtxBuilder().Bind(input, fun a -> DisputedCtx (gfs2, lfs2, a + 1)) - Assert.Equal(DisputedCtx ([gf1; gf2], lfsResult, a + 1), result) + let input = DisputedCtx(gfs, lfs, a) + let result = VCtxBuilder().Bind(input, (fun a -> DisputedCtx(gfs2, lfs2, a + 1))) + Assert.Equal(DisputedCtx([ gf1; gf2 ], lfsResult, a + 1), result) [] let ``VCtxBuilder.Bind: Bind a DisputedCtx with a RefutedCtx properly, results in RefutedCtx with merged failures`` - (a : int, NonWhiteSpaceString n1, lf1 : int, lf2 : int, gf1 : int, gf2 : int) + (a: int, NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] let lfsResult = Utilities.mergeFailures lfs lfs2 - let input = DisputedCtx (gfs, lfs, a) - let result =VCtxBuilder().Bind(input, fun _ -> RefutedCtx (gfs2, lfs2)) - Assert.Equal(RefutedCtx ([gf1; gf2], lfsResult), result) + let input = DisputedCtx(gfs, lfs, a) + let result = VCtxBuilder().Bind(input, (fun _ -> RefutedCtx(gfs2, lfs2))) + Assert.Equal(RefutedCtx([ gf1; gf2 ], lfsResult), result) [] -let ``VCtxBuilder.MergeSources: Merges two ValidCtx into a tuple`` - (a : int, b : int) - = +let ``VCtxBuilder.MergeSources: Merges two ValidCtx into a tuple`` (a: int, b: int) = let input = ValidCtx a, ValidCtx b - VCtxBuilder().MergeSources(input) - |> should equal (ValidCtx (a, b)) + Assert.Equal(ValidCtx(a, b), VCtxBuilder().MergeSources(input)) [] let ``VCtxBuilder.MergeSources: Merging one Valid and one DisputedCtx results in DisputedCtx`` - (a : int, b : int, NonWhiteSpaceString n1, lf1 : int, gf1: int) + (a: int, b: int, NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] - let input1 = ValidCtx a, DisputedCtx (gfs, lfs, b) - let input2 = DisputedCtx (gfs, lfs, b), ValidCtx a + let input1 = ValidCtx a, DisputedCtx(gfs, lfs, b) + let input2 = DisputedCtx(gfs, lfs, b), ValidCtx a let expected1 = DisputedCtx(gfs, lfs, (a, b)) let expected2 = DisputedCtx(gfs, lfs, (b, a)) @@ -277,14 +257,14 @@ let ``VCtxBuilder.MergeSources: Merging one Valid and one DisputedCtx results in [] let ``VCtxBuilder.MergeSources: Merging one Valid and one RefutedCtx results in RefutedCtx`` - (a : int, NonWhiteSpaceString n1, lf1 : int, gf1 : int) + (a: int, NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get - let gfs = [gf1] - let lfs = Map.ofList [([field1], [lf1])] + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] - let input1 = ValidCtx a, RefutedCtx (gfs, lfs) - let input2 = RefutedCtx (gfs, lfs), ValidCtx a + let input1 = ValidCtx a, RefutedCtx(gfs, lfs) + let input2 = RefutedCtx(gfs, lfs), ValidCtx a let expected = RefutedCtx(gfs, lfs) Assert.Equal(expected, VCtxBuilder().MergeSources(input1)) @@ -292,54 +272,58 @@ let ``VCtxBuilder.MergeSources: Merging one Valid and one RefutedCtx results in [] let ``VCtxBuilder.MergeSources: Merging two DisputedCtx results in DisputedCtx`` - (a : int, b : int, NonWhiteSpaceString n1, lf1 : int, lf2 : int, gf1 : int, gf2 : int) + (a: int, b: int, NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get - let gfs1 = [gf1] - let lfs1 = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs1 = [ gf1 ] + let lfs1 = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] + + let input1 = DisputedCtx(gfs1, lfs1, a), DisputedCtx(gfs2, lfs2, b) + let input2 = DisputedCtx(gfs2, lfs2, b), DisputedCtx(gfs1, lfs1, a) + + let expected1 = + DisputedCtx(gfs1 @ gfs2, Map.ofList [ ([ field1 ], [ lf1; lf2 ]) ], (a, b)) - let input1 = DisputedCtx (gfs1, lfs1, a), DisputedCtx (gfs2, lfs2, b) - let input2 = DisputedCtx (gfs2, lfs2, b), DisputedCtx (gfs1, lfs1, a) - let expected1 = DisputedCtx(gfs1 @ gfs2, Map.ofList [([field1], [lf1; lf2])], (a, b)) - let expected2 = DisputedCtx(gfs2 @ gfs1, Map.ofList [([field1], [lf2; lf1])], (b, a)) + let expected2 = + DisputedCtx(gfs2 @ gfs1, Map.ofList [ ([ field1 ], [ lf2; lf1 ]) ], (b, a)) Assert.Equal(expected1, VCtxBuilder().MergeSources(input1)) Assert.Equal(expected2, VCtxBuilder().MergeSources(input2)) [] let ``VCtxBuilder.MergeSources: Merging one RefutedCTX and one DisputedCtx results in RefutedCtx`` - (a : int, NonWhiteSpaceString n1, lf1 : int, lf2 : int, gf1 : int, gf2 : int) + (a: int, NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get - let gfs1 = [gf1] - let lfs1 = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs1 = [ gf1 ] + let lfs1 = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] - let input1 = DisputedCtx (gfs1, lfs1, a), RefutedCtx (gfs2, lfs2) - let input2 = RefutedCtx (gfs2, lfs2), DisputedCtx (gfs1, lfs1, a) - let expected1 = RefutedCtx(gfs1 @ gfs2, Map.ofList [([field1], [lf1; lf2])]) - let expected2 = RefutedCtx(gfs2 @ gfs1, Map.ofList [([field1], [lf2; lf1])]) + let input1 = DisputedCtx(gfs1, lfs1, a), RefutedCtx(gfs2, lfs2) + let input2 = RefutedCtx(gfs2, lfs2), DisputedCtx(gfs1, lfs1, a) + let expected1 = RefutedCtx(gfs1 @ gfs2, Map.ofList [ ([ field1 ], [ lf1; lf2 ]) ]) + let expected2 = RefutedCtx(gfs2 @ gfs1, Map.ofList [ ([ field1 ], [ lf2; lf1 ]) ]) Assert.Equal(expected1, VCtxBuilder().MergeSources(input1)) Assert.Equal(expected2, VCtxBuilder().MergeSources(input2)) [] let ``VCtxBuilder.MergeSources: Merging two RefutedCtx results in RefutedCtx`` - (NonWhiteSpaceString n1, lf1 : int, lf2 : int, gf1 : int, gf2 : int) + (NonWhiteSpaceString n1, lf1: int, lf2: int, gf1: int, gf2: int) = let field1 = mkName n1 |> Option.get - let gfs1 = [gf1] - let lfs1 = Map.ofList [([field1], [lf1])] - let gfs2 = [gf2] - let lfs2 = Map.ofList [([field1], [lf2])] + let gfs1 = [ gf1 ] + let lfs1 = Map.ofList [ ([ field1 ], [ lf1 ]) ] + let gfs2 = [ gf2 ] + let lfs2 = Map.ofList [ ([ field1 ], [ lf2 ]) ] - let input1 = RefutedCtx (gfs1, lfs1), RefutedCtx (gfs2, lfs2) - let input2 = RefutedCtx (gfs2, lfs2), RefutedCtx (gfs1, lfs1) - let expected1 = RefutedCtx(gfs1 @ gfs2, Map.ofList [([field1], [lf1; lf2])]) - let expected2 = RefutedCtx(gfs2 @ gfs1, Map.ofList [([field1], [lf2; lf1])]) + let input1 = RefutedCtx(gfs1, lfs1), RefutedCtx(gfs2, lfs2) + let input2 = RefutedCtx(gfs2, lfs2), RefutedCtx(gfs1, lfs1) + let expected1 = RefutedCtx(gfs1 @ gfs2, Map.ofList [ ([ field1 ], [ lf1; lf2 ]) ]) + let expected2 = RefutedCtx(gfs2 @ gfs1, Map.ofList [ ([ field1 ], [ lf2; lf1 ]) ]) Assert.Equal(expected1, VCtxBuilder().MergeSources(input1)) Assert.Equal(expected2, VCtxBuilder().MergeSources(input2)) @@ -361,89 +345,89 @@ let mk5r i = } [] -let ``VCtxBuilder.Optional: Optional of a RefutedCtx returns RefutedCtx`` - (NonWhiteSpaceString n1, lf1 : int, gf1 : int) - = +let ``VCtxBuilder.Optional: Optional of a RefutedCtx returns RefutedCtx`` (NonWhiteSpaceString n1, lf1: int, gf1: int) = let field1 = mkName n1 |> Option.get - let gfs1 = [gf1] - let lfs1 = Map.ofList [([field1], [lf1])] + let gfs1 = [ gf1 ] + let lfs1 = Map.ofList [ ([ field1 ], [ lf1 ]) ] - let input = RefutedCtx (gfs1, lfs1) + let input = RefutedCtx(gfs1, lfs1) Assert.Equal(input, VCtxBuilder().Optional(input, mk5)) [] -let ``VCtxBuilder.Optional: Optional of a ValidCtx with None returns ValidCtx`` - (NonWhiteSpaceString n1) - = +let ``VCtxBuilder.Optional: Optional of a ValidCtx with None returns ValidCtx`` (NonWhiteSpaceString n1) = let field1 = mkName n1 |> Option.get - let input = ValidCtx (Field (field1, None)) + let input = ValidCtx(Field(field1, None)) Assert.Equal(input, VCtxBuilder().Optional(input, mk5)) [] -let ``VCtxBuilder.Optional: Optional of a ValidCtx with Some valid returns ValidCtx`` - (NonWhiteSpaceString n1) - = +let ``VCtxBuilder.Optional: Optional of a ValidCtx with Some valid returns ValidCtx`` (NonWhiteSpaceString n1) = let field1 = mkName n1 |> Option.get - let input = ValidCtx (Field (field1, Some 5)) - let expected = ValidCtx (Global (Some 5)) + let input = ValidCtx(Field(field1, Some 5)) + let expected = ValidCtx(Global(Some 5)) Assert.Equal(expected, VCtxBuilder().Optional(input, mk5)) [] -let ``VCtxBuilder.Optional: Optional of a ValidCtx with Some disputed returns DisputedCtx`` - (NonWhiteSpaceString n1) - = +let ``VCtxBuilder.Optional: Optional of a ValidCtx with Some disputed returns DisputedCtx`` (NonWhiteSpaceString n1) = let field1 = mkName n1 |> Option.get - let input = ValidCtx (Field (field1, Some 1)) - let expected = DisputedCtx ([], Map.ofList [([field1], [-5])], Global (Some 1)) + let input = ValidCtx(Field(field1, Some 1)) + let expected = DisputedCtx([], Map.ofList [ ([ field1 ], [ -5 ]) ], Global(Some 1)) Assert.Equal(expected, VCtxBuilder().Optional(input, mk5)) [] -let ``VCtxBuilder.Optional: Optional of a ValidCtx with Some refuted returns RefutedCtx`` - (NonWhiteSpaceString n1) - = +let ``VCtxBuilder.Optional: Optional of a ValidCtx with Some refuted returns RefutedCtx`` (NonWhiteSpaceString n1) = let field1 = mkName n1 |> Option.get - let input = ValidCtx (Field (field1, Some 1)) - let expected = RefutedCtx ([], Map.ofList [([field1], [-5])]) + let input = ValidCtx(Field(field1, Some 1)) + let expected = RefutedCtx([], Map.ofList [ ([ field1 ], [ -5 ]) ]) Assert.Equal(expected, VCtxBuilder().Optional(input, mk5r)) [] -let ``VCtxBuilder.Optional: Optional of a DisputedCtx with None returns DisputedCtx`` - (lf1 : int, gf1 : int) - = +let ``VCtxBuilder.Optional: Optional of a DisputedCtx with None returns DisputedCtx`` (lf1: int, gf1: int) = let field1 = mkName "Field1" |> Option.get let field2 = mkName "Field2" |> Option.get - let input = DisputedCtx ([gf1], Map.ofList [([field1], [lf1])], Field (field2, None)) + + let input = + DisputedCtx([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]) ], Field(field2, None)) + Assert.Equal(input, VCtxBuilder().Optional(input, mk5)) [] -let ``VCtxBuilder.Optional: Optional of a DisputedCtx with Some valid returns DisputedCtx`` - (lf1 : int, gf1 : int) - = +let ``VCtxBuilder.Optional: Optional of a DisputedCtx with Some valid returns DisputedCtx`` (lf1: int, gf1: int) = let field1 = mkName "Field1" |> Option.get let field2 = mkName "Field2" |> Option.get - let input = DisputedCtx ([gf1], Map.ofList [([field1], [lf1])], Field (field2, Some 5)) - let expected = DisputedCtx ([gf1], Map.ofList [([field1], [lf1])], Global (Some 5)) + + let input = + DisputedCtx([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]) ], Field(field2, Some 5)) + + let expected = + DisputedCtx([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]) ], Global(Some 5)) + Assert.Equal(expected, VCtxBuilder().Optional(input, mk5)) [] -let ``VCtxBuilder.Optional: Optional of a DisputedCtx with Some disputed returns DisputedCtx`` - (lf1 : int, gf1 : int) - = +let ``VCtxBuilder.Optional: Optional of a DisputedCtx with Some disputed returns DisputedCtx`` (lf1: int, gf1: int) = let field1 = mkName "Field1" |> Option.get let field2 = mkName "Field2" |> Option.get - let input = DisputedCtx ([gf1], Map.ofList [([field1], [lf1])], Field (field2, Some 1)) - let expected = DisputedCtx ([gf1], Map.ofList [([field1], [lf1]); ([field2], [-5])], Global (Some 1)) + + let input = + DisputedCtx([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]) ], Field(field2, Some 1)) + + let expected = + DisputedCtx([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]); ([ field2 ], [ -5 ]) ], Global(Some 1)) + Assert.Equal(expected, VCtxBuilder().Optional(input, mk5)) [] -let ``VCtxBuilder.Optional: Optional of a DisputedCtx with Some refuted returns RefutedCtx`` - (lf1 : int, gf1 : int) - = +let ``VCtxBuilder.Optional: Optional of a DisputedCtx with Some refuted returns RefutedCtx`` (lf1: int, gf1: int) = let field1 = mkName "Field1" |> Option.get let field2 = mkName "Field2" |> Option.get - let input = DisputedCtx ([gf1], Map.ofList [([field1], [lf1])], Field (field2, Some 1)) - let expected = RefutedCtx ([gf1], Map.ofList [([field1], [lf1]); ([field2], [-5])]) + + let input = + DisputedCtx([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]) ], Field(field2, Some 1)) + + let expected = + RefutedCtx([ gf1 ], Map.ofList [ ([ field1 ], [ lf1 ]); ([ field2 ], [ -5 ]) ]) + Assert.Equal(expected, VCtxBuilder().Optional(input, mk5r)) [] @@ -453,18 +437,18 @@ let ``VCtxBuilder.DisputeWith: When validation fails, the valid context becomes let failure = "failure" let func x = if x > 0 then None else Some failure let result = VCtxBuilder().DisputeWith(ctx, func) - let expected = DisputedCtx([failure], Map.ofList [], a) + let expected = DisputedCtx([ failure ], Map.ofList [], a) Assert.Equal(expected, result) [] let ``VCtxBuilder.DisputeWith: When validation fails, the failure is added to the disputed context`` (NegativeInt i) = let a = Global i let failure1 = "failure1" - let ctx = DisputedCtx([failure1], Map.ofList [], a) + let ctx = DisputedCtx([ failure1 ], Map.ofList [], a) let failure2 = "failure2" let func x = if x > 0 then None else Some failure2 let result = VCtxBuilder().DisputeWith(ctx, func) - let expected = DisputedCtx([failure1; failure2], Map.ofList [], a) + let expected = DisputedCtx([ failure1; failure2 ], Map.ofList [], a) Assert.Equal(expected, result) [] @@ -481,7 +465,7 @@ let ``VCtxBuilder.DisputeWith: When validation succeeds, the valid context remai let ``VCtxBuilder.DisputeWith: When validation succeeds, the disputed context remains the same`` (PositiveInt i) = let a = Global i let failure1 = "failure1" - let ctx = DisputedCtx([failure1], Map.ofList [], a) + let ctx = DisputedCtx([ failure1 ], Map.ofList [], a) let failure2 = "failure2" let func x = if x > 0 then None else Some failure2 let result = VCtxBuilder().DisputeWith(ctx, func) @@ -489,24 +473,28 @@ let ``VCtxBuilder.DisputeWith: When validation succeeds, the disputed context re Assert.Equal(expected, result) [] -let ``VCtxBuilder.DisputeWithFact: When validation fails, the valid context becomes a disputed context`` (NegativeInt i) = +let ``VCtxBuilder.DisputeWithFact: When validation fails, the valid context becomes a disputed context`` + (NegativeInt i) + = let a = Global i let ctx = ValidCtx a let func x = x > 0 let failure = "failure" let result = VCtxBuilder().DisputeWithFact(ctx, failure, func) - let expected = DisputedCtx([failure], Map.ofList [], a) + let expected = DisputedCtx([ failure ], Map.ofList [], a) Assert.Equal(expected, result) [] -let ``VCtxBuilder.DisputeWithFact: When validation fails, the failure is added to the disputed context`` (NegativeInt i) = +let ``VCtxBuilder.DisputeWithFact: When validation fails, the failure is added to the disputed context`` + (NegativeInt i) + = let a = Global i let failure1 = "failure1" - let ctx = DisputedCtx([failure1], Map.ofList [], a) + let ctx = DisputedCtx([ failure1 ], Map.ofList [], a) let func x = x > 0 let failure2 = "failure2" let result = VCtxBuilder().DisputeWithFact(ctx, failure2, func) - let expected = DisputedCtx([failure1; failure2], Map.ofList [], a) + let expected = DisputedCtx([ failure1; failure2 ], Map.ofList [], a) Assert.Equal(expected, result) [] @@ -523,7 +511,7 @@ let ``VCtxBuilder.DisputeWithFact: When validation succeeds, the valid context r let ``VCtxBuilder.DisputeWithFact: When validation succeeds, the disputed context remains the same`` (PositiveInt i) = let a = Global i let failure1 = "failure1" - let ctx = DisputedCtx([failure1], Map.ofList [], a) + let ctx = DisputedCtx([ failure1 ], Map.ofList [], a) let func x = x > 0 let failure2 = "failure2" let result = VCtxBuilder().DisputeWithFact(ctx, failure2, func) @@ -536,21 +524,27 @@ let ``VCtxBuilder.RefuteWith: When validation fails, the valid context becomes a let ctx = ValidCtx a let success = "success" let failure = "failure" - let func x = if x > 0 then Ok success else Error failure + + let func x = + if x > 0 then Ok success else Error failure + let result = VCtxBuilder().RefuteWith(ctx, func) - let expected = RefutedCtx([failure], Map.ofList []) + let expected = RefutedCtx([ failure ], Map.ofList []) Assert.Equal(expected, result) [] let ``VCtxBuilder.RefuteWith: When validation fails, the disputed context becomes a refuted context`` (NegativeInt i) = let a = Global i let failure1 = "failure1" - let ctx = DisputedCtx([failure1], Map.ofList [], a) + let ctx = DisputedCtx([ failure1 ], Map.ofList [], a) let success = "success" let failure2 = "failure2" - let func x = if x > 0 then Ok success else Error failure2 + + let func x = + if x > 0 then Ok success else Error failure2 + let result = VCtxBuilder().RefuteWith(ctx, func) - let expected = RefutedCtx([failure1; failure2], Map.ofList []) + let expected = RefutedCtx([ failure1; failure2 ], Map.ofList []) Assert.Equal(expected, result) [] @@ -559,7 +553,10 @@ let ``VCtxBuilder.RefuteWith: When validation succeeds, the valid context remain let ctx = ValidCtx a let success = "success" let failure = "failure" - let func x = if x > 0 then Ok success else Error failure + + let func x = + if x > 0 then Ok success else Error failure + let result = VCtxBuilder().RefuteWith(ctx, func) let b = Global success let expected = ValidCtx b @@ -569,169 +566,602 @@ let ``VCtxBuilder.RefuteWith: When validation succeeds, the valid context remain let ``VCtxBuilder.RefuteWith: When validation succeeds, the disputed context remains the same`` (PositiveInt i) = let a = Global i let failure1 = "failure1" - let ctx = DisputedCtx([failure1], Map.ofList [], a) + let ctx = DisputedCtx([ failure1 ], Map.ofList [], a) let success = "success" let failure2 = "failure2" - let func x = if x > 0 then Ok success else Error failure2 + + let func x = + if x > 0 then Ok success else Error failure2 + let result = VCtxBuilder().RefuteWith(ctx, func) let b = Global success - let expected = DisputedCtx([failure1], Map.ofList [], b) + let expected = DisputedCtx([ failure1 ], Map.ofList [], b) Assert.Equal(expected, result) +// Tests for refute operator +[] +let ``VCtxBuilder.Refute: Refutes a ValidCtx`` (a: int, f: int) = + let input = ValidCtx(Global a) + let result = VCtxBuilder().Refute(input, f) + Assert.Equal(RefutedCtx([ f ], Map.empty), result) + +[] +let ``VCtxBuilder.Refute: Refutes a DisputedCtx`` (a: int, f1: int, f2: int) = + let input = DisputedCtx([ f1 ], Map.empty, Global a) + let result = VCtxBuilder().Refute(input, f2) + Assert.Equal(RefutedCtx([ f1; f2 ], Map.empty), result) + +// Tests for dispute operator +[] +let ``VCtxBuilder.Dispute: Adds failure to ValidCtx`` (a: int, f: int) = + let input = ValidCtx(Global a) + let result = VCtxBuilder().Dispute(input, f) + Assert.Equal(DisputedCtx([ f ], Map.empty, Global a), result) + +[] +let ``VCtxBuilder.Dispute: Adds failure to DisputedCtx`` (a: int, f1: int, f2: int) = + let input = DisputedCtx([ f1 ], Map.empty, Global a) + let result = VCtxBuilder().Dispute(input, f2) + Assert.Equal(DisputedCtx([ f1; f2 ], Map.empty, Global a), result) + +// Tests for refuteEachWith operator +[] +let ``VCtxBuilder.RefuteEachWith: Refutes on first failure`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + + let fn i a = + if a < 2 then Error "too small" else Ok(a * 2) + + let result = VCtxBuilder().RefuteEachWith(input, fn) + + match result with + | RefutedCtx(_, lfs) -> Assert.True(Map.containsKey [ mkName "[0]" |> Option.get ] lfs) + | _ -> failwith "Expected RefutedCtx" + +[] +let ``VCtxBuilder.RefuteEachWith: Succeeds when all elements pass`` () = + let input = ValidCtx(Global [ 2; 3; 4 ]) + + let fn i a = + if a < 2 then Error "too small" else Ok(a * 2) + + let result = VCtxBuilder().RefuteEachWith(input, fn) + + match result with + | ValidCtx(Global xs) -> Assert.Equal([ 4; 6; 8 ], xs) + | _ -> failwith "Expected ValidCtx with transformed values" + +// Tests for refuteEachWithProof operator +[] +let ``VCtxBuilder.RefuteEachWithProof: Refutes on first Invalid`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + + let fn a = + if a < 2 then + Invalid([ "too small" ], Map.empty) + else + Valid(a * 2) + + let result = VCtxBuilder().RefuteEachWithProof(input, fn) + + match result with + | RefutedCtx(_, lfs) -> Assert.True(Map.containsKey [ mkName "[0]" |> Option.get ] lfs) + | _ -> failwith "Expected RefutedCtx" + +[] +let ``VCtxBuilder.RefuteEachWithProof: Succeeds when all elements Valid`` () = + let input = ValidCtx(Global [ 2; 3; 4 ]) + + let fn a = + if a < 2 then + Invalid([ "too small" ], Map.empty) + else + Valid(a * 2) + + let result = VCtxBuilder().RefuteEachWithProof(input, fn) + + match result with + | ValidCtx(Global xs) -> Assert.Equal([ 4; 6; 8 ], xs) + | _ -> failwith "Expected ValidCtx with transformed values" + +// Tests for validateEach operator +[] +let ``VCtxBuilder.ValidateEach: Validates each element`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + + let fn i a = + if a < 2 then + DisputedCtx([ "too small" ], Map.empty, Global a) + else + ValidCtx(Global(a * 2)) + + let result = VCtxBuilder().ValidateEach(input, fn) + + match result with + | DisputedCtx(_, lfs, Global xs) -> + Assert.True(Map.containsKey [ mkName "[0]" |> Option.get ] lfs) + Assert.Equal([ 1; 4; 6 ], Seq.toList xs) // Element 0 keeps original value 1 + | _ -> failwith "Expected DisputedCtx with partial values" + +[] +let ``VCtxBuilder.ValidateEach: Accumulates all failures`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + + let fn i a = + if a < 3 then + DisputedCtx([ "too small" ], Map.empty, Global a) + else + ValidCtx(Global(a * 2)) + + let result = VCtxBuilder().ValidateEach(input, fn) + + match result with + | DisputedCtx(_, lfs, Global xs) -> + Assert.Equal(2, Map.count lfs) // Two elements failed + Assert.Equal([ 1; 2; 6 ], Seq.toList xs) // Elements 0,1 keep originals, element 2 transformed + | _ -> failwith "Expected DisputedCtx with multiple failures" + +// Tests for disputeAnyWith operator +[] +let ``VCtxBuilder.DisputeAnyWith: Disputes if any element fails`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + let fn i a = if a = 2 then Some "found 2" else None + let result = VCtxBuilder().DisputeAnyWith(input, fn) + + match result with + | DisputedCtx(_, lfs, Global xs) -> + Assert.True(Map.containsKey [ mkName "[1]" |> Option.get ] lfs) // Failure on element at index 1 + Assert.Equal([ 1; 2; 3 ], Seq.toList xs) // All elements preserved + | _ -> failwith "Expected DisputedCtx" + +[] +let ``VCtxBuilder.DisputeAnyWith: Succeeds if no element fails`` () = + let input = ValidCtx(Global [ 1; 3; 5 ]) + let fn i a = if a = 2 then Some "found 2" else None + let result = VCtxBuilder().DisputeAnyWith(input, fn) + + match result with + | ValidCtx(Global xs) -> Assert.Equal([ 1; 3; 5 ], Seq.toList xs) + | _ -> failwith "Expected ValidCtx" + +// Tests for disputeAnyWithMany operator +[] +let ``VCtxBuilder.DisputeAnyWithMany: Disputes if any element fails`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + let fn i a = if a = 2 then [ "found 2" ] else [] + let result = VCtxBuilder().DisputeAnyWithMany(input, fn) + + match result with + | DisputedCtx(_, lfs, Global xs) -> + Assert.True(Map.containsKey [ mkName "[1]" |> Option.get ] lfs) // Failure on element at index 1 + Assert.Equal([ 1; 2; 3 ], Seq.toList xs) // All elements preserved + | _ -> failwith "Expected DisputedCtx" + +[] +let ``VCtxBuilder.DisputeAnyWithMany: Succeeds if no element fails`` () = + let input = ValidCtx(Global [ 1; 3; 5 ]) + let fn i a = if a = 2 then [ "found 2" ] else [] + let result = VCtxBuilder().DisputeAnyWithMany(input, fn) + + match result with + | ValidCtx(Global xs) -> Assert.Equal([ 1; 3; 5 ], Seq.toList xs) + | _ -> failwith "Expected ValidCtx" + +// Tests for disputeAnyWithFact operator +[] +let ``VCtxBuilder.DisputeAnyWithFact: Disputes if any element fails check`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + let fn i a = a <> 2 // Returns False (fails check) when element equals 2 + let result = VCtxBuilder().DisputeAnyWithFact(input, "found 2", fn) + + match result with + | DisputedCtx(_, lfs, Global xs) -> + Assert.True(Map.containsKey [ mkName "[1]" |> Option.get ] lfs) // Failure on element at index 1 + Assert.Equal([ 1; 2; 3 ], Seq.toList xs) // All elements preserved + | _ -> failwith "Expected DisputedCtx" + +[] +let ``VCtxBuilder.DisputeAnyWithFact: Succeeds if all elements pass check`` () = + let input = ValidCtx(Global [ 1; 3; 5 ]) + let fn i a = a <> 2 // Returns True (passes) for all elements (none equal 2) + let result = VCtxBuilder().DisputeAnyWithFact(input, "found 2", fn) + + match result with + | ValidCtx(Global xs) -> Assert.Equal([ 1; 3; 5 ], xs) + | _ -> failwith "Expected ValidCtx" + +// Tests for disputeAllWith operator +[] +let ``VCtxBuilder.DisputeAllWith: Disputes if all elements fail`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + let fn i a = if a > 0 then Some "all fail" else None // Returns Some for all elements > 0 (all pass) + let result = VCtxBuilder().DisputeAllWith(input, fn) + + match result with + | DisputedCtx(gfs, _, _) -> Assert.Equal([ "all fail" ], gfs) + | _ -> failwith "Expected DisputedCtx" + +[] +let ``VCtxBuilder.DisputeAllWith: Succeeds if not all elements fail`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + + let fn i a = + if a < 2 then Some "too small" else None + + let result = VCtxBuilder().DisputeAllWith(input, fn) + + match result with + | ValidCtx(Global xs) -> Assert.Equal([ 1; 2; 3 ], xs) + | _ -> failwith "Expected ValidCtx" + +// Tests for disputeAllWithMany operator (includes bug fix verification) +[] +let ``VCtxBuilder.DisputeAllWithMany: Disputes if all elements fail`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + let fn i a = if a > 0 then [ "all fail" ] else [] // Returns list for all elements > 0 (all pass) + let result = VCtxBuilder().DisputeAllWithMany(input, fn) + + match result with + | DisputedCtx(gfs, _, _) -> Assert.Equal([ "all fail" ], gfs) + | _ -> failwith "Expected DisputedCtx" + +[] +let ``VCtxBuilder.DisputeAllWithMany: Succeeds if not all elements fail`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + let fn i a = if a < 2 then [ "too small" ] else [] + let result = VCtxBuilder().DisputeAllWithMany(input, fn) + + match result with + | ValidCtx(Global xs) -> Assert.Equal([ 1; 2; 3 ], xs) + | _ -> failwith "Expected ValidCtx when not all elements fail" + +[] +let ``VCtxBuilder.DisputeAllWithMany: Produces valid DisputedCtx with failures`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + let fn i a = if a > 0 then [ "fail" ] else [] // All elements > 0, so all fail + let result = VCtxBuilder().DisputeAllWithMany(input, fn) + + match result with + | DisputedCtx(gfs, lfs, _) -> + Assert.False(List.isEmpty gfs) // Should have global failure since ALL elements failed + Assert.True(Map.toList lfs |> List.isEmpty) // No field-level failures when all fail + | _ -> failwith "Expected valid DisputedCtx state" + [] -let ``VCtxBuilder.RefuteWithProof: When element validation fails, the valid context becomes a refuted context`` (NegativeInt i) = +let ``VCtxBuilder.DisputeAllWithFact: Disputes if all elements fail check`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + let fn i a = a < 1 // Returns False (fails check) for all elements (all >= 1) + let result = VCtxBuilder().DisputeAllWithFact(input, "all fail", fn) + + match result with + | DisputedCtx(gfs, _, _) -> Assert.Equal([ "all fail" ], gfs) + | _ -> failwith "Expected DisputedCtx" + +[] +let ``VCtxBuilder.DisputeAllWithFact: Succeeds if not all elements fail check`` () = + let input = ValidCtx(Global [ 1; 2; 3 ]) + let fn i a = a < 2 + let result = VCtxBuilder().DisputeAllWithFact(input, "too small", fn) + + match result with + | ValidCtx(Global xs) -> Assert.Equal([ 1; 2; 3 ], xs) + | _ -> failwith "Expected ValidCtx" + +[] +let ``VCtxBuilder.RefuteWithProof: When element validation fails, the valid context becomes a refuted context`` + (NegativeInt i) + = let field1 = mkName "field1" |> Option.get let a = Element(1, i) let ctx = ValidCtx a let success = "success" let failure = "failure" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList [([field1],[failure])]) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList [ ([ field1 ], [ failure ]) ]) + let result = VCtxBuilder().RefuteWithProof(ctx, func) let name = mkName "[1]" |> Option.get - let expected = RefutedCtx([], Map.ofList [([field1],[failure]); ([name],[failure])]) + + let expected = + RefutedCtx([], Map.ofList [ ([ field1 ], [ failure ]); ([ name ], [ failure ]) ]) + Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When element validation fails, the disputed context becomes a refuted context`` (NegativeInt i) = +let ``VCtxBuilder.RefuteWithProof: When element validation fails, the disputed context becomes a refuted context`` + (NegativeInt i) + = let field1 = mkName "field1" |> Option.get let field2 = mkName "field2" |> Option.get let a = Element(1, i) let failure = "failure" - let ctx = DisputedCtx([], Map.ofList [([field1],[failure])], a) + let ctx = DisputedCtx([], Map.ofList [ ([ field1 ], [ failure ]) ], a) let success = "success" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList [([field2],[failure])]) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList [ ([ field2 ], [ failure ]) ]) + let result = VCtxBuilder().RefuteWithProof(ctx, func) let name = mkName "[1]" |> Option.get - let expected = RefutedCtx([], Map.ofList [([field1],[failure]); ([field2],[failure]); ([name],[failure])]) + + let expected = + RefutedCtx( + [], + Map.ofList + [ ([ field1 ], [ failure ]) + ([ field2 ], [ failure ]) + ([ name ], [ failure ]) ] + ) + Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When element validation succeeds, the valid context remains the same`` (PositiveInt i) = +let ``VCtxBuilder.RefuteWithProof: When element validation succeeds, the valid context remains the same`` + (PositiveInt i) + = let field1 = mkName "field1" |> Option.get let a = Element(1, i) let ctx = ValidCtx a let success = "success" let failure = "failure" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList [([field1],[failure])]) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList [ ([ field1 ], [ failure ]) ]) + let result = VCtxBuilder().RefuteWithProof(ctx, func) let b = Element(1, success) let expected = ValidCtx b Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When element validation succeeds, the disputed context remains the same`` (PositiveInt i) = +let ``VCtxBuilder.RefuteWithProof: When element validation succeeds, the disputed context remains the same`` + (PositiveInt i) + = let field1 = mkName "field1" |> Option.get let field2 = mkName "field2" |> Option.get let a = Element(1, i) let failure = "failure" - let ctx = DisputedCtx([], Map.ofList [([field1],[failure])], a) + let ctx = DisputedCtx([], Map.ofList [ ([ field1 ], [ failure ]) ], a) let success = "success" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList [([field2],[failure])]) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList [ ([ field2 ], [ failure ]) ]) + let result = VCtxBuilder().RefuteWithProof(ctx, func) let b = Element(1, success) - let expected = DisputedCtx([], Map.ofList [([field1],[failure])], b) + let expected = DisputedCtx([], Map.ofList [ ([ field1 ], [ failure ]) ], b) Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When field validation fails, the valid context becomes a refuted context`` (NegativeInt i) = +let ``VCtxBuilder.RefuteWithProof: When field validation fails, the valid context becomes a refuted context`` + (NegativeInt i) + = let field1 = mkName "field1" |> Option.get let field2 = mkName "field2" |> Option.get let a = Field(field1, i) let ctx = ValidCtx a let success = "success" let failure = "failure" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList [([field2],[failure])]) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList [ ([ field2 ], [ failure ]) ]) + let result = VCtxBuilder().RefuteWithProof(ctx, func) - let expected = RefutedCtx([], Map.ofList [([field1],[failure]); ([field2],[failure])]) + + let expected = + RefutedCtx([], Map.ofList [ ([ field1 ], [ failure ]); ([ field2 ], [ failure ]) ]) + Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When field validation fails, the disputed context becomes a refuted context`` (NegativeInt i) = +let ``VCtxBuilder.RefuteWithProof: When field validation fails, the disputed context becomes a refuted context`` + (NegativeInt i) + = let field1 = mkName "field1" |> Option.get let field2 = mkName "field2" |> Option.get let field3 = mkName "field3" |> Option.get let a = Field(field1, i) let failure = "failure" - let ctx = DisputedCtx([], Map.ofList [([field2],[failure])], a) + let ctx = DisputedCtx([], Map.ofList [ ([ field2 ], [ failure ]) ], a) let success = "success" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList [([field3],[failure])]) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList [ ([ field3 ], [ failure ]) ]) + let result = VCtxBuilder().RefuteWithProof(ctx, func) - let expected = RefutedCtx([], Map.ofList [([field1],[failure]); ([field2],[failure]); ([field3],[failure])]) + + let expected = + RefutedCtx( + [], + Map.ofList + [ ([ field1 ], [ failure ]) + ([ field2 ], [ failure ]) + ([ field3 ], [ failure ]) ] + ) + Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When field validation succeeds, the valid context remains the same`` (PositiveInt i) = +let ``VCtxBuilder.RefuteWithProof: When field validation succeeds, the valid context remains the same`` + (PositiveInt i) + = let field1 = mkName "field1" |> Option.get let field2 = mkName "field2" |> Option.get let a = Field(field1, i) let ctx = ValidCtx a let success = "success" let failure = "failure" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList [([field2],[failure])]) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList [ ([ field2 ], [ failure ]) ]) + let result = VCtxBuilder().RefuteWithProof(ctx, func) let b = Field(field1, success) let expected = ValidCtx b Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When field validation succeeds, the disputed context remains the same`` (PositiveInt i) = +let ``VCtxBuilder.RefuteWithProof: When field validation succeeds, the disputed context remains the same`` + (PositiveInt i) + = let field1 = mkName "field1" |> Option.get let field2 = mkName "field2" |> Option.get let field3 = mkName "field3" |> Option.get let a = Field(field1, i) let failure = "failure" - let ctx = DisputedCtx([], Map.ofList [([field2],[failure])], a) + let ctx = DisputedCtx([], Map.ofList [ ([ field2 ], [ failure ]) ], a) let success = "success" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList [([field3],[failure])]) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList [ ([ field3 ], [ failure ]) ]) + let result = VCtxBuilder().RefuteWithProof(ctx, func) let b = Field(field1, success) - let expected = DisputedCtx([], Map.ofList [([field2],[failure])], b) + let expected = DisputedCtx([], Map.ofList [ ([ field2 ], [ failure ]) ], b) Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When gobal validation fails, the valid context becomes a refuted context`` (NegativeInt i) = +let ``VCtxBuilder.RefuteWithProof: When gobal validation fails, the valid context becomes a refuted context`` + (NegativeInt i) + = let a = Global i let ctx = ValidCtx a let success = "success" let failure = "failure" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList []) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList []) + let result = VCtxBuilder().RefuteWithProof(ctx, func) - let expected = RefutedCtx([failure], Map.ofList []) + let expected = RefutedCtx([ failure ], Map.ofList []) Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When global validation fails, the disputed context becomes a refuted context`` (NegativeInt i) = +let ``VCtxBuilder.RefuteWithProof: When global validation fails, the disputed context becomes a refuted context`` + (NegativeInt i) + = let a = Global i let failure1 = "failure1" - let ctx = DisputedCtx([failure1], Map.ofList [], a) + let ctx = DisputedCtx([ failure1 ], Map.ofList [], a) let success = "success" let failure2 = "failure2" - let func x = if x > 0 then Valid success else Invalid([failure2], Map.ofList []) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure2 ], Map.ofList []) + let result = VCtxBuilder().RefuteWithProof(ctx, func) - let expected = RefutedCtx([failure1; failure2], Map.ofList []) + let expected = RefutedCtx([ failure1; failure2 ], Map.ofList []) Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When global validation succeeds, the valid context remains the same`` (PositiveInt i) = +let ``VCtxBuilder.RefuteWithProof: When global validation succeeds, the valid context remains the same`` + (PositiveInt i) + = let a = Global i let ctx = ValidCtx a let success = "success" let failure = "failure" - let func x = if x > 0 then Valid success else Invalid([failure], Map.ofList []) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure ], Map.ofList []) + let result = VCtxBuilder().RefuteWithProof(ctx, func) let b = Global success let expected = ValidCtx b Assert.Equal(expected, result) [] -let ``VCtxBuilder.RefuteWithProof: When global validation succeeds, the disputed context remains the same`` (PositiveInt i) = +let ``VCtxBuilder.RefuteWithProof: When global validation succeeds, the disputed context remains the same`` + (PositiveInt i) + = let a = Global i let failure1 = "failure1" - let ctx = DisputedCtx([failure1], Map.ofList [], a) + let ctx = DisputedCtx([ failure1 ], Map.ofList [], a) let success = "success" let failure2 = "failure2" - let func x = if x > 0 then Valid success else Invalid([failure2], Map.ofList []) + + let func x = + if x > 0 then + Valid success + else + Invalid([ failure2 ], Map.ofList []) + let result = VCtxBuilder().RefuteWithProof(ctx, func) let b = Global success - let expected = DisputedCtx([failure1], Map.ofList [], b) + let expected = DisputedCtx([ failure1 ], Map.ofList [], b) + Assert.Equal(expected, result) + +[] +let ``VCtxBuilder.RefuteWithValidation: Maps failures and refutes on invalid proof`` () = + let field = mkName "field" |> Option.get + let ctx = ValidCtx(Field(field, "bad")) + let fn _ = Invalid([ 1 ], Map.empty) + let mapFailure (i: int) = sprintf "E%i" i + let result = VCtxBuilder().RefuteWithValidation(ctx, fn, mapFailure) + let expected = RefutedCtx([], Map.ofList [ ([ field ], [ "E1" ]) ]) Assert.Equal(expected, result) + +[] +let ``VCtxBuilder.RefuteWithValidation: Continues on valid proof`` () = + let field = mkName "field" |> Option.get + let ctx = ValidCtx(Field(field, 5)) + let fn x = Valid(x + 1) + let mapFailure (_: string) = "mapped" + let result = VCtxBuilder().RefuteWithValidation(ctx, fn, mapFailure) + let expected = ValidCtx(Field(field, 6)) + Assert.Equal(expected, result) + +[] +let ``VCtxBuilder.RefuteEachWithValidation: Refutes when any element proof is invalid`` () = + let field = mkName "items" |> Option.get + let items = [ 1; 2; 3 ] + let ctx = ValidCtx(Field(field, items :> seq)) + + let fn x = + if x % 2 = 0 then + Invalid([ 10 ], Map.empty) + else + Valid(x * 2) + + let mapFailure (i: int) = sprintf "E%i" i + let result = VCtxBuilder().RefuteEachWithValidation(ctx, fn, mapFailure) + + match result with + | RefutedCtx(gfs, lfs) -> + Assert.Equal([], gfs) + Assert.True(Map.count lfs > 0) + | _ -> failwith "Expected RefutedCtx" diff --git a/tests/FSharp.Data.Validation.Tests/Tests/Validators/Collection.fs b/tests/FSharp.Data.Validation.Tests/Tests/Validators/Collection.fs new file mode 100644 index 0000000..3f88f90 --- /dev/null +++ b/tests/FSharp.Data.Validation.Tests/Tests/Validators/Collection.fs @@ -0,0 +1,120 @@ +module FSharp.Data.Validation.Tests.Collection + +open Xunit +open FsCheck +open FsCheck.Xunit +open FsUnit.Xunit + +open FSharp.Data.Validation + +[] +let ``isNull: Returns true when empty`` () = Assert.True(isNull "") + +[] +let ``isNull: Returns false when not empty`` (NonWhiteSpaceString a) = Assert.False(isNull a) + +[] +let ``isNotNull: Returns false when empty`` () = Assert.False(isNotNull "") + +[] +let ``isNotNull: Returns true when not empty`` (NonWhiteSpaceString a) = Assert.True(isNotNull a) + +[] +let ``minLength: false when too short`` (NonWhiteSpaceString a, PositiveInt b) = + Assert.False(minLength (a.Length + b) a) + +[] +let ``minLength: true when correct length`` (NonWhiteSpaceString a) = Assert.True(minLength a.Length a) + +[] +let ``minLength: true when greater than required length`` (NonWhiteSpaceString a) = + Assert.True(minLength (a.Length - 1) a) + +[] +let ``maxLength: false when too long`` (NonWhiteSpaceString a) = + Assert.False(maxLength (a.Length - 1) a) + +[] +let ``maxLength: true when correct length`` (NonWhiteSpaceString a) = Assert.True(maxLength a.Length a) + +[] +let ``maxLength: true when less than required length`` (NonWhiteSpaceString a, PositiveInt b) = + Assert.True(maxLength (a.Length + b) a) + +[] +let ``isLength: false when too long`` (NonWhiteSpaceString a) = Assert.False(isLength (a.Length - 1) a) + +[] +let ``isLength: true when correct length`` (NonWhiteSpaceString a) = Assert.True(isLength a.Length a) + +[] +let ``isLength: false when less than required length`` (NonWhiteSpaceString a, PositiveInt b) = + Assert.False(isLength (a.Length + b) a) + +[] +let ``hasElem: true when collection includes element`` () = + let input = [ 1; 2; 5; 7 ] + hasElem 5 input |> should be True + +[] +let ``hasElem: false when collection is missing element`` () = + let input = [ 1; 2; 5; 7 ] + hasElem 3 input |> should be False + +[] +let ``doesNotHaveElem: true when collection is missing element`` () = + let input = [ 1; 2; 5; 7 ] + doesNotHaveElem 3 input |> should be True + +[] +let ``doesNotHaveElem: false when collection includes element`` () = + let input = [ 1; 2; 5; 7 ] + doesNotHaveElem 5 input |> should be False + +[] +let ``isDistinct: Returns true when all elements are unique`` () = + isDistinct [ 1; 2; 3; 4; 5 ] |> should be True + +[] +let ``isDistinct: Returns false when elements are duplicated`` () = + isDistinct [ 1; 2; 3; 2; 5 ] |> should be False + +[] +let ``containsAllElems: Returns true when sequence contains all elements`` () = + containsAllElems [ 1; 2; 3 ] [ 1; 2; 3; 4; 5 ] |> should be True + +[] +let ``containsAllElems: Returns false when sequence does not contain all elements`` () = + containsAllElems [ 1; 2; 6 ] [ 1; 2; 3; 4; 5 ] |> should be False + +[] +let ``containsAnyElem: Returns true when sequence contains at least one element`` () = + containsAnyElem [ 1; 6; 7 ] [ 1; 2; 3; 4; 5 ] |> should be True + +[] +let ``containsAnyElem: Returns false when sequence contains none of the elements`` () = + containsAnyElem [ 6; 7; 8 ] [ 1; 2; 3; 4; 5 ] |> should be False + +[] +let ``allMatch: Returns true when all elements match predicate`` () = + allMatch (fun x -> x > 0) [ 1; 2; 3; 4; 5 ] |> should be True + +[] +let ``allMatch: Returns false when not all elements match predicate`` () = + allMatch (fun x -> x > 3) [ 1; 2; 3; 4; 5 ] |> should be False + +[] +let ``anyMatch: Returns true when at least one element matches predicate`` () = + anyMatch (fun x -> x > 3) [ 1; 2; 3; 4; 5 ] |> should be True + +[] +let ``anyMatch: Returns false when no elements match predicate`` () = + anyMatch (fun x -> x > 10) [ 1; 2; 3; 4; 5 ] |> should be False + +[] +let ``noneMatch: Returns true when no elements match predicate`` () = + noneMatch (fun x -> x > 10) [ 1; 2; 3; 4; 5 ] |> should be True + +[] +let ``noneMatch: Returns false when at least one element matches predicate`` () = + noneMatch (fun x -> x > 3) [ 1; 2; 3; 4; 5 ] |> should be False diff --git a/tests/FSharp.Data.Validation.Tests/Tests/Validators/Core.fs b/tests/FSharp.Data.Validation.Tests/Tests/Validators/Core.fs new file mode 100644 index 0000000..cfa7d3d --- /dev/null +++ b/tests/FSharp.Data.Validation.Tests/Tests/Validators/Core.fs @@ -0,0 +1,214 @@ +module FSharp.Data.Validation.Tests.Core + +open Xunit +open FsCheck +open FsCheck.Xunit +open FsUnit.Xunit + +open FSharp.Data.Validation + +[] +let ``fromVCTx: Transforms a ValidCtx to a Valid Proof`` (a: int) = + let input = ValidCtx a + let result = fromVCtx input + Assert.Equal(Valid a, result) + +[] +let ``fromVCTx: Transforms a DisputedCtx to an Invalid Proof`` (a: int, NonWhiteSpaceString n1, lf1: int, gf1: int) = + let field1 = mkName n1 |> Option.get + // Todo: make failures of arbitrary length + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] + + let input = DisputedCtx(gfs, lfs, a) + let result = fromVCtx input + Assert.Equal(Invalid(gfs, lfs), result) + +[] +let ``fromVCTx: Transforms a RefutedCtx to an Invalid Proof`` (NonWhiteSpaceString n1, lf1: int, gf1: int) = + let field1 = mkName n1 |> Option.get + // Todo: make failures of arbitrary length + let gfs = [ gf1 ] + let lfs = Map.ofList [ ([ field1 ], [ lf1 ]) ] + + let input = RefutedCtx(gfs, lfs) + let result = fromVCtx input + Assert.Equal(Invalid(gfs, lfs), result) + +[] +let ``isError: Returns true when Result is Error`` (NonWhiteSpaceString a) = Assert.True(isError (Error a)) + +[] +let ``isError: Returns false when Result is Ok`` (NonWhiteSpaceString a) = Assert.False(isError (Ok a)) + +[] +let ``isOk: Returns true when Result is OK`` (NonWhiteSpaceString a) = Assert.True(isOk (Ok a)) + +[] +let ``isOk: Returns false when Result is Error`` (NonWhiteSpaceString a) = Assert.False(isOk (Error a)) + +[] +let ``isEqual: true when equal`` (a: int) = Assert.True(isEqual a a) + +[] +let ``isEqual: false when not equal, less than`` (a: int) = Assert.False(isEqual a (a - 1)) + +[] +let ``isEqual: false when not equal, greater`` (a: int) = Assert.False(isEqual a (a + 1)) + +[] +let ``isNotEqual: false when equal`` (a: int) = Assert.False(isNotEqual a a) + +[] +let ``isNotEqual: true when not equal, less than`` (a: int) = Assert.True(isNotEqual a (a - 1)) + +[] +let ``isNotEqual: true when not equal, greater`` (a: int) = Assert.True(isNotEqual a (a + 1)) + +// For comparative operators, our validation input is b, so these may seem logically reversed +[] +let ``isLessThan: true when b is less than a`` (NegativeInt b, NonNegativeInt a) = Assert.True(isLessThan a b) + +[] +let ``isLessThan: false when equal`` (a: int) = Assert.False(isLessThan a a) + +[] +let ``isLessThan: false when b is greater than a`` (NonNegativeInt b, NegativeInt a) = Assert.False(isLessThan a b) + +[] +let ``isGreaterThan: false when b is less than a`` (NegativeInt b, NonNegativeInt a) = Assert.False(isGreaterThan a b) + +[] +let ``isGreaterThan: false when equal`` (a: int) = Assert.False(isGreaterThan a a) + +[] +let ``isGreaterThan: true when b is greater than a`` (NonNegativeInt b, NegativeInt a) = Assert.True(isGreaterThan a b) + +[] +let ``isLessThanOrEqual: true when b is less than a`` (NegativeInt b, NonNegativeInt a) = + Assert.True(isLessThanOrEqual a b) + +[] +let ``isLessThanOrEqual: true when equal`` (a: int) = Assert.True(isLessThanOrEqual a a) + +[] +let ``isLessThanOrEqual: false when b is greater than a`` (NonNegativeInt b, NegativeInt a) = + Assert.False(isLessThanOrEqual a b) + +[] +let ``isGreaterThanOrEqual: false when b is less than a`` (NegativeInt b, NonNegativeInt a) = + Assert.False(isGreaterThanOrEqual a b) + +[] +let ``isGreaterThanOrEqual: false when equal`` (a: int) = Assert.True(isGreaterThanOrEqual a a) + +[] +let ``isGreaterThanOrEqual: true when b is greater than a`` (NonNegativeInt b, NegativeInt a) = + Assert.True(isGreaterThanOrEqual a b) + +type Five = Five +type NotFiveError = NotFiveError + +let mk5 i = + validation { + withValue i + disputeWithFact NotFiveError (isEqual 5) + qed (fun _ -> Five) + } + |> fromVCtx + +let is5 i = + if i = 5 then Ok 5 else Error NotFiveError + +[] +let ``isValid: Returns true when Result is Valid`` (NonWhiteSpaceString a) = Assert.True(isValid (Valid a)) + +[] +let ``isValid: Returns false when Result is Invalid`` () = + isValid (Invalid([], Map.empty)) |> should be False + +[] +let ``isInvalid: Returns false when Result is Valid`` (NonWhiteSpaceString a) = Assert.False(isInvalid (Valid a)) + +[] +let ``isInvalid: Returns true when Result is Invalid`` () = + isInvalid (Invalid([], Map.empty)) |> should be True + +[] +let ``flattenProofs: Returns valid list when all proofs are valid`` () = + let input = [ Valid 1; Valid 2; Valid 3 ] + let expected = Valid [ 1; 2; 3 ] + Assert.Equal(expected, flattenProofs input) + +[] +let ``flattenProofs: Returns invalid proof when some proofs are invalid`` () = + let input = [ Valid 1; Invalid([ "Failure" ], Map.empty); Valid 3 ] + let expected = Invalid([ "Failure" ], Map.empty) + Assert.Equal(expected, flattenProofs input) + +[] +let ``flattenProofs: Returns invalid proof when all proofs are invalid`` () = + let field1 = mkName "Field1" |> Option.get + + let input = + [ Invalid([ "GFailure1" ], Map.ofList [ ([ field1 ], [ "Failure1" ]) ]) + Invalid([ "GFailure2" ], Map.empty) + Invalid([], Map.ofList [ ([ field1 ], [ "Failure2" ]) ]) ] + + let expected = + Invalid([ "GFailure1"; "GFailure2" ], Map.ofList [ ([ field1 ], [ "Failure1"; "Failure2" ]) ]) + + Assert.Equal(expected, flattenProofs input) + +[] +let ``raiseIfInvalid: Returns value when result is Valid`` (a: int) = + Assert.Equal(a, raiseIfInvalid "test" (Valid a)) + +[] +let ``raiseIfInvalid: Raises InvalidProofException if Invalid`` () = + (fun () -> raiseIfInvalid "test" (Invalid([ "test" ], Map.empty)) |> ignore) + |> should (throwWithMessage "test") typeof> + +[] +let ``isBefore: Returns true when date is before threshold`` () = + let date1 = System.DateTime(2020, 1, 1) + let date2 = System.DateTime(2021, 1, 1) + isBefore date2 date1 |> should be True + +[] +let ``isBefore: Returns false when date is after threshold`` () = + let date1 = System.DateTime(2021, 1, 1) + let date2 = System.DateTime(2020, 1, 1) + isBefore date2 date1 |> should be False + +[] +let ``isBefore: Works with DateTimeOffset`` () = + let date1 = System.DateTimeOffset(2020, 1, 1, 0, 0, 0, System.TimeSpan.Zero) + let date2 = System.DateTimeOffset(2021, 1, 1, 0, 0, 0, System.TimeSpan.Zero) + isBefore date2 date1 |> should be True + +[] +let ``isAfter: Returns true when date is after threshold`` () = + let date1 = System.DateTime(2021, 1, 1) + let date2 = System.DateTime(2020, 1, 1) + isAfter date2 date1 |> should be True + +[] +let ``isAfter: Returns false when date is before threshold`` () = + let date1 = System.DateTime(2020, 1, 1) + let date2 = System.DateTime(2021, 1, 1) + isAfter date2 date1 |> should be False + +[] +let ``isBetween: Returns true when date is within range`` () = + let start = System.DateTime(2020, 1, 1) + let end' = System.DateTime(2022, 1, 1) + let date = System.DateTime(2021, 1, 1) + isBetween start end' date |> should be True + +[] +let ``isBetween: Returns false when date is outside range`` () = + let start = System.DateTime(2020, 1, 1) + let end' = System.DateTime(2021, 1, 1) + let date = System.DateTime(2022, 1, 1) + isBetween start end' date |> should be False \ No newline at end of file diff --git a/tests/FSharp.Data.Validation.Tests/Tests/Validators/Numeric.fs b/tests/FSharp.Data.Validation.Tests/Tests/Validators/Numeric.fs new file mode 100644 index 0000000..3fd01da --- /dev/null +++ b/tests/FSharp.Data.Validation.Tests/Tests/Validators/Numeric.fs @@ -0,0 +1,47 @@ +module FSharp.Data.Validation.Tests.Numeric + +open Xunit +open FsCheck +open FsCheck.Xunit +open FsUnit.Xunit + +open FSharp.Data.Validation + +[] +let ``inRange: Returns true when value is within range`` (a: int) = + let min = a - 10 + let max = a + 10 + Assert.True(inRange min max a) + +[] +let ``inRange: Returns false when value is outside range`` (a: int) = + let min = a + 10 + let max = a + 20 + Assert.False(inRange min max a) + +[] +let ``inRangeExclusive: Returns true when value is within exclusive range`` (a: int) = + let min = a - 10 + let max = a + 10 + Assert.True(inRangeExclusive min max a) + +[] +let ``inRangeExclusive: Returns false when value equals boundary`` (a: int) = Assert.False(inRangeExclusive a 100 a) + +[] +let ``isPositive: Returns true for positive numbers`` (PositiveInt a) = Assert.True(isPositive a) + +[] +let ``isPositive: Returns false for zero`` () = isPositive 0 |> should be False + +[] +let ``isNegative: Returns true for negative numbers`` (NegativeInt a) = Assert.True(isNegative a) + +[] +let ``isNegative: Returns false for zero`` () = isNegative 0 |> should be False + +[] +let ``isNonZero: Returns true for non-zero numbers`` (NonZeroInt a) = Assert.True(isNonZero a) + +[] +let ``isNonZero: Returns false for zero`` () = isNonZero 0 |> should be False diff --git a/tests/FSharp.Data.Validation.Tests/Tests/Validators/Required.fs b/tests/FSharp.Data.Validation.Tests/Tests/Validators/Required.fs new file mode 100644 index 0000000..8b32139 --- /dev/null +++ b/tests/FSharp.Data.Validation.Tests/Tests/Validators/Required.fs @@ -0,0 +1,55 @@ +module FSharp.Data.Validation.Tests.Required + +open Xunit +open FsCheck +open FsCheck.Xunit + +open FSharp.Data.Validation + +[] +let ``isRequired: Adds a failure to the context if the value is None`` (NonWhiteSpaceString f1) = + let input: int option = None + let result = isRequired f1 input + Assert.Equal(Error f1, result) + +[] +let ``isRequired: Returns the value if Some`` (a: int, NonWhiteSpaceString f1) = + let input: int option = Some a + let result = isRequired f1 input + Assert.Equal(Ok a, result) + +[] +let ``isRequiredWhen: Returns None when the value is Some`` (a: int, NonWhiteSpaceString f1, b: bool) = + let input: int option = Some a + let result = isRequiredWhen f1 b input + Assert.Equal(None, result) + +[] +let ``isRequiredWhen: Returns None when the value is None and condition is false`` (NonWhiteSpaceString f1) = + let input: int option = None + let result = isRequiredWhen f1 false input + Assert.Equal(None, result) + +[] +let ``isRequiredWhen: Returns Some error when the value is None and condition is true`` (NonWhiteSpaceString f1) = + let input: int option = None + let result = isRequiredWhen f1 true input + Assert.Equal(Some f1, result) + +[] +let ``isRequiredUnless: Returns None when the value is Some`` (a: int, NonWhiteSpaceString f1, b: bool) = + let input: int option = Some a + let result = isRequiredUnless f1 b input + Assert.Equal(None, result) + +[] +let ``isRequiredUnless: Returns Some Error when the value is None and condition is false`` (NonWhiteSpaceString f1) = + let input: int option = None + let result = isRequiredUnless f1 false input + Assert.Equal(Some f1, result) + +[] +let ``isRequiredUnless: Returns None when the value is None and condition is true`` (NonWhiteSpaceString f1) = + let input: int option = None + let result = isRequiredUnless f1 true input + Assert.Equal(None, result) diff --git a/tests/FSharp.Data.Validation.Tests/Tests/Validators/String.fs b/tests/FSharp.Data.Validation.Tests/Tests/Validators/String.fs new file mode 100644 index 0000000..233cced --- /dev/null +++ b/tests/FSharp.Data.Validation.Tests/Tests/Validators/String.fs @@ -0,0 +1,72 @@ +module FSharp.Data.Validation.Tests.String + +open Xunit +open FsCheck +open FsCheck.Xunit +open FsUnit.Xunit + +open FSharp.Data.Validation + +[] +let ``matchesRegex: Returns true when string matches pattern`` () = + let pattern = System.Text.RegularExpressions.Regex(@"^\d{3}-\d{4}$") + matchesRegex pattern "123-4567" |> should be True + +[] +let ``matchesRegex: Returns false when string does not match pattern`` () = + let pattern = System.Text.RegularExpressions.Regex(@"^\d{3}-\d{4}$") + matchesRegex pattern "abc-defg" |> should be False + +[] +let ``containsAny: Returns true when string contains at least one character`` () = + containsAny [ 'a'; 'b'; 'c' ] "hello world abc" |> should be True + +[] +let ``containsAny: Returns false when string contains none of the characters`` () = + containsAny [ 'x'; 'y'; 'z' ] "hello world" |> should be False + +[] +let ``containsAll: Returns true when string contains all characters`` () = + containsAll [ 'h'; 'e'; 'l' ] "hello world" |> should be True + +[] +let ``containsAll: Returns false when string does not contain all characters`` () = + containsAll [ 'x'; 'y'; 'z' ] "hello world" |> should be False + +[] +let ``startsWith: Returns true when string starts with prefix`` (NonWhiteSpaceString prefix) = + let str = prefix + "suffix" + Assert.True(startsWith prefix str) + +[] +let ``startsWith: Returns false when string does not start with prefix`` + (NonWhiteSpaceString prefix, NonWhiteSpaceString other) + = + // Only test when other doesn't start with prefix + if not (startsWith prefix other) then + Assert.False(startsWith prefix other) + +[] +let ``endsWith: Returns true when string ends with suffix`` (NonWhiteSpaceString suffix) = + let str = "prefix" + suffix + Assert.True(endsWith suffix str) + +[] +let ``isAlphanumeric: Returns true for alphanumeric strings`` () = + isAlphanumeric "abc123XYZ" |> should be True + +[] +let ``isAlphanumeric: Returns false for non-alphanumeric strings`` () = + isAlphanumeric "abc-123" |> should be False + +[] +let ``isAlpha: Returns true for alphabetic strings`` () = isAlpha "abcXYZ" |> should be True + +[] +let ``isAlpha: Returns false for non-alphabetic strings`` () = isAlpha "abc123" |> should be False + +[] +let ``isNumeric: Returns true for numeric strings`` () = isNumeric "123456" |> should be True + +[] +let ``isNumeric: Returns false for non-numeric strings`` () = isNumeric "123abc" |> should be False diff --git a/tests/FSharp.Data.Validation.Tests/Tests/ValueCtx.fs b/tests/FSharp.Data.Validation.Tests/Tests/ValueCtx.fs index e98dd9d..bb1dbff 100644 --- a/tests/FSharp.Data.Validation.Tests/Tests/ValueCtx.fs +++ b/tests/FSharp.Data.Validation.Tests/Tests/ValueCtx.fs @@ -7,70 +7,54 @@ open FsCheck.Xunit open FSharp.Data.Validation [] -let ``getValue: Retrieves the value from a global context`` - (gf1 : string) - = +let ``getValue: Retrieves the value from a global context`` (gf1: string) = let input = Global gf1 let result = ValueCtx.getValue input Assert.Equal(gf1, result) [] -let ``getValue: Retrieves the value from a field context`` - (NonWhiteSpaceString n1, lf1 : string) - = +let ``getValue: Retrieves the value from a field context`` (NonWhiteSpaceString n1, lf1: string) = let field1 = mkName n1 |> Option.get - let input = Field (field1, lf1) + let input = Field(field1, lf1) let result = ValueCtx.getValue input Assert.Equal(lf1, result) [] -let ``setValue: Sets the value of a global context`` - (gf1 : string, gf2 : string) - = +let ``setValue: Sets the value of a global context`` (gf1: string, gf2: string) = let input = Global gf1 let result = ValueCtx.setValue input gf2 Assert.Equal(Global gf2, result) [] -let ``setValue: Sets the value of a field context`` - (NonWhiteSpaceString n1, lf1 : string, lf2 : string) - = +let ``setValue: Sets the value of a field context`` (NonWhiteSpaceString n1, lf1: string, lf2: string) = let field1 = mkName n1 |> Option.get - let input = Field (field1, lf1) + let input = Field(field1, lf1) let result = ValueCtx.setValue input lf2 - Assert.Equal(Field (field1, lf2), result) + Assert.Equal(Field(field1, lf2), result) [] -let ``map: Transforms a global context`` - (gf1 : int) - = +let ``map: Transforms a global context`` (gf1: int) = let input = Global gf1 let result = ValueCtx.map (fun a -> a.ToString()) input - Assert.Equal(Global (gf1.ToString()), result) + Assert.Equal(Global(gf1.ToString()), result) [] -let ``map: Transforms a field context while preserving the field name`` - (NonWhiteSpaceString n1, lf1 : int) - = +let ``map: Transforms a field context while preserving the field name`` (NonWhiteSpaceString n1, lf1: int) = let field1 = mkName n1 |> Option.get - let input = Field (field1, lf1) + let input = Field(field1, lf1) let result = ValueCtx.map (fun a -> a.ToString()) input - Assert.Equal(Field (field1, lf1.ToString()), result) + Assert.Equal(Field(field1, lf1.ToString()), result) [] -let ``bind: Transforms a global context`` - (NonWhiteSpaceString n1, gf1 : int) - = +let ``bind: Transforms a global context`` (NonWhiteSpaceString n1, gf1: int) = let field1 = mkName n1 |> Option.get let input = Global gf1 - let result = ValueCtx.bind (fun a -> Field (field1, a)) input - Assert.Equal(Field (field1, gf1), result) + let result = ValueCtx.bind (fun a -> Field(field1, a)) input + Assert.Equal(Field(field1, gf1), result) [] -let ``bind: Transforms a field context`` - (NonWhiteSpaceString n1, lf1 : int) - = +let ``bind: Transforms a field context`` (NonWhiteSpaceString n1, lf1: int) = let field1 = mkName n1 |> Option.get - let input = Field (field1, lf1) + let input = Field(field1, lf1) let result = ValueCtx.bind Global input Assert.Equal(Global lf1, result)