f # асинхронная отмена не работает - застрял на console.readline - PullRequest
Новая
       19

f # асинхронная отмена не работает - застрял на console.readline

0 голосов
/ 23 сентября 2018

Я запускаю простое приложение чата с 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

(Я обернул консоль объектом, чтобы не видеть странных вещей на экране: outputer)

Когда я получаю «выход»по проводу я возвращаю false и поэтому вызовы цикла отменяются, поэтому он также должен остановить асинхронные вычисления при отправке сообщений.

Однако, когда я делаю это, sendUI застревает: 

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

Одним из исправлений было бы как-то сделать Console.ReadLine () асинхронным, однако простой async {return ...} не работает.

Я также попытался запустить его как задачу и вызвать Async.AwaitTask, ноэто тоже не работает!

Я читал, что можно использовать Async.FromContinuations, но я не мог понять, как его использовать (и то, что я пытался, не решило это ...)

Маленькая помощь?

EDIT

Причина, по которой это не просто работает, заключается в том, что работает способ отмены асинхронных вычислений.Они проверяют, следует ли отменить, когда он достигает let! / Do! / Return!и т. д., поэтому приведенные выше решения не работают.

РЕДАКТИРОВАТЬ 2

Добавлен пример исполняемого кода

1 Ответ

0 голосов
/ 24 сентября 2018

Вы можете обернуть 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
...