diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Petr Pilař + +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. + + * Neither the name of Petr Pilař nor the names of other + contributors may 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Control/Concurrent/Delay.hs b/src/Control/Concurrent/Delay.hs new file mode 100644 --- /dev/null +++ b/src/Control/Concurrent/Delay.hs @@ -0,0 +1,57 @@ +module Control.Concurrent.Delay +( +-- * Delay + Delay(Delay) + +, usDelay +, msDelay +, sDelay +, mDelay +, hDelay +, (.+.) +) where + +------------------------------------------------------------------------------ +import Data.Int (Int64) +------------------------------------------------------------------------------ + +------------------------------------------------------------------------------ +-- | DELAY +-- +-- TODO: +-- * Add overflow checks. + +-- | Type representing delay in microseconds. +newtype Delay = Delay Int64 + +-- | Sums two delays. +(.+.) :: Delay -> Delay -> Delay +(Delay x) .+. (Delay y) = Delay $ x + y +{-# INLINE (.+.) #-} + +infixl 6 .+. + +-- | Delay in microseconds. +usDelay :: Int64 -> Delay +usDelay = Delay +{-# INLINE usDelay #-} + +-- | Delay in milliseconds. +msDelay :: Int64 -> Delay +msDelay = Delay . (1000 *) +{-# INLINE msDelay #-} + +-- | Delay in seconds. +sDelay :: Int64 -> Delay +sDelay = Delay . (1000 * 1000 *) +{-# INLINE sDelay #-} + +-- | Delay in minutes. +mDelay :: Int64 -> Delay +mDelay = Delay . (1000 * 1000 * 60 *) +{-# INLINE mDelay #-} + +-- | Delay in hours. +hDelay :: Int64 -> Delay +hDelay = Delay . (1000 * 1000 * 60 * 24 *) +{-# INLINE hDelay #-} diff --git a/src/Control/Concurrent/Suspend.hs b/src/Control/Concurrent/Suspend.hs new file mode 100644 --- /dev/null +++ b/src/Control/Concurrent/Suspend.hs @@ -0,0 +1,31 @@ +module Control.Concurrent.Suspend +( suspend + +, Delay +, usDelay +, msDelay +, sDelay +, mDelay +, hDelay +, (.+.) +) where + +------------------------------------------------------------------------------ +import Control.Concurrent (threadDelay) +import Control.Monad (when) +------------------------------------------------------------------------------ +import Control.Concurrent.Delay +------------------------------------------------------------------------------ + +-- | Analogy of `Control.Concurrent.threadDelay` that allows for longer delays. +-- +-- Suspends the current thread for the given delay (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. +suspend :: Delay -> IO () +suspend (Delay us) = when (us > 0) $ do + let wait = min us $ fromIntegral (maxBound :: Int) + threadDelay (fromIntegral wait) + suspend $! Delay (us - wait) +{-# INLINEABLE suspend #-} diff --git a/src/Control/Concurrent/Suspend/Lifted.hs b/src/Control/Concurrent/Suspend/Lifted.hs new file mode 100644 --- /dev/null +++ b/src/Control/Concurrent/Suspend/Lifted.hs @@ -0,0 +1,31 @@ +module Control.Concurrent.Suspend.Lifted +( suspend + +, Delay +, usDelay +, msDelay +, sDelay +, mDelay +, hDelay +, (.+.) +) where + +------------------------------------------------------------------------------ +import Control.Concurrent.Lifted (threadDelay) +import Control.Monad (when) +------------------------------------------------------------------------------ +import Control.Concurrent.Delay +------------------------------------------------------------------------------ + +-- | Analogy of `Control.Concurrent.threadDelay` that allows for longer delays. +-- +-- Suspends the current thread for the given delay (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. +suspend :: Delay -> IO () +suspend (Delay us) = when (us > 0) $ do + let wait = min us $ fromIntegral (maxBound :: Int) + threadDelay (fromIntegral wait) + suspend $! Delay (us - wait) +{-# INLINEABLE suspend #-} diff --git a/suspend.cabal b/suspend.cabal new file mode 100644 --- /dev/null +++ b/suspend.cabal @@ -0,0 +1,36 @@ +name: suspend +version: 0.1.0.0 +synopsis: Simple package that allows for long thread suspensions. +description: Simple package that allows for long thread suspensions. Uses newtype wrapper (of Int64 at the moment) to represent delay. +license: BSD3 +license-file: LICENSE +author: Petr Pilař +maintainer: Petr Pilař +copyright: Petr Pilař 2012 +category: Concurrency +stability: Experimental +build-type: Simple +cabal-version: >=1.8 + +extra-source-files: + LICENSE + , README.md + +library + exposed-modules: + Control.Concurrent.Suspend + , Control.Concurrent.Suspend.Lifted + + other-modules: + Control.Concurrent.Delay + + build-depends: + base == 4.5.* + , lifted-base == 0.1.* + + hs-source-dirs: src + ghc-options: -Wall -fwarn-unused-imports + +source-repository head + type: git + location: git://github.com/Palmik/suspend.git