同时哈斯克尔操作与超时
-
06-09-2019 - |
题
如何能实现一个在并发Haskell这样的函数,要么返回“一个”成功或者由于超时“B”?
timed :: Int → IO a → b → IO (Either a b)
timed max act def = do
最好的问候,结果 切廷塞尔特
注意:的定时的签名可以是完全或稍微不同的
。
解决方案
实现上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))
其他提示
这里的第一个答案,我可以拿出。我需要这一个端口扫描器。 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 的-__-“
不隶属于 StackOverflow