summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-03-10 21:36:13 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-03-10 22:10:26 -0400
commit9d5b42222a10050fc733a49c427359f88e8be36c (patch)
tree4fa0b1d6cf4a38ba772557dc4277fbd887020e46 /Utility
parente107ddb4507d92303e14ebee3ccdec7662350031 (diff)
assistant: generate better commits for renames
Diffstat (limited to 'Utility')
-rw-r--r--Utility/TSet.hs28
-rw-r--r--Utility/ThreadScheduler.hs12
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