Validation with Error Accumulation
Most validation stops at the first error. This example collects all errors using
a Validate effect with a continuation-based handler that accumulates failures
instead of aborting.
The Validate effect
A single operation: report that something is invalid.
effect Validate {
fun invalid : String -> Unit
}Note that invalid returns Unit, not a. The computation continues after
each validation error, which is the key difference from Fail.
Validation helpers
Plain functions that perform the effect:
fun require_non_empty : String -> String -> Unit needs {Validate}
require_non_empty label value =
if value == "" then invalid! $"{label} is required"
else ()
fun require_min_age : Int -> Int -> Unit needs {Validate}
require_min_age min age =
if age < min then invalid! $"age must be at least {min}"
else ()The collecting handler
This is where it gets interesting. The handler calls resume after every
invalid!, letting the computation continue. But it captures the error and
prepends it to the error list returned alongside the value:
handler collecting for Validate {
invalid err = {
let (v, errs) = resume ()
(v, err :: errs)
}
return v = (v, [])
}The return clause wraps the success value in a tuple with an empty error list.
Each invalid! call adds to that list as the continuation unwinds. The result
is always (value, errors) where errors is a list of all validation failures.
Using it
record UserInput { name: String, age: Int }
record ValidUser { name: String, age: Int }
type Validation e a =
| Valid a
| Invalid e
fun validate_user : UserInput -> Validation (List String) ValidUser
validate_user input = {
let (v, errs) = {
require_non_empty "name" input.name
require_min_age 18 input.age
ValidUser { name: input.name, age: input.age }
} with collecting
case errs {
[] -> Valid v
_ -> Invalid errs
}
}Running it
main () = {
validate_user (UserInput { name: "Alice", age: 25 }) |> dbg
validate_user (UserInput { name: "", age: 25 }) |> dbg
validate_user (UserInput { name: "Bob", age: 15 }) |> dbg
validate_user (UserInput { name: "", age: 15 }) |> dbg
}Output:
Valid: ValidUser { name: "Alice", age: 25 }
Invalid: ["name is required"]
Invalid: ["age must be at least 18"]
Invalid: ["name is required", "age must be at least 18"]
The last case is the payoff: both errors are reported, not just the first one.
Full source
effect Validate {
fun invalid : String -> Unit
}
fun require_non_empty : String -> String -> Unit needs {Validate}
require_non_empty label value =
if value == "" then invalid! $"{label} is required"
else ()
fun require_min_age : Int -> Int -> Unit needs {Validate}
require_min_age min age =
if age < min then invalid! $"age must be at least {min}"
else ()
record UserInput { name: String, age: Int }
record ValidUser { name: String, age: Int } deriving (Debug)
type Validation e a =
| Valid a
| Invalid e
impl Debug for Validation e a where {e: Debug, a: Debug} {
debug v = case v {
Valid x -> $"Valid: {debug x}"
Invalid e -> $"Invalid: {debug e}"
}
}
handler collecting for Validate {
invalid err = {
let (v, errs) = resume ()
(v, err :: errs)
}
return v = (v, [])
}
fun validate_user : UserInput -> Validation (List String) ValidUser
validate_user input = {
let (v, errs) = {
require_non_empty "name" input.name
require_min_age 18 input.age
ValidUser { name: input.name, age: input.age }
} with collecting
case errs {
[] -> Valid v
_ -> Invalid errs
}
}
main () = {
let print_result = validate_user >> debug >> dbg
print_result (UserInput { name: "Alice", age: 25 })
print_result (UserInput { name: "", age: 25 })
print_result (UserInput { name: "Bob", age: 15 })
print_result (UserInput { name: "", age: 15 })
}