Actions simultanées Haskell avec délai d'attente

Question

comment pourrait-on mettre en œuvre une fonction haskell concurrente qui soit retourne 'a' avec succès ou en raison de délai d'attente 'b'?

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

Cordialement,
Cetin Sert

Note: la signature chronométrée peut être complètement ou légèrement différent

.

Answer 1

La mise en œuvre de votre timed désiré sur le dessus de System.Timeout.timeout est facile:

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)

Par ailleurs, la mise en œuvre commune de timeout est plus proche de celle-ci: ($! = seq pour tenter de forcer l'évaluation de la valeur retournée dans le thread plutôt que seulement retourner un 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

La mise en œuvre de System.Timeout.timeout dans les bibliothèques est un peu plus complexe, le traitement des cas plus exceptionnels.

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

Voici la première réponse que je pouvais trouver. Je avais besoin pour cela d'un scanner de port. o_O Vous avez oublié le mot de passe administrateur de mon routeur et je voulais vérifier quels ports j'avais ouvert sur notre serveur domestique avant que je puisse maintenant réutiliser et réutiliser ^ _ ^ » ... Cette mise en œuvre doit faire le travail pour le moment.

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 tout simplement utiliser System.Timeout.timeout -__- "