Concurrentes acciones Haskell con Tiempo de espera

Question

¿cómo se podría implementar una función en Haskell concurrente que o bien vuelve 'a' con éxito o tiempo de espera debido a la 'b'?

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

Mejores Saludos, Cetin Sert

Nota: la firma de temporizado puede ser completamente o ligeramente diferentes

.

Answer 1

La implementación de su timed deseada en la parte superior de System.Timeout.timeout es 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)

Por cierto, la aplicación común de timeout está más cerca de esto: ($! = seq para tratar de forzar la evaluación del valor devuelto en el hilo en lugar de solamente el retorno de una de procesador):

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

La implementación de System.Timeout.timeout en las bibliotecas es un poco más compleja, el manejo de los casos más excepcionales.

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))

Answer 2

Esta es la primera respuesta que pudiera ocurrir. Necesitaba esto para un escáner de puertos. o_O olvidó la contraseña de administrador de mi router y quería comprobar qué puertos había abierto en nuestro servidor a casa antes de que ahora podía reutilizar y reutilizar ^ _ ^" ... Esta aplicación debe hacer el trabajo por el momento.

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 -__- "