Ações Haskell simultâneos com Timeout
-
06-09-2019 - |
Pergunta
como se poderia implementar uma função em Haskell concorrente que ou retorna 'um' sucesso ou devido a timeout 'b'?
timed :: Int → IO a → b → IO (Either a b)
timed max act def = do
Atenciosamente,
Cetin Sert
Nota: a assinatura do cronometrada pode ser completamente ou ligeiramente diferente
.
Solução
A implementação de seu timed
desejado no topo da System.Timeout.timeout
é fácil:
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)
A propósito, a implementação comum de timeout
está mais próximo a este: ($!
= seq
para tentar avaliação vigor do valor retornado no tópico e não apenas retornando uma conversão):
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
A implementação de System.Timeout.timeout
nas bibliotecas é um pouco mais complexo, tratamento de casos mais excepcionais.
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))
Outras dicas
Aqui está a primeira resposta que eu poderia vir acima com. Eu precisava disso para um scanner de porta. o_O Esqueceu a senha de administrador do meu router e queria verificar quais portas eu tinha aberto em nosso servidor de casa antes que eu pudesse agora redirecionar e reutilização ^ _ ^" ... Esta implementação deve fazer o trabalho por enquanto.
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
ou simplesmente usar System.Timeout.timeout -__- "