packages feed

unbounded-delays (empty) → 0.1

raw patch · 5 files changed

+235/−0 lines, 5 filesdep +basesetup-changed

Dependencies added: base

Files

+ Control/Concurrent/Thread/Delay.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE CPP, NoImplicitPrelude, UnicodeSyntax #-}++-------------------------------------------------------------------------------+-- |+-- Module     : Control.Concurrent.Thread.Delay+-- Copyright  : 2011 Bas van Dijk & Roel van Dijk+-- License    : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--            , Roel van Dijk <vandijk.roel@gmail.com>+--+-- Arbitrarily long thread delays.+-------------------------------------------------------------------------------++module Control.Concurrent.Thread.Delay ( delay ) where+++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++-- from base:+import Control.Concurrent ( threadDelay )+import Control.Monad      ( when )+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 '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 = do+  let maxWait = min time $ toInteger (maxBound ∷ Int)+  threadDelay $ fromInteger maxWait+  when (maxWait /= time) $ delay (time - maxWait)+++-- The End ---------------------------------------------------------------------
+ Control/Concurrent/Timeout.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE CPP+           , DeriveDataTypeable+           , NoImplicitPrelude+           , UnicodeSyntax+  #-}++-------------------------------------------------------------------------------+-- |+-- Module     : Control.Concurrent.Timeout+-- Copyright  : 2011 Bas van Dijk & Roel van Dijk+-- License    : BSD3 (see the file LICENSE)+-- Maintainer : Bas van Dijk <v.dijk.bas@gmail.com>+--            , Roel van Dijk <vandijk.roel@gmail.com>+--+-- Wait arbitrarily long for an IO computation to finish.+-------------------------------------------------------------------------------++module Control.Concurrent.Timeout ( timeout ) where+++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++-- from base:+import Control.Concurrent       ( forkIO, myThreadId, throwTo, killThread )+import Control.Exception        ( Exception, bracket, handleJust )+import Control.Monad            ( return, (>>) )+import Data.Bool                ( otherwise )+import Data.Eq                  ( Eq, (==) )+import Data.Functor             ( fmap )+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__+import Data.Int                 ( Int )+import System.IO                ( hGetBuf, hPutBuf, hWaitForInput )+import qualified System.Timeout ( timeout )+#endif++-- from concurrent-extra (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 _ = "<<timeout>>"++instance Exception Timeout++{-|+Like '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\".++The design of this combinator was guided by the objective that @timeout n 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.+-}+timeout ∷ Integer → IO α → IO (Maybe α)+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 (delay n >> throwTo pid ex))+                            (killThread)+                            (\_ → fmap Just f)+                   )+++-- The End ---------------------------------------------------------------------
+ LICENSE view
@@ -0,0 +1,32 @@+Copyright (c) 2011 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ unbounded-delays.cabal view
@@ -0,0 +1,27 @@+name:          unbounded-delays+version:       0.1+cabal-version: >= 1.6+build-type:    Simple+author:        Bas van Dijk <v.dijk.bas@gmail.com>+               Roel van Dijk <vandijk.roel@gmail.com>+maintainer:    Bas van Dijk <v.dijk.bas@gmail.com>+               Roel van Dijk <vandijk.roel@gmail.com>+copyright:     2011 Bas van Dijk & Roel van Dijk+license:       BSD3+license-file:  LICENSE+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.+  +source-repository head+  Type: darcs+  Location: http://code.haskell.org/~basvandijk/code/unbounded-delays++library+  build-depends: base >= 3 && < 4.4+  exposed-modules: Control.Concurrent.Thread.Delay+                 , Control.Concurrent.Timeout+  ghc-options: -Wall