如何构建一个累加的任意生成器

Question

我想为这两个表达式构建一个计算表达式。这很简单

type Result<'TSuccess> = 
| Success of 'TSuccess
| Failure of List<string>
type Foo = {
a: int
b: string
c: bool
}
type EitherBuilder () =
member this.Bind(x, f) = 
match x with
| Success s -> f s
| Failure f -> Failure f
member this.Return x = Success x
let either = EitherBuilder ()
let Ok = either {
let! a = Success 1
let! b = Success "foo"
let! c = Success true
return 
{
a = a
b = b
c = c
}
}
let fail1 = either {
let! a = Success 1
let! b = Failure ["Oh nose!"]
let! c = Success true
return 
{
a = a
b = b
c = c
}
} //returns fail1 = Failure ["Oh nose!"]

但在Failures(多个)的情况下，我想累积这些并返回Failure，如下所示。

let fail2 = either {
let! a = Success 1
let! b = Failure ["Oh nose!"]
let! c = Failure ["God damn it, uncle Bob!"]
return 
{
a = a
b = b
c = c
}
} //should return fail2 = Failure ["Oh nose!"; "God damn it, uncle Bob!"]

我知道如何通过重写Bind并始终返回Success(尽管有一些额外的结构表示累积的eror)来做到这一点。然而，如果我这样做，那么我就会错过停止信号，并且我总是得到返回值(实际上并不是真的，因为我会遇到运行时异常，但原则上)

Answer 1

我认为您想要做的事情不能用monad来表达。问题是，如果Bind能够获得函数参数的值，那么它只能调用其余的计算(这可能会产生更多的失败)。在您的示例中：

let! a = Success 1
let! b = Failure ["Oh nose!"]
let! c = Failure ["God damn it, uncle Bob!"]

绑定无法调用以b开头的延续，因为Failure ["Oh nose!"]没有为b提供值。您可以使用默认值并保留错误，但这正在改变您使用的结构：

type Result<'T> = { Value : 'T; Errors : list<string> }

你可以使用应用函子抽象来写这篇文章，你需要：

Merge  : F<'T1> * F<'T2> -> F<'T1 * 'T2>
Map    : ('T1 -> 'T2) -> M<'T1> -> M<'T2> 
Return : 'T -> M<'T>

您可以通过以下方式实现所有这些：Merge累积错误(如果两个参数都表示失败)，而Map仅在没有值的情况下应用计算。

F#中有各种编码应用函子的方法，但没有很好的语法，所以你很可能最终会使用丑陋的自定义运算符。

Answer 2

正如@tomasp所说，一种方法是在故障之外始终提供一个值，以使bind正常工作。这是我在处理这个问题时一直使用的方法。然后，我会将Result的定义更改为，例如：

type BadCause =
| Exception of exn
| Message   of string
type BadTree =
| Empty
| Leaf  of BadCause
| Fork  of BadTree*BadTree
type [<Struct>] Result<'T> = Result of 'T*BadTree

这意味着Result总是有一个值，无论它是好的还是坏的。如果BadTree为空，则该值良好。

我更喜欢树而不是列表的原因是Bind将聚合两个单独的结果，这两个结果可能具有导致列表串联的子细节。

一些让我们创造好价值或坏价值的功能：

let rreturn     v       = Result (v, Empty)
let rbad        bv bt   = Result (bv, bt)
let rfailwith   bv msg  = rbad bv (Message msg |> Leaf)

因为即使是糟糕的结果也需要携带一个值才能使Bind工作，所以我们需要通过bv参数提供该值。对于支持Zero的类型，我们可以创建一个方便的方法：

let inline rfailwithz  msg  = rfailwith LanguagePrimitives.GenericZero<_> msg

Bind易于实现：

let rbind (Result (tv, tbt)) uf =
let (Result (uv, ubt)) = uf tv
Result (uv, btjoin tbt ubt)

也就是说；我们评估这两个结果，并在需要时加入坏树。

使用计算表达式生成器可以执行以下程序：

let r =
result {
let! a = rreturn    1
let! b = rfailwithz "Oh nose!"
let! c = rfailwithz "God damn it, uncle Bob!"
return a + b + c
}
printfn "%A" r

