f异步工作流/任务与自由monad相结合

在我的理解中,free monad的全部要点是,您不需要像async那样公开效果,所以我认为它们不应该在pipeinstruction类型中使用。解释器是添加效果的地方。

另外,free monad只在haskell中才有意义,在haskell中,您只需要定义一个函子,然后就可以自动获得实现的其余部分。在f中,您还必须编写其余代码,因此使用free比使用更传统的解释器模式没有多大好处。 你链接到的那个TurtleProgram代码只是一个实验——我不建议使用真正的免费代码。

最后,如果你已经知道你将要使用的效果,并且你不会有多个解释,那么使用这种方法是没有意义的。只有当利益大于复杂性时才有意义。

无论如何,如果你确实想写一个解释器版本(而不是免费的),我会这样做:

首先,定义说明 没有任何影响 是的。

/// 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

首先,我认为在f_中使用自由单子非常接近于反模式。这是一个非常抽象的结构,不太适合习惯的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> 您应该能够通过对命令执行递归异步函数来计算。