From f1b2fe457c45d200588dd6c757abb6d7ca19f04e Mon Sep 17 00:00:00 2001 From: "Reuben J. Sonnenberg" Date: Fri, 27 Feb 2026 17:15:56 -0900 Subject: [PATCH] feat: expand async validation API --- src/FSharp.Data.Validation.Async/README.md | 492 +++++++++++++++- src/FSharp.Data.Validation.Async/VCtx.fs | 547 +++++++++++++----- .../Tests.fs | 511 ++++++++++++++++ 3 files changed, 1409 insertions(+), 141 deletions(-) diff --git a/src/FSharp.Data.Validation.Async/README.md b/src/FSharp.Data.Validation.Async/README.md index 48f7496..218ab68 100644 --- a/src/FSharp.Data.Validation.Async/README.md +++ b/src/FSharp.Data.Validation.Async/README.md @@ -1,16 +1,486 @@ # FSharp.Data.Validation.Async -## Description +## Overview -This library provides a small set of functions that extend the `FSharp.Data.Validation` library to work with asynchronous workflows. +This library extends FSharp.Data.Validation to support asynchronous workflows. When validation logic requires I/O operations (database lookups, API calls, file operations), you need to work with `Async>` instead of just `VCtx<'F, 'A>`. -## Functions +### What This Library Adds -- `bindToAsync: ('A -> Async>) -> VCtx<'F, 'A> -> Async>` -- `bindAsync: ('A -> Async>) -> Async> -> Async>` -- `bindFromAsync: ('A -> VCtx<'F, 'B>) -> Async> -> Async>` -- `combineAsync: Async> -> Async> -> Async>` -- `bindAndMergeSourcesAsync: ('A -> Async>) -> Async> -> Async>` -- `bindToAndMergeSourcesAsync: ('A -> Async>) -> VCtx<'F, 'A> -> Async>` -- `bindFromAndMergeSourcesAsync: ('A -> VCtx<'F, 'B>) -> Async> -> Async>` -- `mapAsync: ('A -> Async<'B>) -> VCtx<'F, 'A> -> Async>` +**Base Library (`FSharp.Data.Validation`):** +- Synchronous validation with the `validation` computation expression +- Works with `VCtx<'F, 'A>` directly +- Immediate validation without I/O + +**This Library (`FSharp.Data.Validation.Async`):** +- Asynchronous validation with the `asyncValidation` computation expression +- Works with `AsyncVCtx<'F, 'A>` (alias for `Async>`) +- Supports I/O-based validation (database checks, API calls, file operations) +- **Seamless composition** - directly bind `VCtx`, `Result`, and `Proof` values without manual lifting +- Parallel and sequential async operation support + +| Feature | Base Library | Async Library | +|---------|-------------|---------------| +| **Computation Expression** | `validation { }` | `asyncValidation { }` | +| **Core Type** | `VCtx<'F, 'A>` | `AsyncVCtx<'F, 'A>` (= `Async>`) | +| **I/O Operations** | ❌ Synchronous only | ✅ Full async support | +| **Automatic Type Lifting** | N/A | ✅ `VCtx`, `Result`, `Proof` → `AsyncVCtx` | +| **Use Case** | Pure validation logic | Database checks, API calls, file I/O | + +### Key Features + +- **`asyncValidation` computation expression** - compose async validations naturally with `let!` and `and!` syntax +- **Source overloads** - automatic type conversion eliminates manual wrapping (inspired by FsToolkit.ErrorHandling) +- **AsyncVCtx module** - conversion functions and combinators for flexible composition +- **VCtx module extensions** - backwards-compatible async functions (`bindAsync`, `mapAsync`, etc.) + +## Quick Start + +### Using `asyncValidation` + +The `asyncValidation` computation expression automatically handles type conversions, letting you mix sync and async validations seamlessly: + +```fsharp +open FSharp.Data.Validation + +type ValidationFailure = + | EmailRequired + | EmailExists + | InvalidFormat + +// Check if email already exists in database +let emailExistsAsync (email: string): Async = + async { + // Simulate database lookup + do! Async.Sleep 100 + return email = "taken@example.com" + } + +// Validate email with async check - automatic type lifting in action! +let validateEmailAsync (emailVM: string) : AsyncVCtx = + asyncValidation { + // Directly bind synchronous VCtx - automatically converted + let! email = + validation { + withValue emailVM + refuteWith (isRequired EmailRequired) + refuteWith (hasValidEmailFormat InvalidFormat) + qed id + } |> fromVCtx + + // Bind Async directly - automatically converted to AsyncVCtx + let! _ = + async { + let! exists = emailExistsAsync email + return if exists then Error EmailExists else Ok () + } + + return email + } + +// Use it +let result = validateEmailAsync "user@example.com" |> Async.RunSynchronously +``` + +### The Traditional Way: Using VCtx Functions + +You can still use explicit combinators when you prefer functional composition: + +```fsharp +let validateEmailAsync (emailVM: string) : Async> = + async { + let initial = + validation { + withValue emailVM + refuteWith (isRequired EmailRequired) + refuteWith (hasValidEmailFormat InvalidFormat) + qed id + } |> fromVCtx + + let! result = + initial + |> VCtx.bindToAsync (fun email -> + async { + let! exists = emailExistsAsync email + return + if exists then + Invalid ([EmailExists], Map.empty) + else + Valid email + } + ) + + return result |> fromVCtx + } +``` + +**Key Difference:** The `asyncValidation` CE automatically converts `VCtx`, `Result`, and `Proof` values when you use `let!`, while the traditional approach requires explicit wrapping with `Invalid`/`Valid` or conversion functions. + +## The AsyncVCtx Type + +`AsyncVCtx<'F, 'A>` is a type alias for `Async>` that represents an asynchronous validation context. + +```fsharp +type AsyncVCtx<'F, 'A> = Async> +``` + +### AsyncVCtx Module Functions + +The `AsyncVCtx` module provides conversion and composition functions: + +#### Conversion Functions + +**`ofVCtx`** - Lift a synchronous validation context to async: +```fsharp +let syncContext = Valid "hello" +let asyncContext : AsyncVCtx = AsyncVCtx.ofVCtx syncContext +``` + +**`ofAsync`** - Convert an async value to async validation context: +```fsharp +let asyncValue : Async = async { return "hello" } +let asyncContext : AsyncVCtx<'F, string> = AsyncVCtx.ofAsync asyncValue +``` + +**`ofResult`** - Convert a Result to async validation context: +```fsharp +let result = Ok "hello" +let asyncContext : AsyncVCtx = AsyncVCtx.ofResult result +``` + +**`ofProof`** - Convert a Proof to async validation context: +```fsharp +let proof = Valid "hello" +let asyncContext : AsyncVCtx = AsyncVCtx.ofProof proof +``` + +**`ofAsyncResult`** - Convert an async Result to async validation context: +```fsharp +let asyncResult : Async> = async { return Ok "hello" } +let asyncContext : AsyncVCtx = AsyncVCtx.ofAsyncResult asyncResult +``` +This is particularly useful for async I/O operations that return `Result`. + +#### Composition Functions + +**`bind`** - Chain async validation operations: +```fsharp +let validate1 : AsyncVCtx = AsyncVCtx.ofVCtx (Valid 5) +let validate2 (x: int) : AsyncVCtx = + AsyncVCtx.ofVCtx (Valid (string x)) + +let result = validate1 |> AsyncVCtx.bind validate2 +``` + +**`map`** - Transform the success value: +```fsharp +let asyncContext = AsyncVCtx.ofVCtx (Valid 5) +let doubled = asyncContext |> AsyncVCtx.map (fun x -> x * 2) +``` + +**`mergeSources`** - Combine two independent async validations: +```fsharp +let validation1 : AsyncVCtx = AsyncVCtx.ofVCtx (Valid 5) +let validation2 : AsyncVCtx = AsyncVCtx.ofVCtx (Valid "hello") +let combined : AsyncVCtx = + AsyncVCtx.mergeSources validation1 validation2 +``` + +### The asyncValidation Computation Expression + +The `asyncValidation` computation expression (backed by `asyncValidationBuilder`) provides Source overloads that automatically convert: + +- `VCtx<'F, 'A>` → `AsyncVCtx<'F, 'A>` +- `Result<'A, 'F>` → `AsyncVCtx<'F, 'A>` +- `AsyncValue<'A>` → `AsyncVCtx<'F, 'A>` (pure async values, wrapped) +- `Async>` → `AsyncVCtx<'F, 'A>` (ideal for I/O operations) +- `Proof<'F, 'A>` → `AsyncVCtx<'F, 'A>` +- `AsyncVCtx<'F, 'A>` → (no conversion needed) + +This means you can use `let!` with any of these types without manual conversion: + +```fsharp +asyncValidation { + // VCtx - automatically lifted + let! x = Valid 5 + + // Result - automatically converted + let! y = Ok 10 + + // AsyncValue wrapper - for pure async values + let! a = AsyncValue (someAsyncIntCall ()) + + // Async from API or database calls - automatically converted + let! z = + async { + // Simulate API call + let! apiResult = someAsyncApiCall () + return apiResult // Result<'A, 'F> + } + + // Proof - automatically converted + let! w = Valid "hello" + + // AsyncVCtx - used directly + let! v = AsyncVCtx.ofAsync (async { return 3 }) + + // Parallel composition with and! + let! a = Valid 1 + and! b = Valid 2 + + return (x + y + a + b, w, v, z) +} +``` + +**Edge Case - Pure Async Values:** + +Plain `Async<'A>` values (not wrapped in Result/Proof) cannot be bound directly due to type ambiguity. You have three options: + +**Option 1: Wrap with `AsyncValue` (recommended)** +```fsharp +asyncValidation { + // Use AsyncValue wrapper - clean and explicit + let! x = AsyncValue (someAsyncIntCall ()) + let! y = AsyncValue (anotherAsyncCall ()) + return (x, y) +} +``` + +**Option 2: Use `AsyncVCtx.ofAsync` explicitly** +```fsharp +asyncValidation { + let! x = AsyncVCtx.ofAsync (someAsyncCall ()) + return x +} +``` + +**Option 3: Wrap in Result/Proof** +```fsharp +asyncValidation { + let! x = + async { + let! value = someAsyncCall () + return Ok value // Now it's Async + } + return x +} +``` + +**Why this limitation exists:** + +`AsyncVCtx<'F, 'A>` is defined as `Async>`, which is structurally `Async<...>`. Therefore, adding a Source overload for plain `Async<'A>` would create type ambiguity: +- Should `Async` be treated as a pure value or as a validation context? +- The wrapper type makes this explicit and unambiguous. + +**Recommendation:** Use `AsyncValue` for pure async operations—it's the most semantically clear and requires only wrapping the outermost call. + +**Note on Conversion Priority:** + +The Source overloads are tried in this order during overload resolution: +1. `AsyncVCtx<'F, 'A>` (exact match) +2. `VCtx<'F, 'A>` (sync validation lift) +3. `AsyncValue<'A>` (pure async wrapper) +4. `Async>` (async I/O result) +5. `Result<'A, 'F>` (sync result) +6. `Proof<'F, 'A>` (sync proof) + +## VCtx Module Extensions (Legacy API) + +### bindToAsync + +**Signature:** `('A -> Async>) -> VCtx<'F, 'A> -> Async>` + +**Use when:** You have a synchronous validation context and need to apply an async validation operation to its value. + +**Behavior:** +- If context is `ValidCtx a`, applies the async function to `a` +- If context is `RefutedCtx`, short-circuits and returns immediately +- If context is `DisputedCtx`, applies async function and merges failures + +**Example:** + +```fsharp +let validateUsername (un: string) : VCtx = + validation { + withValue un + disputeWithFact Empty (minLength 3) + qed Username + } |> fromVCtx + +let result = + validateUsername "alice" + |> VCtx.bindToAsync (fun name -> + async { + let! exists = checkUserExistsAsync name + if exists then + return Invalid([UsernameTaken], Map.empty) + else + return Valid name + } + ) +``` + +### bindAsync + +**Signature:** `('A -> Async>) -> Async> -> Async>` + +**Use when:** You have an async validation context and need to apply another async operation. + +**Example:** + +```fsharp +let getProfileAsync (user: User) : Async> = async { ... } +let getPermissionsAsync (profile: Profile) : Async> = async { ... } + +let result = + getProfileAsync user + |> VCtx.bindAsync getPermissionsAsync +``` + +### bindFromAsync + +**Signature:** `('A -> VCtx<'F, 'B>) -> Async> -> Async>` + +**Use when:** You have an async validation context but need a synchronous validation operation afterward. + +### mergeSourcesAsync + +**Signature:** `Async> -> Async> -> Async>` + +**Use when:** You need to combine results from two independent async operations. + +**Example:** + +```fsharp +let validateUserAsync (vm: UserVM) : Async> = async { ... } +let validatePrefsAsync (vm: PrefsVM) : Async> = async { ... } + +let result = + VCtx.mergeSourcesAsync + (validateUserAsync userVm) + (validatePrefsAsync prefsVm) +``` + +### bindAndMergeSourcesAsync + +**Signature:** `('A -> Async>) -> Async> -> Async>` + +**Use when:** You have an async operation whose result determines a dependent async operation. + +### bindToAndMergeSourcesAsync + +**Signature:** `('A -> Async>) -> VCtx<'F, 'A> -> Async>` + +**Use when:** You have a synchronous validation context and need a dependent async operation. + +### bindFromAndMergeSourcesAsync + +**Signature:** `('A -> VCtx<'F, 'B>) -> Async> -> Async>` + +**Use when:** You have an async validation context and need a synchronous operation. + +### mapAsync + +**Signature:** `('A -> Async<'B>) -> Async> -> Async>` + +**Use when:** You need to transform the valid value with async operation, but don't add failures. + +## Common Patterns + +### Sequential Async Validation + +**Modern approach with `asyncValidation`:** + +```fsharp +let validateUserWithProfileAsync (userVm: UserVM) : AsyncVCtx = + asyncValidation { + let! user = validateUserAsync userVm + let! profile = getProfileAsync user.Id + return (user, profile) + } +``` + +**Traditional approach with VCtx functions:** + +```fsharp +let validateUserWithProfileAsync (userVm: UserVM) : Async> = + validateUserAsync userVm + |> VCtx.bindAndMergeSourcesAsync (fun user -> getProfileAsync user.Id) + |> Async.map fromVCtx +``` + +### Parallel Async Validation + +**Modern approach with `asyncValidation`:** + +```fsharp +let validateRegistrationAsync (userVm: UserVM) (prefsVm: PrefsVM) + : AsyncVCtx = + asyncValidation { + let! user = validateUserAsync userVm + and! prefs = validatePrefsAsync prefsVm + return (user, prefs) + } +``` + +**Traditional approach with VCtx functions:** + +```fsharp +let validateRegistrationAsync (userVm: UserVM) (prefsVm: PrefsVM) + : Async> = + VCtx.mergeSourcesAsync + (validateUserAsync userVm) + (validatePrefsAsync prefsVm) + |> Async.map fromVCtx +``` + +### Mixing Sync and Async Validations + +**Modern approach with `asyncValidation`:** + +```fsharp +let validateOrderAsync (orderVm: OrderVM) : AsyncVCtx = + asyncValidation { + // Sync validation - automatically lifted + let! items = + validation { + withValue orderVm.Items + refuteWith (isNotEmpty EmptyOrder) + qed id + } |> fromVCtx + + // Async check - used directly + let! inventory = checkInventoryAsync items + + // Result from external API - automatically converted + let! shipping = calculateShippingAsync orderVm.Address + + return { Items = items; Inventory = inventory; Shipping = shipping } + } +``` + +**Traditional approach:** Requires manual type conversions with `VCtx.bindToAsync`, `AsyncVCtx.ofResult`, etc. + +## Decision Tree: Which Approach to Use? + +``` +Do you have async operations? +├─ NO: Use standard FSharp.Data.Validation (validation CE) +└─ YES: Choose your style + ├─ Computation Expression Style + │ └─ Use asyncValidation { ... } + │ - Natural let!/and! syntax + │ - Automatic type conversions + │ - Best for complex compositions + │ + └─ Functional Composition Style + └─ Use AsyncVCtx module or VCtx async functions + - Explicit combinators (bind, map, mergeSources) + - Point-free style possible + - Best for simple pipelines +``` + +## See Also + +- [Main README](../../README.md) +- [Giraffe Integration](../FSharp.Data.Validation.Giraffe/README.md) +- [Samples](../../samples/) diff --git a/src/FSharp.Data.Validation.Async/VCtx.fs b/src/FSharp.Data.Validation.Async/VCtx.fs index 807f19b..a835784 100644 --- a/src/FSharp.Data.Validation.Async/VCtx.fs +++ b/src/FSharp.Data.Validation.Async/VCtx.fs @@ -1,182 +1,469 @@ namespace FSharp.Data.Validation +open System +open System.Linq.Expressions +open FSharpPlus.Data + +/// +/// Type alias for asynchronous validation contexts. +/// Combines Async computations with VCtx validation contexts. +/// +type AsyncVCtx<'F, 'A> = Async> + +/// +/// Wrapper type for pure async values to enable Source overload in asyncValidation CE. +/// Use this when you have a plain Async<'A> that doesn't return a validation context. +/// +/// +/// Due to type ambiguity between Async<'A> and AsyncVCtx<'F,'A> (which is Async<VCtx<'F,'A>>), +/// plain Async values need to be wrapped. Users can either: +/// - Wrap explicitly: AsyncValue (myAsyncCall ()) +/// - Use the ofAsync helper: AsyncVCtx.ofAsync (myAsyncCall ()) +/// +type AsyncValue<'A> = AsyncValue of Async<'A> + +/// +/// AsyncVCtx module provides conversion functions and core operations for asynchronous validation contexts. +/// [] -module VCtx = +module AsyncVCtx = + /// + /// Converts a synchronous validation context into an asynchronous one. + /// + let ofVCtx (c: VCtx<'F, 'A>): AsyncVCtx<'F, 'A> = async.Return c + + /// + /// Converts a pure asynchronous value into a valid validation context. + /// + let ofAsync (a: Async<'A>): AsyncVCtx<'F, 'A> = + async { + let! x = a + return ValidCtx x + } + /// - /// Binds a function that returns an asynchronous validation context to a validation context. + /// Converts a Result into a validation context. + /// Errors become RefutedCtx, success becomes ValidCtx. + /// + let ofResult (r: Result<'A, 'F>): AsyncVCtx<'F, 'A> = + async { + return + match r with + | Ok a -> ValidCtx a + | Error f -> RefutedCtx ([f], Map.empty) + } + + /// + /// Converts a Proof into a validation context. + /// + let ofProof (p: Proof<'F, 'A>): AsyncVCtx<'F, 'A> = + async { + match p with + | Valid a -> return ValidCtx a + | Invalid (gfs, lfs) -> return RefutedCtx (gfs, lfs) + } + + /// + /// Converts an asynchronous Result into an asynchronous validation context. /// /// - /// This function takes a function fn that transforms a value of type 'A into an - /// asynchronous validation context of type Async<VCtx<'F, 'B>> and a validation context c - /// of type VCtx<'F, 'A>. It returns an asynchronous validation context of type Async<VCtx<'F, 'B>>. - /// - /// The function handles the following cases: - /// - /// - /// ValidCtx a: Applies the function fn to a and returns the result. - /// - /// - /// RefutedCtx (gfs, lfs): Returns the same RefutedCtx without applying the function. - /// - /// - /// DisputedCtx (gfs, lfs, a): Applies the function fn to a and merges the results accordingly. - /// - /// + /// Useful when you have an async operation that returns a Result. + /// Success values (Ok) become ValidCtx, while errors (Error) become RefutedCtx + /// with the error value in the global failures list. /// - /// A function that takes a value of type 'A and returns an asynchronous validation context of type Async<VCtx<'F, 'B>>. - /// A validation context of type VCtx<'F, 'A>. - /// An asynchronous validation context of type Async<VCtx<'F, 'B>>. - let bindToAsync (fn:'A -> Async>) (c: VCtx<'F, 'A>): Async> = + let ofAsyncResult (ar: Async>): AsyncVCtx<'F, 'A> = + async { + let! result = ar + return! ofResult result + } + + /// + /// Binds a function that returns an asynchronous validation context to a synchronous validation context. + /// + let bindToAsync (fn: 'A -> AsyncVCtx<'F, 'B>) (c: VCtx<'F, 'A>): AsyncVCtx<'F, 'B> = async { match c with - | ValidCtx a -> return! fn a - | RefutedCtx (gfs,lfs) -> return RefutedCtx (gfs,lfs) - | DisputedCtx (gfs,lfs,a) -> + | ValidCtx a -> return! fn a + | RefutedCtx (gfs, lfs) -> return RefutedCtx (gfs, lfs) + | DisputedCtx (gfs, lfs, a) -> let! b = fn a match b with - | ValidCtx b -> return DisputedCtx (gfs,lfs,b) - | DisputedCtx (gfs',lfs',b) -> return DisputedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs', b) - | RefutedCtx (gfs',lfs') -> return RefutedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs') + | ValidCtx b -> return DisputedCtx (gfs, lfs, b) + | DisputedCtx (gfs', lfs', b) -> + return DisputedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs', b) + | RefutedCtx (gfs', lfs') -> + return RefutedCtx (gfs @ gfs', Utilities.mergeFailures lfs lfs') } /// /// Binds a function that returns an asynchronous validation context to an asynchronous validation context. /// - /// - /// This function takes a function fn that transforms a value of type 'A into a validation context - /// of type VCtx<'F, 'B> and an asynchronous validation context c of type Async<VCtx<'F, 'A>>. - /// It returns an asynchronous validation context of type Async<VCtx<'F, 'B>>. - /// - /// A function that takes a value of type 'A and returns a validation context of type VCtx<'F, 'B>. - /// An asynchronous validation context of type Async<VCtx<'F, 'A>>. - /// An asynchronous validation context of type Async<VCtx<'F, 'B>>. - let bindAsync (fn:'A -> Async>) (c: Async>): Async> = + let bind (fn: 'A -> AsyncVCtx<'F, 'B>) (c: AsyncVCtx<'F, 'A>): AsyncVCtx<'F, 'B> = async { let! c' = c return! bindToAsync fn c' } /// - /// Binds a function that returns a validation context to an asynchronous validation context. + /// Binds a function that returns a synchronous validation context to an asynchronous validation context. /// - /// - /// This function takes a function fn that transforms a value of type 'A into a validation context - /// of type VCtx<'F, 'B> and a validation context c of type VCtx<'F, 'A>. - /// It returns a validation context of type VCtx<'F, 'B>. - /// - /// A function that takes a value of type 'A and returns a validation context of type VCtx<'F, 'B>. - /// A validation context of type VCtx<'F, 'A>. - /// A validation context of type VCtx<'F, 'B>. - let bindFromAsync (fn:'A -> VCtx<'F, 'B>) (c: Async>): Async> = - bindAsync (fn >> async.Return) c + let bindFrom (fn: 'A -> VCtx<'F, 'B>) (c: AsyncVCtx<'F, 'A>): AsyncVCtx<'F, 'B> = + bind (fun a -> async.Return (fn a)) c /// - /// Merge sources of two asynchronous computations of validation contexts into a single asynchronous validation context. + /// Maps a synchronous function over the value of an asynchronous validation context. /// - /// - /// This function takes two asynchronous validation contexts c1 and c2 of type Async<VCtx<'F, 'A>> - /// and returns an asynchronous computation of type Async<VCtx<'F, 'A * 'B>> that merges the results. - /// - /// An asynchronous computation of type Async<VCtx<'F, 'A>>. - /// An asynchronous computation of type Async<VCtx<'F, 'B>>. - /// An asynchronous computation of type Async<VCtx<'F, 'A * 'B>>. - /// - let mergeSourcesAsync - (c1: Async>) - (c2: Async>) - : Async> = + let map (fn: 'A -> 'B) (c: AsyncVCtx<'F, 'A>): AsyncVCtx<'F, 'B> = + async { + let! c' = c + return + match c' with + | ValidCtx a -> ValidCtx (fn a) + | DisputedCtx (gfs, lfs, a) -> DisputedCtx (gfs, lfs, fn a) + | RefutedCtx (gfs, lfs) -> RefutedCtx (gfs, lfs) + } + + /// + /// Maps an asynchronous function over the value of an asynchronous validation context. + /// + let mapAsync (fn: 'A -> Async<'B>) (c: AsyncVCtx<'F, 'A>): AsyncVCtx<'F, 'B> = + async { + let! c' = c + match c' with + | ValidCtx a -> + let! b = fn a + return ValidCtx b + | RefutedCtx (gfs, lfs) -> return RefutedCtx (gfs, lfs) + | DisputedCtx (gfs, lfs, a) -> + let! b = fn a + return DisputedCtx (gfs, lfs, b) + } + + /// + /// Merges two asynchronous validation contexts into a single one containing a tuple of both values. + /// + let mergeSources (c1: AsyncVCtx<'F, 'A>) (c2: AsyncVCtx<'F, 'B>): AsyncVCtx<'F, 'A * 'B> = async { let! a = c1 let! b = c2 return VCtx.mergeSources a b } + // Backwards compatibility: expose old helper names as delegating wrappers + let bindAsync (fn: 'A -> Async>) (c: Async>) = + bind fn c + + let bindFromAsync (fn: 'A -> VCtx<'F, 'B>) (c: Async>) = + bindFrom fn c + + let mergeSourcesAsync + (c1: Async>) + (c2: Async>) + : Async> = + mergeSources c1 c2 + + let bindAndMergeSourcesAsync + (fn: 'A -> Async>) + (c: Async>) + : Async> = + async { + let! a = c + let b = bindToAsync fn a + let! b' = b + return VCtx.mergeSources a b' + } + + let bindToAndMergeSourcesAsync + (fn: 'A -> Async>) + (c: VCtx<'F, 'A>) + : Async> = + async { + let! b = bindToAsync fn c + return VCtx.mergeSources c b + } + + let bindFromAndMergeSourcesAsync + (fn: 'A -> VCtx<'F, 'B>) + (c: Async>) + : Async> = + async { + let! a = c + let b = bindFromAsync fn (async.Return a) + let! b' = b + return VCtx.mergeSources a b' + } + +// Backwards compatibility: VCtx module extends with async-specific helpers +[] +module VCtx = + let bindToAsync (fn: 'A -> Async>) (c: VCtx<'F, 'A>): Async> = + AsyncVCtx.bindToAsync fn c + + let bindAsync (fn: 'A -> Async>) (c: Async>): Async> = + AsyncVCtx.bindAsync fn c + + let bindFromAsync (fn: 'A -> VCtx<'F, 'B>) (c: Async>): Async> = + AsyncVCtx.bindFromAsync fn c + + let mergeSourcesAsync + (c1: Async>) + (c2: Async>) + : Async> = + AsyncVCtx.mergeSourcesAsync c1 c2 + + let bindAndMergeSourcesAsync + (fn: 'A -> Async>) + (c: Async>) + : Async> = + AsyncVCtx.bindAndMergeSourcesAsync fn c + + let bindToAndMergeSourcesAsync + (fn: 'A -> Async>) + (c: VCtx<'F, 'A>) + : Async> = + AsyncVCtx.bindToAndMergeSourcesAsync fn c + + let bindFromAndMergeSourcesAsync + (fn: 'A -> VCtx<'F, 'B>) + (c: Async>) + : Async> = + AsyncVCtx.bindFromAndMergeSourcesAsync fn c + + let mapAsync + (fn: 'A -> Async<'B>) + (c: Async>) + : Async> = + AsyncVCtx.mapAsync fn c + +/// +/// AsyncVCtxBuilder provides computation expression support for asynchronous validation contexts +/// with seamless type coercion via Source overloads, eliminating manual type lifting. +/// +type AsyncVCtxBuilder() = /// - /// Binds a function that returns an asynchronous validation context to an asynchronous validation context and merges the results. + /// Binds an asynchronous validation context to a function, enabling monadic composition. /// + /// The input asynchronous validation context to bind. + /// A function that takes the validated value and returns a new asynchronous validation context. + /// An asynchronous validation context resulting from applying the function to the input context. /// - /// This function takes a function fn that transforms a value of type 'A into an asynchronous computation - /// of type Async<VCtx<'F, 'B>> and an asynchronous computation c of type Async<VCtx<'F, 'A>>. - /// It returns an asynchronous validation context of type Async<VCtx<'F, 'A * 'B>> that merges the results. + /// This method enables the let! syntax in computation expressions. It threads validation + /// state (Valid, Disputed, Refuted) through the monadic chain, accumulating failures as needed. /// - /// A function that takes a value of type 'A and returns an asynchronous validation computation of type Async<VCtx<'F, 'B>>. - /// An asynchronous validation context of type Async<VCtx<'F, 'A>>. - /// An asynchronous validation context of type Async<VCtx<'F, 'A * 'B>>. - /// - /// - let bindAndMergeSourcesAsync - (fn: 'A -> Async>) - (c: Async>) - : Async> = - bindAsync fn c |> mergeSourcesAsync c + member this.Bind(c: AsyncVCtx<'F, 'A>, fn: 'A -> AsyncVCtx<'F, 'B>): AsyncVCtx<'F, 'B> = + AsyncVCtx.bind fn c /// - /// Binds a function that returns an asynchronous validation context to a validation context and merges the results. + /// Wraps a value in a valid asynchronous validation context. /// + /// The value to wrap. + /// An asynchronous validation context containing the value in a ValidCtx state. /// - /// This function takes a function fn that transforms a value of type 'A into an - /// asynchronous validation context of type Async<VCtx<'F, 'B>> and a validation context c - /// of type VCtx<'F, 'A>. It returns an asynchronous validation context of type Async<VCtx<'F, 'B>>. + /// This method enables the return syntax in computation expressions, creating + /// a successful validation with no failures. /// - /// A function that takes a value of type 'A and returns an asynchronous validation context of type Async<VCtx<'F, 'B>>. - /// A validation context of type VCtx<'F, 'A>. - /// An asynchronous validation context of type Async<VCtx<'F, 'B>>. - /// - /// - let bindToAndMergeSourcesAsync - (fn: 'A -> Async>) - (c: VCtx<'F,'A>) - : Async> = - async { - let! b = bindToAsync fn c - return VCtx.mergeSources c b - } + member this.Return(a: 'A): AsyncVCtx<'F, 'A> = + AsyncVCtx.ofVCtx (ValidCtx a) - // bindFromAndMergeSourcesAsync: ('A -> VCtx<'F, 'B>) -> Async> -> Async> + /// + /// Returns an asynchronous validation context as-is without wrapping. + /// + /// The asynchronous validation context to return. + /// The same asynchronous validation context, unchanged. + /// + /// This method enables the return! syntax in computation expressions, allowing + /// direct return of existing validation contexts without additional wrapping. + /// + member this.ReturnFrom(c: AsyncVCtx<'F, 'A>): AsyncVCtx<'F, 'A> = + c /// - /// Binds a function that returns a validation context to an asynchronous validation context and merges the results. + /// Delays execution of a computation expression until explicitly evaluated. /// + /// A function that produces an asynchronous validation context when invoked. + /// A delayed computation that can be executed later. /// - /// This function takes a function fn that transforms a value of type 'A into a validation context - /// of type VCtx<'F, 'B> and an asynchronous validation context c of type Async<VCtx<'F, 'A>>. - /// It returns an asynchronous validation context of type Async<VCtx<'F, 'A * 'B>> that merges the results. + /// This method enables lazy evaluation of computation expressions, which is necessary + /// for proper handling of control flow and side effects. /// - /// A function that takes a value of type 'A and returns a validation context of type VCtx<'F, 'B>. - /// An asynchronous validation context of type Async<VCtx<'F, 'A>>. - /// An asynchronous computation of type Async<VCtx<'F, 'A * 'B>>. - /// - /// - let bindFromAndMergeSourcesAsync - (fn: 'A -> VCtx<'F, 'B>) - (c: Async>) - : Async> = - let b = bindFromAsync fn c - mergeSourcesAsync c b + member this.Delay(fn: unit -> AsyncVCtx<'F, 'A>): unit -> AsyncVCtx<'F, 'A> = + fn /// - /// Maps a function over the value of a validation context. The function returns an asynchronous computation. + /// Executes a delayed computation expression. /// + /// The delayed computation to execute. + /// The asynchronous validation context produced by executing the computation. /// - /// This function takes a function fn that transforms a value of type 'A into an asynchronous computation - /// of type Async<'B> and an asynchronous validation context c of type Async<VCtx<'F, 'A>>. - /// It returns an asynchronous validation context of type Async<VCtx<'F, 'B>>. + /// This method is called automatically by the F# compiler to execute delayed computations + /// created by the Delay method. /// - /// A function that takes a value of type 'A and returns an asynchronous computation of type Async<'B>. - /// An asynchronous validation context of type Async<VCtx<'F, 'A>>. - /// An asynchronous validation context of type Async<VCtx<'F, 'B>>. - let mapAsync - (fn: 'A -> Async<'B>) - (c: Async>) - : Async> = - async { - let! c' = c - match c' with - | ValidCtx a -> - let! b = fn a - return ValidCtx b - | RefutedCtx (gfs,lfs) -> return RefutedCtx (gfs,lfs) - | DisputedCtx (gfs,lfs,a) -> - let! b = fn a - return DisputedCtx (gfs,lfs, b) - } \ No newline at end of file + member this.Run(fn: unit -> AsyncVCtx<'F, 'A>): AsyncVCtx<'F, 'A> = + fn() + + /// + /// Provides an empty computation that produces a unit value in a valid validation context. + /// + /// An asynchronous validation context containing unit in a ValidCtx state. + /// + /// This method enables computation expressions that don't explicitly return a value, + /// resulting in a successful validation with no data. + /// + member this.Zero(): AsyncVCtx<'F, unit> = + AsyncVCtx.ofVCtx (ValidCtx ()) + + /// + /// Merges two asynchronous validation contexts into a single context containing a tuple of both values. + /// + /// The first asynchronous validation context. + /// The second asynchronous validation context. + /// An asynchronous validation context containing a tuple of both values. + /// + /// This method enables the and! syntax in computation expressions, allowing parallel + /// binding of multiple validation contexts. Failures from both contexts are merged according + /// to VCtx merging semantics (Refuted takes precedence over Disputed over Valid). + /// + member this.MergeSources(c1: AsyncVCtx<'F, 'A>, c2: AsyncVCtx<'F, 'B>): AsyncVCtx<'F, 'A * 'B> = + AsyncVCtx.mergeSources c1 c2 + + /// + /// Binds each element of a collection through a computation, enabling iteration in computation expressions. + /// + /// The collection wrapped in an asynchronous validation context. + /// A function to apply to each element. + /// An asynchronous validation context containing the results. + /// + /// This method enables the for syntax in computation expressions for iterating + /// over validated collections. + /// + member this.For(c: AsyncVCtx<'F, 'A>, fn: 'A -> AsyncVCtx<'F, 'B>): AsyncVCtx<'F, 'B> = + this.Bind(c, fn) + + /// + /// Wraps a value in a valid asynchronous validation context (alternative to Return). + /// + /// The value to wrap. + /// An asynchronous validation context containing the value in a ValidCtx state. + /// + /// This method enables the yield syntax in computation expressions, which is + /// semantically equivalent to return in this context. + /// + member this.Yield(a: 'A): AsyncVCtx<'F, 'A> = + this.Return(a) + + // ========== Source Overloads ========== + // These enable automatic type coercion in let! binding + + /// + /// Source overload for AsyncVCtx - passes through the asynchronous validation context unchanged. + /// + /// The asynchronous validation context to use as a source. + /// The same asynchronous validation context. + /// + /// This overload enables direct binding of AsyncVCtx values in let! expressions + /// without requiring manual type conversion. + /// + member this.Source(c: AsyncVCtx<'F, 'A>): AsyncVCtx<'F, 'A> = + c + + /// + /// Source overload for VCtx - lifts a synchronous validation context to an asynchronous one. + /// + /// The synchronous validation context to lift. + /// An asynchronous validation context containing the same validation state. + /// + /// This overload enables direct binding of VCtx values in let! expressions, + /// automatically lifting them to AsyncVCtx without manual conversion via AsyncVCtx.ofVCtx. + /// + member this.Source(c: VCtx<'F, 'A>): AsyncVCtx<'F, 'A> = + AsyncVCtx.ofVCtx c + + /// + /// Source overload for Result - converts a Result to a validation context. + /// + /// The Result value to convert (Ok becomes ValidCtx, Error becomes RefutedCtx). + /// An asynchronous validation context representing the Result. + /// + /// This overload enables direct binding of Result<'A, 'F> values in let! expressions. + /// Success values (Ok) become ValidCtx, while errors (Error) become RefutedCtx + /// with the error value in the global failures list. + /// + member this.Source(r: Result<'A, 'F>): AsyncVCtx<'F, 'A> = + AsyncVCtx.ofResult r + + /// + /// Source overload for AsyncResult - converts an async Result to a validation context. + /// + /// The async Result to convert (Ok becomes ValidCtx, Error becomes RefutedCtx). + /// An asynchronous validation context representing the async Result. + /// + /// This overload enables direct binding of Async<Result<'A, 'F>> values in let! expressions + /// returned from async I/O operations, eliminating the need for manual conversion with AsyncVCtx.ofAsyncResult. + /// + member this.Source(ar: Async>): AsyncVCtx<'F, 'A> = + AsyncVCtx.ofAsyncResult ar + + /// + /// Source overload for Proof - converts a Proof to a validation context. + /// + /// The Proof value to convert (Valid becomes ValidCtx, Invalid becomes RefutedCtx). + /// An asynchronous validation context representing the Proof. + /// + /// This overload enables direct binding of Proof<'F, 'A> values in let! expressions. + /// Valid proofs become ValidCtx, while invalid proofs become RefutedCtx with their + /// associated failure information preserved. + /// + member this.Source(p: Proof<'F, 'A>): AsyncVCtx<'F, 'A> = + AsyncVCtx.ofProof p + + /// + /// Source overload for AsyncValue - converts a wrapper around pure async to validation context. + /// + /// The AsyncValue wrapper containing a pure async value. + /// An asynchronous validation context with the async value in a ValidCtx. + /// + /// This overload solves the type ambiguity problem with plain Async<'A> values. + /// Wrap pure async values with AsyncValue to enable direct binding: + /// + /// let! x = AsyncValue (someAsyncCall ()) + /// + /// Alternatively, use AsyncVCtx.ofAsync for the same effect without wrapping. + /// + member this.Source(av: AsyncValue<'A>): AsyncVCtx<'F, 'A> = + match av with + | AsyncValue a -> AsyncVCtx.ofAsync a + +/// +/// Module containing the asyncValidationBuilder instance for creating async validation computation expressions. +/// +[] +module AsyncValidation = + /// + /// Computation expression builder for asynchronous validation contexts. + /// Enables seamless composition of async operations with validation logic using Source overloads. + /// + /// + /// + /// The builder provides Source overloads for the following types, enabling direct binding in let! expressions: + /// + /// + /// AsyncVCtx<'F, 'A> - Pass-through for async validation contexts + /// VCtx<'F, 'A> - Automatically lifts sync validation contexts + /// Result<'A, 'F> - Converts Result to validation (Ok → ValidCtx, Error → RefutedCtx) + /// Proof<'F, 'A> - Converts Proof to validation (Valid → ValidCtx, Invalid → RefutedCtx) + /// + /// + /// For pure Async<'A> values, use AsyncVCtx.ofAsync explicitly to avoid type ambiguity. + /// + /// + /// + /// + /// asyncValidationBuilder { + /// let! userId = AsyncVCtx.ofAsync (async { return 123 }) // Pure async requires ofAsync + /// and! userName = Ok "john_doe" // Result automatically lifted + /// and! profile = getProfileVCtx userId // VCtx automatically lifted + /// return (userId, userName, profile) + /// } + /// + /// + let asyncValidationBuilder = AsyncVCtxBuilder() \ No newline at end of file diff --git a/tests/FSharp.Data.Validation.Async.Tests/Tests.fs b/tests/FSharp.Data.Validation.Async.Tests/Tests.fs index 68c98a1..d86b718 100644 --- a/tests/FSharp.Data.Validation.Async.Tests/Tests.fs +++ b/tests/FSharp.Data.Validation.Async.Tests/Tests.fs @@ -103,3 +103,514 @@ let ``mapAsync with DisputedCtx should map and return DisputedCtx`` let expected: VCtx = DisputedCtx ([f1], Map.empty, a * 2) let actual = VCtx.mapAsync asyncFunc result |> Async.RunSynchronously actual |> should equal expected +[] +let ``bindToAsync with ValidCtx should bind value to async computation and return ValidCtx`` + (a: int) = + let asyncFunc x = async { return ValidCtx (x * 2) } + let input = ValidCtx a + let expected = ValidCtx (a * 2) + let actual = VCtx.bindToAsync asyncFunc input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``bindToAsync with RefutedCtx should return RefutedCtx unchanged`` + (f1: int) = + let asyncFunc x = async { return ValidCtx (x * 2) } + let input: VCtx = RefutedCtx ([f1], Map.empty) + let expected = input + let actual = VCtx.bindToAsync asyncFunc input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``bindToAsync with DisputedCtx should bind value to async computation and preserve disputes`` + (a: int, f1: int) = + let asyncFunc x = async { return ValidCtx (x * 2) } + let input = DisputedCtx ([f1], Map.empty, a) + let expected = DisputedCtx ([f1], Map.empty, a * 2) + let actual = VCtx.bindToAsync asyncFunc input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``bindToAsync handles async computation returning DisputedCtx`` + (a: int, f1: int, f2: int) = + let asyncFunc x = async { return DisputedCtx ([f2], Map.empty, x * 2) } + let input = ValidCtx a + let expected = DisputedCtx ([f2], Map.empty, a * 2) + let actual = VCtx.bindToAsync asyncFunc input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``bindToAsync handles async computation returning RefutedCtx`` + (a: int, f1: int) = + let asyncFunc x = async { return RefutedCtx ([f1], Map.empty) } + let input = ValidCtx a + let expected = RefutedCtx ([f1], Map.empty) + let actual = VCtx.bindToAsync asyncFunc input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``bindFromAsync with ValidCtx should bind async result to value`` + (a: int) = + let func x = ValidCtx (x * 2) + let input = async { return ValidCtx a } + let expected = ValidCtx (a * 2) + let actual = VCtx.bindFromAsync func input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``bindFromAsync with RefutedCtx should return RefutedCtx unchanged`` + (f1: int) = + let func x = ValidCtx (x * 2) + let input: Async> = async { return RefutedCtx ([f1], Map.empty) } + let expected: VCtx = RefutedCtx ([f1], Map.empty) + let actual = VCtx.bindFromAsync func input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``bindFromAsync with DisputedCtx should bind async result to value and preserve disputes`` + (a: int, f1: int) = + let func x = ValidCtx (x * 2) + let input = async { return DisputedCtx ([f1], Map.empty, a) } + let expected = DisputedCtx ([f1], Map.empty, a * 2) + let actual = VCtx.bindFromAsync func input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``bindFromAsync handles synchronous function returning DisputedCtx`` + (a: int, f1: int) = + let func x = DisputedCtx ([f1], Map.empty, x * 2) + let input = async { return ValidCtx a } + let expected = DisputedCtx ([f1], Map.empty, a * 2) + let actual = VCtx.bindFromAsync func input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``bindFromAsync handles synchronous function returning RefutedCtx`` + (a: int, f1: int) = + let func x = RefutedCtx ([f1], Map.empty) + let input = async { return ValidCtx a } + let expected = RefutedCtx ([f1], Map.empty) + let actual = VCtx.bindFromAsync func input |> Async.RunSynchronously + actual |> should equal expected + +// ========== AsyncVCtx Module Tests ========== + +[] +let ``AsyncVCtx.ofVCtx should lift ValidCtx to AsyncVCtx`` + (a: int) = + let input = ValidCtx a + let expected = ValidCtx a + let actual = AsyncVCtx.ofVCtx input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.ofVCtx should lift RefutedCtx to AsyncVCtx`` + (f1: int) = + let input: VCtx = RefutedCtx ([f1], Map.empty) + let expected = input + let actual = AsyncVCtx.ofVCtx input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.ofVCtx should lift DisputedCtx to AsyncVCtx`` + (a: int, f1: int) = + let input = DisputedCtx ([f1], Map.empty, a) + let expected = input + let actual = AsyncVCtx.ofVCtx input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.ofAsync should lift pure async value to ValidCtx`` + (a: int) = + let input = async { return a } + let expected = ValidCtx a + let actual = AsyncVCtx.ofAsync input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.ofResult should lift Ok to ValidCtx`` + (a: int) = + let input = Ok a + let expected = ValidCtx a + let actual = AsyncVCtx.ofResult input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.ofResult should lift Error to RefutedCtx`` + (f1: int) = + let input = Error f1 + let actual = AsyncVCtx.ofResult input |> Async.RunSynchronously + match actual with + | RefutedCtx (failures, fieldFailures) -> + failures |> should equal [f1] + Map.isEmpty fieldFailures |> should equal true + | _ -> failwith "Expected RefutedCtx" + +[] +let ``AsyncVCtx.ofProof should lift Valid to ValidCtx`` + (a: int) = + let input = Valid a + let expected = ValidCtx a + let actual = AsyncVCtx.ofProof input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.ofProof should lift Invalid to RefutedCtx`` + (f1: int) = + let input: Proof = Invalid ([f1], Map.empty) + let expected: VCtx = RefutedCtx ([f1], Map.empty) + let actual = AsyncVCtx.ofProof input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.bind with ValidCtx should bind and return ValidCtx`` + (a: int) = + let input = AsyncVCtx.ofVCtx (ValidCtx a) + let fn x = AsyncVCtx.ofVCtx (ValidCtx (x * 2)) + let expected = ValidCtx (a * 2) + let actual = AsyncVCtx.bind fn input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.bind with RefutedCtx should return RefutedCtx`` + (f1: int) = + let input: AsyncVCtx = AsyncVCtx.ofVCtx (RefutedCtx ([f1], Map.empty)) + let fn x = AsyncVCtx.ofVCtx (ValidCtx (x * 2)) + let expected: VCtx = RefutedCtx ([f1], Map.empty) + let actual = AsyncVCtx.bind fn input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.bind with DisputedCtx should bind and merge disputes`` + (a: int, f1: int, f2: int) = + let input = AsyncVCtx.ofVCtx (DisputedCtx ([f1], Map.empty, a)) + let fn x = AsyncVCtx.ofVCtx (DisputedCtx ([f2], Map.empty, x * 2)) + let expected = DisputedCtx ([f1; f2], Map.empty, a * 2) + let actual = AsyncVCtx.bind fn input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.bindFrom should bind sync function to async context`` + (a: int) = + let input = AsyncVCtx.ofVCtx (ValidCtx a) + let fn x = ValidCtx (x * 2) + let expected = ValidCtx (a * 2) + let actual = AsyncVCtx.bindFrom fn input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.map should transform value in ValidCtx`` + (a: int) = + let input = AsyncVCtx.ofVCtx (ValidCtx a) + let fn x = x * 2 + let expected = ValidCtx (a * 2) + let actual = AsyncVCtx.map fn input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.map should preserve RefutedCtx`` + (f1: int) = + let input: AsyncVCtx = AsyncVCtx.ofVCtx (RefutedCtx ([f1], Map.empty)) + let fn x = x * 2 + let expected: VCtx = RefutedCtx ([f1], Map.empty) + let actual = AsyncVCtx.map fn input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.map should transform value and preserve disputes`` + (a: int, f1: int) = + let input = AsyncVCtx.ofVCtx (DisputedCtx ([f1], Map.empty, a)) + let fn x = x * 2 + let expected = DisputedCtx ([f1], Map.empty, a * 2) + let actual = AsyncVCtx.map fn input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.mapAsync should map async function over ValidCtx`` + (a: int) = + let input = AsyncVCtx.ofVCtx (ValidCtx a) + let fn x = async { return x * 2 } + let expected = ValidCtx (a * 2) + let actual = AsyncVCtx.mapAsync fn input |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.mergeSources should merge two ValidCtx`` + (a: int, b: int) = + let input1 = AsyncVCtx.ofVCtx (ValidCtx a) + let input2 = AsyncVCtx.ofVCtx (ValidCtx b) + let expected = ValidCtx (a, b) + let actual = AsyncVCtx.mergeSources input1 input2 |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.mergeSources should merge ValidCtx and DisputedCtx`` + (a: int, b: int, f1: int) = + let input1 = AsyncVCtx.ofVCtx (ValidCtx a) + let input2 = AsyncVCtx.ofVCtx (DisputedCtx ([f1], Map.empty, b)) + let expected = DisputedCtx ([f1], Map.empty, (a, b)) + let actual = AsyncVCtx.mergeSources input1 input2 |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.mergeSources should prioritize RefutedCtx`` + (a: int, f1: int) = + let input1 = AsyncVCtx.ofVCtx (ValidCtx a) + let input2: AsyncVCtx = AsyncVCtx.ofVCtx (RefutedCtx ([f1], Map.empty)) + let actual = AsyncVCtx.mergeSources input1 input2 |> Async.RunSynchronously + match actual with + | RefutedCtx (failures, fieldFailures) -> + failures |> should equal [f1] + Map.isEmpty fieldFailures |> should equal true + | _ -> failwith "Expected RefutedCtx" + +// ========== asyncValidationBuilder Tests ========== + +[] +let ``asyncValidationBuilder can bind ValidCtx directly`` + (a: int) = + let result = + asyncValidationBuilder { + let! value = ValidCtx a + return value * 2 + } + let expected = ValidCtx (a * 2) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder can bind AsyncVCtx directly`` + (a: int) = + // Explicitly create an AsyncVCtx and bind it + let asyncCtx = async { return ValidCtx a } + let result = + asyncValidationBuilder { + let! value = asyncCtx + return value * 2 + } + let expected = ValidCtx (a * 2) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder can bind pure Async value using ofAsync`` + (a: int) = + let result = + asyncValidationBuilder { + let! value = AsyncVCtx.ofAsync (async { return a }) + return value * 2 + } + let expected = ValidCtx (a * 2) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder can bind Result Ok`` + (a: int) = + let result = + asyncValidationBuilder { + let! value = Ok a + return value * 2 + } + let expected = ValidCtx (a * 2) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder can bind Result Error`` + (f1: int) = + let result = + asyncValidationBuilder { + let! value = Error f1 + return value * 2 + } + let expected: VCtx = RefutedCtx ([f1], Map.empty) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder can bind Proof Valid`` + (a: int) = + let result = + asyncValidationBuilder { + let! value = Valid a + return value * 2 + } + let expected = ValidCtx (a * 2) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder can bind Proof Invalid`` + (f1: int) = + let result = + asyncValidationBuilder { + let! value = Invalid ([f1], Map.empty) + return value * 2 + } + let expected: VCtx = RefutedCtx ([f1], Map.empty) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder can use and! to merge sources`` + (a: int, b: int) = + let result = + asyncValidationBuilder { + let! value1 = ValidCtx a + and! value2 = ValidCtx b + return value1 + value2 + } + let expected = ValidCtx (a + b) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder can mix different source types with and!`` + (a: int, b: int) = + let result = + asyncValidationBuilder { + let! value1 = ValidCtx a + and! value2 = AsyncVCtx.ofAsync (async { return b }) + and! value3 = Ok (a + b) + return value1 + value2 + value3 + } + let expected = ValidCtx (a + b + a + b) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder preserves RefutedCtx when binding`` + (a: int, f1: int) = + let result = + asyncValidationBuilder { + let! value1 = ValidCtx a + and! value2 = RefutedCtx ([f1], Map.empty) + return value1 + value2 + } + let expected: VCtx = RefutedCtx ([f1], Map.empty) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``AsyncVCtx.ofAsyncResult with Ok should lift to ValidCtx`` + (a: int) = + let asyncResult: Async> = async { return Ok a } + let actual = AsyncVCtx.ofAsyncResult asyncResult |> Async.RunSynchronously + match actual with + | ValidCtx value -> value |> should equal a + | _ -> failwith "Expected ValidCtx" + +[] +let ``AsyncVCtx.ofAsyncResult with Error should lift to RefutedCtx`` + (f1: int) = + let asyncResult: Async> = async { return Error f1 } + let actual = AsyncVCtx.ofAsyncResult asyncResult |> Async.RunSynchronously + match actual with + | RefutedCtx (failures, fieldFailures) -> + failures |> should equal [f1] + Map.isEmpty fieldFailures |> should equal true + | _ -> failwith "Expected RefutedCtx" + +[] +let ``asyncValidationBuilder Source overload binds Async directly`` + (a: int, b: int) = + let result = + asyncValidationBuilder { + let! x = Ok a // Result - automatic Source overload + let! y = + async { + // Async - automatic Source overload + return Ok b + } + return x + y + } + let expected = ValidCtx (a + b) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder Source overload for AsyncValue wraps pure async`` + (a: int) = + let result = + asyncValidationBuilder { + // AsyncValue wrapper - automatic Source overload + let! x = AsyncValue (async { return a }) + return x * 2 + } + let expected = ValidCtx (a * 2) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder combines AsyncValue with other types`` + (a: int, b: int, c: int) = + let result = + asyncValidationBuilder { + let! x = AsyncValue (async { return a }) + let! y = Ok b + let! z = ValidCtx c + return x + y + z + } + let expected = ValidCtx (a + b + c) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder parallel binds with AsyncValue`` + (a: int, b: int) = + let result = + asyncValidationBuilder { + let! x = AsyncValue (async { return a }) + and! y = AsyncValue (async { return b }) + return x + y + } + let expected = ValidCtx (a + b) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder handles Async Error with Source overload`` + (a: int, f1: int) = + let result = + asyncValidationBuilder { + let! x = Ok a + let! y = + async { + // Return an error - Source overload converts to RefutedCtx + return Error f1 + } + return x + y + } + let actual = result |> Async.RunSynchronously + match actual with + | RefutedCtx (failures, fieldFailures) -> + failures |> should equal [f1] + Map.isEmpty fieldFailures |> should equal true + | _ -> failwith "Expected RefutedCtx" + +[] +let ``asyncValidationBuilder preserves DisputedCtx when binding`` + (a: int, b: int, f1: int) = + let result = + asyncValidationBuilder { + let! value1 = ValidCtx a + and! value2 = DisputedCtx ([f1], Map.empty, b) + return value1 + value2 + } + let expected = DisputedCtx ([f1], Map.empty, a + b) + let actual = result |> Async.RunSynchronously + actual |> should equal expected + +[] +let ``asyncValidationBuilder merges multiple disputes`` + (a: int, b: int, f1: int, f2: int) = + let result = + asyncValidationBuilder { + let! value1 = DisputedCtx ([f1], Map.empty, a) + and! value2 = DisputedCtx ([f2], Map.empty, b) + return value1 + value2 + } + let expected = DisputedCtx ([f1; f2], Map.empty, a + b) + let actual = result |> Async.RunSynchronously + actual |> should equal expected \ No newline at end of file