From bb533119c58252f0f110e5c19e57f4edf4645ee4 Mon Sep 17 00:00:00 2001 From: "Reuben J. Sonnenberg" Date: Mon, 2 Mar 2026 10:42:34 -0900 Subject: [PATCH 1/2] docs: add general documentation improvements to README Add comprehensive documentation sections: - Installation: How to install the library - Quick Start: Minimal email validation example with key concepts - FAQ / Common Patterns: Guidance on refute vs dispute, failure composition, nested collections, mapInvalid usage, and async validation - Advanced Patterns: Detailed patterns for complex validation scenarios including: * Failure type composition across domains * Conditional field validation * Validating nested collections with indices * Using flattenProofs for nested validations * Cross-field validation * Smart constructors for validated types * Error transformation with mapInvalid These general documentation improvements complement the new features added in PR #29 and help users understand validation patterns and best practices. --- README.md | 641 +++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 637 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index e797c4b..d7f23eb 100644 --- a/README.md +++ b/README.md @@ -4,6 +4,8 @@ ## Table of Contents +- [Installation](#installation) +- [Quick Start](#quick-start) - [Getting Started](#getting-started) - [Validating Primitive Types](#validating-primitive-types) - [The Proof Type](#the-proof-type) @@ -70,8 +72,103 @@ - [Proof Helpers](#proof-helpers) - [`toResult` Helper](#toresult-helper) - [`toValidationFailures` Helper](#tovalidationfailures-helper) +- [FAQ / Common Patterns](#faq--common-patterns) + - [When should I use `refute` vs `dispute`?](#when-should-i-use-refute-vs-dispute) + - [How do I compose failures from multiple domains?](#how-do-i-compose-failures-from-multiple-domains) + - [How do I validate nested collections?](#how-do-i-validate-nested-collections) + - [When should I use `mapInvalid`?](#when-should-i-use-mapinvalid) + - [How do I handle async validation?](#how-do-i-handle-async-validation) +- [Advanced Patterns](#advanced-patterns) + - [Failure Type Composition Across Domains](#failure-type-composition-across-domains) + - [Conditional Field Validation](#conditional-field-validation) + - [Validating Nested Collections with Indices](#validating-nested-collections-with-indices) + - [Using `flattenProofs` for Nested Validations](#using-flattenproofs-for-nested-validations) + - [Cross-Field Validation](#cross-field-validation) + - [Pattern: Smart Constructors for Validated Types](#pattern-smart-constructors-for-validated-types) + - [Using `mapInvalid` for Error Transformation](#using-mapinvalid-for-error-transformation) - [Data-Validation Library for Haskell](#data-validation-library-for-haskell) +## Installation + +```powershell +dotnet add package FSharp.Data.Validation +``` + +For async validation support: + +```powershell +dotnet add package FSharp.Data.Validation.Async +``` + +**Requirements:** +- .NET 8.0 or higher +- F# 6.0 or higher + +**Resources:** +- [Getting Started guide](samples/GettingStarted/) - Step-by-step tutorial project +- [Async validation README](src/FSharp.Data.Validation.Async/README.md) - Detailed async patterns +- [Giraffe integration README](src/FSharp.Data.Validation.Giraffe/README.md) - Web framework usage + +## Quick Start + +Here's a minimal example showing how to validate an email address: + +```fsharp +open FSharp.Data.Validation + +// 1. Define your failure type +type EmailFailure = + | Required + | InvalidFormat + | DomainNotAllowed + +// 2. Create a validated type with private constructor +type Email = private Email of string + +module Email = + // 3. Define a smart constructor that validates + let make (input: string option) : Proof = + validation { + withValue input + refuteWith (isRequired Required) + disputeWithFact InvalidFormat (fun s -> + s.Contains("@") && s.Contains(".") + ) + disputeWithFact DomainNotAllowed (fun s -> + let domain = s.Split('@').[1] + domain <> "tempmail.com" + ) + qed Email + } |> fromVCtx + + let unwrap (Email s) = s + +// 4. Use it in your application +let sendWelcomeEmail email = + let address = Email.unwrap email + printfn "Sending email to %s" address + +// Validate user input +let userInput = Some "user@example.com" +match Email.make userInput with +| Valid email -> + sendWelcomeEmail email // Type-safe: only valid emails can reach here +| Invalid (failures, fieldFailures) -> + printfn "Validation failed: %A" failures +``` + +**Key Concepts:** + +- **Transformation-oriented**: Validation transforms `string option` → `Email` +- **Type safety**: Impossible to use unvalidated data (private constructor) +- **Accumulating failures**: See all validation problems at once +- **refute vs dispute**: `refute` stops validation and transforms types; `dispute` continues collecting failures + +**Next Steps:** +- Read the [Getting Started](#getting-started) guide for detailed explanations +- Explore [Advanced Patterns](#advanced-patterns) for complex scenarios +- Check [Validation Helpers](#validation-helpers) for built-in validation functions + ## Getting Started *The code for these examples can be found [here](samples/GettingStarted/).* @@ -1207,7 +1304,6 @@ validation { #### `refuteEachWithProof` - Similar to `refuteWithProof` but used for validating list like types. ```fsharp @@ -1265,7 +1361,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 +1518,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 +1531,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 @@ -1559,6 +1658,540 @@ 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>`. +## FAQ / Common Patterns + +### When should I use `refute` vs `dispute`? + +**Use `refute*` operations when:** +- You need to **transform the type** (e.g., `string option` → `string`, `string` → `EmailAddress`) +- Validation **cannot continue** without this transformation +- The value is **required** for subsequent validations + +**Use `dispute*` operations when:** +- You want to **collect multiple failures** without stopping +- The type **doesn't need to change** +- You're performing **independent checks** on the same value + +**Example:** + +```fsharp +type PasswordFailure = + | Required + | TooShort + | NoNumbers + | NoSpecialChars + +let validatePassword (input: string option) : Proof = + validation { + withValue input + + // REFUTE: Transform option to string - must happen first + refuteWith (isRequired Required) + + // DISPUTE: Collect all password rule violations + disputeWithFact TooShort (minLength 8) + disputeWithFact NoNumbers (fun s -> Regex.IsMatch(s, @"\d")) + disputeWithFact NoSpecialChars (fun s -> Regex.IsMatch(s, @"[!@#$%^&*]")) + + qed id + } |> fromVCtx +// If input is None: stops at refuteWith, returns Invalid ([Required], ...) +// If input is Some "short": continues through all disputes, returns Invalid ([TooShort; NoNumbers; NoSpecialChars], ...) +``` + +**Rule of thumb:** `refute` to transform and gate, `dispute` to accumulate. + +### How do I compose failures from multiple domains? + +Create a parent failure type that wraps sub-domain failures, then use `Proof.mapInvalid` to lift failures: + +```fsharp +// Sub-domain failures +type EmailFailure = InvalidFormat | DomainBlocked +type PasswordFailure = TooWeak | Compromised +type UsernameFailure = Taken | InvalidChars + +// Composite failure type +type RegistrationFailure = + | EmailError of EmailFailure + | PasswordError of PasswordFailure + | UsernameError of UsernameFailure + | PasswordMismatch + +// Individual validators return their own failure types +let validateEmail (s: string option) : Proof = ... +let validatePassword (s: string option) : Proof = ... +let validateUsername (s: string option) : Proof = ... + +// Compose them with mapInvalid +let validateRegistration (vm: RegistrationVM) : Proof = + validation { + let! email = + validation { + withField (fun () -> vm.Email) + refuteWithProof (validateEmail >> Proof.mapInvalid EmailError) + qed + } + + and! password = + validation { + withField (fun () -> vm.Password) + refuteWithProof (validatePassword >> Proof.mapInvalid PasswordError) + qed + } + + and! username = + validation { + withField (fun () -> vm.Username) + refuteWithProof (validateUsername >> Proof.mapInvalid UsernameError) + qed + } + + // Cross-field validation at parent level + if vm.Password <> vm.ConfirmPassword then + dispute PasswordMismatch + + return { Email = email; Password = password; Username = username } + } |> fromVCtx +``` + +This allows each domain to maintain its own failure vocabulary while composing cleanly at higher levels. + +### How do I validate nested collections? + +Use `validateEach` for collections, with indices automatically tracked: + +```fsharp +type ItemFailure = + | NameRequired + | PriceTooLow + | QuantityInvalid + +type OrderFailure = + | ItemError of ItemFailure + | NoItems + +type OrderItemVM = { Name: string option; Price: decimal option; Quantity: int option } +type OrderItem = { Name: string; Price: decimal; Quantity: int } + +let validateOrderItem (vm: OrderItemVM) : Proof = + validation { + let! name = + validation { + withField (fun () -> vm.Name) + refuteWith (isRequired NameRequired) + qed + } + and! price = + validation { + withField (fun () -> vm.Price) + refuteWith (isRequired PriceTooLow) + disputeWithFact PriceTooLow (fun p -> p > 0.0m) + qed + } + and! quantity = + validation { + withField (fun () -> vm.Quantity) + refuteWith (isRequired QuantityInvalid) + disputeWithFact QuantityInvalid (fun q -> q > 0) + qed + } + + return { Name = name; Price = price; Quantity = quantity } + } |> fromVCtx + +let validateOrder (items: OrderItemVM list) : Proof = + validation { + withValue items + disputeWithFact NoItems (fun lst -> lst.Length > 0) + + // validateEach automatically tracks indices + validateEach (fun item -> + validation { + withValue item + refuteWithProof (validateOrderItem >> Proof.mapInvalid ItemError) + qed + } + ) + qed + } |> fromVCtx + +// Field failures will include indices: "items.[0].Name", "items.[2].Price" +``` + +**Alternative with flattenProofs:** + +```fsharp +let validateOrderAlternative (items: OrderItemVM list) : Proof = + items + |> List.map (validateOrderItem >> Proof.mapInvalid ItemError) + |> flattenProofs +``` + +### When should I use `mapInvalid`? + +Use `mapInvalid` whenever you need to **lift failures into a parent type**: + +**1. Composing validators from different domains** (see above) + +**2. Adding context to failures:** + +```fsharp +type InnerFailure = Empty | TooLong +type OuterFailure = ValidationFailed of context: string * InnerFailure + +let validateWithContext (context: string) (input: string option) = + validateInner input + |> Proof.mapInvalid (fun failure -> ValidationFailed (context, failure)) + +validateWithContext "user registration" (Some "") +// Returns: Invalid ([ValidationFailed ("user registration", Empty)], ...) +``` + +**3. Wrapping library validators:** + +```fsharp +// Library returns its own failure type +type LibraryFailure = | LibError + +// Your app has its own failure type +type AppFailure = + | AppError + | ExternalValidationFailed of LibraryFailure + +let validateInApp input = + LibraryValidator.validate input + |> Proof.mapInvalid ExternalValidationFailed +``` + +**Key insight:** `mapInvalid` transforms the `'F` type parameter in `Proof<'F, 'A>`, leaving the valid value `'A` unchanged. + +### How do I handle async validation? + +Use the `FSharp.Data.Validation.Async` package for I/O-bound validations: + +```fsharp +open FSharp.Data.Validation.Async + +type UserFailure = + | Required + | InvalidEmail + | EmailAlreadyRegistered + | UsernameTaken + +// Async check against database +let checkEmailExistsAsync (email: string) : Async = + async { + // Database query + return! DbContext.users.AnyAsync(fun u -> u.Email = email) + } + +let checkUsernameTakenAsync (username: string) : Async = + async { + return! DbContext.users.AnyAsync(fun u -> u.Username = username) + } + +// Sync validation first, then async +let validateUserAsync (vm: UserVM) : Async> = + async { + // 1. Synchronous validations first + let syncValidation = + validation { + let! email = + validation { + withField (fun () -> vm.Email) + refuteWith (isRequired Required) + disputeWithFact InvalidEmail (fun s -> s.Contains("@")) + qed + } + and! username = + validation { + withField (fun () -> vm.Username) + refuteWith (isRequired Required) + qed + } + + return (email, username) + } + + // 2. If sync validation passed, run async checks + let! result = + syncValidation + |> VCtx.bindToAsync (fun (email, username) -> + async { + // Run async validations in parallel + let! emailExists = checkEmailExistsAsync email + let! usernameTaken = checkUsernameTakenAsync username + + return + validation { + withValue (email, username) + + if emailExists then + dispute EmailAlreadyRegistered + + if usernameTaken then + dispute UsernameTaken + + qed (fun (e, u) -> { Email = e; Username = u }) + } + } + ) + + return result |> fromVCtx + } + +// Usage +async { + let! proof = validateUserAsync userInput + + match proof with + | Valid user -> + // Save user to database + do! saveUser user + | Invalid (failures, fieldFailures) -> + // Return validation errors + return! badRequest failures +} +``` + +**Pattern summary:** +1. Run cheap synchronous validations first (format, required, length) +2. Use `bindToAsync` to chain async validations only if sync passed +3. Async validations can run in parallel for better performance +4. See [Async README](src/FSharp.Data.Validation.Async/README.md) for more patterns + +## Advanced Patterns + +### Failure Type Composition Across Domains + +When validating complex domains with multiple sub-types, compose failure types to maintain type safety: + +```fsharp +type UsernameFailures = + | Empty + | TooLong + +type EmailFailures = + | InvalidFormat + | AlreadyRegistered + +type PasswordFailures = + | Empty + | TooWeak + +// Composite domain failure type +type RegistrationFailures = + | Username of UsernameFailures + | Email of EmailFailures + | Password of PasswordFailures + | PasswordsDoNotMatch + +let validateUsername (un: string option) : Proof = + validation { + withField (fun () -> un) + refuteWith (isRequired Empty) + refuteWith (fun u -> if String.length u > 50 then Some TooLong else None) + qed Username + } |> fromVCtx + +// Use Proof.mapInvalid to lift into composite type +let validateRegistration (form: RegisterVM) + : Proof = + let un = validateUsername form.Username |> Proof.mapInvalid Username + let em = validateEmail form.Email |> Proof.mapInvalid Email + let pw = validatePassword form.Password |> Proof.mapInvalid Password + Proof.combine (Proof.combine un em) pw +``` + +### Conditional Field Validation + +Validate fields based on other field values: + +```fsharp +type AddressType = | Residential | Business + +type AddressVM = + { Type: AddressType + Street: string option + Company: string option } + + member this.Validate() = + validation { + let! street = + validation { + withField (fun () -> this.Street) + refuteWith (isRequired StreetRequired) + qed id + } + + and! company = + if this.Type = Business then + validation { + withField (fun () -> this.Company) + refuteWith (isRequired CompanyRequired) + qed id + } + else + validation { + withValue None + qed id + } + + return { Street = street; Company = company } + } |> fromVCtx +``` + +### Validating Nested Collections with Indices + +Track validation failures by index for collection items: + +```fsharp +type ItemFailure = | NameRequired | PriceTooLow + +type OrderVM = + { Items: ItemVM list } + + member this.Validate() = + validation { + let validateItem (idx, item: ItemVM) = + validation { + let! name = + validation { + withField (fun () -> item.Name) + refuteWith (isRequired NameRequired) + qed id + } + and! price = + validation { + withField (fun () -> item.Price) + disputeWithFact PriceTooLow (fun p -> p >= 0.01M) + qed id + } + return { Name = name; Price = price } + } |> fromVCtx + + withValue this.Items + validateEach validateItem + qed id + } |> fromVCtx +``` + +### Using `flattenProofs` for Nested Validations + +When you have a list of proofs that need to be flattened: + +```fsharp +// Validating a list of items where each validation returns a Proof +let validateItems (items: string list) : Proof = + let proofs = + items + |> List.map (fun item -> + validation { + withValue item + disputeWithFact Empty (isNotNull) + qed id + } |> fromVCtx + ) + + // flattenProofs combines Proof<'F, 'A> list into Proof<'F, 'A list> + flattenProofs proofs +``` + +### Cross-Field Validation + +Validate relationships between multiple fields: + +```fsharp +type PasswordChangeFailures = + | OldPasswordIncorrect + | NewPasswordSameAsOld + | ConfirmationDoesNotMatch + +type PasswordChangeVM = + { OldPassword: string option + NewPassword: string option + ConfirmNewPassword: string option } + + member this.Validate() = + validation { + let! oldPwd = + validation { + withField (fun () -> this.OldPassword) + refuteWith (isRequired Required) + qed id + } + + and! newPwd = + validation { + withField (fun () -> this.NewPassword) + refuteWith (isRequired Required) + refuteWith (fun p -> + if p = oldPwd then Some NewPasswordSameAsOld + else None + ) + qed id + } + + and! confirmPwd = + validation { + withField (fun () -> this.ConfirmNewPassword) + refuteWith (isRequired Required) + qed id + } + + // Cross-field validation + if newPwd <> confirmPwd then + disputeWithFact ConfirmationDoesNotMatch false + + return { OldPassword = oldPwd; NewPassword = newPwd } + } |> fromVCtx +``` + +### Pattern: Smart Constructors for Validated Types + +Establish a pattern where only validated values can be constructed: + +```fsharp +type ValidatedEmail = private ValidatedEmail of string + +module ValidatedEmail = + type ValidationFailure = + | InvalidFormat + | DomainNotAllowed + + let make (str: string) : Proof = + validation { + withValue str + disputeWithFact InvalidFormat (fun s -> Regex.IsMatch(s, ".+@.+")) + disputeWithFact DomainNotAllowed (fun s -> + let domain = s.Split('@').[1] + ["gmail.com"; "yahoo.com"; "outlook.com"] + |> List.contains domain |> not + ) + qed ValidatedEmail + } |> fromVCtx + + let unwrap (ValidatedEmail s) = s + +// Usage ensures type safety +let handleEmail (email: ValidatedEmail) = + let address = ValidatedEmail.unwrap email + sendEmail address +``` + +### Using `mapInvalid` for Error Transformation + +Transform failure types to compose validators: + +```fsharp +let validateUsername un : Proof = ... + +let addInvalidUsernameToForm (proof: Proof) + : Proof = + Proof.mapInvalid (fun uf -> FormError.UsernameError uf) proof +``` + ## Data-Validation Library for Haskell This library is based on our original library for [Haskell](https://www.haskell.org/). From 1e398331a4e527e9e98600e1f447cf439cd044ee Mon Sep 17 00:00:00 2001 From: "Reuben J. Sonnenberg" Date: Tue, 3 Mar 2026 11:26:50 -0900 Subject: [PATCH 2/2] docs: update README and sample types for F# 8.0 compatibility and improve validation logic --- README.md | 127 ++++++++++++++++++++------------ samples/GettingStarted/Types.fs | 30 ++++---- 2 files changed, 96 insertions(+), 61 deletions(-) diff --git a/README.md b/README.md index d7f23eb..af2f417 100644 --- a/README.md +++ b/README.md @@ -102,7 +102,7 @@ dotnet add package FSharp.Data.Validation.Async **Requirements:** - .NET 8.0 or higher -- F# 6.0 or higher +- F# 8.0 or higher **Resources:** - [Getting Started guide](samples/GettingStarted/) - Step-by-step tutorial project @@ -131,12 +131,16 @@ module Email = validation { withValue input refuteWith (isRequired Required) - disputeWithFact InvalidFormat (fun s -> - s.Contains("@") && s.Contains(".") + refuteWith (fun s -> + if not (s.Contains("@") && s.Contains(".")) then + Error InvalidFormat + else + Ok s ) disputeWithFact DomainNotAllowed (fun s -> - let domain = s.Split('@').[1] - domain <> "tempmail.com" + let parts = s.Split('@') + if parts.Length < 2 then false + else parts.[1] <> "tempmail.com" ) qed Email } |> fromVCtx @@ -525,7 +529,7 @@ That's why we need both `dispute*` and `refute*` operations. ### Back to the Example Now that we understand the difference between `dispute*` and `refute*`, let's break our example down. -The `refuteWith` operation takes a function with the signature `'A -> Result<'F, 'B>`. +The `refuteWith` operation takes a function with the signature `'A -> Result<'B, 'F>`. This function checks if a value is suitable for transformation from `'A` to `'B`. If so, it performs the transformation and returns it. Otherwise, it returns the failure. @@ -792,22 +796,22 @@ module Example.Types let makeNewUser(vm:NewUserVM) = validation { let! name = validation { - withField (fun () -> this.Name) + withField (fun () -> vm.Name) // validate name qed } and! username = validation { - withField (fun () -> this.Username) + withField (fun () -> vm.Username) // validate username qed } and! password = validation { - withField (fun () -> this.Password) + withField (fun () -> vm.Password) // validate password qed } and! emailAddress = validation { - withField (fun () -> this.EmailAddress) + withField (fun () -> vm.EmailAddress) // validate email address qed } @@ -844,24 +848,24 @@ type NewUserFailure = let makeNewUser(vm:NewUserVM) = validation { let! name = validation { - withField (fun () -> this.Name) + withField (fun () -> vm.Name) // how do we validate an optional field? qed } and! username = validation { - withField (fun () -> this.Username) + withField (fun () -> vm.Username) refuteWith (isRequired RequiredField) refuteWithProof (mkUsername >> Proof.mapInvalid InvalidUsername) qed } and! password = validation { - withField (fun () -> this.Password) + withField (fun () -> vm.Password) refuteWith (isRequired RequiredField) refuteWithProof (mkPassword >> Proof.mapInvalid InvalidPassword) qed } and! emailAddress = validation { - withField (fun () -> this.EmailAddress) + withField (fun () -> vm.EmailAddress) refuteWith (isRequired RequiredField) refuteWithProof (mkEmailAddress >> Proof.mapInvalid InvalidEmailAddress) qed @@ -895,7 +899,7 @@ Let's see it in action. ```fsharp let! name = validation { - withField (fun () -> this.Name) + withField (fun () -> vm.Name) optional (fun v -> validation { withValue v refuteWithProof (mkName >> Proof.mapInvalid InvalidName) @@ -923,36 +927,42 @@ module Example.Types let makeNewUser(vm:NewUserVM) = validation { let! name = validation { - withField (fun () -> this.Name) + withField (fun () -> vm.Name) optional (fun v -> validation { withValue v - refuteWithProof (mkName >> Proof.mapInvalid InvalidEmailAddress) + refuteWithProof (mkName >> Proof.mapInvalid InvalidName) }) qed } and! username = validation { - withField (fun () -> this.Username) + withField (fun () -> vm.Username) refuteWith (isRequired RequiredField) refuteWithProof (mkUsername >> Proof.mapInvalid InvalidUsername) qed } and! password = validation { - withField (fun () -> this.Password) + withField (fun () -> vm.Password) refuteWith (isRequired RequiredField) refuteWithProof (mkPassword >> Proof.mapInvalid InvalidPassword) qed } and! emailAddress = validation { - withField (fun () -> this.EmailAddress) + withField (fun () -> vm.EmailAddress) refuteWith (isRequired RequiredField) refuteWithProof (mkEmailAddress >> Proof.mapInvalid InvalidEmailAddress) qed } - and! _ = validation { - withValue this - disputeWithFact NameMatchesUsername (fun a -> a.Name = a.Username |> not) + + let! _ = validation { + withValue (name, username) + disputeWithFact NameMatchesUsername (fun (n, u) -> + match n with + | Some nameVal -> Name.unwrap nameVal <> Username.unwrap u + | None -> true + ) qed } + return { NewUser.name = name; username = username; password = password; emailAddress = emailAddress; } } |> fromVCtx ``` @@ -1062,7 +1072,7 @@ module NewUserVM = validation { // ... nothing new here and! contact = validation { - withField (fun () -> this.Contact) + withField (fun () -> vm.Contact) refuteWith (isRequired RequiredField) refuteWithProof (ContactVM.makeContact >> Proof.mapInvalid InvalidContact) qed @@ -1122,13 +1132,13 @@ module NewUserVM = validation { // ... nothing new here and! preferredContact = validation { - withField (fun () -> this.PreferredContact) + withField (fun () -> vm.PreferredContact) refuteWith (isRequired RequiredField) refuteWithProof (ContactVM.makeContact >> Proof.mapInvalid InvalidContact) qed } and! additionalContacts = validation { - withField (fun () -> this.AdditionalContacts) + withField (fun () -> vm.AdditionalContacts) refuteEachWithProof (ContactVM.makeContact >> Proof.mapInvalid InvalidContact) qed List.ofSeq } @@ -1747,11 +1757,20 @@ let validateRegistration (vm: RegistrationVM) : Proof vm.ConfirmPassword then - dispute PasswordMismatch + and! confirmPassword = + validation { + withField (fun () -> vm.ConfirmPassword) + refuteWith (isRequired PasswordMismatch) + qed + } - return { Email = email; Password = password; Username = username } + let! _ = validation { + withValue (password, confirmPassword) + disputeWithFact PasswordMismatch (fun (p, cp) -> Password.unwrap p = cp) + qed + } + + return (email, password, username, confirmPassword) } |> fromVCtx ``` @@ -1813,7 +1832,7 @@ let validateOrder (items: OrderItemVM list) : Proof fromVCtx // Field failures will include indices: "items.[0].Name", "items.[2].Price" @@ -1883,12 +1902,12 @@ type UserFailure = let checkEmailExistsAsync (email: string) : Async = async { // Database query - return! DbContext.users.AnyAsync(fun u -> u.Email = email) + return! DbContext.users.AnyAsync(fun u -> u.Email = email) |> Async.AwaitTask } let checkUsernameTakenAsync (username: string) : Async = async { - return! DbContext.users.AnyAsync(fun u -> u.Username = username) + return! DbContext.users.AnyAsync(fun u -> u.Username = username) |> Async.AwaitTask } // Sync validation first, then async @@ -1919,7 +1938,7 @@ let validateUserAsync (vm: UserVM) : Async> = syncValidation |> VCtx.bindToAsync (fun (email, username) -> async { - // Run async validations in parallel + // Run async validations asynchronously as possible let! emailExists = checkEmailExistsAsync email let! usernameTaken = checkUsernameTakenAsync username @@ -2001,7 +2020,10 @@ let validateRegistration (form: RegisterVM) let un = validateUsername form.Username |> Proof.mapInvalid Username let em = validateEmail form.Email |> Proof.mapInvalid Email let pw = validatePassword form.Password |> Proof.mapInvalid Password - Proof.combine (Proof.combine un em) pw + Proof.combine + (fun ((u, e), p) -> createRegisteredUser u e p) + (Proof.combine (fun u e -> (u, e)) un em) + pw ``` ### Conditional Field Validation @@ -2054,7 +2076,7 @@ type OrderVM = member this.Validate() = validation { - let validateItem (idx, item: ItemVM) = + let validateItem idx (item: ItemVM) : VCtx> = validation { let! name = validation { @@ -2069,7 +2091,7 @@ type OrderVM = qed id } return { Name = name; Price = price } - } |> fromVCtx + } withValue this.Items validateEach validateItem @@ -2127,8 +2149,8 @@ type PasswordChangeVM = withField (fun () -> this.NewPassword) refuteWith (isRequired Required) refuteWith (fun p -> - if p = oldPwd then Some NewPasswordSameAsOld - else None + if p = oldPwd then Error NewPasswordSameAsOld + else Ok p ) qed id } @@ -2140,9 +2162,14 @@ type PasswordChangeVM = qed id } - // Cross-field validation - if newPwd <> confirmPwd then - disputeWithFact ConfirmationDoesNotMatch false + and! _ = + validation { + // Cross-field validation: compare old and new passwords + withValue (oldPwd, newPwd, confirmPwd) + disputeWithFact NewPasswordSameAsOld (fun (old, new_, _) -> new_ <> old) + disputeWithFact ConfirmationDoesNotMatch (fun (_, new_, confirm) -> new_ = confirm) + qed + } return { OldPassword = oldPwd; NewPassword = newPwd } } |> fromVCtx @@ -2163,11 +2190,19 @@ module ValidatedEmail = let make (str: string) : Proof = validation { withValue str - disputeWithFact InvalidFormat (fun s -> Regex.IsMatch(s, ".+@.+")) + refuteWith (fun s -> + if not (Regex.IsMatch(s, ".+@.+")) then + Error InvalidFormat + else + Ok s + ) disputeWithFact DomainNotAllowed (fun s -> - let domain = s.Split('@').[1] - ["gmail.com"; "yahoo.com"; "outlook.com"] - |> List.contains domain |> not + let parts = s.Split('@') + if parts.Length < 2 then false + else + let domain = parts.[1] + ["gmail.com"; "yahoo.com"; "outlook.com"] + |> List.contains domain |> not ) qed ValidatedEmail } |> fromVCtx diff --git a/samples/GettingStarted/Types.fs b/samples/GettingStarted/Types.fs index e77e5bf..9ca6c67 100644 --- a/samples/GettingStarted/Types.fs +++ b/samples/GettingStarted/Types.fs @@ -7,7 +7,7 @@ open System.Text.RegularExpressions type Name = private Name of string -type NameFailure = +type NameFailure = | Empty module Name = @@ -44,7 +44,7 @@ type PasswordFailure = | MinLength | NeedsTwoOfLetterNumberSpecial -module Password = +module Password = let private hasLetter (str:string) = str.Any(fun c -> Char.IsLetter(c)) let private hasNumber (str:string) = str.Any(fun c -> Char.IsDigit(c)) let private hasSpecial (str:string) = str.Any(fun c -> Char.IsLetterOrDigit(c) |> not) @@ -71,7 +71,7 @@ type EmailAddress = private { } with member public this.Username = this.username member public this.Domain = this.domain - + type EmailAddressFailure = | InvalidDomain | InvalidUsername @@ -106,12 +106,12 @@ type PhoneNumber = private { member public this.AreaCode = this.areaCode member public this.Exchange = this.exchange member public this.LineNumber = this.lineNumber - + type PhoneNumberFailure = | Empty | MissingAreaCode - | ToShort - | ToLong + | TooShort + | TooLong module PhoneNumber = let make (str:string) = @@ -121,11 +121,11 @@ module PhoneNumber = withValue clean disputeWithFact Empty (isNotNull) refuteWith (fun s -> if s.Length = 7 then Error MissingAreaCode else Ok s) - disputeWithFact ToShort (minLength 10) - disputeWithFact ToLong (minLength 11) + disputeWithFact TooShort (minLength 10) + disputeWithFact TooLong (maxLength 11) qed (fun s -> let s' = if s.Length = 10 then s else s.Substring(1) - { areaCode = s.Substring(0,3); exchange = s.Substring(3,3); lineNumber = s.Substring(6) } + { areaCode = s'.Substring(0,3); exchange = s'.Substring(3,3); lineNumber = s'.Substring(6) } ) } |> fromVCtx @@ -136,8 +136,8 @@ type Contact = | Call of PhoneNumber | Text of PhoneNumber | Email of EmailAddress - -type ContactFailure = + +type ContactFailure = | MissingContactType | MissingContactDetails | InvalidPhoneNumber of PhoneNumberFailure @@ -186,12 +186,12 @@ module ContactVM = } |> fromVCtx // The validated new user type (the model) -type NewUser = private { +type NewUser = private { name: Name option username: Username password: Password preferredContact: Contact - additionalContacts: Contact list + additionalContacts: Contact list } with member public this.Name = this.name member public this.Username = this.username @@ -199,7 +199,7 @@ type NewUser = private { member public this.PreferredContact = this.preferredContact member public this.AdditionalContacts = this.additionalContacts -type NewUserFailure = +type NewUserFailure = | RequiredField | NameMatchesUsername | InvalidName of NameFailure @@ -216,7 +216,7 @@ type NewUserVM = AdditionalContacts: ContactVM list } module NewUserVM = - let makeNewUser (vm: NewUserVM) = + let makeNewUser (vm: NewUserVM) = validation { let! name = validation { withField (fun () -> vm.Name)