Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
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