如何在并发haskell中实现一个函数,该函数要么成功返回'a',要么由于超时'b'而返回?
timed :: Int → IO a → b → IO (Either a b)
timed max act def = do
最好的问候,
Cetin Sert
注意:timed 的签名可以完全不同,也可以略有不同。
如何在并发haskell中实现一个函数,该函数要么成功返回'a',要么由于超时'b'而返回?
timed :: Int → IO a → b → IO (Either a b)
timed max act def = do
最好的问候,
Cetin Sert
注意:timed 的签名可以完全不同,也可以略有不同。
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
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))
这是我能想到的第一个答案。我需要这个用于端口扫描仪。o_O 忘记了我的路由器的管理员密码,并想检查我之前在家庭服务器上打开了哪些端口,我现在可以重新利用和重用 ^ _ ^" ...这个实现暂时应该可以完成这项工作。
module Control.Concurrent.Timed (timed) where
import Prelude hiding (take)
import System.IO
import Control.Monad
import System.Process
import System.Timeout
import Control.Concurrent
import System.Environment
timed :: Int → IO a → b → IO (Either b a)
timed max act def = do
w ← new
r ← new
t ← forkIO $ do
a ← act
r ≔ Right a
e ← em w
case e of
False → kill =<< take w
True → return ()
s ← forkIO $ do
(w ≔) =<< mine
wait max
e ← em r
case e of
True → do
kill t
r ≔ Left def
False → return ()
take r
timed_ :: Int → IO a → a → IO a
timed_ max act def = do
r ← timed max act def
return $ case r of
Right a → a
Left a → a
(≔) = putMVar
new = newEmptyMVar
wait = threadDelay
em = isEmptyMVar
kill = killThread
mine = myThreadId
take = takeMVar
或者只使用System.Timeout.timeout -__-"