do not close queue state when queue is opened for writing

This commit is contained in:
Evgeny Poberezkin
2025-02-16 20:41:11 +00:00
parent 4a3f01ff9c
commit a7a4e278e0
7 changed files with 154 additions and 55 deletions
+3 -3
View File
@@ -89,8 +89,8 @@ instance MsgStoreClass STMMsgStore where
queueRec' = queueRec
{-# INLINE queueRec' #-}
getMsgQueue :: STMMsgStore -> STMQueue -> STM STMMsgQueue
getMsgQueue _ STMQueue {msgQueue_} = readTVar msgQueue_ >>= maybe newQ pure
getMsgQueue :: STMMsgStore -> STMQueue -> Bool -> STM STMMsgQueue
getMsgQueue _ STMQueue {msgQueue_} _ = readTVar msgQueue_ >>= maybe newQ pure
where
newQ = do
msgQueue <- newTQueue
@@ -131,7 +131,7 @@ instance MsgStoreClass STMMsgStore where
writeMsg :: STMMsgStore -> STMQueue -> Bool -> Message -> ExceptT ErrorType IO (Maybe (Message, Bool))
writeMsg ms q' _logState msg = liftIO $ atomically $ do
STMMsgQueue {msgQueue = q, canWrite, size} <- getMsgQueue ms q'
STMMsgQueue {msgQueue = q, canWrite, size} <- getMsgQueue ms q' True
canWrt <- readTVar canWrite
empty <- isEmptyTQueue q
if canWrt || empty