[commit: packages/stm] master: Implement isFullTBQueue (7dddeef)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/stm

On branch  : master
Link       : http://git.haskell.org/?p=packages/stm.git;a=commit;h=7dddeef8380258049e88680b666d38c91091e8f4

>---------------------------------------------------------------

commit 7dddeef8380258049e88680b666d38c91091e8f4
Author: Austin Seipp <aseipp at pobox.com>
Date:   Fri Sep 6 19:28:54 2013 -0500

    Implement isFullTBQueue
    
    This was proposed on the libraries@ mailing list by Merijn with no
    objections.
    
    Authored-by: Merijn Verstraaten <merijn at inconsistent.nl>
    Signed-off-by: Austin Seipp <aseipp at pobox.com>


>---------------------------------------------------------------

7dddeef8380258049e88680b666d38c91091e8f4
 Control/Concurrent/STM/TBQueue.hs |   13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/Control/Concurrent/STM/TBQueue.hs b/Control/Concurrent/STM/TBQueue.hs
index 82b46b3..028fd57 100644
--- a/Control/Concurrent/STM/TBQueue.hs
+++ b/Control/Concurrent/STM/TBQueue.hs
@@ -38,6 +38,7 @@ module Control.Concurrent.STM.TBQueue (
 	writeTBQueue,
         unGetTBQueue,
         isEmptyTBQueue,
+        isFullTBQueue,
   ) where
 
 import Data.Typeable
@@ -177,3 +178,15 @@ isEmptyTBQueue (TBQueue _rsize read _wsize write) = do
              case ys of
                [] -> return True
                _  -> return False
+
+-- |Returns 'True' if the supplied 'TBQueue' is full.
+isFullTBQueue :: TBQueue a -> STM Bool
+isFullTBQueue (TBQueue rsize _read wsize _write) = do
+  w <- readTVar wsize
+  if (w > 0)
+     then return False
+     else do
+         r <- readTVar rsize
+         if (r > 0)
+            then return False
+            else return True