I'm trying to refactor the working code below which intends to handle bill cancellation, but doesn't seem "linear" enough.
open FSharpPlus
open FSharpPlus.Data
type BillCancellationReason = | A | B
type OrderBillingCommand = | A | B
type OrderBillingEvent = | A | B
type CommandError = | A | B
type BillCancellationRequest =
{ BillSequence: int32
Reason: BillCancellationReason
Comment: string }
type BillCancellationsRequestPart =
{ OrderId: int32
BillSequence: int32
Reason: BillCancellationReason
Comment: string }
type BillCancellationsRequest = BillCancellationsRequestPart list
module Validation =
// Validation<'Failure list, 'Success> list -> Validation<'Failure list, 'Success list>
let cumulativeFoldList (validations: Validation<'Failure list, 'Success> list):
Validation<'Failure list, 'Success list> =
traverse id validations
// BillCancellationsRequestPart -> Validation<CommandError list, (int32 * OrderBillingCommand)>
let toCommand (requestPart: BillCancellationsRequestPart) =
Unchecked.defaultof<Validation<CommandError list, (int32 * OrderBillingCommand)>>
// (int32 * OrderBillingCommand) list -> Async<Result<OrderBillingEvent list, CommandError list>>
let processValidCommands (commands: (int32 * OrderBillingCommand) list) =
Unchecked.defaultof<Async<Result<OrderBillingEvent list, CommandError list>>>
// BillCancellationsRequest -> Async<Result<OrderBillingEvent list,CommandError list>>
let cancelBills (request: BillCancellationsRequest) =
async {
match request |> List.map toCommand |> Validation.cumulativeFoldList with
| Success commands -> return! processValidCommands commands
| Failure failure -> return Error failure
}
In particular this last bit:
// BillCancellationsRequest -> Async<Result<OrderBillingEvent list,CommandError list>>
let cancelBills (request: BillCancellationsRequest) =
async {
match request |> List.map toCommand |> Validation.cumulativeFoldList with
| Success commands -> return! processValidCommands commands
| Failure failure -> return Error failure
}
I tried to come up with a new module but I found myself rolling a lot more code:
module Result =
// ('T -> 'U) -> ('V -> 'W) -> Result<'T, 'V> -> Result<'U, 'W>
let bimap okMapping errorMapping result =
result
|> Result.map okMapping
|> Result.mapError errorMapping
// Result<Async<'T>, 'U> -> Async<Result<'T, 'U>>
let awaitOnOk result =
async {
match result with
| Ok ok ->
let! awaitedOk = ok
return Ok awaitedOk
| Error error ->
return Error error
}
// BillCancellationsRequest -> Async<Result<OrderBillingEvent list,CommandError list>>
let cancelBills (request: BillCancellationsRequest) =
request
|> List.map toCommand
|> Validation.cumulativeFoldList
|> Validation.toResult
|> Result.map processValidCommands
|> Result.awaitOnOk
|> Async.map Result.flatten
I'm wondering if there is like a better and more concise approach to achieve that?
Note: Unchecked.defaultof<...>
has been used just for the sake of making the code above to compile.