bounded-tchan 0.2 → 0.2.1

raw patch · 2 files changed

+58/−28 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Control/Concurrent/STM/BTChan.hs +57/−27
• bounded-tchan.cabal +1/−1

@@ -20,42 +20,64 @@  -- |A 'BTChan' is a bounded 'TChan' - a FIFO channel using 'TChan' and -- a transactional variable to limit the number of elements on the channel.-data BTChan a = BTChan {-# UNPACK #-} !Int (TChan a) (TVar  Int)+data BTChan a =+	BTChan  { maxSize	:: {-# UNPACK #-} !Int+		, channel	:: (TChan a)+		, readSize	:: (TVar Int)+		, writeSize	:: (TVar  Int)+	}  -- |An IO version of 'newBTChanIO'.  This should be useful with unsafePerformIO -- in the same manner as 'newTVarIO' and 'newTChanIO' are used. newBTChanIO :: Int -> IO (BTChan a)-newBTChanIO m = BTChan m <$> newTChanIO <*> newTVarIO 0+newBTChanIO m = BTChan m <$> newTChanIO <*> newTVarIO 0 <*> newTVarIO 0  -- |@newBTChan m@ make a new bounded TChan of max size @m@. newBTChan :: Int -> STM (BTChan a)-newBTChan m = BTChan m <$> newTChan <*> newTVar 0+newBTChan m = BTChan m <$> newTChan <*> newTVar 0 <*> newTVar 0  -- |Writes the value to the 'BTChan' or blocks if the channel is full. writeBTChan :: BTChan a -> a -> STM ()-writeBTChan (BTChan mx c szTV) x = do-        sz <- readTVar szTV-        when (sz >= mx) retry-        writeTVar szTV (sz + 1)-        writeTChan c x+writeBTChan (BTChan mx c rdTV wrTV) x = do+        sz <- readTVar wrTV+        if (sz >= mx)+	    then do+		rsz <- readTVar rdTV+		let !newWR = sz + rsz+		when (newWR >= mx) retry+		writeTVar wrTV newWR+		writeTVar rdTV 0+		writeTChan c x+	    else do+        	writeTVar wrTV (sz + 1)+        	writeTChan c x  -- |A non-blocking write that returns 'True' if the write succeeded, 'False' otherwise. tryWriteBTChan :: BTChan a -> a -> STM Bool-tryWriteBTChan (BTChan mx c szTV) x = do-        sz <- readTVar szTV+tryWriteBTChan (BTChan mx c rdTV wrTV) x = do+        sz <- readTVar wrTV         if (sz >= mx)-                then return False-                else do writeTVar szTV (sz + 1)-                        writeTChan c x-                        return True+            then do+                rsz <- readTVar rdTV+                let !newWR = sz + rsz+                if (newWR >= mx)+			then return False+                	else do writeTVar wrTV newWR+		                writeTVar rdTV 0+        		        writeTChan c x+				return True+            else do+                writeTVar wrTV (sz + 1)+                writeTChan c x+		return True  -- |Reads the next value from the 'BTChan' readBTChan :: BTChan a -> STM a-readBTChan (BTChan _ c szTV) = do+readBTChan (BTChan _ c rdTV wrTV) = do         x <- readTChan c-        sz <- readTVar szTV+        sz <- readTVar rdTV         let !sz' = sz - 1-        writeTVar szTV sz'+        writeTVar rdTV sz'         return x  -- |A non-blocking read that returns 'Just a' on success and 'Nothing'@@ -67,20 +89,28 @@  -- Put an element on the front of the queue so it will be the next item read. unGetBTChan :: BTChan a -> a -> STM ()-unGetBTChan (BTChan m c sTV) a = do-        s <- readTVar sTV-        when (s >= m) retry-        let !s' = s+1-        writeTVar sTV s'-        unGetTChan c a+unGetBTChan (BTChan m c rdTV wrTV) a = do+        sz <- readTVar wrTV+        if (sz >= m)+	    then do+                rsz <- readTVar rdTV+                let !newWR = sz + rsz+                when (newWR >= m) retry+                writeTVar wrTV newWR+                writeTVar rdTV 0+                unGetTChan c a+	    else do+		let !s' = sz + 1+        	writeTVar wrTV s'+        	unGetTChan c a  -- |Returns 'True' if the supplied 'TChan' is empty. isEmptyBTChan :: BTChan a -> STM Bool-isEmptyBTChan (BTChan _ c _) = isEmptyTChan c+isEmptyBTChan (BTChan _ c _ _) = isEmptyTChan c  -- |Get the current number of elements in the 'BTChan'. sizeOfBTChan :: BTChan a -> STM Int-sizeOfBTChan (BTChan _ _ sTV) = readTVar sTV+sizeOfBTChan (BTChan _ _ rdTV wrTV) = (+) <$> readTVar wrTV <*> readTVar rdTV  -- |@let c2 = setMaxOfBTChan c1 mx@ Using the same underlying 'TChan', -- set a new maximum number of messages, @mx@.  If the current size@@ -90,8 +120,8 @@ -- maximum while writes to @c1@ will block at the new, making it biased -- against whichever writer has the channel with the smaller bound. setMaxOfBTChan :: BTChan a -> Int -> BTChan a-setMaxOfBTChan (BTChan _ c s) m = BTChan m c s+setMaxOfBTChan (BTChan _ c rd wr) m = BTChan m c rd wr  -- |Get the bound of the `BTChan`. maxOfBTChan :: BTChan a -> Int-maxOfBTChan (BTChan m _ _) = m+maxOfBTChan (BTChan m _ _ _) = m

@@ -1,5 +1,5 @@ Name:                bounded-tchan-Version:             0.2+Version:             0.2.1 Synopsis:            Bounded Transactional channels (queues) Description:         Bounded TChan's, or BTChan's, are a transactional queue with a limit to the number of elements (further calls to @writeBTChan@ or @unGetBTChan@ call STM retry).