F＃異步工作流/任務與免費monad相結合

Question

我正在嘗試使用免費的monad模式構建用於消息處理的管道，我的代碼看起來像這樣：

module PipeMonad =
type PipeInstruction<'msgIn, 'msgOut, 'a> =
    | HandleAsync of 'msgIn * (Async<'msgOut> -> 'a)
    | SendOutAsync of 'msgOut * (Async -> 'a)

let private mapInstruction f = function
    | HandleAsync (x, next) -> HandleAsync (x, next >> f)
    | SendOutAsync (x, next) -> SendOutAsync (x, next >> f)

type PipeProgram<'msgIn, 'msgOut, 'a> =
    | Act of PipeInstruction<'msgIn, 'msgOut, PipeProgram<'msgIn, 'msgOut, 'a>>
    | Stop of 'a

let rec bind f = function
    | Act x -> x |> mapInstruction (bind f) |> Act
    | Stop x -> f x

type PipeBuilder() =
    member __.Bind (x, f) = bind f x
    member __.Return x = Stop x
    member __.Zero () = Stop ()
    member __.ReturnFrom x = x

let pipe = PipeBuilder()
let handleAsync msgIn = Act (HandleAsync (msgIn, Stop))
let sendOutAsync msgOut = Act (SendOutAsync (msgOut, Stop))

我根據這篇文章寫的

然而，讓這些方法異步是很重要的（ Task最好，但Async是可以接受的），但是當我為我的pipeline創建一個構建器時，我無法弄清楚如何使用它 - 我怎么能等待一個Task<'msgOut>或Async<'msgOut>所以我可以把它發送出來並等待這個“發送”任務？

現在我有這段代碼：

let pipeline log msgIn =
    pipe {
        let! msgOut = handleAsync msgIn
        let result = async {
            let! msgOut = msgOut
            log msgOut
            return sendOutAsync msgOut
        }
        return result
    }

返回PipeProgram<'b, 'a, Async<PipeProgram<'c, 'a, Async>>>

Answer 1

首先，我認為在F＃中使用免費monad非常接近於反模式。 這是一個非常抽象的結構，不適合用慣用的F＃風格 - 但這是一個偏好的問題，如果你（和你的團隊）發現這種編寫代碼可讀且易於理解的方式，那么你當然可以去在這個方向。

出於好奇，我花了一些時間玩你的例子 - 雖然我還沒有弄清楚如何完全修復你的例子，但我希望以下可能有助於引導你朝着正確的方向前進。 總結是，我認為您需要將Async集成到PipeProgram以便管道程序本質上是異步的：

type PipeInstruction<'msgIn, 'msgOut, 'a> =
    | HandleAsync of 'msgIn * (Async<'msgOut> -> 'a)
    | SendOutAsync of 'msgOut * (Async<unit> -> 'a)
    | Continue of 'a 

type PipeProgram<'msgIn, 'msgOut, 'a> =
    | Act of Async<PipeInstruction<'msgIn, 'msgOut, PipeProgram<'msgIn, 'msgOut, 'a>>>
    | Stop of Async<'a>

請注意，我必須添加Continue以使我的函數類型檢查，但我認為這可能是一個錯誤的黑客，你可能需要遠程。 通過這些定義，您可以執行以下操作：

let private mapInstruction f = function
    | HandleAsync (x, next) -> HandleAsync (x, next >> f)
    | SendOutAsync (x, next) -> SendOutAsync (x, next >> f)
    | Continue v -> Continue v

