F#. Validation.

Im letzten Beitrag habe ich mich mit der Validierung beschäftigt. FSharpx bietet bereits die entsprechende Funktionen.
Dann sah ich die Scala-Version - Monoids and Errors Accumulation und wollte so ähnlich in F# implementieren.
Dazu ist die fsharp-typeclasses Bibliothek geeignet.

Folgende Validierungsszenarien sind zu berücksichtigen:

//Es gibt zwei Listen und eine Dictionary
    let foo = [1;2;3]   
    let bar = [3;4;5]
    let dict = Map.ofList [1,"a"; 3,"b"]
//Als Eingabe ist eine Liste von Werten definiert.

• Einfache Prüfung, ob alle Werte aus der Eingabeliste in foo vorhanden sind. Wenn es zutrifft, dann als Ergebnis die Summe von Werten aus der Eingabeliste zurückliefern, sonst die Liste mit den Fehlermeldungen.
• Prüfen, ob alle Werte aus der Eingabeliste in foo und in bar vorhanden sind. Wenn es zutrifft, dann als Ergebnis die Eingabeliste zurückliefern, sonst die Liste mit gesammelten Fehlermeldungen. Alternative Variante - die Validierung nur durchführen, bis die ersten Fehler auftreten.
• Prüfen, ob alle Werte aus der Eingabeliste in foo oder in bar vorhanden sind. Wenn es zutrifft, dann als Ergebnis die Eingabeliste zurückliefern, sonst die Liste mit gesammelten Fehlermeldungen. Alternative Variante - die Validierung nur durchführen, bis die ersten Fehler auftreten.
• Prüfen, ob alle Werte aus der Eingabeliste in foo vorhanden sind, und danach anschließend prüfen, ob die entsprechende Einträge in dict zu finden sind. Wenn es zutrifft, dann als Ergebnis die Eingabeliste zurückliefern, sonst die Liste mit gesammelten Fehlermeldungen.

Wie Mauricio Scheffer hier erklärte -

...If you take a look at its definition, you'll see that Choice.foldM is defined in terms of monadic return and bind... . The Either monad (called Choice in FSharpx) does "short-circuit" evaluation on bind, just like the Maybe monad. But for validation, you usually want to accumulate errors instead, so you want the opposite of this short-circuit evaluation... . What you can use in this case is Validation.mapM, which is built on top of Validation.sequence, which in turn is built on the applicative functor

- brauchen wir monadic bind und applicative functor zu implementieren.

// ErrorAccumulator implementation on top of 
// http://code.google.com/p/fsharp-typeclasses/
// replace <<|> Operator with <!> 
namespace Control
open System
open Prelude
open Data.Foldable
open Data.Traversable
open Control.Monad.Base
open Control.Applicative
open Data.Monoid

