stm-ringbuffer 0.1.0.0 → 0.1.0.1

raw patch · 6 files changed

+119/−24 lines, 6 filesdep ~QuickCheckdep ~randomPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: QuickCheck, random

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−1
• README.md +19/−10
• benchmark/StmBench.hs +18/−1
• src/Control/Concurrent/STM/TRingBuffer.hs +29/−6
• stm-ringbuffer.cabal +7/−5
• test/TestTRingBuffer.hs +41/−1

@@ -1,4 +1,8 @@-# Revision history for stm-queue+# Revision history for stm-ringbuffer++## 0.1.0.1 -- Unreleased++* Add `ringPushFront` and `ringPushBack`  ## 0.1.0.0 -- 2026-04-18 

@@ -3,7 +3,7 @@ ## About This is an implementation of a ring buffer for STM. A wrapper exposing a TBQueue-like interface is provided, offering improved performance compared to the current implementation of TBQueue in the STM package. -This work is similar to https://github.com/haskell/stm/pull/70 . However, this implementation is hopefully correct and supports ringbuffers with size == 0.+This work is similar to https://github.com/haskell/stm/pull/70 , but fixes the implementation of flushing and supports ringbuffers with size == 0.  ## Usage Mixins can be used to quickly replace the standard TBQueue implementation with the one in this library. Add the following fields to your cabal file:@@ -21,9 +21,10 @@  It is recommended to add the following to your cabal.project.local file: ```-tests: True-benchmarks: True-semaphore: True+tests: true+benchmarks: true+semaphore: true+jobs: $ncpus ```  ## Benchmark results@@ -32,17 +33,25 @@ All   concurrent spsc     TBQueue:    OK-      119  ms ± 6.8 ms+      121  ms ± 7.4 ms     RB.TBQueue: OK-      109  ms ± 7.3 ms+      110  ms ± 7.0 ms   concurrent mpmc     TBQueue:    OK-      193  ms ±  14 ms+      194  ms ±  17 ms     RB.TBQueue: OK-      136  ms ± 7.0 ms+      138  ms ± 7.0 ms   burst     TBQueue:    OK-      114  ms ± 7.2 ms+      116  ms ± 7.1 ms     RB.TBQueue: OK-      108  ms ± 6.8 ms+      109  ms ± 7.6 ms+  write/flush+    TBQueue:    OK+      279  μs ±  13 μs+    RB.TBQueue: OK+      263  μs ±  14 μs++(Above results for M2 Macbook Pro with 16GB RAM and macOS 15.7.2) ```+

@@ -7,7 +7,7 @@ module StmBench (stmBench) where  import Control.Concurrent.STM-    ( atomically, newTBQueueIO, readTBQueue, writeTBQueue, TBQueue )+    ( atomically, flushTBQueue, newTBQueueIO, readTBQueue, writeTBQueue, TBQueue ) import Control.Concurrent.STM.TRingBuffer.TBQueue qualified as RB import Control.Concurrent.Async ( async, wait ) import Control.Monad ( replicateM, replicateM_ )@@ -31,24 +31,32 @@         [ bench "TBQueue" $ whnfAppIO (burst @TBQueue 1000) n         , bench "RB.TBQueue" $ whnfAppIO (burst @RB.TBQueue 1000) n         ]+    , bgroup "write/flush"+        [ bench "TBQueue" $ whnfAppIO (burst @TBQueue 1000) flushSz+        , bench "RB.TBQueue" $ whnfAppIO (burst @RB.TBQueue 1000) flushSz+        ]     ]   where     n = 2000000+    flushSz = 4096  class Channel c where     newc :: IO (c a)     readc :: c a -> IO a     writec :: c a -> a -> IO ()+    flushc :: c a -> IO [a]  instance Channel TBQueue where     newc = newTBQueueIO 4096     readc c = atomically $ readTBQueue c     writec c x = atomically $ writeTBQueue c x+    flushc c = atomically $ flushTBQueue c  instance Channel RB.TBQueue where     newc = RB.newTBQueueIO 4096     readc c = atomically $ RB.readTBQueue c     writec c x = atomically $ RB.writeTBQueue c x+    flushc c = atomically $ RB.flushTBQueue c  -- concurrent writing and reading with single producer, single consumer concurrentSpsc :: forall c. (Channel c) => Int -> IO ()@@ -75,3 +83,12 @@     replicateM_ k $ do         replicateM_ (n `div` k) $ writec c 1         replicateM_ (n `div` k) $ readc c++-- sequential push and flush+sequentialFlush :: forall c. (Channel c) => Int -> Int -> IO ()+sequentialFlush k n = do+   c :: c Int <- newc+   replicateM_ k $ do+     replicateM_ n $ writec c 1+     flushc c+

