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