module Validation =
    type ErrorAccumulator<'a,'b >  = 
        Succ of 'a | Fail of 'b with
        static member inline (?<-) (_,    _Functor : Fmap,    e : ErrorAccumulator<_,_>) = 
            fun f -> 
                match e with
                | Succ x -> Succ (f x)
                | Fail y -> Fail y
        static member inline (?<-) (_,    _Monoid : Mempty,   _ : ErrorAccumulator<_, _>) = 
            Succ (mempty())

        static member inline (?<-) (a : ErrorAccumulator<_, _>,    _Monoid : Mappend,  b : ErrorAccumulator<_, _>) = 
            match a,b with
            | Succ x, Succ y -> Succ(mappend x y)
            | Fail x, _ -> Fail x
            | Succ _, Fail y -> Fail y

        static member inline (?<-) (x : ErrorAccumulator<'c, _>,     _Monad : Bind,      _ : ErrorAccumulator<'d, _>) = 
            fun (k : _ -> ErrorAccumulator<'d, _>) ->
                match x with
                | Fail l -> Fail l
                | Succ r -> k r

        static member inline (?<-) (_,                          _ : FoldMap,        e : ErrorAccumulator<_,_>) = 
            fun f -> 
                match e with
                | Succ x -> f x
                | Fail  y -> foldMap f y
        
        static member inline (?<-) (_ ,    _Applicative : Pure,   _ : ErrorAccumulator<_, _>) = 
            Succ

        static member inline (?<-) (f:ErrorAccumulator<_, _>,     _Applicative : Ap  ,   x : ErrorAccumulator<_, _>) = 
            match f, x with
            | Succ g, Succ y -> Succ(g y)
            | Succ _, Fail y -> Fail y
            | Fail y, Succ _ -> Fail y
            | Fail x, Fail y -> Fail (mappend x y)

        static member  inline (?<-) (a : ErrorAccumulator<_,_>,   _Alternative : Append,   b : ErrorAccumulator<_, _>) = 
            match a, b with
            | Succ x, _ -> Succ x 
            | _, Succ y -> Succ y
            | Fail x, Fail y -> Fail (mappend x y)
        
    let inline fromOption e o = match o with | None -> Fail e | Some x -> Succ x

module TestValidation =
    open Validation
    open Control.Monad.Trans

    let foo = [1;2;3]   
    let bar = [3;4;5]
    let dict = Map.ofList [1,"a"; 3,"b"]
    
    let inline tryFind x list name = fromOption [sprintf " %A not found in %A " x name] (List.tryFind ((=) x) list) 
    let tryFindFoo x = (tryFind x foo "foo" )
    let tryFindBar x = (tryFind x bar "bar" )

    let inline traverseFoo input = traverse tryFindFoo input

    let inline foldSum input = foldMap (fmap Sum<<tryFindFoo) input

    let inline ``search in foo OR in bar and accumulate errors`` input = 
        traverse (fun x -> tryFindFoo x <|> tryFindBar x) input

    let inline ``search in foo OR in bar and stops after the first appearance on error`` input= 
        foldMap (fun x -> singleton <!> (tryFindFoo x <|> tryFindBar x)) input 

    let inline ``search in foo AND in bar and accumulate errors`` input = 
        traverse (fun x -> Prelude.const' <!> tryFindFoo x <*> tryFindBar x) input

    let inline ``search in foo AND bar and stops after the first appearance on error`` input = 
        foldMap (fun x ->  singleton <!> (Prelude.const' <!> tryFindFoo x <*> tryFindBar x)) input 

    let inline ``search in foo AND THEN in dictionary`` input = 
        let inner k = Prelude.const' k <!> fromOption [sprintf "key %A is not found." k ] (Map.tryFind k dict) 
        (traverse inner) >=> traverseFoo <| input

//Program.fs
open Control.TestValidation
let input1 = [1;4;6] 
let input2 = [2;4;1]   
let input3 = [1;3]  
let input4 = [3;3]  

let inline test f a =     
     printfn "input: %A" a
     printfn "result: %A" (f a)

printfn "------search in 'foo'.-----------------------"
List.map (test foldSum) [input1;input2;input3;input4] 
|> ignore
printfn "---------------------" 
printfn "----search in 'foo' AND in 'bar'. stops after the first appearance on error``.---"
List.map (test ``search in foo AND bar and stops after the first appearance on error``) [input1;input2;input3;input4] 
|> ignore
printfn "---------------------" 
printfn "----search in 'foo' OR in 'bar'. stops after the first appearance on error.---"
List.map (test ``search in foo OR in bar and stops after the first appearance on error``) [input1;input2;input3;input4] 
|> ignore
printfn "---------------------" 
printfn "----search in 'foo' AND in 'bar'. accumulate errors.--"
List.map (test ``search in foo AND in bar and accumulate errors``) [input1;input2;input3;input4] 
|> ignore
printfn "---------------------" 
printfn "----search in 'foo' OR in 'bar'. accumulate errors.--"
List.map (test ``search in foo OR in bar and accumulate errors``) [input1;input2;input3;input4] 
|> ignore
printfn "---------------------" 
printfn "----search in 'foo' AND THEN search in 'dict'."
List.map (test ``search in foo AND THEN in dictionary``) [input1;input2;input3;input4] 
|> ignore

------search in 'foo'.-----------------------
input: [1; 4; 6]
result: Fail [" 4 not found in "foo" "]
input: [2; 4; 1]
result: Fail[" 4 not found in "foo" "]
input: [1; 3]
result: Succ (Sum 4)
input: [3; 3]
result: Succ (Sum 6)
---------------------
----search in 'foo' AND in 'bar'. stops after the first appearance on error.

input: [1; 4; 6]
result: Fail [" 1 not found in "bar" "]
input: [2; 4; 1]
result: Fail [" 2 not found in "bar" "]
input: [1; 3]
result: Fail [" 1 not found in "bar" "]
input: [3; 3]
result: Succ [3; 3]
---------------------
----search in 'foo' OR in 'bar'. stops after the first appearance on error.
input: [1; 4; 6]
result: Fail [" 6 not found in "foo" "; " 6 not found in "bar" "]
input: [2; 4; 1]
result: Succ [2; 4; 1]
input: [1; 3]
result: Succ [1; 3]
input: [3; 3]
result: Succ [3; 3]
---------------------
----search in 'foo' AND in 'bar'. accumulate errors.
input: [1; 4; 6]
result: Fail
  [" 1 not found in "bar" "; " 4 not found in "foo" "; " 6 not found in "foo" ";

   " 6 not found in "bar" "]
input: [2; 4; 1]
result: Fail
  [" 2 not found in "bar" "; " 4 not found in "foo" "; " 1 not found in "bar" "]

input: [1; 3]
result: Fail [" 1 not found in "bar" "]
input: [3; 3]
result: Succ [3; 3]
---------------------
----search in 'foo' OR in 'bar'. accumulate errors.
input: [1; 4; 6]
result: Fail [" 6 not found in "foo" "; " 6 not found in "bar" "]
input: [2; 4; 1]
result: Succ [2; 4; 1]
input: [1; 3]
result: Succ [1; 3]
input: [3; 3]
result: Succ [3; 3]
---------------------
----search in 'foo' AND THEN search in 'dict'.
input: [1; 4; 6]
result: Fail ["key 4 is not found."; "key 6 is not found."]
input: [2; 4; 1]
result: Fail ["key 2 is not found."; "key 4 is not found."]
input: [1; 3]
result: Succ [1; 3]
input: [3; 3]
result: Succ [3; 3]