@@ -1,3 +1,7 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE InstanceSigs #-}+ -- | -- Module      :  Control.Concurrent.STM.TRingBuffer -- Copyright   :  (c) Greg Baimetov 2026@@ -9,10 +13,6 @@ -- 'TRingBuffer' is an STM ring buffer. The implementation allows for -- simultaneous operations on the front and back of the buffer. -{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE InstanceSigs #-}- module Control.Concurrent.STM.TRingBuffer   ( TRingBuffer,     new,@@ -23,6 +23,8 @@     size,     pushFront,     pushBack,+    ringPushFront,+    ringPushBack,     popFront,     popBack,     peekFront,@@ -43,6 +45,7 @@     writeTVar,   ) import Control.Concurrent.STM.TArray ()+import Control.Monad (void, when) import Data.Array.Base   ( MArray (newArray, unsafeRead, unsafeWrite),   )@@ -100,7 +103,10 @@       b <- readTVar back       pure $ (b + 1 - f) `mod` size --- | Is the ring buffer empty?+-- | Is the ring buffer empty? O(1). May be more efficien than+-- @+-- \\b -> (==0) \<\$\> length b+-- @ isEmpty :: TRingBuffer a -> STM Bool isEmpty MkTRingBuffer {arr, front, size} = testPure size True $ do   ix <- readTVar front@@ -109,7 +115,10 @@     Nothing -> True     Just _ -> False --- | Is the ring buffer full?+-- | Is the ring buffer full? O(1). May be more efficient than+-- @+-- \\b -> (== size b) \<\$\> length b+-- @ isFull :: TRingBuffer a -> STM Bool isFull MkTRingBuffer {arr, front, size} = testPure size True $ do   ix <- decr size <$> readTVar front@@ -139,6 +148,20 @@     Nothing -> do       unsafeWrite arr ix (Just e)       writeTVar back ix++-- | Push an element to the front of the buffer, overwriting the backmost element if the buffer is full. O(1)+ringPushFront :: TRingBuffer a -> a -> STM ()+ringPushFront ring item = do+    full <- isFull ring+    when full . void $ popBack ring+    pushFront ring item++-- | Push an element to the back of the buffer, overwriting the frontmost element if the buffer is full. O(1)+ringPushBack :: TRingBuffer a -> a -> STM ()+ringPushBack ring item = do+    full <- isFull ring+    when full . void $ popFront ring+    pushBack ring item  -- | Pop an element from the front of the buffer. Retry if the buffer is empty. O(1) popFront :: TRingBuffer b -> STM b

@@ -1,14 +1,16 @@ cabal-version:   3.4 name:            stm-ringbuffer category:        Concurrency-version:         0.1.0.0+version:         0.1.0.1 license:         BSD-3-Clause author:          Greg Baimetov maintainer:      Greg Baimetov synopsis:  Ring buffer implementation in STM description:-  This package provides a ring buffer in STM and a wrapper which mimics the interface to TBQueue.+  This package provides a ring buffer in STM and a wrapper which mimics the interface to TBQueue (from STM).+  Compared to TBQueue, this package offers better performance as a bounded queue, especially when used with+  multiple producers and consumers, as well as push, pop, peek and flush operations on both ends.  copyright:       (c) Greg Baimetov 2026 build-type:      Simple@@ -28,7 +30,7 @@  source-repository head   type:git-  location: github.com/Greg-Bm/stm-ringbuffer.git+  location: https://github.com/Greg-Bm/stm-ringbuffer.git  library   hs-source-dirs:     src@@ -61,8 +63,8 @@     , base     , generic-random  >=1.5.0   && <1.6     , hspec           >=2.11.17 && <2.12-    , QuickCheck      >=2.16.0  && <2.17-    , random          >=1.3.1   && <1.4+    , QuickCheck      >=2.15.0  && <2.19+    , random          >=1.2     && <1.4     , stm     , stm-ringbuffer 

@@ -19,7 +19,9 @@       flushFront,       popBack,       peekBack,-      flushBack )+      flushBack,+      ringPushFront,+      ringPushBack ) import Control.Monad     ( Monad((>>), (>>=)), replicateM, replicateM_, forM_ ) import Data.Functor ( (<&>) )@@ -191,3 +193,41 @@       forM_ testSeq (atomically . pushBack buf)       atomically (flushBack buf)       atomically (isEmpty buf) `shouldReturn` True++  describe "ringPushBack" $ do+    it "behaves like pushBack when buffer is not full" $ do+      buf <- newIO 10+      forM_ [1 .. 5] (atomically . ringPushBack buf)+      atomically (flushFront buf) `shouldReturn` [1 .. 5]+    it "keeps the length at size when buffer is full" $ do+      buf <- newIO 3+      forM_ [1 .. 10] (atomically . ringPushBack buf)+      atomically (length buf) `shouldReturn` 3+    it "overwrites the frontmost element when buffer is full" $ do+      buf <- newIO 3+      forM_ [1 .. 10] (atomically . ringPushBack buf)+      atomically (flushFront buf) `shouldReturn` [8, 9, 10]+    it "does not retry when buffer is full" $ do+      buf <- newIO 3+      forM_ [1 .. 3] (atomically . pushBack buf)+      atomically ((ringPushBack buf 4 >> pure True) `orElse` pure False)+        `shouldReturn` True++  describe "ringPushFront" $ do+    it "behaves like pushFront when buffer is not full" $ do+      buf <- newIO 10+      forM_ [1 .. 5] (atomically . ringPushFront buf)+      atomically (flushBack buf) `shouldReturn` [1 .. 5]+    it "keeps the length at size when buffer is full" $ do+      buf <- newIO 3+      forM_ [1 .. 10] (atomically . ringPushFront buf)+      atomically (length buf) `shouldReturn` 3+    it "overwrites the backmost element when buffer is full" $ do+      buf <- newIO 3+      forM_ [1 .. 10] (atomically . ringPushFront buf)+      atomically (flushBack buf) `shouldReturn` [8, 9, 10]+    it "does not retry when buffer is full" $ do+      buf <- newIO 3+      forM_ [1 .. 3] (atomically . pushFront buf)+      atomically ((ringPushFront buf 4 >> pure True) `orElse` pure False)+        `shouldReturn` True