Ring buffer in Haskell

RingBuffer.hs

{-# LANGUAGE BangPatterns #-}

{-
    Scenario / preconditions for the usefulness of this ring buffer:

    - mutable data structure
    - elements of the same size (here: ByteString, extending to values of class Storable should be trivial)
    - each element is denoted by a continuous Int id

    - main benefit, esp. for a large number of elements:
        * avoid the garbage collector running over each single value per cycle
        * reduce heap allocation/deallocation steps
-}

module RingBuffer where

import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Marshal.Utils
import Data.Word8           (Word8)
import Data.IORef
import qualified Data.ByteString.Internal as B


data RingBuffer = RingBuffer
        {-# UNPACK #-} !(IORef (Int, Int))
        {-# UNPACK #-} !(ForeignPtr Word8)
        {-# UNPACK #-} !Int
        {-# UNPACK #-} !Int

newRingBuffer :: Int -> Int -> IO RingBuffer
newRingBuffer sz maxO = do
    ix      <- newIORef (1, 0)
    s       <- mallocForeignPtrBytes (sz * maxO)
    return  $ RingBuffer ix s sz maxO

member :: Int -> RingBuffer -> IO Bool
member elemId (RingBuffer ixR _ _ maxO) = do
    (ix, wrap) <- readIORef ixR
    let
        upper = wrap + ix
        lower = max 0 (upper - maxO)
    return $ elemId < upper && elemId >= lower

write :: RingBuffer -> Int -> B.ByteString -> IO ()
write bank@(RingBuffer ixR _ sz _) elemId bs@(B.PS _ _ len)
    | sz /= len = error "RingBuffer.write: element has the wrong size"
    | otherwise = do
        (ix, wrap) <- readIORef ixR
        if wrap + ix /= elemId
            then error $ "RingBuffer.write: element has the wrong id "
            else unsafeWrite bank elemId bs

unsafeWrite :: RingBuffer -> Int -> B.ByteString -> IO ()
unsafeWrite (RingBuffer ixR s sz maxO) elemId (B.PS payload _ _) = do
    ix <- atomicModifyIORef' ixR incIx
    withForeignPtr payload $ \bs ->
        withForeignPtr s $ \bank ->
            copyBytes (bank `plusPtr` (sz * ix)) bs sz
  where
    incIx (ix, wrap) =
        let ix' = ix + 1
        in (if ix' < maxO then (ix', wrap) else (0, elemId + 1), ix)

unsafeRead :: RingBuffer -> Int -> IO B.ByteString
unsafeRead (RingBuffer ixR s sz maxO) elemId =
    B.create sz $ \bs -> do
        (_, wrap) <- readIORef ixR
        let
            ix_ = elemId - wrap
            ix  = if ix_< 0 then ix_ + maxO else ix_
        withForeignPtr s $ \bank ->
            copyBytes bs (bank `plusPtr` (sz * ix)) sz