Using lists in validation in F#
open Microsoft.FSharp.Quotations.Patterns | |
open System | |
open Microsoft.FSharp.Reflection | |
open Microsoft.FSharp.Quotations | |
module P = Microsoft.FSharp.Quotations.Patterns | |
// http://www.fssnip.net/h1 | |
let rec eval = function | |
| Value(v,t) -> v | |
| Coerce(e,t) -> eval e | |
| NewObject(ci,args) -> ci.Invoke(evalAll args) | |
| NewArray(t,args) -> | |
let array = Array.CreateInstance(t, args.Length) | |
args |> List.iteri (fun i arg -> array.SetValue(eval arg, i)) | |
box array | |
| NewUnionCase(case,args) -> FSharpValue.MakeUnion(case, evalAll args) | |
| NewRecord(t,args) -> FSharpValue.MakeRecord(t, evalAll args) | |
| NewTuple(args) -> | |
let t = FSharpType.MakeTupleType [|for arg in args -> arg.Type|] | |
FSharpValue.MakeTuple(evalAll args, t) | |
| FieldGet(Some(Value(v,_)),fi) -> fi.GetValue(v) | |
| PropertyGet(None, pi, args) -> pi.GetValue(null, evalAll args) | |
| PropertyGet(Some(x),pi,args) -> pi.GetValue(eval x, evalAll args) | |
| Call(None,mi,args) -> mi.Invoke(null, evalAll args) | |
| Call(Some(x),mi,args) -> mi.Invoke(eval x, evalAll args) | |
| arg -> raise <| NotSupportedException(arg.ToString()) | |
and evalAll args = [|for arg in args -> eval arg|] | |
let getValue (expr: Quotations.Expr<'t>) = | |
match eval expr with | |
| null -> None | |
| x -> Some (x :?> 't) | |
type Validate<'a> = | |
| Object of | |
value : Expr<'a> * | |
required : bool * | |
proof : ('a -> (string list option) list) | |
| Array of | |
value : Expr<'a[]> * | |
required : bool * | |
proof : ('a[] -> string Option) list * | |
proveItems : ('a -> Validate<'a>) | |
| Primitive of | |
value : Expr<'a> * | |
required : bool * | |
proof : ('a -> string Option) list | |
| Raw of | |
value : 'a * | |
message : string * | |
proof : ('a -> string Option) list | |
let getParameterName a = | |
match a with | |
| PropertyGet(e, info, li) -> | |
let d = info.DeclaringType.ToString() | |
Some (sprintf "%s.%s" (d.Substring(d.IndexOf('+')+1)) info.Name) | |
| _ -> Some a.Type.Name | |
let getOrElse def = | |
function | |
| Some x -> x | |
| None -> def | |
let printParameterWith s expression = | |
Option.fold (fun _ v -> v + s) "" (getParameterName expression) | |
let private prettyIndex i xs = | |
xs | |
|> List.head | |
|> sprintf " [%i]: %s" i | |
let rec prove validation = | |
match validation with | |
| Primitive (v, required, fs) -> | |
match required, getValue v with | |
| true, None -> Some [sprintf "The value `%s` is required but was found to be `null`." v.Type.Name] | |
| false, None -> None | |
| _, Some value -> | |
fs | |
|> List.fold (fun acc f -> | |
match acc with | |
| None -> f value | |
| Some _ -> acc | |
) None | |
|> Option.map (fun x -> [printParameterWith " - " v + x] ) | |
| Object (v, required, f) -> | |
match required, getValue v with | |
| true, None -> Some [sprintf "The object `%s` is required but was found to be `null`." (getOrElse "Unknown Parameter" <| getParameterName v)] | |
| false, None -> None | |
| _, Some x -> | |
f x | |
|> List.fold ( | |
fun acc option -> | |
match option, acc with | |
| Some newError, Some error -> Some (List.append error newError) | |
| Some newError, None -> Some newError | |
| None, Some error -> Some error | |
| None, None -> None | |
) None | |
| Array (vs, required, proof, proveItems) -> | |
match required, getValue vs with | |
| true, None -> Some [sprintf "%s: %s" (getOrElse "Unknown Parameter" <| getParameterName vs) "This array is required."] | |
| false, None -> None | |
| _, Some xs -> | |
let validSelf = | |
proof | |
|> List.fold (fun acc f -> | |
match acc with | |
| None -> f xs | |
| Some _ -> acc | |
) None | |
match validSelf, obj.Equals(vs, null) with | |
| Some error, _ -> | |
Some [(printParameterWith ": " vs) + error] | |
| _, true -> | |
None | |
| None, false -> | |
xs | |
|> Array.fold (fun (i, acc) x -> | |
let i = i + 1 | |
match (prove (proveItems x) ), acc with | |
| Some newError, Some error -> | |
(i, Some <| List.append error [prettyIndex i newError]) | |
| Some newError, None -> (i, Some [prettyIndex i newError]) | |
| None, Some error -> (i, Some error) | |
| None, None -> (i, None) | |
) (-1, None) | |
|> snd | |
|> Option.map (fun xs -> (printParameterWith ":" vs)::xs) | |
| Raw (a, msg, fs) -> | |
fs | |
|> List.fold (fun acc f -> | |
match acc with | |
| None -> f a | |
| Some _ -> acc | |
) None | |
|> Option.map (fun x -> [msg+" - "+x] ) | |
let stringMax value (x : string) = | |
if x.Length <= value | |
then None | |
else Some <| sprintf "String must be less than %i characters, but was %i" value x.Length | |
let maxDate (max : DateTime) x = | |
if x <= max then | |
None | |
else | |
Some (sprintf "Date must be less than or equal to %s, but given %s" (max.ToShortDateString()) (x.ToShortDateString())) | |
let arrayMinLength (min : int) xs = | |
let len = Array.length xs | |
if min <= len then | |
None | |
else | |
Some (sprintf "Array must have at least %i items, but only has %i items." min len) | |
//type IValidation = | |
// abstract member Validate: unit -> string list option | |
type Name = { | |
First : string | |
Last : string | |
} with | |
static member Proof a = | |
[ | |
prove <| Primitive (<@ a.First @>, true, [stringMax 50]) | |
prove <| Primitive (<@ a.Last @>, true, [stringMax 5]) | |
] | |
type Person = | |
{ | |
Name : Name | |
BirthDate : DateTime | |
Favorites : string[] | |
} | |
static member Proof a = | |
[ | |
prove <| Primitive (<@ a.BirthDate @>, true, []) | |
prove <| Object (<@ a.Name @>, true, Name.Proof) | |
prove <| | |
Array ( | |
<@ a.Favorites @>, | |
true, | |
[arrayMinLength 1], | |
(fun favorite -> Primitive (<@ favorite @>, true, [stringMax 5]) )) | |
] | |
static member Validate a = | |
prove <| Object (<@ a @>, true, Person.Proof) | |
let jon = { | |
Name = { First = "Jon"; Last = "Nyman1" } | |
BirthDate = new DateTime(1947, 9, 9) | |
Favorites = [| "Reading"; "Red"; "Writing" |] | |
} | |
let result = | |
prove <| Object (<@ jon.Name @>, true, Name.Proof) | |
let result2 = | |
prove <| Object (<@ jon @>, true, Person.Proof) | |
let result3 = | |
prove <| Object (<@ Microsoft.FSharp.Core.Operators.Unchecked.defaultof<Person> @>, true, Person.Proof) | |
let result4 = | |
prove <| Primitive (<@ jon.Favorites @>, true, [fun a -> if a.Length > 0 then None else Some <| "Array must contain at least one item."]) | |
type DosArrays = { | |
Array1 : string[] | |
Array2 : int[] | |
} | |
let dos = { Array1 = [| "yep" |]; Array2 = [| 1; 2 |] } | |
let result5 = | |
prove <| Primitive (<@ (dos.Array1, dos.Array2) @>, true, [fun (a, b) -> if a.Length = b.Length then None else Some <| "Arrays must be same length!" ]) | |
let result6 = | |
prove <| Raw ((dos.Array1, dos.Array2), "DosArrays - Array1, Array2", | |
[ | |
fun (a, b) -> | |
match a, b with | |
| null, null | null, _ | _, null -> Some "Items must not be null." | |
| _ -> None | |
fun (a, b) -> | |
if a.Length = b.Length then None else Some "Arrays must be same length!" | |
]) | |
// Can't do it this way since `a` could be null. | |
//let validate (a : IValidation) = | |
// match a.Validate () with | |
// | Some xs -> Choice1Of2 <| String.concat "\n" xs | |
// | None -> Choice2Of2 a | |
let validate f a = | |
match f a with | |
| Some xs -> Choice1Of2 <| String.concat "\n" xs | |
| None -> Choice2Of2 a | |
jon | |
|> validate Person.Validate | |
// |> .... | |
// OR | |
jon | |
|> validate (fun a -> prove <| Object (<@ a @>, true, Person.Proof)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment