Question

是否有一种取消Async a值的简单方法，以便在某些关键操作过程中不会中断？我想我可以在循环条件中使用信号量。

async $ whileM readSemaphore runLoopBody

但我想知道async或其他一些相关的库是否支持开箱即用。

我的代码，按要求。

-- |
-- TODO | - Rename (?)
--        - Time-out
awaitResult :: String -> IO a -> IO a
awaitResult s act = do
  putStr s
  sem <- newMVar True
  a <- async $ ellipsis sem
  r <- act
  swapMVar sem False
  return r
  where
    ellipsis :: MVar Bool -> IO ()
    ellipsis sem = void $ do
      whileM (readMVar sem) $ forM [".  ", ".. ", "...", "   "] $ \dots -> do
        putStr dots
        cursorBackward 3
        threadDelay (floor $ 0.4 * second)
      -- TODO | - If the Windows console wasn't shit, I'd use a checkmark
      putStr " (" >> withPretty fgGreen "done" >> putStrLn ")"

Answer 1

问题的措辞使我想到了一种更具对立性的关系，在这种情况下，使用Control.Concurrent.mask限制任务可以被中断的时间应该是合理的。

基于更新的代码，似乎线程具有紧密耦合，我能想到的第一个替代方案是产生动作而不是指标并使用poll，我认为它比MVar更少噪音{1}}路线：

import Control.Monad (forM_)
import Control.Exception (throw)
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (Async,async,poll)

second :: (Num a) => a
second = 1000000

awaitResult :: String -> IO a -> IO a
awaitResult s act = do
  putStrLn s
  a <- async $ act
  ellipsis a
  where
    ellipsis :: Async a -> IO a
    ellipsis a = do
      result <- poll a
      case result of
        Nothing -> do
          forM_ [".  ",".. ","...","   "] $ \dots -> do
            putStr dots
            putStr "\r"
            threadDelay $ floor $ 0.4 * second
          ellipsis a
        Just (Left e) -> throw e
        Just (Right x) -> return x

main = awaitResult "testing" (threadDelay (5 * second) >> return 5)

来自`Async`行动的优雅出口

1 个答案: