aboutsummaryrefslogtreecommitdiff
path: root/Utility/TSet.hs
blob: 24d345477c893d3523d83eaa8fb6eff2a213c2c9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
{- Transactional sets
 -
 - Copyright 2012 Joey Hess <joey@kitenet.net>
 -}

module Utility.TSet where

import Common

import Control.Concurrent.STM

type TSet = TChan

runTSet :: STM a -> IO a
runTSet = atomically

newTSet :: IO (TSet a)
newTSet = atomically newTChan

{- Gets the contents of the TSet. Blocks until at least one item is
 - present. -}
getTSet :: TSet a -> IO [a]
getTSet tset = runTSet $ do
	c <- readTChan tset
	go [c]
	where
		go l = do
			v <- tryReadTChan tset
			case v of
				Nothing -> return l
				Just c -> go (c:l)

{- Puts items into a TSet. -}
putTSet :: TSet a -> [a] -> IO ()
putTSet tset vs = runTSet $ mapM_ (writeTChan tset) vs

{- Put a single item into a TSet. -}
putTSet1 :: TSet a -> a -> IO ()
putTSet1 tset v = void $ runTSet $ writeTChan tset v