Result Builder that accumulates Errors - functional-programming

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