我想为两种表达式构建计算表达式。 这很简单
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!"]
但是在失败(多次)的情况下,我想积累那些并返回失败,如下所示。
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
来做到这一点(尽管有一些额外的结构表示累积的错误)。但是,如果我这样做,那么我错过了停止信号,我总是得到返回值(实际上并不是因为我会遇到运行时异常,但原则上)
答案 0 :(得分:4)
我认为你要做的事情不能用monads来表达。问题是如果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>
你可以使用applicative functor抽象来编写这个,你需要:
Merge
您可以以Map
累积错误的方式实现所有这些(如果两个参数都表示失败),{}
仅在没有值的情况下应用计算。
在F#中有各种编码applicative仿函数的方法,但是没有很好的语法,所以你很可能最终会使用丑陋的自定义运算符。
答案 1 :(得分:1)
最后有了@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!"]
答案 2 :(得分:1)
正如@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
输出:
结果(1,Fork(Leaf(消息&#34;哦鼻子!&#34;),Leaf(消息&#34;上帝该死,Bob叔叔!&#34;))
那是;我们得到一个错误的值1
,它的不好的原因是因为两个连接的错误叶子。
我在使用可组合组合器转换和验证树结构时使用了这种方法。在我的情况下,重要的是让所有验证失败,而不仅仅是第一次。这意味着需要对Bind
中的两个分支进行评估,但为了做到这一点,我们必须始终拥有一个值才能在uf
中调用Bind t 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
答案 3 :(得分:1)
我们现在在构建器中拥有带有 and!
和 MergeSources 的应用计算表达式。
请参阅 this 以获取解决方案