累积错误的结果生成器

Question

我正在尝试构建Result Builder 来累积Errors（在我的例子中，它们被命名为Failures，因为我正在关注https://fsharpforfunandprofit.com/ 的一些代码）。它的当前实现返回第一次遇到Failure，理想情况下，我希望它返回带有所需值的Success，或者返回带有所有缺失/损坏值列表的Failure。不幸的是，当前的实现有点冗长。

样板代码

module Rop

type RopResult<'TSuccess, 'TMessage> =
    | Success of 'TSuccess * 'TMessage list
    | Failure of 'TMessage list

/// create a Success with no messages
let succeed x =
    Success (x,[])

/// create a Success with a message
let succeedWithMsg x msg =
    Success (x,[msg])

/// create a Failure with a message
let fail msg =
    Failure [msg]

/// A function that applies either fSuccess or fFailure 
/// depending on the case.
let either fSuccess fFailure = function
    | Success (x,msgs) -> fSuccess (x,msgs) 
    | Failure errors -> fFailure errors 

/// merge messages with a result
let mergeMessages msgs result =
    let fSuccess (x,msgs2) = 
        Success (x, msgs @ msgs2) 
    let fFailure errs = 
        Failure (errs @ msgs) 
    either fSuccess fFailure result

/// given a function that generates a new RopResult
/// apply it only if the result is on the Success branch
/// merge any existing messages with the new result
let bindR f result =
    let fSuccess (x,msgs) =
        f x |> mergeMessages msgs
    let fFailure errs =
        Failure errs
    either fSuccess fFailure result

生成器代码

module ResultComputationExpression
    open Rop
    type ResultBuilder() =
        member __.Return(x) = RopResult.Success (x,[])
        member __.Bind(x, f) = bindR f x

        member __.ReturnFrom(x) = x
        member this.Zero() = this.Return ()

        member __.Delay(f) = f
        member __.Run(f) = f()

        member this.While(guard, body) =
            if not (guard()) 
            then this.Zero() 
            else this.Bind( body(), fun () -> 
                this.While(guard, body))  

        member this.TryWith(body, handler) =
            try this.ReturnFrom(body())
            with e -> handler e

        member this.TryFinally(body, compensation) =
            try this.ReturnFrom(body())
            finally compensation() 

        member this.Using(disposable:#System.IDisposable, body) =
            let body' = fun () -> body disposable
            this.TryFinally(body', fun () -> 
                match disposable with 
                    | null -> () 
                    | disp -> disp.Dispose())

        member this.For(sequence:seq<_>, body) =
            this.Using(sequence.GetEnumerator(),fun enum -> 
                this.While(enum.MoveNext, 
                    this.Delay(fun () -> body enum.Current)))

        member this.Combine (a,b) = 
            this.Bind(a, fun () -> b())

    let result = new ResultBuilder()

用例

let crateFromPrimitive (taskId:int) (title:string) (startTime:DateTime) : RopResult<SomeValue,DomainErrror> =
    result {
        // functions that, at the end, return "RopResult<TaskID,DomainError>" therefore "let! id" is of type "TaskID"
        let! id = taskId |>  RecurringTaskId.create  |> mapMessagesR mapIntErrors 
        // functions that, at the end, return "RopResult<Title,DomainError>" therefore "let! tt" is of type "Title"
        let! tt = title|> Title.create  |> mapMessagesR mapStringErrors 
        // functions that, at the end, return "RopResult<StartTime,DomainError>" therefore "let! st" is of type "StartTime"
        let! st = startTime|> StartTime.create   |> mapMessagesR mapIntErrors 
        

        // "create" returns "RopResult<SomeValue,DomainErrror>",  "let! value" is of type "SomeValue" 
        let! value = create id tt st 

        return value
    }

我可以将其拆分为首先验证taskId、title 和startTime，然后最终调用create，但可以一次性完成吗？

我找到了this answer，但我不知道如何将它翻译成我的案例，或者它是否相关。

更新：解决方案

就像brainbers 评论和solution 所说，and! 解决了我的问题。仍然困扰我的是自动去耦合的想法（即，它何时发生以及遵循什么规则？）。无论如何，我希望人们能够将两个和两个放在一起，但我的问题的有效解决方案是：

构建器部分

...
member _.MergeSources(result1, result2) =
    match result1, result2 with
    | Success (ok1,msgs1), Success (ok2,msgs2) -> 
        Success ((ok1,ok2),msgs1@msgs2 ) 
    | Failure errs1, Success _ -> Failure errs1
    | Success _, Failure errs2 -> Failure errs2
    | Failure errs1, Failure errs2 -> Failure (errs1 @ errs2)   // accumulate errors
...

用例

let crateFromPrimitive taskId title startTime duration category description (subtasks:string list option) (repeatFormat:RepeatFormat option) =
    result {

        let strintToSubTask = (Subtask.create >> (mapMessagesR mapStringErrors)) 
        let sListToSubtaskList value =  List.map strintToSubTask value
                                          |> RopResultHelpers.sequence

        let! id = RecurringTaskId.create taskId |> mapMessagesR mapIntErrors
        and! tt = Title.create title  |> mapMessagesR mapStringErrors
        and! st = StartTime.create startTime  |> mapMessagesR mapIntErrors
        and! dur = Duration.create duration  |> mapMessagesR mapIntErrors
        and! cat = Category.create category  |> mapMessagesR mapStringErrors
        and! desc = Description.create description  |> mapMessagesR mapStringErrors
        and! subtOption = someOrNone sListToSubtaskList subtasks |> RopResultHelpers.fromOptionToSuccess 
        //let! value = create id tt st dur cat desc subtOption repeatFormat

        return! create id tt st dur cat desc subtOption repeatFormat
    }

Answer 1

我搜索了一下，没有找到任何使用新的and! 语法并累积错误的验证器，所以我决定自己快速编写一个。我认为这可以满足您的要求，并且要简单得多。请注意，我使用Result<_, List<_>> 来累积错误列表，而不是创建新类型。

type AccumValidationBuilder() =

    member _.BindReturn(result, f) =
        result |> Result.map f

    member _.MergeSources(result1, result2) =
        match result1, result2 with
            | Ok ok1, Ok ok2 -> Ok (ok1, ok2)   // compiler will automatically de-tuple these - very cool!
            | Error errs1, Ok _ -> Error errs1
            | Ok _, Error errs2 -> Error errs2
            | Error errs1, Error errs2 -> Error (errs1 @ errs2)   // accumulate errors

let accValid = AccumValidationBuilder()

它正在发挥作用：

let validateInt (str : string) =
    match Int32.TryParse(str) with
        | true, n -> Ok n
        | _ -> Error [ str ]

let test str1 str2 str3 =
    let result =
        accValid {
            let! n1 = validateInt str1
            and! n2 = validateInt str2
            and! n3 = validateInt str3
            return n1 + n2 + n3
        }
    printfn "Result : %A" result

[<EntryPoint>]
let main argv =
    test "1" "2" "3"        // output: Ok 6
    test "1" "red" "blue"   // output: Error [ "red"; "blue" ]
    0