[英]F# async workflow / tasks combined with free monad
我正在尝试使用免费的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>>>
首先,我认为在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>
,您应该能够通过具有作用于命令的递归异步函数来评估它。
在我的理解中,自由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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.