From 59835df4658d580803da31441f29d243729b040e Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 23 Apr 2022 13:28:18 +0100
Subject: [PATCH 1/3] Add snapshotTBQueue

---
 Control/Concurrent/STM/TBQueue.hs | 9 +++++++++
 testsuite/src/Issue9.hs           | 3 +++
 2 files changed, 12 insertions(+)

diff --git a/Control/Concurrent/STM/TBQueue.hs b/Control/Concurrent/STM/TBQueue.hs
index e38a2a2..23b2756 100644
--- a/Control/Concurrent/STM/TBQueue.hs
+++ b/Control/Concurrent/STM/TBQueue.hs
@@ -35,6 +35,7 @@ module Control.Concurrent.STM.TBQueue (
         newTBQueueIO,
         readTBQueue,
         tryReadTBQueue,
+        snapshotTBQueue,
         flushTBQueue,
         peekTBQueue,
         tryPeekTBQueue,
@@ -146,6 +147,14 @@ readTBQueue (TBQueue rsize read _wsize write _size) = 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 without changing queue contents.
+-- This function never retries.
+snapshotTBQueue :: TBQueue a -> STM [a]
+snapshotTBQueue (TBQueue _ read _ write _) = do
+  xs <- readTVar read
+  ys <- readTVar write
+  return $ if null xs && null ys then [] else xs ++ reverse ys
+
 -- | Efficiently read the entire contents of a 'TBQueue' into a list. This
 -- function never retries.
 --
diff --git a/testsuite/src/Issue9.hs b/testsuite/src/Issue9.hs
index 88c0036..ef92113 100644
--- a/testsuite/src/Issue9.hs
+++ b/testsuite/src/Issue9.hs
@@ -24,6 +24,9 @@ main = do
   -- Read 1
   1 <- atomically (readTBQueue queue)
 
+  -- Snapshot [2..5]
+  [2,3,4,5] <- atomically (snapshotTBQueue queue)
+
   -- Flush [2..5]
   [2,3,4,5] <- atomically (flushTBQueue queue)
 

From cb2b880cf6579518aa8eadccbe9a747280273192 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 15 Jul 2023 09:46:54 +0100
Subject: [PATCH 2/3] remove condition, add snapshotTQueue

---
 Control/Concurrent/STM/TBQueue.hs | 2 +-
 Control/Concurrent/STM/TQueue.hs  | 9 +++++++++
 testsuite/src/Issue17.hs          | 3 +++
 3 files changed, 13 insertions(+), 1 deletion(-)

diff --git a/Control/Concurrent/STM/TBQueue.hs b/Control/Concurrent/STM/TBQueue.hs
index 23b2756..5b75449 100644
--- a/Control/Concurrent/STM/TBQueue.hs
+++ b/Control/Concurrent/STM/TBQueue.hs
@@ -153,7 +153,7 @@ snapshotTBQueue :: TBQueue a -> STM [a]
 snapshotTBQueue (TBQueue _ read _ write _) = do
   xs <- readTVar read
   ys <- readTVar write
-  return $ if null xs && null ys then [] else xs ++ reverse ys
+  return $ xs ++ reverse ys
 
 -- | Efficiently read the entire contents of a 'TBQueue' into a list. This
 -- function never retries.
diff --git a/Control/Concurrent/STM/TQueue.hs b/Control/Concurrent/STM/TQueue.hs
index 720cfa7..679a706 100644
--- a/Control/Concurrent/STM/TQueue.hs
+++ b/Control/Concurrent/STM/TQueue.hs
@@ -39,6 +39,7 @@ module Control.Concurrent.STM.TQueue (
         newTQueueIO,
         readTQueue,
         tryReadTQueue,
+        snapshotTQueue,
         flushTQueue,
         peekTQueue,
         tryPeekTQueue,
@@ -108,6 +109,14 @@ 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 without changing queue contents.
+-- This function never retries.
+snapshotTQueue :: TQueue a -> STM [a]
+snapshotTQueue (TQueue read write) = do
+  xs <- readTVar read
+  ys <- readTVar write
+  return (xs ++ reverse ys)
+
 -- | Efficiently read the entire contents of a 'TQueue' into a list. This
 -- function never retries.
 --
diff --git a/testsuite/src/Issue17.hs b/testsuite/src/Issue17.hs
index 06b72f0..f04f9b7 100644
--- a/testsuite/src/Issue17.hs
+++ b/testsuite/src/Issue17.hs
@@ -63,6 +63,9 @@ assertEmptyTBQueue queue = do
   atomically (tryPeekTBQueue queue) >>=
     assertEqual "Expected empty: tryPeekTBQueue should return Nothing" Nothing
 
+  atomically (snapshotTBQueue queue) >>=
+    assertEqual "Expected empty: snapshotTBQueue should return []" []
+
   atomically (flushTBQueue queue) >>=
     assertEqual "Expected empty: flushTBQueue should return []" []
 

From 828e26d1d5094c49c6405d8cd83516f5f6a81b90 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Sat, 15 Jul 2023 09:49:08 +0100
Subject: [PATCH 3/3] remove $

---
 Control/Concurrent/STM/TBQueue.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Control/Concurrent/STM/TBQueue.hs b/Control/Concurrent/STM/TBQueue.hs
index 5b75449..c2948ea 100644
--- a/Control/Concurrent/STM/TBQueue.hs
+++ b/Control/Concurrent/STM/TBQueue.hs
@@ -153,7 +153,7 @@ snapshotTBQueue :: TBQueue a -> STM [a]
 snapshotTBQueue (TBQueue _ read _ write _) = do
   xs <- readTVar read
   ys <- readTVar write
-  return $ xs ++ reverse ys
+  return (xs ++ reverse ys)
 
 -- | Efficiently read the entire contents of a 'TBQueue' into a list. This
 -- function never retries.