let rec bind (f:'a -> PipeProgram<_, _, _>) = function
    | Act x -> 
        let w = async { 
          let! x = x 
          return mapInstruction (bind f) x }
        Act w
    | Stop x -> 
        let w = async {
          let! x = x
          let pg = f x
          return Continue pg
        }
        Act w

type PipeBuilder() =
    member __.Bind (x, f) = bind f x
    member __.Return x = Stop x
    member __.Zero () = Stop (async.Return())
    member __.ReturnFrom x = x

let pipe = PipeBuilder()
let handleAsync msgIn = Act (async.Return(HandleAsync (msgIn, Stop)))
let sendOutAsync msgOut = Act (async.Return(SendOutAsync (msgOut, Stop)))

let pipeline log msgIn =
    pipe {
        let! msgOut = handleAsync msgIn
        log msgOut
        return! sendOutAsync msgOut
    }

pipeline ignore 0 

現在，這將為您提供簡單的PipeProgram<int, unit, unit> ，您應該能夠通過具有作用於命令的遞歸異步函數來評估它。

Answer 2

在我的理解中，自由monad的重點在於你沒有暴露像Async這樣的效果，所以我不認為它們應該在PipeInstruction類型中使用。 解釋器是添加效果的地方。

此外，Free Monad真的只在Haskell中有意義，你需要做的就是定義一個仿函數，然后你自動完成其余的實現。 在F＃中，您還必須編寫其余的代碼，因此使用Free比傳統的解釋器模式沒有多大好處。 您鏈接到的TurtleProgram代碼只是一個實驗 - 我不建議使用Free代替實際代碼。

最后，如果您已經知道將要使用的效果，並且您不會有多個解釋，那么使用這種方法是沒有意義的。 只有當收益超過復雜性時才有意義。

無論如何，如果你確實想要編寫一個解釋器版本（而不是Free），我就是這樣做的：

首先，定義指令而不產生任何影響 。

/// The abstract instruction set
module PipeProgram =

    type PipeInstruction<'msgIn, 'msgOut,'state> =
        | Handle of 'msgIn * ('msgOut -> PipeInstruction<'msgIn, 'msgOut,'state>)
        | SendOut of 'msgOut * (unit -> PipeInstruction<'msgIn, 'msgOut,'state>)
        | Stop of 'state

然后你可以為它編寫一個計算表達式：

/// A computation expression for a PipeProgram
module PipeProgramCE =
    open PipeProgram

    let rec bind f instruction =
        match instruction with
        | Handle (x,next) ->  Handle (x, (next >> bind f))
        | SendOut (x, next) -> SendOut (x, (next >> bind f))
        | Stop x -> f x

    type PipeBuilder() =
        member __.Bind (x, f) = bind f x
        member __.Return x = Stop x
        member __.Zero () = Stop ()
        member __.ReturnFrom x = x

let pipe = PipeProgramCE.PipeBuilder()

然后你就可以開始編寫你的計算表​​達式了。 這將有助於在開始使用解釋器之前清除設計。

// helper functions for CE
let stop x = PipeProgram.Stop x
let handle x = PipeProgram.Handle (x,stop)
let sendOut x  = PipeProgram.SendOut (x, stop)

let exampleProgram : PipeProgram.PipeInstruction<string,string,string> = pipe {
    let! msgOut1 = handle "In1"
    do! sendOut msgOut1
    let! msgOut2 = handle "In2"
    do! sendOut msgOut2
    return msgOut2
    }

一旦描述了說明，就可以編寫解釋器。 正如我所說，如果你不是在寫多個口譯員，那么也許你根本不需要這樣做。

這是一個非異步版本的解釋器（“Id monad”，就像它一樣）：

module PipeInterpreterSync =
    open PipeProgram

    let handle msgIn =
        printfn "In: %A"  msgIn
        let msgOut = System.Console.ReadLine()
        msgOut

    let sendOut msgOut =
        printfn "Out: %A"  msgOut
        ()

    let rec interpret instruction =
        match instruction with
        | Handle (x, next) ->
            let result = handle x
            result |> next |> interpret
        | SendOut (x, next) ->
            let result = sendOut x
            result |> next |> interpret
        | Stop x ->
            x

這是異步版本：

module PipeInterpreterAsync =
    open PipeProgram

    /// Implementation of "handle" uses async/IO
    let handleAsync msgIn = async {
        printfn "In: %A"  msgIn
        let msgOut = System.Console.ReadLine()
        return msgOut
        }

    /// Implementation of "sendOut" uses async/IO
    let sendOutAsync msgOut = async {
        printfn "Out: %A"  msgOut
        return ()
        }

    let rec interpret instruction =
        match instruction with
        | Handle (x, next) -> async {
            let! result = handleAsync x
            return! result |> next |> interpret
            }
        | SendOut (x, next) -> async {
            do! sendOutAsync x
            return! () |> next |> interpret
            }
        | Stop x -> x