Created
March 13, 2026 19:36
-
-
Save TheAngryByrd/b6cc57e0d5fe3a0d91519790e501815c to your computer and use it in GitHub Desktop.
Use any IEnumerable type for Error concatenation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #nowarn "3535" | |
| #nowarn "3536" | |
| type Joinable<'e,'T> = | |
| static abstract member Join: 'e * 'e -> 'e | |
| static abstract member Singleton : 'T -> 'e | |
| module Joinable = | |
| let inline singleton<'e, 'T when 'e :> Joinable<'e, 'T>> (input) = | |
| 'e.Singleton input | |
| let inline join<'e, 'T when 'e :> Joinable<'e, 'T>> (input) (input2) = | |
| 'e.Join (input, input2) | |
| type ValidationResult<'T, 'Error> = Result<'T, 'Error> | |
| module ValidationResult = | |
| let inline singleton (value: 'T) : ValidationResult<'T, 'Error> = | |
| Ok value | |
| let inline singletonError<'T, 'Error, 'Input when 'Error :> Joinable<'Error, 'Input>> | |
| (e: 'Input): ValidationResult<'T, 'Error> = | |
| Error (Joinable.singleton<'Error, 'Input> e) | |
| type ValidationBuilder() = | |
| member _.Bind(m: ValidationResult<'T, 'Error>, f: 'T -> ValidationResult<'U, 'Error>) : ValidationResult<'U, 'Error> = | |
| match m with | |
| | Ok value -> f value | |
| | Error errors -> Error errors | |
| member _.Return(value: 'T) : ValidationResult<'T, 'Error> = | |
| Ok value | |
| member _.ReturnFrom(m: ValidationResult<'T, 'Error>) : ValidationResult<'T, 'Error> = | |
| m | |
| member _.BindReturn(m: ValidationResult<'T, 'Error>, f: 'T -> 'U) : ValidationResult<'U, 'Error> = | |
| match m with | |
| | Ok value -> Ok (f value) | |
| | Error errors -> Error errors | |
| member _.Combine(m1: ValidationResult<'T, 'Error>, m2: ValidationResult<'T, 'Error>) : ValidationResult<'T, 'Error> = | |
| match m1, m2 with | |
| | Ok value, _ -> Ok value | |
| | _, Ok value -> Ok value | |
| | Error errors1, Error errors2 -> Joinable.join errors1 errors2 |> Error | |
| member _.MergeSources(m1: ValidationResult<'T, 'Error>, m2: ValidationResult<'U, 'Error>) : ValidationResult<struct ('T * 'U), 'Error> = | |
| match m1, m2 with | |
| | Ok a, Ok b -> Ok (struct (a,b)) | |
| | Error errors1, Error errors2 -> Joinable.join errors1 errors2 |> Error | |
| | Error errors, _ -> Error errors | |
| | _, Error errors -> Error errors | |
| [<AutoOpen>] | |
| module ValidationOverloads = | |
| type ValidationBuilder with | |
| member _.Bind(m: ValidationResult<'T, 'Error>, f: 'T -> ValidationResult<'U, 'Error>) : ValidationResult<'U, 'Error> = | |
| match m with | |
| | Ok value -> f value | |
| | Error errors -> Error errors | |
| let validation = ValidationBuilder() | |
| open System | |
| type ListErrors<'Error> = | |
| { Errors: 'Error list } | |
| interface Joinable<ListErrors<'Error>,'Error> with | |
| static member Singleton(input) = | |
| { Errors = [input] } | |
| static member Join(one, two) = | |
| { | |
| one with Errors = List.append one.Errors two.Errors | |
| } | |
| type ResizeArrayErrors<'Error> = | |
| { Errors: 'Error ResizeArray } | |
| interface Joinable<ResizeArrayErrors<'Error>,'Error> with | |
| static member Singleton(input) = | |
| { Errors = ResizeArray([input]) } | |
| static member Join(one, two) = | |
| one.Errors.AddRange two.Errors | |
| one | |
| type ErrorResult = ListErrors<string> | |
| // type ErrorResult = ResizeArrayErrors<string> | |
| let inline validateName | |
| (name: string) = | |
| if String.IsNullOrWhiteSpace name then | |
| ValidationResult.singletonError "Name cannot be empty." | |
| else | |
| Ok name | |
| let inline validateAge | |
| (age: int) = | |
| if age < 0 then | |
| ValidationResult.singletonError "Age cannot be negative." | |
| else | |
| Ok age | |
| type Person = { Name: string; Age: int } | |
| let validatePerson (name: string) (age: int) : ValidationResult<Person, ErrorResult> = | |
| validation { | |
| let! validName = validateName name | |
| and! validAge = validateAge age | |
| return { Name = validName; Age = validAge } | |
| } | |
| [<EntryPoint>] | |
| let main argv = | |
| let result = validatePerson "" -30 | |
| match result with | |
| | Ok person -> printfn "Valid person: %A" person | |
| | Error errors -> printfn "Validation errors: %A" errors.Errors | |
| 0 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment