haskell - 使用 Either monad ("railway-oriented programming"时如何处理回滚)

Question

我正在使用 F# 和 Chessie 组成一系列可以成功或失败的任务(带有副作用)。

如果有任何失败，我想停止执行剩余的任务并回滚那些已经成功的任务。

不幸的是，一旦我进入“失败”路径，就无法再检索成功任务的结果，因此我可以回滚它们。

是否有处理这种情况的函数式编程“模式”？

例子:

let refuel =
  async {
    printfn "1 executed"
    // Fill missile with fuel
    return Result<string,string>.Succeed "1"
  }  |> AR

let enterLaunchCodes =
  async {
    printfn "2 executed"
    // 
    return Result<string,string>.FailWith "2"
  }  |> AR

let fireMissile =
  async {
    printfn "3 executed"
    return Result<string,string>.Succeed "3"
  } |> AR

let launchSequence =
  asyncTrial {
    let! a = refuel
    let! b = enterLaunchCodes
    let! c = fireMissile
    return a,b,c
  }

let result = launchSequence
    |> Chessie.ErrorHandling.AsyncExtensions.Async.ofAsyncResult
    |> Async.RunSynchronously

// Result is a failure... how do I know the results of the successful operations here so I can roll them back?

printfn "Result: %A" result

Answer 1

正如人们在评论中指出的那样，有几个选项可以用来解决这个问题。

一种方法是使用 compensating transactions .

在这种方法中，Success case 包含“撤消”功能的列表。每个可以撤消的步骤都会在此列表中添加一个功能。
当任何步骤失败时，将执行列表中的每个撤消函数(以相反的顺序)。

当然有更复杂的方法可以做到这一点(例如，在崩溃的情况下持久存储撤消功能，
或 this kind of thing )。

下面是一些演示这种方法的代码:

/// ROP design with compensating transactions    
module RopWithUndo =

    type Undo = unit -> unit

    type Result<'success> =
        | Success of 'success * Undo list
        | Failure of string

    let bind f x =
        match x with
        | Failure e -> Failure e 
        | Success (s1,undoList1) ->
            match f s1 with
            | Failure e ->
                // undo everything in reverse order 
                undoList1 |> List.rev |> List.iter (fun undo -> undo())
                // return the error
                Failure e 
            | Success (s2,undoList2) ->
                // concatenate the undo lists
                Success (s2, undoList1 @ undoList2)

/// Example
module LaunchWithUndo =

    open RopWithUndo

    let undo_refuel() =
        printfn "undoing refuel"

    let refuel ok =
        if ok then
            printfn "doing refuel"
            Success ("refuel", [undo_refuel])
        else 
            Failure "refuel failed"

    let undo_enterLaunchCodes() =
        printfn "undoing enterLaunchCodes"

    let enterLaunchCodes ok refuelInfo =
        if ok then
            printfn "doing enterLaunchCodes"
            Success ("enterLaunchCodes", [undo_enterLaunchCodes])
        else 
            Failure "enterLaunchCodes failed"

    let fireMissile ok launchCodesInfo =
        if ok then
            printfn "doing fireMissile "
            Success ("fireMissile ", [])
        else 
            Failure "fireMissile failed"

    // test with failure at refuel
    refuel false
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile true)
    (*
    val it : Result<string> = Failure "refuel failed"
    *)

    // test with failure at enterLaunchCodes
    refuel true
    |> bind (enterLaunchCodes false)
    |> bind (fireMissile true)
    (*
    doing refuel
    undoing refuel
    val it : Result<string> = Failure "enterLaunchCodes failed"
    *)

    // test with failure at fireMissile
    refuel true
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile false)
    (*
    doing refuel
    doing enterLaunchCodes
    undoing enterLaunchCodes
    undoing refuel
    val it : Result<string> = Failure "fireMissile failed"
    *)

    // test with no failure 
    refuel true
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile true)
    (*
    doing refuel
    doing enterLaunchCodes
    doing fireMissile 
    val it : Result<string> =
      Success ("fireMissile ",[..functions..])
    *)

如果每一步的结果都无法撤消，那么第二个选择是在每一步中根本不做不可逆转的事情，
但是要延迟不可逆位，直到所有步骤都正常为止。

在这种方法中， Success case 包含“执行”函数的列表。成功的每一步都会在此列表中添加一个函数。
最后，执行整个函数列表。

缺点是一旦提交，所有函数都会运行(尽管你也可以将它们链接起来!)

这基本上是解释器模式的一个非常粗略的版本。

下面是一些演示这种方法的代码:

/// ROP design with delayed executions
module RopWithExec =

    type Execute = unit -> unit

    type Result<'success> =
        | Success of 'success * Execute list
        | Failure of string

    let bind f x =
        match x with
        | Failure e -> Failure e 
        | Success (s1,execList1) ->
            match f s1 with
            | Failure e ->
                // return the error
                Failure e 
            | Success (s2,execList2) ->
                // concatenate the exec lists
                Success (s2, execList1 @ execList2)

    let execute x =
        match x with
        | Failure e -> 
            Failure e 
        | Success (s,execList) ->
            execList |> List.iter (fun exec -> exec())
            Success (s,[])

/// Example
module LaunchWithExec =

    open RopWithExec

    let exec_refuel() =
        printfn "refuel"

    let refuel ok =
        if ok then
            printfn "checking if refuelling can be done"
            Success ("refuel", [exec_refuel])
        else 
            Failure "refuel failed"

    let exec_enterLaunchCodes() =
        printfn "entering launch codes"

    let enterLaunchCodes ok refuelInfo =
        if ok then
            printfn "checking if launch codes can be entered"
            Success ("enterLaunchCodes", [exec_enterLaunchCodes])
        else 
            Failure "enterLaunchCodes failed"

    let exec_fireMissile() =
        printfn "firing missile"

    let fireMissile ok launchCodesInfo =
        if ok then
            printfn "checking if missile can be fired"
            Success ("fireMissile ", [exec_fireMissile])
        else 
            Failure "fireMissile failed"

    // test with failure at refuel
    refuel false
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile true)
    |> execute
    (*
    val it : Result<string> = Failure "refuel failed"
    *)

    // test with failure at enterLaunchCodes
    refuel true
    |> bind (enterLaunchCodes false)
    |> bind (fireMissile true)
    |> execute
    (*
    checking if refuelling can be done
    val it : Result<string> = Failure "enterLaunchCodes failed"
    *)

    // test with failure at fireMissile
    refuel true
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile false)
    |> execute
    (*
    checking if refuelling can be done
    checking if launch codes can be entered
    val it : Result<string> = Failure "fireMissile failed"
    *)

    // test with no failure 
    refuel true
    |> bind (enterLaunchCodes true)
    |> bind (fireMissile true)
    |> execute
    (*
    checking if refuelling can be done
    checking if launch codes can be entered
    checking if missile can be fired
    refuel
    entering launch codes
    firing missile
    val it : Result<string> = Success ("fireMissile ",[])
    *)

你明白了，我希望。我敢肯定还有其他方法——这是两种显而易见且简单的方法。 :)