module RingBuffer where

import Control.Monad
import Data.Int
import Data.IORef

data TargetBuffer u = TargetBuffer
    { -- | Called whenever the rBack or rSize changes.  The purpose is so that
      -- some other state, such as an OpenGL vertex buffer object, can remain in
      -- sync.
      syncBuffer :: (Int32 -> [(Int32,Int32)]) -> IO ()
      -- | This updates the data associated with a particular index (usually
      -- rBack).  The update specification /u/ may be a value or a set of
      -- key-value pairs or whatever is most convenient way to instruct the
      -- target representation to update itself.
    , updateBuffer :: Int -> u -> IO ()
    }

data RingBuffer u = RingBuffer
    { rBack        :: IORef Int
    , rSize        :: IORef Int
    , ringCapacity :: Int
    , rBuffer      :: TargetBuffer u
    }

newRing :: Int -> IO (TargetBuffer u) -> IO (RingBuffer u)
newRing sz newBuffer = do
    backRef <- newIORef 0
    sizeRef <- newIORef 0
    b <- newBuffer
    let r = RingBuffer
            { rBack        = backRef
            , rSize        = sizeRef
            , ringCapacity = sz
            , rBuffer      = b
            }
    syncRing r
    return r

ringMask :: RingBuffer u -> IO (Int32 -> [(Int32,Int32)])
ringMask r = do
    size <- fromIntegral <$> readIORef (rSize r)
    back <- fromIntegral <$> readIORef (rBack r)
    let mask 0   = []
        mask cnt
            | cnt==size = [(0,cnt)]
            | otherwise = case cnt + back - size of
                front | front >= cnt -> [(front - cnt,size)]
                      | otherwise    -> [(0,back), (front,cnt - front)]
    return mask

syncRing :: RingBuffer u -> IO ()
syncRing r = do
    mask <- ringMask r
    syncBuffer (rBuffer r) mask

clearRing :: RingBuffer u -> IO ()
clearRing r = do
    writeIORef (rBack r) 0
    writeIORef (rSize r) 0
    syncRing r

pushBack :: RingBuffer u -> u -> IO ()
pushBack r upd = do
    back <- readIORef $ rBack r
    writeIORef (rBack r) (mod (back + 1) (ringCapacity r))
    updateBuffer (rBuffer r) back upd
    sz <- readIORef (rSize r)
    when (sz < ringCapacity r) $ writeIORef (rSize r) (sz + 1)
    syncRing r

updateBack :: RingBuffer u -> u -> IO ()
updateBack r upd = do
    size <- readIORef $ rSize r
    when (size > 0) $ do
        back <- readIORef $ rBack r
        updateBuffer (rBuffer r) (mod (back + ringCapacity r - 1) (ringCapacity r)) upd