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
}
