17 people like it.

Declarative validation

Simple combinator library to declarative validation.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 

module Validation =
    open System
    open Microsoft.FSharp.Quotations

    type 'e Test = Test of ('e -> (string*string) option) 
   
    let CreateValidator (f: 'e -> ('e Test list -> 'e Test list)) =  
        let entries = f Unchecked.defaultof<_> []
        fun entity -> List.choose (fun (Test test) -> test entity) entries

    let private add (propQ:'x Expr) args message fx (xs: 'e Test list) = 
        let propName, eval =
            match propQ with
            | Patterns.PropertyGet (_,p,_) -> p.Name, fun x -> p.GetValue(x,[||])
            | Patterns.Value (_, ty) when ty = typeof<'e> -> "x", box 
            | _ -> failwith "Unsupported expression"
        let test entity =
            let value = eval entity
            if fx (unbox value) then None
            else  Some (propName, String.Format(message, Array.ofList (value::args)))
        Test(test) :: xs
    
    let email propQ = 
        let regex = Text.RegularExpressions.Regex(@"\w+([-+.']\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*")
        add propQ [] "Please enter a valid email address" regex.IsMatch
         
    let required propQ = 
        add propQ [] "Is a required field" (String.IsNullOrWhiteSpace >> not)
    
    let between propQ min max = 
        add propQ [box min; box max] "Must be at least {2} and great {1}"  
            (fun v -> v >= min && v <= max)
    
    let cardNumber propQ = 
        add propQ [] "Invlid card number" <| fun (value:string) -> 
            let checkSum index digit =
                let v = (int digit - int '0') * (index % 2 + 1)
                v % 10 + v / 10 % 10
            Seq.forall Char.IsDigit value
            && Seq.sum (Seq.mapi checkSum value) % 10 = 0   
 

// usage
open Validation
    
type Account = 
    { Email      : string
      BirthYear  : int
      CardNumber : string }

let validateAccount =
    CreateValidator <| fun x -> 
        required   <@ x.Email @> >>
        email      <@ x.Email @> >>
        between    <@ x.BirthYear @> 1920 2000 >>
        required   <@ x.CardNumber @> >>
        cardNumber <@ x.CardNumber @>

let acc = { Email = "example#mail.com"; BirthYear = 2003; CardNumber = "" }
let validResult = validateAccount acc
namespace System
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Quotations
Multiple items
union case Test.Test: ('e -> (string * string) option) -> 'e Test

--------------------
type 'e Test = | Test of ('e -> (string * string) option)

Full name: Script.Validation.Test<_>
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
val CreateValidator : f:('e -> 'e Test list -> 'e Test list) -> ('e -> (string * string) list)

Full name: Script.Validation.CreateValidator
val f : ('e -> 'e Test list -> 'e Test list)
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val entries : 'e Test list
module Unchecked

from Microsoft.FSharp.Core.Operators
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
val entity : 'e
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val choose : chooser:('T -> 'U option) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.choose
val test : ('e -> (string * string) option)
val private add : propQ:Expr<'x> -> args:obj list -> message:string -> fx:('a -> bool) -> xs:'e Test list -> 'e Test list

Full name: Script.Validation.add
val propQ : Expr<'x>
Multiple items
type Expr =
  override Equals : obj:obj -> bool
  member GetFreeVars : unit -> seq<Var>
  member Substitute : substitution:(Var -> Expr option) -> Expr
  member ToString : full:bool -> string
  member CustomAttributes : Expr list
  member Type : Type
  static member AddressOf : target:Expr -> Expr
  static member AddressSet : target:Expr * value:Expr -> Expr
  static member Application : functionExpr:Expr * argument:Expr -> Expr
  static member Applications : functionExpr:Expr * arguments:Expr list list -> Expr
  ...

Full name: Microsoft.FSharp.Quotations.Expr

--------------------
type Expr<'T> =
  inherit Expr
  member Raw : Expr

Full name: Microsoft.FSharp.Quotations.Expr<_>
val args : obj list
val message : string
val fx : ('a -> bool)
val xs : 'e Test list
val propName : string
val eval : ('e -> obj)
module Patterns

from Microsoft.FSharp.Quotations
active recognizer PropertyGet: Expr -> (Expr option * Reflection.PropertyInfo * Expr list) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |PropertyGet|_| )
val p : Reflection.PropertyInfo
property Reflection.MemberInfo.Name: string
val x : 'e
Reflection.PropertyInfo.GetValue(obj: obj, index: obj []) : obj
Reflection.PropertyInfo.GetValue(obj: obj, invokeAttr: Reflection.BindingFlags, binder: Reflection.Binder, index: obj [], culture: Globalization.CultureInfo) : obj
active recognizer Value: Expr -> (obj * Type) option

Full name: Microsoft.FSharp.Quotations.Patterns.( |Value|_| )
val ty : Type
val typeof<'T> : Type

Full name: Microsoft.FSharp.Core.Operators.typeof
val box : value:'T -> obj

Full name: Microsoft.FSharp.Core.Operators.box
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val value : obj
val unbox : value:obj -> 'T

Full name: Microsoft.FSharp.Core.Operators.unbox
union case Option.None: Option<'T>
union case Option.Some: Value: 'T -> Option<'T>
Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
String(value: nativeptr<char>) : unit
String(value: nativeptr<sbyte>) : unit
String(value: char []) : unit
String(c: char, count: int) : unit
String(value: nativeptr<char>, startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
String(value: char [], startIndex: int, length: int) : unit
String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: Text.Encoding) : unit
String.Format(format: string, [<ParamArray>] args: obj []) : string
String.Format(format: string, arg0: obj) : string
String.Format(provider: IFormatProvider, format: string, [<ParamArray>] args: obj []) : string
String.Format(format: string, arg0: obj, arg1: obj) : string
String.Format(format: string, arg0: obj, arg1: obj, arg2: obj) : string
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
val ofList : list:'T list -> 'T []

Full name: Microsoft.FSharp.Collections.Array.ofList
val email : propQ:Expr<'a> -> ('b Test list -> 'b Test list)

Full name: Script.Validation.email
val propQ : Expr<'a>
val regex : Text.RegularExpressions.Regex
namespace System.Text
namespace System.Text.RegularExpressions
Multiple items
type Regex =
  new : pattern:string -> Regex + 1 overload
  member GetGroupNames : unit -> string[]
  member GetGroupNumbers : unit -> int[]
  member GroupNameFromNumber : i:int -> string
  member GroupNumberFromName : name:string -> int
  member IsMatch : input:string -> bool + 1 overload
  member Match : input:string -> Match + 2 overloads
  member Matches : input:string -> MatchCollection + 1 overload
  member Options : RegexOptions
  member Replace : input:string * replacement:string -> string + 5 overloads
  ...

Full name: System.Text.RegularExpressions.Regex

--------------------
Text.RegularExpressions.Regex(pattern: string) : unit
Text.RegularExpressions.Regex(pattern: string, options: Text.RegularExpressions.RegexOptions) : unit
Text.RegularExpressions.Regex.IsMatch(input: string) : bool
Text.RegularExpressions.Regex.IsMatch(input: string, startat: int) : bool
val required : propQ:Expr<'a> -> ('b Test list -> 'b Test list)

Full name: Script.Validation.required
String.IsNullOrWhiteSpace(value: string) : bool
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
val between : propQ:Expr<'a> -> min:'b -> max:'b -> ('c Test list -> 'c Test list) (requires comparison)

Full name: Script.Validation.between
val min : 'b (requires comparison)
val max : 'b (requires comparison)
val v : 'b (requires comparison)
val cardNumber : propQ:Expr<'a> -> ('b Test list -> 'b Test list)

Full name: Script.Validation.cardNumber
val value : string
val checkSum : (int -> char -> int)
val index : int
val digit : char
val v : int
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
module Seq

from Microsoft.FSharp.Collections
val forall : predicate:('T -> bool) -> source:seq<'T> -> bool

Full name: Microsoft.FSharp.Collections.Seq.forall
type Char =
  struct
    member CompareTo : value:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 1 overload
    static val MaxValue : char
    static val MinValue : char
    static member ConvertFromUtf32 : utf32:int -> string
    static member ConvertToUtf32 : highSurrogate:char * lowSurrogate:char -> int + 1 overload
    static member GetNumericValue : c:char -> float + 1 overload
    ...
  end

Full name: System.Char
Char.IsDigit(c: char) : bool
Char.IsDigit(s: string, index: int) : bool
val sum : source:seq<'T> -> 'T (requires member ( + ) and member get_Zero)

Full name: Microsoft.FSharp.Collections.Seq.sum
val mapi : mapping:(int -> 'T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.mapi
module Validation

from Script
type Account =
  {Email: string;
   BirthYear: int;
   CardNumber: string;}

Full name: Script.Account
Account.Email: string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
Account.BirthYear: int
Account.CardNumber: string
val validateAccount : (Account -> (string * string) list)

Full name: Script.validateAccount
val x : Account
val required : propQ:Quotations.Expr<'a> -> ('b Test list -> 'b Test list)

Full name: Script.Validation.required
val email : propQ:Quotations.Expr<'a> -> ('b Test list -> 'b Test list)

Full name: Script.Validation.email
val between : propQ:Quotations.Expr<'a> -> min:'b -> max:'b -> ('c Test list -> 'c Test list) (requires comparison)

Full name: Script.Validation.between
val cardNumber : propQ:Quotations.Expr<'a> -> ('b Test list -> 'b Test list)

Full name: Script.Validation.cardNumber
val acc : Account

Full name: Script.acc
val validResult : (string * string) list

Full name: Script.validResult

More information

Link:http://fssnip.net/eu
Posted:12 years ago
Author:Kaspar
Tags: quotations , combinatorial functions

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.