Dann sah ich die Scala-Version - Monoids and Errors Accumulation und wollte so ähnlich in F# implementieren.
Dazu ist die fsharp-typeclasses Bibliothek geeignet.
//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.
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]
