Result Builder that accumulates Errors

Question

I'm trying to build Result Builder that accumulates Errors (in my case they are named Failures as I'm following some code from https://fsharpforfunandprofit.com/). It's current implementation returns first encountered Failure when ideally I'd prefer it to either return Success with desired value or a Failure with a list of all missing/corrupted values. Unfortunately current implementation it's a bit verbose.

Boilerplate code

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

Builder code

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()

Use case

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
    }

I could possibly split it to first validate taskId, title and startTime and then eventually call create but is it possible to do in one go?

I found this answer but I have no idea how to translate it to my case or if it's even related.

UPDATE: Solution

Just like brainbers comment and solution says, and! solves my problem. What still troubles me is the idea of automatically de-toupling (namely, when does it happen and on what rules?). In any case, I expect people will be more than able to put two and two together but the working solution for my problem is:

Builder part

...
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
...

Use Case

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

I searched around a bit and didn't find any validators that use the new and! syntax and accumulate errors, so I decided to write a quick one myself. I think this does what you want, and is much simpler. Note that I'm using Result<_, List<_>> to accumulate a list of errors, rather than creating a new type.

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()

And here it is in action:

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