System/Timeout.hs

   1 {-# OPTIONS -fglasgow-exts #-}
   2 -------------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  System.Timeout
   5 -- Copyright   :  (c) The University of Glasgow 2007
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  non-portable
  11 --
  12 -- Attach a timeout event to arbitrary 'IO' computations.
  13 --
  14 -------------------------------------------------------------------------------
  15
  16 module System.Timeout ( timeout ) where
  17
  18 #if __NHC__
  19 timeout :: Int -> IO a -> IO (Maybe a)
  20 timeout n f = fmap Just f
  21 #else
  22
  23 import Prelude             (IO, Ord((<)), Eq((==)), Int, (.), otherwise, fmap)
  24 import Data.Maybe          (Maybe(..))
  25 import Control.Monad       (Monad(..), guard)
  26 import Control.Concurrent  (forkIO, threadDelay, myThreadId, killThread)
  27 import Control.Exception   (handleJust, throwDynTo, dynExceptions, bracket)
  28 import Data.Dynamic        (Typeable, fromDynamic)
  29 import Data.Unique         (Unique, newUnique)
  30
  31 -- An internal type that is thrown as a dynamic exception to
  32 -- interrupt the running IO computation when the timeout has
  33 -- expired.
  34
  35 data Timeout = Timeout Unique deriving (Eq, Typeable)
  36
  37 -- |Wrap an 'IO' computation to time out and return @Nothing@ in case no result
  38 -- is available within @n@ microseconds (@1\/10^6@ seconds). In case a result
  39 -- is available before the timeout expires, @Just a@ is returned. A negative
  40 -- timeout interval means \"wait indefinitely\". When specifying long timeouts,
  41 -- be careful not to exceed @maxBound :: Int@.
  42 --
  43 -- The design of this combinator was guided by the objective that @timeout n f@
  44 -- should behave exactly the same as @f@ as long as @f@ doesn't time out. This
  45 -- means that @f@ has the same 'myThreadId' it would have without the timeout
  46 -- wrapper. Any exceptions @f@ might throw cancel the timeout and propagate
  47 -- further up. It also possible for @f@ to receive exceptions thrown to it by
  48 -- another thread.
  49 --
  50 -- A tricky implementation detail is the question of how to abort an @IO@
  51 -- computation. This combinator relies on asynchronous exceptions internally.
  52 -- The technique works very well for computations executing inside of the
  53 -- Haskell runtime system, but it doesn't work at all for non-Haskell code.
  54 -- Foreign function calls, for example, cannot be timed out with this
  55 -- combinator simply because an arbitrary C function cannot receive
  56 -- asynchronous exceptions. When @timeout@ is used to wrap an FFI call that
  57 -- blocks, no timeout event can be delivered until the FFI call returns, which
  58 -- pretty much negates the purpose of the combinator. In practice, however,
  59 -- this limitation is less severe than it may sound. Standard I\/O functions
  60 -- like 'System.IO.hGetBuf', 'System.IO.hPutBuf', Network.Socket.accept, or
  61 -- 'System.IO.hWaitForInput' appear to be blocking, but they really don't
  62 -- because the runtime system uses scheduling mechanisms like @select(2)@ to
  63 -- perform asynchronous I\/O, so it is possible to interrupt standard socket
  64 -- I\/O or file I\/O using this combinator.
  65
  66 timeout :: Int -> IO a -> IO (Maybe a)
  67 timeout n f
  68     | n <  0    = fmap Just f
  69     | n == 0    = return Nothing
  70     | otherwise = do
  71         pid <- myThreadId
  72         ex  <- fmap Timeout newUnique
  73         handleJust (\e -> dynExceptions e >>= fromDynamic >>= guard . (ex ==))
  74                    (\_ -> return Nothing)
  75                    (bracket (forkIO (threadDelay n >> throwDynTo pid ex))
  76                             (killThread)
  77                             (\_ -> fmap Just f))
  78 #endif