ring-buffers (empty) → 0.1

raw patch · 8 files changed

+471/−0 lines, 8 filesdep +basedep +contiguousdep +contiguous-checked

Dependencies added: base, contiguous, contiguous-checked, primitive, primitive-checked, semirings

Files

• CHANGELOG.md +12/−0
• README.md +8/−0
• ring-buffers.cabal +76/−0
• src/Prelude.hs +25/−0
• src/RingBuffers/Internal.hs +122/−0
• src/RingBuffers/Lifted.hs +76/−0
• src/RingBuffers/Unboxed.hs +76/−0
• src/RingBuffers/Unlifted.hs +76/−0

@@ -0,0 +1,12 @@+# Changelog++`ring-buffers` uses [PVP Versioning][1].+The changelog is available [on GitHub][2].++0.0.0+=====++* Initially created.++[1]: https://pvp.haskell.org+[2]: https://github.com/chessai/ring-buffers/releases

@@ -0,0 +1,8 @@+# ring-buffers++[![Hackage](https://img.shields.io/hackage/v/ring-buffers.svg)](https://hackage.haskell.org/package/ring-buffers)+[![BSD3 license](https://img.shields.io/badge/license-BSD3-blue.svg)](LICENSE)++This package provides concurrent, mutable ring buffers with atomic updates in GHC Haskell.++It uses the [contiguous](http://hackage.haskell.org/package/contiguous) package to provide multiple array backends found in the [primitive](http://hackage.haskell.org/package/primitive) package.

@@ -0,0 +1,76 @@+cabal-version: 2.2+name:+  ring-buffers+version:+  0.1+synopsis:+  mutable ring buffers with atomic updates in GHC Haskell+description:+  mutable ring buffers with atomic updates in GHC Haskell, using the contiguous api internally to provide multiple array backends+homepage:+  https://github.com/chessai/ring-buffers+bug-reports:+  https://github.com/chessai/ring-buffers/issues+license:+  BSD-3-Clause+author:+  chessai+maintainer:+  chessai1996@gmail.com+copyright:+  2019 chessai+category:+  Data+build-type:+  Simple+extra-doc-files:+    README.md+  , CHANGELOG.md+tested-with:+    GHC == 8.2.2+  , GHC == 8.4.4+  , GHC == 8.6.3++library+  hs-source-dirs:+    src+  exposed-modules:+    RingBuffers.Lifted+    RingBuffers.Unlifted+    RingBuffers.Unboxed+  other-modules:+    Prelude+    RingBuffers.Internal+  build-depends:+    , base >= 4.10.1 && < 4.13+    , semirings >= 0.3+  mixins:+    base hiding (Prelude)+  if flag(checked)+    build-depends:+      , contiguous-checked >= 0.3.2+      , primitive-checked >= 0.6.4.1+  else+    build-depends:+      , contiguous >= 0.3.2+      , primitive >= 0.6.4+  ghc-options:+    -Wall+  default-language:+    Haskell2010++flag checked+  description:+    Check all array indexing. This makes most functions slower, but+    it replaces segfaults with descriptive errors. This should only+    be used for debugging.+  default:+    False+  manual:+    True++source-repository head+  type:+    git+  location:+    https://github.com/chessai/ring-buffers.git

