diff options
author | Joey Hess <joey@kitenet.net> | 2013-03-10 21:36:13 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-03-10 22:10:26 -0400 |
commit | 9d5b42222a10050fc733a49c427359f88e8be36c (patch) | |
tree | 4fa0b1d6cf4a38ba772557dc4277fbd887020e46 /Utility | |
parent | e107ddb4507d92303e14ebee3ccdec7662350031 (diff) |
assistant: generate better commits for renames
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/TSet.hs | 28 | ||||
-rw-r--r-- | Utility/ThreadScheduler.hs | 12 |
2 files changed, 23 insertions, 17 deletions
diff --git a/Utility/TSet.hs b/Utility/TSet.hs index bb711a4fb..c5ee22c89 100644 --- a/Utility/TSet.hs +++ b/Utility/TSet.hs @@ -1,6 +1,6 @@ {- Transactional sets - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012, 2013 Joey Hess <joey@kitenet.net> -} module Utility.TSet where @@ -11,18 +11,20 @@ import Control.Concurrent.STM type TSet = TChan -runTSet :: STM a -> IO a -runTSet = atomically - -newTSet :: IO (TSet a) -newTSet = atomically newTChan +newTSet :: STM (TSet a) +newTSet = newTChan {- Gets the contents of the TSet. Blocks until at least one item is - present. -} -getTSet :: TSet a -> IO [a] -getTSet tset = runTSet $ do +getTSet :: TSet a -> STM [a] +getTSet tset = do c <- readTChan tset - go [c] + l <- readTSet tset + return $ c:l + +{- Gets anything currently in the TSet, without blocking. -} +readTSet :: TSet a -> STM [a] +readTSet tset = go [] where go l = do v <- tryReadTChan tset @@ -31,9 +33,9 @@ getTSet tset = runTSet $ do Just c -> go (c:l) {- Puts items into a TSet. -} -putTSet :: TSet a -> [a] -> IO () -putTSet tset vs = runTSet $ mapM_ (writeTChan tset) vs +putTSet :: TSet a -> [a] -> STM () +putTSet tset vs = mapM_ (writeTChan tset) vs {- Put a single item into a TSet. -} -putTSet1 :: TSet a -> a -> IO () -putTSet1 tset v = void $ runTSet $ writeTChan tset v +putTSet1 :: TSet a -> a -> STM () +putTSet1 tset v = void $ writeTChan tset v diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs index a32606cfd..25ccbf25e 100644 --- a/Utility/ThreadScheduler.hs +++ b/Utility/ThreadScheduler.hs @@ -1,6 +1,6 @@ {- thread scheduling - - - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2012, 2013 Joey Hess <joey@kitenet.net> - Copyright 2011 Bas van Dijk & Roel van Dijk - - Licensed under the GNU GPL version 3 or higher. @@ -14,6 +14,7 @@ import Common import Control.Concurrent import System.Posix.Signals +import Data.Time.Clock #ifndef __ANDROID__ import System.Posix.Terminal #endif @@ -21,6 +22,8 @@ import System.Posix.Terminal newtype Seconds = Seconds { fromSeconds :: Int } deriving (Eq, Ord, Show) +type Microseconds = Integer + {- Runs an action repeatedly forever, sleeping at least the specified number - of seconds in between. -} runEvery :: Seconds -> IO a -> IO a @@ -30,8 +33,6 @@ runEvery n a = forever $ do threadDelaySeconds :: Seconds -> IO () threadDelaySeconds (Seconds n) = unboundDelay (fromIntegral n * oneSecond) - where - oneSecond = 1000000 -- microseconds {- Like threadDelay, but not bounded by an Int. - @@ -42,7 +43,7 @@ threadDelaySeconds (Seconds n) = unboundDelay (fromIntegral n * oneSecond) - Taken from the unbounded-delay package to avoid a dependency for 4 lines - of code. -} -unboundDelay :: Integer -> IO () +unboundDelay :: Microseconds -> IO () unboundDelay time = do let maxWait = min time $ toInteger (maxBound :: Int) threadDelay $ fromInteger maxWait @@ -61,3 +62,6 @@ waitForTermination = do where check sig lock = void $ installHandler sig (CatchOnce $ putMVar lock ()) Nothing + +oneSecond :: Microseconds +oneSecond = 1000000 |