f# 异步取消不起作用 - 卡在 console.readline

Question

我正在使用 f# 运行一个简单的聊天应用程序。在聊天中，当一个用户键入“退出”时，我希望两个客户端都完成聊天。目前我在控制台中运行，所以读写是阻塞的，但是我使用一个类来包装控制台，所以没有异步问题。

（在下面的代码中，sendUI 和 reciveUI 是通过网络发送和接收消息的异步函数）

type IConnection =
    abstract Send : string -> Async<bool>
    abstract Recieve : unit -> Async<string>
    abstract Connected : bool
    abstract Close : unit -> unit

type IOutput =
    abstract ClearLine : unit -> unit
    abstract ReadLine : ?erase:bool -> string
    abstract WriteLine : string -> unit

let sendUI (outputer:#IOutput) (tcpConn: #IConnection) () =
    async {
        if not tcpConn.Connected then return false
        else
        let message = outputer.ReadLine(true)
        try 
            match message with
            | "exit" -> do! tcpConn.Send "exit" |> Async.Ignore
                        return false
            | _      -> if message.Trim() <> "" 
                        then do! message.Trim() |> tcpConn.Send |> Async.Ignore
                        outputer.WriteLine("me: " + message)
                        return true
        with
        | e -> outputer.WriteLine("log: " + e.Message)
               return false
    }

let recieveUI (outputer:#IOutput) (tcpConn: #IConnection) () =
    async {
        if not tcpConn.Connected then return false
        else
        try
            let! response = tcpConn.Recieve()
            match response with
            | "exit" -> return false
            | _ -> outputer.WriteLine("other: " + response)
                   return true
        with
        | e -> outputer.WriteLine("error: " + e.Message)
               return false
    }

let rec loop (cancel:CancellationTokenSource) f =
    async {
        match! f() with
        | false -> cancel.Cancel(true)
        | true -> do! loop cancel f
    }

let messaging recieve send (outputer: #IOutput) (tcpConn:#IConnection) =
    printfn "write: exit to exit"
    use cancelSrc = new CancellationTokenSource()
    let task =
        [ recieve outputer tcpConn
          send    outputer tcpConn ]
        |> List.map (loop cancelSrc)
        |> Async.Parallel
        |> Async.Ignore
    try
        Async.RunSynchronously (computation=task, cancellationToken=cancelSrc.Token)
    with
    | :? OperationCanceledException ->
        tcpConn.Close()

let exampleReceive = 
    { new IConnection with
          member this.Connected = true
          member this.Recieve() = async { do! Async.Sleep 1000
                                          return "exit" }
          member this.Send(arg1) = async { return true }
          member this.Close() = ()
    }

let exampleOutputer =
    { new IOutput with
          member this.ClearLine() = raise (System.NotImplementedException())
          member this.ReadLine(erase) = Console.ReadLine()
          member this.WriteLine(arg) = Console.WriteLine(arg) }

[<EntryPoint>]
let main args =
    messaging recieveUI sendUI exampleOutputer exampleReceive
    0

（我用一个对象包裹了控制台，所以我不会在屏幕上看到奇怪的东西：输出器）

当我通过线路“退出”时，我返回 false，因此循环调用取消，因此它也应该停止发送消息的异步计算。

但是，当我这样做时，sendUI 会卡住：

async {
    //do stuff
    let message = Console.ReadLine() //BLOCKS! doesn't cancel
    //do stuff
}

一种解决方法是以某种方式使 Console.ReadLine() 成为异步，但是简单的 async { return ...} 不起作用。

我也尝试将其作为任务运行并调用 Async.AwaitTask，但这也不起作用！

我读到有人可以使用 Async.FromContinuations 但我不知道如何使用它（我尝试过的方法并没有解决它......）

帮助不大？

编辑

这不能简单地起作用的原因是异步计算取消的工作方式。他们检查是否在到达 let!/do!/return 时取消！等等，所以上面的解决方案不起作用。

编辑 2

添加了可运行的代码示例

Answer 1

您可以将Console.ReadLine 包装在自己的async 中，然后使用Async.RunSynchronously 和CancellationToken 调用它。这将允许您取消该阻塞操作，因为它与控制台本身不在同一个线程上。

open System
open System.Threading

type ITcpConnection =
    abstract member Send: string -> unit

let readLineAsync cancellation =
    async {
        try
            return Some <| Async.RunSynchronously(async { return Console.ReadLine() }, cancellationToken = cancellation)
        with | _ ->
            return None
    }

let receiveUI cancellation (tcpConnection: ITcpConnection) =
    let rec loop () =
        async {
            let! message = readLineAsync cancellation
            match message with
            | Some msg -> msg |> tcpConnection.Send
            | None -> printfn "Chat Session Ended"
            return! loop ()
        }
    loop () |> Async.Start