Параллельные действия на Haskell с Timeout - PullRequest
Новая
       11

Параллельные действия на Haskell с Timeout

6 голосов
/ 31 мая 2009

как можно реализовать функцию в параллельном haskell, которая либо возвращает «a» успешно, либо из-за тайм-аута «b»? 

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

С наилучшими пожеланиями,
Cetin Sert

Примечание: подпись по времени может быть полностью или немного другой.

Ответы [ 2 ]

9 голосов
/ 31 мая 2009

Реализация желаемого 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))
0 голосов
/ 31 мая 2009

Вот первый ответ, который я смог придумать. Мне нужно это для сканера портов. 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 -__- "

...