unbounded-delays-0.1.1.0/0000755000000000000000000000000013102753430013275 5ustar0000000000000000unbounded-delays-0.1.1.0/README.markdown0000644000000000000000000000067213102753430016003 0ustar0000000000000000The [threadDelay] and [timeout] functions from the `base` library use the bounded `Int` type for specifying the delay or timeout period. This packages provides alternatives which use the unbounded `Integer` type. [threadDelay]: http://hackage.haskell.org/packages/archive/base/latest/doc/html/Control-Concurrent.html#v:threadDelay [timeout]: http://hackage.haskell.org/packages/archive/base/latest/doc/html/System-Timeout.html#v:timeout unbounded-delays-0.1.1.0/LICENSE0000644000000000000000000000302213102753430014277 0ustar0000000000000000Copyright (c) 2011-2012 Bas van Dijk & Roel van Dijk All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of Bas van Dijk, Roel van Dijk and the names of contributors may NOT be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. unbounded-delays-0.1.1.0/unbounded-delays.cabal0000644000000000000000000000224013102753430017521 0ustar0000000000000000name: unbounded-delays version: 0.1.1.0 cabal-version: >= 1.6 build-type: Simple author: Bas van Dijk Roel van Dijk maintainer: Bas van Dijk Roel van Dijk copyright: 2011-2012 Bas van Dijk & Roel van Dijk license: BSD3 license-file: LICENSE homepage: https://github.com/basvandijk/unbounded-delays bug-reports: https://github.com/basvandijk/unbounded-delays/issues category: Concurrency synopsis: Unbounded thread delays and timeouts description: The @threadDelay@ and @timeout@ functions from the @base@ library use the bounded @Int@ type for specifying the delay or timeout period. This packages provides alternatives which use the unbounded @Integer@ type. extra-source-files: README.markdown source-repository head Type: git Location: git://github.com/basvandijk/unbounded-delays.git library build-depends: base >= 4 && < 5 exposed-modules: Control.Concurrent.Thread.Delay , Control.Concurrent.Timeout ghc-options: -Wall unbounded-delays-0.1.1.0/Setup.hs0000644000000000000000000000005613102753430014732 0ustar0000000000000000import Distribution.Simple main = defaultMain unbounded-delays-0.1.1.0/Control/0000755000000000000000000000000013102753430014715 5ustar0000000000000000unbounded-delays-0.1.1.0/Control/Concurrent/0000755000000000000000000000000013102753430017037 5ustar0000000000000000unbounded-delays-0.1.1.0/Control/Concurrent/Timeout.hs0000644000000000000000000001216113102753430021022 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, NoImplicitPrelude #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.Timeout -- Copyright : 2011 Bas van Dijk & Roel van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk -- , Roel van Dijk -- -- Wait arbitrarily long for an IO computation to finish. ------------------------------------------------------------------------------- module Control.Concurrent.Timeout ( timeout, Timeout, timeoutWithPred ) where ------------------------------------------------------------------------------- -- Imports ------------------------------------------------------------------------------- -- from base: import Control.Concurrent ( forkIOWithUnmask, myThreadId, throwTo, killThread ) import Control.Exception ( Exception, bracket, handleJust ) import Control.Monad ( return, (>>), fmap ) import Data.Bool ( Bool(False), otherwise ) import Data.Eq ( Eq, (==) ) import Data.Function ( (.), const) import Data.Maybe ( Maybe(Nothing, Just) ) import Data.Ord ( (<) ) import Data.Typeable ( Typeable ) import Data.Unique ( Unique, newUnique ) import Prelude ( Integer ) import System.IO ( IO ) import Text.Show ( Show, show ) #if __GLASGOW_HASKELL__ < 700 import Prelude ( fromInteger ) import Control.Monad ( (>>=), fail ) #endif #ifdef __HADDOCK_VERSION__ import Data.Int ( Int ) import System.IO ( hGetBuf, hPutBuf, hWaitForInput ) import qualified System.Timeout ( timeout ) #endif -- from unbounded-delays (this package): import Control.Concurrent.Thread.Delay ( delay ) ------------------------------------------------------------------------------- -- Long delays and timeouts ------------------------------------------------------------------------------- {- The following code was mostly copied from the module System.Timeout in the package base-4.2.0.0. (c) The University of Glasgow 2007 -} newtype Timeout = Timeout Unique deriving (Eq, Typeable) instance Show Timeout where show _ = "<>" instance Exception Timeout {-| Like @System.Timeout.'System.Timeout.timeout'@, but not bounded by an 'Int'. (..) Wrap an 'IO' computation to time out and return 'Nothing' in case no result is available within @n@ microseconds (@1\/10^6@ seconds). In case a result is available before the timeout expires, 'Just' @a@ is returned. A negative timeout interval means \"wait indefinitely\". If the computation has not terminated after @n@ microseconds, it is interrupted by an asynchronous exception. The function passed to @f@ can be used to detect whether it was interrupted by this timeout or some other exception. The design of this combinator was guided by the objective that @timeout n (const f)@ should behave exactly the same as @f@ as long as @f@ doesn't time out. This means that @f@ has the same 'myThreadId' it would have without the timeout wrapper. Any exceptions @f@ might throw cancel the timeout and propagate further up. It also possible for @f@ to receive exceptions thrown to it by another thread. A tricky implementation detail is the question of how to abort an 'IO' computation. This combinator relies on asynchronous exceptions internally. The technique works very well for computations executing inside of the Haskell runtime system, but it doesn't work at all for non-Haskell code. Foreign function calls, for example, cannot be timed out with this combinator simply because an arbitrary C function cannot receive asynchronous exceptions. When @timeout@ is used to wrap an FFI call that blocks, no timeout event can be delivered until the FFI call returns, which pretty much negates the purpose of the combinator. In practice, however, this limitation is less severe than it may sound. Standard I\/O functions like 'System.IO.hGetBuf', 'System.IO.hPutBuf', Network.Socket.accept, or 'System.IO.hWaitForInput' appear to be blocking, but they really don't because the runtime system uses scheduling mechanisms like @select(2)@ to perform asynchronous I\/O, so it is possible to interrupt standard socket I\/O or file I\/O using this combinator. -} timeoutWithPred :: Integer -> ((Timeout -> Bool) -> IO α) -> IO (Maybe α) timeoutWithPred n f | n < 0 = fmap Just (f (const False)) | n == 0 = return Nothing | otherwise = do pid <- myThreadId ex <- fmap Timeout newUnique handleJust (\e -> if e == ex then Just () else Nothing) (\_ -> return Nothing) (bracket (forkIOWithUnmask (\unmask -> unmask (delay n >> throwTo pid ex))) (killThread) (\_ -> fmap Just (f (==ex))) ) {-| Like 'timeoutWithPred', but does not expose the 'Timeout' exception to the called action. -} timeout :: Integer -> IO α -> IO (Maybe α) timeout n = timeoutWithPred n . const unbounded-delays-0.1.1.0/Control/Concurrent/Thread/0000755000000000000000000000000013102753430020246 5ustar0000000000000000unbounded-delays-0.1.1.0/Control/Concurrent/Thread/Delay.hs0000644000000000000000000000376313102753430021651 0ustar0000000000000000{-# LANGUAGE CPP, NoImplicitPrelude #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #endif ------------------------------------------------------------------------------- -- | -- Module : Control.Concurrent.Thread.Delay -- Copyright : 2011 Bas van Dijk & Roel van Dijk -- License : BSD3 (see the file LICENSE) -- Maintainer : Bas van Dijk -- , Roel van Dijk -- -- Arbitrarily long thread delays. ------------------------------------------------------------------------------- module Control.Concurrent.Thread.Delay ( delay ) where ------------------------------------------------------------------------------- -- Imports ------------------------------------------------------------------------------- -- from base: import Control.Concurrent ( threadDelay ) import Control.Monad ( when, return ) import Data.Eq ( (/=) ) import Data.Function ( ($) ) import Data.Int ( Int ) import Data.Ord ( min, (<=) ) import Prelude ( Integer, toInteger, fromInteger, maxBound, (-) ) import System.IO ( IO ) #if __GLASGOW_HASKELL__ < 700 import Control.Monad ( (>>) ) #endif ------------------------------------------------------------------------------- -- Delay ------------------------------------------------------------------------------- {-| Like @Control.Concurrent.'threadDelay'@, but not bounded by an 'Int'. Suspends the current thread for a given number of microseconds (GHC only). There is no guarantee that the thread will be rescheduled promptly when the delay has expired, but the thread will never continue to run earlier than specified. -} delay :: Integer -> IO () delay time | time <= 0 = -- When time is a big negative integer, casting it to Int may overflow. -- So we handle it as a special case here. return () delay time = do let maxWait = min time $ toInteger (maxBound :: Int) threadDelay $ fromInteger maxWait when (maxWait /= time) $ delay (time - maxWait)