-
-
Save wallymathieu/23a7d4f4ef2cc21c1a1f4192d1b3ff1e to your computer and use it in GitHub Desktop.
Applicative Validation easy with F#+
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#r @"c:/packages/FSharpPlus.1.0.0-CI00099/lib/net45/FSharpPlus.dll" | |
open System | |
open FSharpPlus | |
// Validation definition | |
type Validation<'a,'e> = Success of 'a | Failure of 'e | |
with | |
// Validation is an instance of Applicative | |
static member inline Return x = Success x | |
static member inline (<*>) (f: Validation<_, _>, x: Validation<_, _>) = | |
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 (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 | |
// No longer required, FsControl supports Default Methods now. | |
//static member inline instance (_:Functor.Map, v: Validation<_,_>, _) = | |
// fun f -> Functor.DefaultImpl.FmapFromApplicative f v | |
module Validation= | |
let toResult x :Result<_,_> = | |
match x with | |
| Success a -> Result.Ok a | |
| Failure e -> Result.Error e | |
let fromResult (x :Result<_,_>) = | |
match x with | |
| Result.Ok a -> Success a | |
| Result.Error e -> Failure e | |
// 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 integer (a:string) = | |
match tryParse a with | |
| Some a -> Success a | |
| _ -> Failure (result( sprintf "Invalid integer %s" a)) | |
let inline date y m d : Validation<DateTime, _> = | |
DateTime.tryCreate <!> integer y <*> integer m <*> integer d | |
|> Validation.toResult // convert to Result, since Validation is not a monad | |
>>= (function Some x -> Result.Ok x | _ -> Result.Error (result "Invalid date")) | |
|> Validation.fromResult | |
// 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 get_Zero = DList id | |
static member inline (+) (DList x, DList y) = DList (y >> x) | |
// DList applicative | |
static member inline Return 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 Append (x: _ NonEmptyList, y: _ NonEmptyList) = | |
{ Head = x.Head | |
Tail = x.Tail @ (y.Head::y.Tail) } | |
// non-empty list is applicative | |
static member inline Return 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" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment