具有超时的并发Haskell操作

Question

如何在并发haskell中实现一个函数,该函数要么成功返回'a'还是由于超时'b'？

timed :: Int ? IO a ? b ? IO (Either a b)
timed max act def = do

最诚挚的问候,
Cetin Sert

注意:timed的签名可以完全或略有不同.

Answer 1

实现你想要timed的顶部System.Timeout.timeout很简单:

import System.Timeout (timeout)

timed :: Int -> IO a -> b -> IO (Either b a)
timed us act def = liftM (maybe (Left def) Right) (timeout us act)

顺便说一句,常见的实现timeout更接近于:($!= seq尝试强制评估线程中的返回值而不是仅返回thunk):

import Control.Concurrent (forkIO, threadDelay, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import System.IO (hPrint, stderr)

timeout :: Int -> IO a -> IO (Maybe a)
timeout us act = do
    mvar <- newEmptyMVar
    tid1 <- forkIO $ (putMVar mvar . Just $!) =<< act
    tid2 <- forkIO $ threadDelay us >> putMVar mvar Nothing
    res <- takeMVar mvar
    killThread (maybe tid1 (const tid2) res) `catch` hPrint stderr
    return res

的实施System.Timeout.timeout在图书馆是一个有点复杂,处理更多的例外情况.

import Control.Concurrent  (forkIO, threadDelay, myThreadId, killThread)
import Control.Exception   (Exception, handleJust, throwTo, bracket)
import Data.Typeable
import Data.Unique         (Unique, newUnique)

data Timeout = Timeout Unique deriving Eq
timeoutTc :: TyCon
timeoutTc = mkTyCon "Timeout"
instance Typeable Timeout where { typeOf _ = mkTyConApp timeoutTc [] }
instance Show Timeout where
    show _ = "<<timeout>>"
instance Exception Timeout

timeout n f
    | n <  0    = fmap Just f
    | n == 0    = return Nothing
    | otherwise = do
        pid <- myThreadId
        ex  <- fmap Timeout newUnique
        handleJust (\e -> if e == ex then Just () else Nothing)
                   (\_ -> return Nothing)
                   (bracket (forkIO (threadDelay n >> throwTo pid ex))
                            (killThread)
                            (\_ -> fmap Just f))