Validation.fsx

#r @"bin\debug\FsControl.Core.dll" // from https://github.com/gmpl/FsControl

open System
open FsControl.Core.Abstractions

// generic semigroup operator
let inline mappend x y = Inline.instance (Monoid.Mappend, x) y 

// generic functor operators
let inline fmap f x = Inline.instance (Functor.Fmap, x) f
let inline (<!>) a b = fmap a b

// generic applicative functor operators
let inline puree x = Inline.instance Applicative.Pure x
let inline ap y x = Inline.instance (Applicative.Ap, x, y) ()
let inline (<*>) a b = ap b a

// generic monad operator
let inline (>>=) x f = Inline.instance (Monad.Bind, x) f

// Validation definition
type Validation<'a,'e> = Success of 'a | Failure of 'e
with
    // Validation is an instance of Applicative
    static member inline instance (Applicative.Pure, _:Validation<_,_>) = Success
    static member inline instance (Applicative.Ap, f: Validation<_, _>, x: Validation<_, _>, _) =
        fun () ->
            match f,x with
            | Success f , Success x  -> Success (f x)
            | Failure e , Success x  -> Failure e
            | Success f , Failure e  -> Failure e
            | Failure e1, Failure e2 -> Failure (mappend e1 e2) // works with anything that has mappend. Can be a semigroup, not necessarily a monoid

    // Validation is an instance of Functor
    // Derived from applicative
    static member inline instance (Functor.Fmap, v: Validation<_,_>, _) = 
        fun f -> Functor.DefaultImpl.FmapFromApplicative f v

// Sadly, DateTime.TryCreate is internal in .NET
module DateTime =
    let tryCreate y m d =
        try
            Some (DateTime(y,m,d))
        with _ -> None

// Some validation functions
module Validators =
    let inline toChoice x = 
        match x with
        | Success a -> Choice1Of2 a
        | Failure e -> Choice2Of2 e

    let inline fromChoice x = 
        match x with
        | Choice1Of2 a -> Success a
        | Choice2Of2 e -> Failure e

    let inline integer a = 
        match Int32.TryParse a with
        | true, a -> Success a
        | _ -> Failure (puree (sprintf "Invalid integer %s" a))

    let inline date y m d : Validation<DateTime, _> = 
          DateTime.tryCreate <!> integer y <*> integer m <*> integer d 
          |> toChoice // convert to Choice, since Validation is not a monad
          >>= (function Some x -> Choice1Of2 x | _ -> Choice2Of2 (puree "Invalid date"))
          |> fromChoice

// trying the validation
let parsedDate : Validation<DateTime, string list> =
    Validators.date "1999" "2" "30" // Failure ["Invalid date"]

// A difference list ( http://en.wikipedia.org/wiki/Difference_list )
type 'a DList = DList of ('a list -> 'a list)
with
    // DList is a monoid
    static member inline instance (Monoid.Mempty, _: 'a DList) = 
        fun () -> DList id
    static member inline instance (Monoid.Mappend, DList x, _) = 
        fun (DList y) -> DList (y >> x)

    // DList applicative
    static member inline instance (Applicative.Pure, _: 'a DList) = 
        fun x -> DList (fun r -> x::r)

    // TODO ap, I'm too lazy and it's not needed for this example

// Same code with a different error accumulator
let parsedDateDList : Validation<DateTime, string DList> =
    Validators.date "1999" "2" "30"

// A non-empty list
type 'a NonEmptyList = { Head: 'a; Tail: 'a list }
with
    // non-empty list is a semigroup
    static member inline instance (Monoid.Mappend, x: _ NonEmptyList, _) = 
        fun (y: _ NonEmptyList) ->
            { Head = x.Head
              Tail = x.Tail @ (y.Head::y.Tail) }

    // non-empty list is applicative
    static member inline instance (Applicative.Pure, _: _ NonEmptyList) = 
        fun x -> { Head = x; Tail = [] }

    // TODO ap, I'm too lazy and it's not needed for this example

// Same code with a different error accumulator
let parsedDateNEL : Validation<DateTime, string NonEmptyList> =
    Validators.date "1999" "2" "30"

This is quite cool! Perhaps the most concise way to write higher-kinded code I've seen.. This should be on FsControl home page, will make a good case..

Have you used it more in code? I'm assuming the technique breaks down at some point? Generic monad transformers probably won't make it?

It is a pity F# language does not give us more direct support for HK. Wonder if F* has something to offer here.

@ToyVo I have a blogpost draft including this example since April or so, comparing this with the equivalent Haskell code. My explanations suck so far so I can't publish it yet.

I haven't used this in anger yet. I write C# and VB.NET for my day job, so I don't get to write a lot of F#. I tried a previous incarnation of FsControl, over a year ago, and found some issues with type inference . I haven't tried that code with a recent FsControl. Also, since there aren't any real higher kinds, the signatures don't say much. Pervasive inlining tends to bloat the code (not sure how much), and there may be performance issues (again don't know how much).
Not surprisingly, there are some issues with subtyping, e.g. Functor is defined for list but not for seq. I think if you define it for seq you get some ambigüity in the dispatch for list.

There are some monad transformers in FsControl I haven't tried them yet.

So there are many tradeoffs to this, but the benefits are pretty clear, and so I think this should be given a real chance before shooting it down as "unnatural" or such. All the tradeoffs should be discovered and documented, so that a real decision can be made about whether to use it or not in some situation. I talked to Gustavo a while ago and he mentioned he was using it for some generic numeric code. Send him an email and ask him :)

IIRC F* does support higher kinds. I tried some simple code some time ago (can't remember what it was) and the compiler consumed 4.5GB memory and hanged (not even crashed) :-/

Hehe, fun stuff with F*. On a similar note, I played a bit with extraction from Coq to OCaml, looks like the code is mostly compilable with F# so there's another (inconvenient) route for running "type-intensive" code on .NET.

I'm with you on FsControl. It's a brilliant solution with some serious trade-offs. Good to know there's monad transformers, looks like it works by underconstraining bind ('ma and 'mb for 'm 'a and 'm 'b).

I just forked and updated the gist to make it work with the latest version of FsControl.

gmpl -> gusty