Validation Combinators, a F# prototype

Suppose we have the following situation: we have a bag/set of named objects which have to be validated. These objects are primitives, let's say strings, for our sample.
Some strings can be validated as 'standalone' some need to be validate against each other. This validation doesn't belong to the domain for several reasons.
Regrettably, the existing frameworks don't suite our needs.

Trying to decompose the problem, we need:
- a way to get object out of the bag, by name
- a validation method/function which can validate one or more objects
- if the validation fails, we want to collect a 'failed validation message'
- we want to compose these validations: and, or, not, xor, etc...

Let's put that in code:

1 #light

2 open System

3 open System.Collections.Generic

4 open System.Text

5

6 type get_by_name = String -> String

7 type accumulate_message = String -> unit

8 type validator = get_by_name -> accumulate_message -> bool

We use F# light syntax, and open some .Net namespaces, define the required function types: I really like this kind of 'aliasing': give name to a type, since being based on type inference, is not obtrusive.It is not like a java/c# Interface, where the interface must be implemented. In our case, if we have another function with a signature matching our type, we can use that function as the required type. (we could say is a type-safe duck-typing)

10 let _and_ (x : validator) (y : validator) = (fun (get_value_from_bag : get_by_name) (accumulate_validation_message : accumulate_message) ->

11 let ok_x = lazy x get_value_from_bag accumulate_validation_message

12 let ok_y = lazy y get_value_from_bag accumulate_validation_message

13 Lazy.force ok_x && Lazy.force ok_y)

14

15 let _or_ (x : validator) (y : validator) = (fun (get_value_from_bag : get_by_name) (accumulate_validation_message : accumulate_message) ->

16 let ok_x = lazy x get_value_from_bag accumulate_validation_message

17 let ok_y = lazy y get_value_from_bag accumulate_validation_message

18 Lazy.force ok_x || Lazy.force ok_y)

19

20 let _not_ (x : validator) = (fun (get_value_from_bag : get_by_name) (accumulate_validation_message : accumulate_message) ->

21 let ok_x = x get_value_from_bag accumulate_validation_message

22 not ok_x)

23

24 let _xor_ (x : validator) (y : validator) = ((_not_ x) |> _and_ y ) |> _or_ (y |> _and_ (_not_ x) )

Having defined what a validator is, we have defined functions to combined them: and, or, xor. In order to simulate the behavior (a and b -> b is evaluated only if a is false), we cache the result of a validator in
a lazy value: the value is computed only once, delayed, on demand. In the xor combinator we have used another DSL-friendly feature: partial-function application: ie. if we have a function f(x, y) -> z we could write this as: y |> f x.

Ok, let's see how it works. We define a validator:

27 let is_starting_with (start : String) (name : String) = (fun (get_value_from_bag : get_by_name) (accumulate_validation_message : accumulate_message) ->

28 let value = get_value_from_bag name

29 let ok = value.StartsWith(start)

30 if not ok then

31 let msg = string.Format("{0} '{1}' doesn't start with {2}", name, value, start)

32 accumulate_validation_message msg

33 ok)

Lets define a map of name -> values, and a message accumulator:

36 let map = new Dictionary()

37 map.Add("customer","ali")

38 map.Add("buyer", "baba")

39 map.Add("vendor", "nono")

40

41 let get_value (key : String) : String = map.Item(key)

42

43 let acc = new StringBuilder()

44 let accumulate (msg: String) : unit = acc.AppendLine(msg) |> ignore

Lets create a more complex validator:

46 let x = ("customer" |> is_starting_with "a") |> _and_ ("buyer" |> is_starting_with "b") |> _and_ ("vendor" |> is_starting_with "v")

That's really readable, isn't it?

And we can evaluate it:

48 printfn "evaluation: %b messages: %s" (x get_value accumulate) (acc.ToString())

49

50 System.Console.ReadKey()

ps. Look at a better example in a Good Video: "Composing Contracts: An Adventure in Financial Engineering".
pps. here is the code.