Add flushTQueue, flushTBQueue
authorMitchell Rosen <mitchellwrosen@gmail.com>
Mon, 20 Nov 2017 21:53:09 +0000 (16:53 -0500)
committerHerbert Valerio Riedel <hvr@gnu.org>
Wed, 27 Dec 2017 20:14:42 +0000 (21:14 +0100)
Control/Concurrent/STM/TBQueue.hs
Control/Concurrent/STM/TQueue.hs
changelog.md

index 381ac28..aae2699 100644 (file)
@@ -34,6 +34,7 @@ module Control.Concurrent.STM.TBQueue (
         newTBQueueIO,
         readTBQueue,
         tryReadTBQueue,
+        flushTBQueue,
         peekTBQueue,
         tryPeekTBQueue,
         writeTBQueue,
@@ -137,6 +138,22 @@ readTBQueue (TBQueue rsize read _wsize write) = do
 tryReadTBQueue :: TBQueue a -> STM (Maybe a)
 tryReadTBQueue c = fmap Just (readTBQueue c) `orElse` return Nothing
 
+-- | Efficiently read the entire contents of a 'TBQueue' into a list. This
+-- function never retries.
+--
+-- @since TBD
+flushTBQueue :: TBQueue a -> STM [a]
+flushTBQueue (TBQueue rsize read wsize write) = do
+  xs <- readTVar read
+  ys <- readTVar write
+  r <- readTVar rsize
+  w <- readTVar wsize
+  writeTVar read []
+  writeTVar write []
+  writeTVar rsize 0
+  writeTVar wsize (r + w)
+  return (xs ++ reverse ys)
+
 -- | Get the next value from the @TBQueue@ without removing it,
 -- retrying if the channel is empty.
 peekTBQueue :: TBQueue a -> STM a
index 23afb4d..3930eef 100644 (file)
@@ -38,6 +38,7 @@ module Control.Concurrent.STM.TQueue (
         newTQueueIO,
         readTQueue,
         tryReadTQueue,
+        flushTQueue,
         peekTQueue,
         tryPeekTQueue,
         writeTQueue,
@@ -106,6 +107,18 @@ readTQueue (TQueue read write) = do
 tryReadTQueue :: TQueue a -> STM (Maybe a)
 tryReadTQueue c = fmap Just (readTQueue c) `orElse` return Nothing
 
+-- | Efficiently read the entire contents of a 'TQueue' into a list. This
+-- function never retries.
+--
+-- @since TBD
+flushTQueue :: TQueue a -> STM [a]
+flushTQueue (TQueue read write) = do
+  xs <- readTVar read
+  ys <- readTVar write
+  writeTVar read []
+  writeTVar write []
+  return (xs ++ reverse ys)
+
 -- | Get the next value from the @TQueue@ without removing it,
 -- retrying if the channel is empty.
 peekTQueue :: TQueue a -> STM a
index a08e2c5..2dffbd8 100644 (file)
@@ -1,5 +1,11 @@
 # Changelog for [`stm` package](http://hackage.haskell.org/package/stm)
 
+## TBD
+
+  * Add `flushTQueue` to `Control.Concurrent.STM.TQueue`
+
+  * Add `flushTBQueue` to `Control.Concurrent.STM.TBQueue`
+
 ## 2.4.4.1  *Dec 2015*
 
   * Add support for `base-4.9.0.0`