packages feed

concurrent-utilities 0.1.0.0 → 0.2.0.0

raw patch · 3 files changed

+25/−6 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

+ Control.Concurrent.Datastructures.BlockingConcurrentQueue: instance GHC.Show.Show (Control.Concurrent.Datastructures.BlockingConcurrentQueue.BlockingConcurrentQueue a)
+ Control.Concurrent.ExceptionCollection: hasExceptions :: ExceptionCollection e -> IO Bool

Files

concurrent-utilities.cabal view
@@ -6,7 +6,7 @@ -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.1.0.0
+version:             0.2.0.0
 synopsis:            More utilities and broad-used datastructures for concurrency.
 description:         More utilities and broad-used datastructures for concurrency.
 homepage:            -
src/Control/Concurrent/Datastructures/BlockingConcurrentQueue.hs view
@@ -8,6 +8,9 @@ data BlockingConcurrentQueue a = BlockingConcurrentQueue { queue :: MVar [a]
                                                          , threadWaitQueue :: ThreadWaitQueue -- Used to signal when to try again if the queue was empty and we wanted to take one
                                                          }
+
+instance Show (BlockingConcurrentQueue a) where
+    show _ = "BlockingConcurrentQueue"
                                  
 
 showBlockingConcurrentQueue :: (Show a) => BlockingConcurrentQueue a -> IO [Char]
@@ -59,9 +62,16 @@ takeAllFromBlockingConcurrentQueue :: BlockingConcurrentQueue a -> IO [a]
 takeAllFromBlockingConcurrentQueue blockingConcurrentQueue
     = do
-        els <- takeMVar (queue blockingConcurrentQueue)
-        putMVar (queue blockingConcurrentQueue) []
-        return els
+        oldQueue <- takeMVar (queue blockingConcurrentQueue)
+        case oldQueue of
+            []       -> do
+                            queueTicket <- getQueueTicket (threadWaitQueue blockingConcurrentQueue)
+                            putMVar (queue blockingConcurrentQueue) []
+                            enterWaitQueueWithTicket queueTicket
+                            takeAllFromBlockingConcurrentQueue blockingConcurrentQueue
+            (el:els) -> do
+                            putMVar (queue blockingConcurrentQueue) []
+                            return (el:els)
         
     
 readAllFromBlockingConcurrentQueue :: BlockingConcurrentQueue a -> IO [a]
src/Control/Concurrent/ExceptionCollection.hs view
@@ -4,6 +4,7 @@     , logException
     , readExceptions
     , collectExceptions
+    , hasExceptions
     ) where
 
 import Control.Concurrent.MVar
@@ -25,8 +26,16 @@     = do
         raisedExceptions <- takeMVar exceptionsM
         putMVar exceptionsM (raisedExceptions ++ [e])
-        
-        
+
+
+hasExceptions :: ExceptionCollection e
+              -> IO Bool
+hasExceptions (ExceptionCollection exceptionsM)
+    = do
+        raisedExceptions <- readMVar exceptionsM
+        return (not $ null raisedExceptions)
+
+
 readExceptions :: ExceptionCollection e
                -> IO [e]
 readExceptions (ExceptionCollection exceptionsM)