ring-buffers 0.1.1 → 0.2

raw patch · 6 files changed

+83/−26 lines, 6 files

Files

• ring-buffers.cabal +3/−3
• src/RingBuffers/Internal.hs +30/−19
• src/RingBuffers/Lifted.hs +1/−0
• src/RingBuffers/Unboxed.hs +1/−0
• src/RingBuffers/Unlifted.hs +1/−0
• test/Properties.hs +47/−4

@@ -2,7 +2,7 @@ name:   ring-buffers version:-  0.1.1+  0.2 synopsis:   mutable ring buffers with atomic updates in GHC Haskell description:@@ -29,8 +29,8 @@ tested-with:     GHC == 8.4.4   , GHC == 8.6.5-  , GHC == 8.8.3-  , GHC == 8.10.1+  , GHC == 8.8.4+  , GHC == 8.10.2  library   hs-source-dirs:

@@ -66,11 +66,13 @@ filledLength :: (Contiguous arr, Element arr a)   => RingBuffer arr a   -> IO Int-filledLength rb = withRing rb $ \_ rs@(RingState full pos) -> if full-  then do-    cap <- capacity rb-    pure (rs,cap)-  else pure (rs,pos)+filledLength rb = do+  withRing rb $ \_ rs@(RingState full pos) ->+    if full+      then do+        cap <- capacity rb+        pure (rs,cap)+      else pure (rs,pos) {-# inline filledLength #-}  latest :: (Contiguous arr, Element arr a)@@ -78,10 +80,16 @@   -> Int   -> IO (Maybe a) latest rb n = do-  len <- filledLength rb-  if n >= len-    then pure Nothing-    else Just <$> unsafeLatest rb n+  withRing rb $ \ra rs@(RingState full pos) -> do+    cap <- capacity rb+    let len = if full then cap else pos+    if n >= len+      then do+        pure (rs, Nothing)+      else do+        let ix = (pos - n - 1) `mod` cap+        a <- Contiguous.read ra ix+        pure $ (rs, Just a) {-# inline latest #-}  unsafeLatest :: (Contiguous arr, Element arr a)@@ -132,16 +140,19 @@   => RingBuffer arr a   -> (a -> IO b)   -> IO b-foldMap rb action = withRing rb $ \ba bs -> do-  n <- filledLength rb-  let go !ix !acc = if ix < n-        then do-          v <- Contiguous.read ba ix-          m <- action v-          go (ix + 1) (acc <> m)-        else-          pure (bs, acc)-  go 0 mempty+foldMap rb action = do+  withRing rb $ \ba bs@(RingState full pos) -> do+    n <- do+      cap <- capacity rb+      pure $ if full then cap else pos+    let go !ix !acc = if ix < n+          then do+            v <- Contiguous.read ba ix+            m <- action v+            go (ix + 1) (acc <> m)+          else+            pure (bs, acc)+    go 0 mempty {-# inline foldMap #-}  toList :: (Contiguous arr, Element arr a)

@@ -1,3 +1,4 @@+-- | A concurrent, mutable ring buffer that supports atomic updates. This module supports buffers containing all lifted types. If you are using a buffer which contains some unboxable or unliftable type, consider using 'RingBuffers.Unboxed' or 'RingBuffers.Unlifted'. module RingBuffers.Lifted   ( RingBuffer   , new

@@ -1,3 +1,4 @@+-- | A concurrent, mutable ring buffer that supports atomic updates. This module is most efficient on buffers containing unlifted types. module RingBuffers.Unboxed   ( RingBuffer   , new

@@ -1,3 +1,4 @@+-- | A concurrent, mutable ring buffer that supports atomic updates. This module is most efficient on buffers containing unboxed types. module RingBuffers.Unlifted   ( RingBuffer   , new

@@ -1,3 +1,4 @@+{-# language LambdaCase #-} {-# language ScopedTypeVariables #-} {-# language TypeApplications #-} @@ -5,21 +6,63 @@  import Control.Monad (forM_) import Control.Monad.IO.Class (liftIO)+import Data.Monoid (Last(..))+import GHC.Exts (fromList)+import Prelude hiding (foldMap) import Test.QuickCheck import Test.QuickCheck.Monadic-import RingBuffers.Lifted as R+import qualified Data.List as List+import qualified RingBuffers.Lifted as R  main :: IO () main = do-  quickCheck (testAppend @Int)+  quickCheck $ append @Int+  quickCheck $ newIsEmpty+  quickCheck $ latest @Int+  quickCheck $ foldMap @Int -testAppend :: forall a. (Eq a, Show a)+append :: forall a. (Eq a, Show a)   => Positive Int   -> [a]   -> Property-testAppend (Positive cap) xs = monadicIO $ do+append (Positive cap) xs = monadicIO $ do   xs' <- liftIO $ do     rb <- R.new @a cap     forM_ (reverse xs) $ \x -> R.append x rb     R.toList rb   pure $ counterexample (show xs') $ xs' == take cap xs++newIsEmpty :: ()+  => Positive Int+  -> Property+newIsEmpty (Positive cap) = monadicIO $ do+  rb <- liftIO $ R.new @Int cap+  rbCap <- liftIO $ R.capacity rb+  rbLen <- liftIO $ R.filledLength rb+  pure $ rbCap == cap && rbLen == 0++latest :: forall a. (Eq a, Show a)+  => Positive Int+  -> [a]+  -> Property+latest (Positive cap) xs = monadicIO $ do+  rb <- liftIO $ R.new @a cap+  let go = \case+        [] -> do+          pure ()+        (a : as) -> do+          liftIO $ R.append a rb+          l <- liftIO $ R.latest rb 0+          assert (Just a == l)+          go as+  go xs++foldMap :: forall a. (Ord a, Show a)+  => Positive Int+  -> [a]+  -> Property+foldMap (Positive cap) xs = monadicIO $ do+  rb <- liftIO $ R.new @a cap+  liftIO $ R.extend (fromList xs) rb+  m <- liftIO $ R.foldMap rb $ \x -> pure [x]+  pure $ counterexample (show m) $ all (`elem` xs) m