Asynchronous F#CancellationTokenSource.Cancel（）不取消基础工作

我有一些可能运行很长时间的函数，有时可能会挂断。所以，我想如果我把它包装成一个

异步

工作流，那么我应该能够取消它。下面是一个不起作用的FSI示例（但编译后的代码也会发生相同的行为）：

这意味着调用

c.Cancel（）

后，它根本不会停止

我做错了什么？如何让这样的事情发生

以下是一些附加信息：

当代码挂起时，它会在某个外部同步C#库中执行， 这是我无法控制的。所以，检查取消令牌 我控制的代码是无用的。这就是函数

run（）

上面就是这样建模的

我不需要任何关于完成和/或进度的沟通。它已经通过一些消息传递系统完成，超出了范围 问题的关键

基本上，只要我“决定”这样做，我就需要停止背景工作

---

这段代码是为了解决我无法获得一些终止/超时调用的情况而开发的。他们会被吊死。也许你能得到一些想法，帮助你解决问题

对您来说，有趣的部分只是前两个函数。剩下的只是演示我如何使用它们

module RobustTcp =

    open System
    open System.Text
    open System.Net.Sockets
    open Railway

    let private asyncSleep (sleepTime: int) (error: 'a) = async {
        do! Async.Sleep sleepTime
        return Some error
    }

    let private asyncWithTimeout asy (timeout: int) (error: 'a) =
        Async.Choice [ asy; asyncSleep timeout error ]

    let private connectTcpClient (host: string) (port: int) (tcpClient: TcpClient) = async {
        let asyncConnect = async {
            do! tcpClient.ConnectAsync(host, port) |> Async.AwaitTask
            return Some tcpClient.Connected }
        match! asyncWithTimeout asyncConnect 1_000 false with
        | Some isConnected -> return Ok isConnected
        | None -> return Error "unexpected logic error in connectTcpClient"
        }

    let private writeTcpClient (outBytes: byte[]) (tcpClient: TcpClient) = async {
        let asyncWrite = async {
            let stream = tcpClient.GetStream()
            do! stream.WriteAsync(outBytes, 0, outBytes.Length) |> Async.AwaitTask
            do! stream.FlushAsync() |> Async.AwaitTask
            return Some (Ok ()) }
        match! asyncWithTimeout asyncWrite 10_000 (Error "timeout writing") with
        | Some isWrite -> return isWrite
        | None -> return Error "unexpected logic error in writeTcpClient"
        }

    let private readTcpClient (tcpClient: TcpClient) = async {
        let asyncRead = async {
            let inBytes: byte[] = Array.zeroCreate 1024
            let stream = tcpClient.GetStream()
            let! byteCount = stream.ReadAsync(inBytes, 0, inBytes.Length) |> Async.AwaitTask
            let bytesToReturn = inBytes.[ 0 .. byteCount - 1 ]
            return Some (Ok bytesToReturn) }
        match! asyncWithTimeout asyncRead 2_000 (Error "timeout reading reply") with
        | Some isRead ->
            match isRead with
            | Ok s -> return Ok s
            | Error error -> return Error error
        | None -> return Error "unexpected logic error in readTcpClient"
        }

    let sendReceiveBytes (host: string) (port: int) (bytesToSend: byte[]) = async {
        try
            use tcpClient = new TcpClient()
            match! connectTcpClient host port tcpClient with
            | Ok isConnected ->
                match isConnected with
                | true ->
                    match! writeTcpClient bytesToSend tcpClient with
                    | Ok () ->
                        let! gotData = readTcpClient tcpClient
                        match gotData with
                        | Ok result -> return Ok result
                        | Error error -> return Error error
                    | Error error -> return Error error
                | false -> return Error "Not connected."
            | Error error -> return Error error
        with
        | :? AggregateException as ex ->
            (* TODO ? *)
            return Error ex.Message
        | ex ->
            (*
            printfn "Exception in getStatus : %s" ex.Message
            *)
            return Error ex.Message
    }

    let sendReceiveText (host: string) (port: int) (textToSend: string) (encoding: Encoding) =
        encoding.GetBytes textToSend
        |> sendReceiveBytes host port
        |> Async.map (Result.map encoding.GetString)

---

这段代码是为了解决我无法获得一些终止/超时调用的情况而开发的。他们会被吊死。也许你能得到一些想法，帮助你解决问题

对您来说，有趣的部分只是前两个函数。剩下的只是演示我如何使用它们

module RobustTcp =

    open System
    open System.Text
    open System.Net.Sockets
    open Railway

    let private asyncSleep (sleepTime: int) (error: 'a) = async {
        do! Async.Sleep sleepTime
        return Some error
    }

    let private asyncWithTimeout asy (timeout: int) (error: 'a) =
        Async.Choice [ asy; asyncSleep timeout error ]

    let private connectTcpClient (host: string) (port: int) (tcpClient: TcpClient) = async {
        let asyncConnect = async {
            do! tcpClient.ConnectAsync(host, port) |> Async.AwaitTask
            return Some tcpClient.Connected }
        match! asyncWithTimeout asyncConnect 1_000 false with
        | Some isConnected -> return Ok isConnected
        | None -> return Error "unexpected logic error in connectTcpClient"
        }

    let private writeTcpClient (outBytes: byte[]) (tcpClient: TcpClient) = async {
        let asyncWrite = async {
            let stream = tcpClient.GetStream()
            do! stream.WriteAsync(outBytes, 0, outBytes.Length) |> Async.AwaitTask
            do! stream.FlushAsync() |> Async.AwaitTask
            return Some (Ok ()) }
        match! asyncWithTimeout asyncWrite 10_000 (Error "timeout writing") with
        | Some isWrite -> return isWrite
        | None -> return Error "unexpected logic error in writeTcpClient"
        }

    let private readTcpClient (tcpClient: TcpClient) = async {
        let asyncRead = async {
            let inBytes: byte[] = Array.zeroCreate 1024
            let stream = tcpClient.GetStream()
            let! byteCount = stream.ReadAsync(inBytes, 0, inBytes.Length) |> Async.AwaitTask
            let bytesToReturn = inBytes.[ 0 .. byteCount - 1 ]
            return Some (Ok bytesToReturn) }
        match! asyncWithTimeout asyncRead 2_000 (Error "timeout reading reply") with
        | Some isRead ->
            match isRead with
            | Ok s -> return Ok s
            | Error error -> return Error error
        | None -> return Error "unexpected logic error in readTcpClient"
        }

    let sendReceiveBytes (host: string) (port: int) (bytesToSend: byte[]) = async {
        try
            use tcpClient = new TcpClient()
            match! connectTcpClient host port tcpClient with
            | Ok isConnected ->
                match isConnected with
                | true ->
                    match! writeTcpClient bytesToSend tcpClient with
                    | Ok () ->
                        let! gotData = readTcpClient tcpClient
                        match gotData with
                        | Ok result -> return Ok result
                        | Error error -> return Error error
                    | Error error -> return Error error
                | false -> return Error "Not connected."
            | Error error -> return Error error
        with
        | :? AggregateException as ex ->
            (* TODO ? *)
            return Error ex.Message
        | ex ->
            (*
            printfn "Exception in getStatus : %s" ex.Message
            *)
            return Error ex.Message
    }

    let sendReceiveText (host: string) (port: int) (textToSend: string) (encoding: Encoding) =
        encoding.GetBytes textToSend
        |> sendReceiveBytes host port
        |> Async.map (Result.map encoding.GetString)

---

您正在将控制权移交给代码段，该代码段虽然包装在

async

块中，但无法检查取消。如果您将循环直接包装在

async

中，或者将其替换为递归

async

循环，它将按预期工作：

let run0 () =   // does not cancel
    let counter = ref 0
    while true do
        printfn "(0) counter = %A" !counter
        Thread.Sleep 1000
        incr counter
let m = async { run0 () }

let run1 () =   // cancels
    let counter = ref 0
    async{
        while true do
            printfn "(1) counter = %A" !counter
            Thread.Sleep 1000
            incr counter }

let run2 =      // cancels too
    let rec aux counter = async {
        printfn "(2) counter = %A" counter
        Thread.Sleep 1000
        return! aux (counter + 1) }
    aux 0

printfn "Starting..."
let cts = new CancellationTokenSource()
Async.Start(m, cts.Token)
Async.Start(run1(), cts.Token)
Async.Start(run2, cts.Token)
printfn "Waiting..."
Thread.Sleep 5000
printfn "Cancelling..."
cts.Cancel()
printfn "Waiting again..."
Thread.Sleep 5000
printfn "Completed."

---

不过需要注意的是：F#中嵌套的

async

调用会自动检查是否取消，这就是

do！最好是异步睡眠

。如果您要走递归路线，请确保通过

return启用尾部递归。进一步阅读：Scott W.的博客，由Tomas Petricek撰写。
您正在将控制权交给一个代码段，该代码段虽然封装在一个
async
块中，但无法检查取消。如果您将循环直接包装在
async
中，或者将其替换为递归
async
循环，它将按预期工作：

let run0 () =   // does not cancel
    let counter = ref 0
    while true do
        printfn "(0) counter = %A" !counter
        Thread.Sleep 1000
        incr counter
let m = async { run0 () }

let run1 () =   // cancels
    let counter = ref 0
    async{
        while true do
            printfn "(1) counter = %A" !counter
            Thread.Sleep 1000
            incr counter }

let run2 =      // cancels too
    let rec aux counter = async {
        printfn "(2) counter = %A" counter
        Thread.Sleep 1000
        return! aux (counter + 1) }
    aux 0

printfn "Starting..."
let cts = new CancellationTokenSource()
Async.Start(m, cts.Token)
Async.Start(run1(), cts.Token)
Async.Start(run2, cts.Token)
printfn "Waiting..."
Thread.Sleep 5000
printfn "Cancelling..."
cts.Cancel()
printfn "Waiting again..."
Thread.Sleep 5000
printfn "Completed."

不过需要注意的是：F#中嵌套的
async
调用会自动检查是否取消，这就是
do！最好是异步睡眠
。如果您要走递归路线，请确保通过
return启用尾部递归。进一步阅读：斯科特W.的博客，作者：托马斯·佩特里切克。
你说的杀人是什么意思<代码>CanellationToken
只是一个通知。如果该方法实际上没有注册自身或检查取消，那么它实际上不会做任何事情。您使用的是Tread.Sleep。试试Async.Sleep。不确定，但我想那会尊重取消的。我正试图找到一个可行的替代方案。例如，
t=新线程（fun（）->run（））
。。。然后调用
t.Abort（）
确实会终止线程，但它会随着FSI中的一声巨响而停止-整个FSI会话被终止。
thread.Sleep
是故意的。请看问题末尾的评论1。我认为你根本不应该使用线程。异步和任务不是线程的东西，尽管它们使用线程来完成工作。你说的kill是什么意思<代码>CanellationToken

只是一个通知。如果该方法实际上没有注册自身或检查取消，那么它实际上不会做任何事情。您使用的是Tread.Sleep。试试Async.Sleep。不确定，但我想那会尊重取消的。我正试图找到一个可行的替代方案。例如，

t=新线程（fun（）->run（））

。。。然后调用

t.Abort（）

确实会终止线程，但它会随着FSI中的一声巨响而停止-整个FSI会话被终止。

thread.Sleep

是故意的。请看问题末尾的评论1。我认为你根本不应该使用线程。Async和Task不是线程的东西，尽管它们使用线程来完成工作。这里的想法是asyncSleep将超时，然后asyncWithTimeout也将超时，因此即使TCP的东西不会超时，也会有一个超时。也许有人会告诉我TCP的东西确实有我可以使用的超时。我的问题是，在某些情况下，这些超时将无法工作，并且电话将挂起。这就是为什么这是我能找到的唯一完全安全的方法，以确保无论出现什么问题，都不会出现挂起。这里的想法是asyncSleep将超时，然后asyncWithTimeout也将超时，这样即使TCP内容不会超时，会有一个超时。也许有人会告诉我TCP的东西确实有我可以使用的超时。我的问题是，在某些情况下，这些超时将无法工作，并且电话将挂起。这就是为什么这是我能找到的唯一一种完全万无一失的方法，以确保无论出现什么问题，都不会出现悬空。答案很好，但是。。。请参阅问题中的附加信息#1：当代码挂起时，它会在一些我无法控制的外部同步C#库中执行。因此，

run（）。如果你可以重写你的代码，这样它就可以在取消计算的同时使用原来的
run（）
，那就太好了。答案很好，但是。。。请参阅其他信息#