ring-buffers 0.1.0.2 → 0.1.1
raw patch · 10 files changed
+273/−79 lines, 10 filesdep +HUnitdep +QuickCheckdep +primitive-unlifteddep ~basedep ~primitivedep ~primitive-checked
Dependencies added: HUnit, QuickCheck, primitive-unlifted, ring-buffers
Dependency ranges changed: base, primitive, primitive-checked
Files
- CHANGELOG.md +9/−0
- README.md +1/−0
- ring-buffers.cabal +38/−6
- src/Prelude.hs +15/−13
- src/RingBuffers/Internal.hs +42/−12
- src/RingBuffers/Lifted.hs +30/−16
- src/RingBuffers/Unboxed.hs +30/−16
- src/RingBuffers/Unlifted.hs +30/−16
- test/Properties.hs +25/−0
- test/Unit.hs +53/−0
CHANGELOG.md view
@@ -3,6 +3,15 @@ `ring-buffers` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +0.1.1+=====+* Fix builds with newer primitive.+* Add `extend` function+* Add `unsafeLatest` function+* Add `toList` function+* Add minimal test suite+* Change Internal.withRing to use exception-safe modifyMVar+ 0.0.0 =====
README.md view
@@ -2,6 +2,7 @@ [](https://hackage.haskell.org/package/ring-buffers) [](LICENSE)+[](https://travis-ci.org/chessai/ring-buffers) This package provides concurrent, mutable ring buffers with atomic updates in GHC Haskell.
ring-buffers.cabal view
@@ -2,7 +2,7 @@ name: ring-buffers version:- 0.1.0.2+ 0.1.1 synopsis: mutable ring buffers with atomic updates in GHC Haskell description:@@ -27,9 +27,10 @@ README.md , CHANGELOG.md tested-with:- GHC == 8.2.2- , GHC == 8.4.4- , GHC == 8.6.3+ GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.3+ , GHC == 8.10.1 library hs-source-dirs:@@ -44,16 +45,17 @@ build-depends: , base >= 4.10.1 && < 5 , semirings >= 0.3+ , primitive-unlifted >= 0.1 && < 0.2 mixins: base hiding (Prelude) if flag(checked) build-depends: , contiguous-checked >= 0.3.2- , primitive-checked >= 0.6.4.1+ , primitive-checked >= 0.7.0.0 else build-depends: , contiguous >= 0.3.2- , primitive >= 0.6.4+ , primitive >= 0.7.0.0 ghc-options: -Wall -O2@@ -69,6 +71,36 @@ False manual: True++test-suite properties+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ test+ main-is:+ Properties.hs+ build-depends:+ , QuickCheck+ , base+ , primitive+ , ring-buffers+ default-language:+ Haskell2010++test-suite unit+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ test+ main-is:+ Unit.hs+ build-depends:+ , HUnit+ , base+ , primitive+ , ring-buffers+ default-language:+ Haskell2010 source-repository head type:
src/Prelude.hs view
@@ -2,24 +2,26 @@ ( module P ) where -import Data.Semiring as P (Semiring(..), (+),(*), Ring(..), (-))-import Data.Primitive.Contiguous as P (Contiguous(Mutable,Element))-import Data.Int as P (Int)-import Data.Bool as P (Bool(..), (&&), (||))+import Control.Applicative as P (pure) import Control.Concurrent.MVar as P+import Control.Monad as P ((=<<), when, forM, mapM)+import Control.Monad.Primitive as P (PrimMonad(..))+import Data.Bool as P (Bool(..), (&&), (||))+import Data.Coerce as P (coerce) import Data.Function as P (($))+import Data.Functor as P (fmap, (<$>))+import Data.Int as P (Int) import Data.Maybe as P (Maybe(..))-import GHC.IO as P (IO)-import Control.Applicative as P (pure)+import Data.Monoid as P (Monoid(..)) import Data.Ord as P (Ord(..))-import GHC.Real as P (divMod,mod)-import GHC.Exts as P (RealWorld) import Data.Primitive.Array as P (Array,MutableArray)-import Data.Primitive.UnliftedArray as P (UnliftedArray,MutableUnliftedArray, PrimUnlifted)+import Data.Primitive.Contiguous as P (Contiguous(Mutable,Element)) import Data.Primitive.PrimArray as P (PrimArray,MutablePrimArray) import Data.Primitive.Types as P (Prim(..))-import Data.Coerce as P (coerce)-import Data.Functor as P (fmap)-import Control.Monad.Primitive as P (PrimMonad(..))-import Data.Monoid as P (Monoid(..))+import Data.Primitive.Unlifted.Array as P (UnliftedArray, MutableUnliftedArray)+import Data.Primitive.Unlifted.Class as P (PrimUnlifted) import Data.Semigroup as P (Semigroup(..))+import Data.Semiring as P (Semiring(..), (+),(*), Ring(..), (-))+import GHC.Exts as P (RealWorld)+import GHC.IO as P (IO)+import GHC.Real as P (divMod,mod)
src/RingBuffers/Internal.hs view
@@ -1,4 +1,6 @@ {-# language BangPatterns #-}+{-# language TupleSections #-}+{-# language TypeFamilies #-} module RingBuffers.Internal ( RingBuffer(..)@@ -9,9 +11,12 @@ , capacity , filledLength , latest+ , unsafeLatest , advance+ , extend , append , foldMap+ , toList ) where import qualified Data.Primitive.Contiguous as Contiguous@@ -34,11 +39,7 @@ => RingBuffer arr a -> (Mutable arr RealWorld a -> RingState -> IO (RingState, r)) -> IO r-withRing (RingBuffer ba bs) f = do- s <- takeMVar bs- (s',r) <- f ba s- putMVar bs s'- pure r+withRing (RingBuffer ba bs) f = modifyMVar bs (f ba) {-# inline withRing #-} new :: (Contiguous arr, Element arr a)@@ -76,17 +77,23 @@ => RingBuffer arr a -> Int -> IO (Maybe a)-latest rb n = withRing rb $ \ba bs@(RingState _ hd) -> do+latest rb n = do len <- filledLength rb if n >= len- then pure (bs, Nothing)- else do- cap <- capacity rb- let idx = (hd - n - 1) `mod` cap- v <- Contiguous.read ba idx- pure (bs, Just v)+ then pure Nothing+ else Just <$> unsafeLatest rb n {-# inline latest #-} +unsafeLatest :: (Contiguous arr, Element arr a)+ => RingBuffer arr a+ -> Int+ -> IO a+unsafeLatest rb n = do+ cap <- capacity rb+ withRing rb $ \ba bs@(RingState _ hd) -> do+ let idx = (hd - n - 1) `mod` cap+ (bs,) <$> Contiguous.read ba idx+ advance :: (Contiguous arr, Element arr a) => Int -> (Mutable arr RealWorld a -> RingState -> IO (RingState, ()))@@ -105,6 +112,22 @@ advance 1 ba bs {-# inline append #-} +extend :: (Contiguous arr, Element arr a)+ => arr a+ -> RingBuffer arr a+ -> IO ()+extend xs rb = withRing rb $ \ba bs -> do+ cap <- capacity rb+ let extensionLength = min (Contiguous.size xs) cap+ let currentHead = _ringStateHead bs+ let go !ix = when (ix < extensionLength) $ do+ atIx <- Contiguous.indexM xs ix+ Contiguous.write ba (currentHead + ix) atIx+ go (ix + 1)+ go 0+ advance extensionLength ba bs+{-# inlineable extend #-}+ foldMap :: (Contiguous arr, Element arr a, Monoid b) => RingBuffer arr a -> (a -> IO b)@@ -120,3 +143,10 @@ pure (bs, acc) go 0 mempty {-# inline foldMap #-}++toList :: (Contiguous arr, Element arr a)+ => RingBuffer arr a+ -> IO [a]+toList rb = do+ len <- filledLength rb+ mapM (unsafeLatest rb) [0..len-1]
src/RingBuffers/Lifted.hs view
@@ -3,11 +3,13 @@ , new , clear , append--- ,concat+ , extend , capacity , filledLength , latest+ , unsafeLatest , foldMap+ , toList ) where import qualified RingBuffers.Internal as I@@ -46,6 +48,16 @@ -> IO (Maybe a) latest rb n = I.latest (coerce rb) n +-- | Retrieve the \(n\)th most-recently added item of the ring+--+-- /Note/: This function may exhibit undefined behaviour if+-- the index is out-of-bounds or uninitialised.+unsafeLatest :: ()+ => RingBuffer a+ -> Int+ -> IO a+unsafeLatest rb n = I.unsafeLatest (coerce rb) n+ -- | Add an item to the end of the buffer. append :: () => a@@ -53,25 +65,27 @@ -> IO () append x rb = I.append x (coerce rb) +-- | Write multiple items to the end of the ring.+--+-- Ignores any elements of the input array whose indices+-- are higher than the length of the ring buffer.+extend :: ()+ => Array a+ -> RingBuffer a+ -> IO ()+extend x rb = I.extend x (coerce rb)+ -- | Execute the given action with the items of the ring, accumulating its results.--- +-- foldMap :: (Monoid b) => RingBuffer a -> (a -> IO b) -> IO b foldMap rb action = I.foldMap (coerce rb) action -{---- | Operate atomically on a buffer.-withRing :: ()- => RingBuffer a -- ^ buffer to operate on- -> (MutableArray RealWorld a -> RingState -> IO (RingState, r)) -- ^ function that takes a buffer, a ring state, and returns a new ring state with a value.- -> IO r-withRing rb f = I.withRing (coerce rb) f---- | Advance the ring buffer's state by the given number of elements-advance :: ()- => Int- -> (MutableArray RealWorld a -> RingState -> IO (RingState, ()))-advance n = I.advance n--}+-- | Convert the entire contents of the ring into a list,+-- with the most recently added element at the head.+toList :: ()+ => RingBuffer a+ -> IO [a]+toList rb = I.toList (coerce rb)
src/RingBuffers/Unboxed.hs view
@@ -3,11 +3,13 @@ , new , clear , append--- ,concat+ , extend , capacity , filledLength , latest+ , unsafeLatest , foldMap+ , toList ) where import qualified RingBuffers.Internal as I@@ -46,6 +48,16 @@ -> IO (Maybe a) latest rb n = I.latest (coerce rb) n +-- | Retrieve the \(n\)th most-recently added item of the ring+--+-- /Note/: This function may exhibit undefined behaviour if+-- the index is out-of-bounds or uninitialised.+unsafeLatest :: (Prim a)+ => RingBuffer a+ -> Int+ -> IO a+unsafeLatest rb n = I.unsafeLatest (coerce rb) n+ -- | Add an item to the end of the buffer. append :: (Prim a) => a@@ -53,25 +65,27 @@ -> IO () append x rb = I.append x (coerce rb) +-- | Write multiple items to the end of the ring.+--+-- Ignores any elements of the input array whose indices+-- are higher than the length of the ring buffer.+extend :: (Prim a)+ => PrimArray a+ -> RingBuffer a+ -> IO ()+extend x rb = I.extend x (coerce rb)+ -- | Execute the given action with the items of the ring, accumulating its results.--- +-- foldMap :: (Prim a, Monoid b) => RingBuffer a -> (a -> IO b) -> IO b foldMap rb action = I.foldMap (coerce rb) action -{---- | Operate atomically on a buffer.-withRing :: ()- => RingBuffer a -- ^ buffer to operate on- -> (MutableArray RealWorld a -> RingState -> IO (RingState, r)) -- ^ function that takes a buffer, a ring state, and returns a new ring state with a value.- -> IO r-withRing rb f = I.withRing (coerce rb) f---- | Advance the ring buffer's state by the given number of elements-advance :: ()- => Int- -> (MutableArray RealWorld a -> RingState -> IO (RingState, ()))-advance n = I.advance n--}+-- | Convert the entire contents of the ring into a list,+-- with the most recently added element at the head.+toList :: (Prim a)+ => RingBuffer a+ -> IO [a]+toList rb = I.toList (coerce rb)
src/RingBuffers/Unlifted.hs view
@@ -3,11 +3,13 @@ , new , clear , append--- ,concat+ , extend , capacity , filledLength , latest+ , unsafeLatest , foldMap+ , toList ) where import qualified RingBuffers.Internal as I@@ -46,6 +48,16 @@ -> IO (Maybe a) latest rb n = I.latest (coerce rb) n +-- | Retrieve the \(n\)th most-recently added item of the ring+--+-- /Note/: This function may exhibit undefined behaviour if+-- the index is out-of-bounds or uninitialised.+unsafeLatest :: (PrimUnlifted a)+ => RingBuffer a+ -> Int+ -> IO a+unsafeLatest rb n = I.unsafeLatest (coerce rb) n+ -- | Add an item to the end of the buffer. append :: (PrimUnlifted a) => a@@ -53,25 +65,27 @@ -> IO () append x rb = I.append x (coerce rb) +-- | Write multiple items to the end of the ring.+--+-- Ignores any elements of the input array whose indices+-- are higher than the length of the ring buffer.+extend :: (PrimUnlifted a)+ => UnliftedArray a+ -> RingBuffer a+ -> IO ()+extend x rb = I.extend x (coerce rb)+ -- | Execute the given action with the items of the ring, accumulating its results.--- +-- foldMap :: (PrimUnlifted a, Monoid b) => RingBuffer a -> (a -> IO b) -> IO b foldMap rb action = I.foldMap (coerce rb) action -{---- | Operate atomically on a buffer.-withRing :: ()- => RingBuffer a -- ^ buffer to operate on- -> (MutableArray RealWorld a -> RingState -> IO (RingState, r)) -- ^ function that takes a buffer, a ring state, and returns a new ring state with a value.- -> IO r-withRing rb f = I.withRing (coerce rb) f---- | Advance the ring buffer's state by the given number of elements-advance :: ()- => Int- -> (MutableArray RealWorld a -> RingState -> IO (RingState, ()))-advance n = I.advance n--}+-- | Convert the entire contents of the ring into a list,+-- with the most recently added element at the head.+toList :: (PrimUnlifted a)+ => RingBuffer a+ -> IO [a]+toList rb = I.toList (coerce rb)
+ test/Properties.hs view
@@ -0,0 +1,25 @@+{-# language ScopedTypeVariables #-}+{-# language TypeApplications #-}++module Main (main) where++import Control.Monad (forM_)+import Control.Monad.IO.Class (liftIO)+import Test.QuickCheck+import Test.QuickCheck.Monadic+import RingBuffers.Lifted as R++main :: IO ()+main = do+ quickCheck (testAppend @Int)++testAppend :: forall a. (Eq a, Show a)+ => Positive Int+ -> [a]+ -> Property+testAppend (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
+ test/Unit.hs view
@@ -0,0 +1,53 @@+{-# language TypeApplications #-}++module Main (main) where++import Data.List+import RingBuffers.Lifted as R+import Test.HUnit+import qualified GHC.Exts as Exts++main :: IO Counts+main = do+ runTestTT $ test+ [ testExtend+ ]++testExtend :: Test+testExtend = TestCase $ do+ let len = 40+ rb <- R.new @Int len++ let firstArr = Exts.fromList [0..4]+ let secondArr = Exts.fromList [0..50]+ R.extend firstArr rb+ R.extend secondArr rb++ checkLength rb len++ let expectedItems = []+ ++ Exts.toList firstArr+ ++ take (len - length firstArr) (Exts.toList secondArr)++ items <- R.toList rb+ putStrLn ""+ print items+ --if expectedItems == items+ -- then pure ()+ -- else pure () --fail "lol"+ --checkItems rb expectedItems++-- withItems rb $ \items -> do++checkLength :: RingBuffer a -> Int -> Assertion+checkLength rb expected = do+ len <- R.filledLength rb+ let msg = "Expected length " ++ show expected+ assertEqual msg expected len++checkItems :: (Eq a, Show a) => RingBuffer a -> [a] -> Assertion+checkItems rb expected = do+ items <- R.toList rb+ print items+ let msg = "Expected items " ++ show expected+ assertEqual msg expected [] --items