@@ -0,0 +1,25 @@+module Prelude+  ( 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.Concurrent.MVar as P+import Data.Function as P (($))+import Data.Maybe as P (Maybe(..))+import GHC.IO as P (IO)+import Control.Applicative as P (pure)+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.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.Semigroup as P (Semigroup(..))

@@ -0,0 +1,122 @@+{-# language BangPatterns #-}++module RingBuffers.Internal+  ( RingBuffer(..)+  , RingState(..)+  , withRing+  , new+  , clear+  , capacity+  , filledLength+  , latest+  , advance+  , append+  , foldMap+  ) where++import qualified Data.Primitive.Contiguous as Contiguous++data RingBuffer arr a = RingBuffer+  { _ringBufferBuffer :: !(Mutable arr RealWorld a)+  , _ringBufferState :: {-# UNPACK #-} !(MVar RingState)+  }++data RingState = RingState+  { _ringStateFull :: !Bool -- ^ Is the ring buffer full?+  , _ringStateHead :: !Int  -- ^ next entry to be written+  }++ringState0 :: RingState+ringState0 = RingState False 0+{-# inline ringState0 #-}++withRing :: (Contiguous arr, Element arr a)+  => 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+{-# inline withRing #-}++new :: (Contiguous arr, Element arr a)+  => Int+  -> IO (RingBuffer arr a)+new !sz = do+  ba <- Contiguous.new sz+  s0 <- newMVar ringState0+  pure (RingBuffer ba s0)+{-# inlineable new #-}++clear :: (Contiguous arr, Element arr a)+  => RingBuffer arr a+  -> IO ()+clear rb = withRing rb $ \_ _ -> pure (ringState0,())+{-# inline clear #-}++capacity :: (Contiguous arr, Element arr a)+  => RingBuffer arr a+  -> IO Int+capacity (RingBuffer buf _) = Contiguous.sizeMutable buf+{-# inline capacity #-}++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)+{-# inline filledLength #-}++latest :: (Contiguous arr, Element arr a)+  => RingBuffer arr a+  -> Int+  -> IO (Maybe a)+latest rb n = withRing rb $ \ba bs@(RingState _ hd) -> 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)+{-# inline latest #-}++advance :: (Contiguous arr, Element arr a)+  => Int+  -> (Mutable arr RealWorld a -> RingState -> IO (RingState, ()))+advance n = \ba (RingState full pos) -> do+  cap <- Contiguous.sizeMutable ba+  let (a,pos') = (pos + n) `divMod` cap+  pure (RingState (full || a > 0) pos', ())+{-# inline advance #-}++append :: (Contiguous arr, Element arr a)+  => a+  -> RingBuffer arr a+  -> IO ()+append x rb = withRing rb $ \ba bs -> do+  Contiguous.write ba (_ringStateHead bs) x+  advance 1 ba bs+{-# inline append #-}++foldMap :: (Contiguous arr, Element arr a, Monoid b)+  => 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+{-# inline foldMap #-}

@@ -0,0 +1,76 @@+module RingBuffers.Lifted+  ( RingBuffer+  , new+  , clear+  , append+--  ,concat+  , capacity+  , filledLength+  , latest+  , foldMap+  ) where++import qualified RingBuffers.Internal as I++newtype RingBuffer a = RingBuffer (I.RingBuffer Array a)++-- | Return a new ring buffer of the specified size.+new :: ()+  => Int -- ^ capacity of buffer+  -> IO (RingBuffer a)+new sz = fmap coerce (I.new sz)++-- | Reset the buffer to its empty state.+clear :: ()+  => RingBuffer a -- ^ buffer to clear+  -> IO ()+clear rb = I.clear (coerce rb)++-- | Get the current filled length of the ring+filledLength :: ()+  => RingBuffer a+  -> IO Int+filledLength rb = I.filledLength (coerce rb)++-- | Get the maximum number of items the ring can contain+capacity :: ()+  => RingBuffer a+  -> IO Int+capacity rb = I.capacity (coerce rb)++-- | Retrieve the \(n\)th most-recently added item of the ring+latest :: ()+  => RingBuffer a+  -> Int+  -> IO (Maybe a)+latest rb n = I.latest (coerce rb) n++-- | Add an item to the end of the buffer.+append :: ()+  => a+  -> RingBuffer a+  -> IO ()+append x rb = I.append 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+-}

@@ -0,0 +1,76 @@+module RingBuffers.Unboxed+  ( RingBuffer+  , new+  , clear+  , append+--  ,concat+  , capacity+  , filledLength+  , latest+  , foldMap+  ) where++import qualified RingBuffers.Internal as I++newtype RingBuffer a = RingBuffer (I.RingBuffer PrimArray a)++-- | Return a new ring buffer of the specified size.+new :: (Prim a)+  => Int -- ^ capacity of buffer+  -> IO (RingBuffer a)+new sz = fmap coerce (I.new sz)++-- | Reset the buffer to its empty state.+clear :: (Prim a)+  => RingBuffer a -- ^ buffer to clear+  -> IO ()+clear rb = I.clear (coerce rb)++-- | Get the current filled length of the ring+filledLength :: (Prim a)+  => RingBuffer a+  -> IO Int+filledLength rb = I.filledLength (coerce rb)++-- | Get the maximum number of items the ring can contain+capacity :: (Prim a)+  => RingBuffer a+  -> IO Int+capacity rb = I.capacity (coerce rb)++-- | Retrieve the \(n\)th most-recently added item of the ring+latest :: (Prim a)+  => RingBuffer a+  -> Int+  -> IO (Maybe a)+latest rb n = I.latest (coerce rb) n++-- | Add an item to the end of the buffer.+append :: (Prim a)+  => a+  -> RingBuffer a+  -> IO ()+append x rb = I.append 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+-}

@@ -0,0 +1,76 @@+module RingBuffers.Unlifted+  ( RingBuffer+  , new+  , clear+  , append+--  ,concat+  , capacity+  , filledLength+  , latest+  , foldMap+  ) where++import qualified RingBuffers.Internal as I++newtype RingBuffer a = RingBuffer (I.RingBuffer UnliftedArray a)++-- | Return a new ring buffer of the specified size.+new :: (PrimUnlifted a)+  => Int -- ^ capacity of buffer+  -> IO (RingBuffer a)+new sz = fmap coerce (I.new sz)++-- | Reset the buffer to its empty state.+clear :: (PrimUnlifted a)+  => RingBuffer a -- ^ buffer to clear+  -> IO ()+clear rb = I.clear (coerce rb)++-- | Get the current filled length of the ring+filledLength :: (PrimUnlifted a)+  => RingBuffer a+  -> IO Int+filledLength rb = I.filledLength (coerce rb)++-- | Get the maximum number of items the ring can contain+capacity :: (PrimUnlifted a)+  => RingBuffer a+  -> IO Int+capacity rb = I.capacity (coerce rb)++-- | Retrieve the \(n\)th most-recently added item of the ring+latest :: (PrimUnlifted a)+  => RingBuffer a+  -> Int+  -> IO (Maybe a)+latest rb n = I.latest (coerce rb) n++-- | Add an item to the end of the buffer.+append :: (PrimUnlifted a)+  => a+  -> RingBuffer a+  -> IO ()+append x rb = I.append 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+-}