输出：

Result(1，Fork(Leaf(消息"哦，鼻子！")，Leaf(信息"该死的，鲍勃叔叔！"))

也就是说；我们得到一个坏值CCD_ 18，它坏的原因是因为两个连接的错误叶。

我在使用可组合子转换和验证树结构时使用了这种方法。在我的情况下，重要的是获得所有验证失败，而不仅仅是第一次。这意味着Bind中的两个分支都需要求值，但为了求值，我们必须始终有一个值才能调用Bind t uf中的uf。

在OP自己的回答中，我确实用Unchecked.defaultof<_>进行了实验，但我放弃了，例如，因为字符串的默认值是null，并且在调用uf时通常会导致崩溃。我确实创建了一个映射Type -> empty value，但在我的最终解决方案中，当构建一个坏结果时，我需要一个坏值。

希望这能帮助

完整示例：

type BadCause =
| Exception of exn
| Message   of string
type BadTree =
| Empty
| Leaf  of BadCause
| Fork  of BadTree*BadTree
type [<Struct>] Result<'T> = Result of 'T*BadTree
let (|Good|Bad|) (Result (v, bt)) =
let ra = ResizeArray 16
let rec loop bt =
match bt with
| Empty         -> ()
| Leaf  bc      -> ra.Add bc |> ignore
| Fork  (l, r)  -> loop l; loop r
loop bt
if ra.Count = 0 then 
Good v
else 
Bad (ra.ToArray ())
module Result =
let btjoin      l  r    =
match l, r with
| Empty , _     -> r
| _     , Empty -> l
| _     , _     -> Fork (l, r)
let rreturn     v       = Result (v, Empty)
let rbad        bv bt   = Result (bv, bt)
let rfailwith   bv msg  = rbad bv (Message msg |> Leaf)
let inline rfailwithz  msg  = rfailwith LanguagePrimitives.GenericZero<_> msg
let rbind (Result (tv, tbt)) uf =
let (Result (uv, ubt)) = uf tv
Result (uv, btjoin tbt ubt)
type ResultBuilder () =
member x.Bind         (t, uf) = rbind t uf
member x.Return       v       = rreturn v
member x.ReturnFrom   r       = r : Result<_>
let result = Result.ResultBuilder ()
open Result
[<EntryPoint>]
let main argv = 
let r =
result {
let! a = rreturn    1
let! b = rfailwithz "Oh nose!"
let! c = rfailwithz "God damn it, uncle Bob!"
return a + b + c
}
match r with
| Good v  -> printfn "Good: %A" v
| Bad  es -> printfn "Bad: %A" es
0

Answer 3

最终，通过上面@tomas的提示，我可以得到这个解决方案，它保留了数据类型的原样，但创建了一个有状态的生成器。

现在，留给我的唯一问题是这个线程是否安全——我认为是的。也许有人可以证实？

type Result<'TSuccess> = 
| Success of 'TSuccess
| Failure of List<string>
type Foo = {
a: int
b: string
c: bool
}
type EitherBuilder (msg) =
let mutable errors = [msg]
member this.Bind(x, fn) =
match x with
| Success s -> fn s
| Failure f ->
errors <- List.concat [errors;f] 
fn (Unchecked.defaultof<_>)
member this.Return x =
if List.length errors = 1 then
Success x
else
Failure errors
let either msg = EitherBuilder (msg)
let Ok = either("OK") {
let! a = Success 1
let! b = Success "foo"
let! c = Success true
return 
{
a = a
b = b
c = c
}
}
let fail1 = either("Fail1") {
let! a = Success 1
let! b = Failure ["Oh nose!"]
let! c = Success true
return 
{
a = a
b = b
c = c
}
} //returns fail1 = Failure ["Fail1"; "Oh nose!"]

let fail2 = either("Fail2") {
let! a = Success 1
let! b = Failure ["Oh nose!"]
let! c = Failure ["God damn it, uncle Bob!"]
return 
{
a = a
b = b
c = c
}
} //should return fail2 = Failure ["Fail2"; "Oh nose!"; "God damn it, uncle Bob!"]

Answer 4

我们现在在构建器中有了and!和MergeSources的应用计算表达式。

有关的解决方案，请参阅此