-- | This is a thread-safe implementation of a mutable ring-buffer
-- built upon @vector@.

module Data.RingBuffer ( RingBuffer
                       , new
                       , clear
                       , append
                       , concat
                       , capacity
                       , length
                       , latest
                       , toList
                       , withItems
                       ) where

import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import Control.Applicative
import Control.Concurrent
import Control.Monad (when)
import Control.Monad.Catch
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Primitive
import Prelude hiding (length, concat)

-- | A concurrent ring buffer.
data RingBuffer v a
    = RingBuffer { forall (v :: * -> *) a.
RingBuffer v a -> Mutable v (PrimState IO) a
ringBuffer :: !(VG.Mutable v (PrimState IO) a)
                 , forall (v :: * -> *) a. RingBuffer v a -> MVar RingState
ringState  :: !(MVar RingState)
                 }

data RingState = RingState { RingState -> Bool
ringFull :: !Bool -- ^ is the ring full?
                           , RingState -> Int
ringHead :: !Int -- ^ index of next entry to be written
                           }

-- | We use the @Mutable@ vector type to ensure injectiveness
type RingM m vm a = StateT RingState (ReaderT (vm (PrimState IO) a) m)

-- | Atomically perform an action with the ring
withRing :: (VG.Vector v a, MonadIO m, MonadMask m)
         => RingBuffer v a
         -> RingM m (VG.Mutable v) a r
         -> m r
withRing :: forall (v :: * -> *) a (m :: * -> *) r.
(Vector v a, MonadIO m, MonadMask m) =>
RingBuffer v a -> RingM m (Mutable v) a r -> m r
withRing RingBuffer v a
rb RingM m (Mutable v) a r
action = m r -> m r
forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
mask_ (m r -> m r) -> m r -> m r
forall a b. (a -> b) -> a -> b
$ do
    RingState
s <- IO RingState -> m RingState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RingState -> m RingState) -> IO RingState -> m RingState
forall a b. (a -> b) -> a -> b
$ MVar RingState -> IO RingState
forall a. MVar a -> IO a
takeMVar (RingBuffer v a -> MVar RingState
forall (v :: * -> *) a. RingBuffer v a -> MVar RingState
ringState RingBuffer v a
rb)
    (r
r, RingState
s') <- ReaderT (Mutable v RealWorld a) m (r, RingState)
-> Mutable v RealWorld a -> m (r, RingState)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT RingState (ReaderT (Mutable v RealWorld a) m) r
-> RingState -> ReaderT (Mutable v RealWorld a) m (r, RingState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT RingState (ReaderT (Mutable v RealWorld a) m) r
RingM m (Mutable v) a r
action RingState
s) (RingBuffer v a -> Mutable v (PrimState IO) a
forall (v :: * -> *) a.
RingBuffer v a -> Mutable v (PrimState IO) a
ringBuffer RingBuffer v a
rb)
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar RingState -> RingState -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (RingBuffer v a -> MVar RingState
forall (v :: * -> *) a. RingBuffer v a -> MVar RingState
ringState RingBuffer v a
rb) RingState
s'
    r -> m r
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return r
r

advance :: (VGM.MVector v a, MonadIO m) => Int -> RingM m v a ()
advance :: forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
Int -> RingM m v a ()
advance Int
n = do
    RingState Bool
full Int
pos <- StateT RingState (ReaderT (v RealWorld a) m) RingState
forall s (m :: * -> *). MonadState s m => m s
get
    Int
cap <- StateT RingState (ReaderT (v RealWorld a) m) Int
RingM m v a Int
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
capacity'
    let (Int
a, Int
pos') = (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
cap
    RingState -> StateT RingState (ReaderT (v RealWorld a) m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RingState -> StateT RingState (ReaderT (v RealWorld a) m) ())
-> RingState -> StateT RingState (ReaderT (v RealWorld a) m) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> RingState
RingState (Bool
full Bool -> Bool -> Bool
|| Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Int
pos'
{-# INLINEABLE advance #-}

-- | Create a new ring of a given length
--
-- /Note:/ size must be non-zero
new :: (VG.Vector v a) => Int -> IO (RingBuffer v a)
new :: forall (v :: * -> *) a. Vector v a => Int -> IO (RingBuffer v a)
new Int
n = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Data.RingBuffer.new: invalid ring size"
    Mutable v RealWorld a
buffer <- Int -> IO (Mutable v (PrimState IO) a)
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VGM.new Int
n
    MVar RingState
state0 <- RingState -> IO (MVar RingState)
forall a. a -> IO (MVar a)
newMVar (RingState -> IO (MVar RingState))
-> RingState -> IO (MVar RingState)
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> RingState
RingState Bool
False Int
0
    RingBuffer v a -> IO (RingBuffer v a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RingBuffer v a -> IO (RingBuffer v a))
-> RingBuffer v a -> IO (RingBuffer v a)
forall a b. (a -> b) -> a -> b
$ RingBuffer { ringBuffer :: Mutable v (PrimState IO) a
ringBuffer=Mutable v RealWorld a
Mutable v (PrimState IO) a
buffer, ringState :: MVar RingState
ringState=MVar RingState
state0 }

-- | Reset the ringbuffer to its empty state
clear :: VG.Vector v a => RingBuffer v a -> IO ()
clear :: forall (v :: * -> *) a. Vector v a => RingBuffer v a -> IO ()
clear RingBuffer v a
rb = RingBuffer v a -> RingM IO (Mutable v) a () -> IO ()
forall (v :: * -> *) a (m :: * -> *) r.
(Vector v a, MonadIO m, MonadMask m) =>
RingBuffer v a -> RingM m (Mutable v) a r -> m r
withRing RingBuffer v a
rb (RingM IO (Mutable v) a () -> IO ())
-> RingM IO (Mutable v) a () -> IO ()
forall a b. (a -> b) -> a -> b
$ RingState -> RingM IO (Mutable v) a ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (RingState -> RingM IO (Mutable v) a ())
-> RingState -> RingM IO (Mutable v) a ()
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> RingState
RingState Bool
False Int
0

-- | Add an item to the end of the ring
append :: (VG.Vector v a) => a -> RingBuffer v a -> IO ()
append :: forall (v :: * -> *) a. Vector v a => a -> RingBuffer v a -> IO ()
append a
x RingBuffer v a
rb = RingBuffer v a -> RingM IO (Mutable v) a () -> IO ()
forall (v :: * -> *) a (m :: * -> *) r.
(Vector v a, MonadIO m, MonadMask m) =>
RingBuffer v a -> RingM m (Mutable v) a r -> m r
withRing RingBuffer v a
rb (RingM IO (Mutable v) a () -> IO ())
-> RingM IO (Mutable v) a () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    RingState
s <- StateT RingState (ReaderT (Mutable v RealWorld a) IO) RingState
forall s (m :: * -> *). MonadState s m => m s
get
    IO () -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
forall a.
IO a -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ())
-> IO ()
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VGM.unsafeWrite (RingBuffer v a -> Mutable v (PrimState IO) a
forall (v :: * -> *) a.
RingBuffer v a -> Mutable v (PrimState IO) a
ringBuffer RingBuffer v a
rb) (RingState -> Int
ringHead RingState
s) a
x
    Int -> RingM IO (Mutable v) a ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
Int -> RingM m v a ()
advance Int
1
{-# INLINABLE append #-}

-- | Add multiple items to the end of the ring
-- This ignores any items above the length of the ring
concat :: (VG.Vector v a) => v a -> RingBuffer v a -> IO ()
concat :: forall (v :: * -> *) a.
Vector v a =>
v a -> RingBuffer v a -> IO ()
concat v a
xs RingBuffer v a
rb = RingBuffer v a -> RingM IO (Mutable v) a () -> IO ()
forall (v :: * -> *) a (m :: * -> *) r.
(Vector v a, MonadIO m, MonadMask m) =>
RingBuffer v a -> RingM m (Mutable v) a r -> m r
withRing RingBuffer v a
rb (RingM IO (Mutable v) a () -> IO ())
-> RingM IO (Mutable v) a () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Int
cap <- StateT RingState (ReaderT (Mutable v RealWorld a) IO) Int
RingM IO (Mutable v) a Int
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
capacity'
    let takeN :: Int
takeN = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v a
xs) Int
cap
    Mutable v RealWorld a
xs' <- IO (Mutable v RealWorld a)
-> StateT
     RingState
     (ReaderT (Mutable v RealWorld a) IO)
     (Mutable v RealWorld a)
forall a.
IO a -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Mutable v RealWorld a)
 -> StateT
      RingState
      (ReaderT (Mutable v RealWorld a) IO)
      (Mutable v RealWorld a))
-> IO (Mutable v RealWorld a)
-> StateT
     RingState
     (ReaderT (Mutable v RealWorld a) IO)
     (Mutable v RealWorld a)
forall a b. (a -> b) -> a -> b
$ v a -> IO (Mutable v (PrimState IO) a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
VG.unsafeThaw (v a -> IO (Mutable v (PrimState IO) a))
-> v a -> IO (Mutable v (PrimState IO) a)
forall a b. (a -> b) -> a -> b
$ Int -> v a -> v a
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.drop (v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
VG.length v a
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
takeN) v a
xs
    Int
pos <- (RingState -> Int)
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RingState -> Int
ringHead

    let untilWrap :: Int
untilWrap = Int
cap Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos
        src :: Mutable v RealWorld a
src  = Int -> Mutable v RealWorld a -> Mutable v RealWorld a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
VGM.take Int
untilWrap Mutable v RealWorld a
xs'
        dest :: Mutable v RealWorld a
dest = Int -> Mutable v RealWorld a -> Mutable v RealWorld a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
VGM.take (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
takeN Int
untilWrap) (Mutable v RealWorld a -> Mutable v RealWorld a)
-> Mutable v RealWorld a -> Mutable v RealWorld a
forall a b. (a -> b) -> a -> b
$ Int -> Mutable v RealWorld a -> Mutable v RealWorld a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
VGM.drop Int
pos (Mutable v RealWorld a -> Mutable v RealWorld a)
-> Mutable v RealWorld a -> Mutable v RealWorld a
forall a b. (a -> b) -> a -> b
$ RingBuffer v a -> Mutable v (PrimState IO) a
forall (v :: * -> *) a.
RingBuffer v a -> Mutable v (PrimState IO) a
ringBuffer RingBuffer v a
rb
    IO () -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
forall a.
IO a -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ())
-> IO ()
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState IO) a -> Mutable v (PrimState IO) a -> IO ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VGM.copy Mutable v RealWorld a
Mutable v (PrimState IO) a
dest Mutable v RealWorld a
Mutable v (PrimState IO) a
src

    -- did we wrap around?
    Bool
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
takeN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
untilWrap) (StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
 -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ())
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
forall a b. (a -> b) -> a -> b
$ do
        let src' :: Mutable v RealWorld a
src'  = Int -> Mutable v RealWorld a -> Mutable v RealWorld a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
VGM.drop Int
untilWrap Mutable v RealWorld a
xs'
            dest' :: Mutable v RealWorld a
dest' = Int -> Mutable v RealWorld a -> Mutable v RealWorld a
forall (v :: * -> * -> *) a s. MVector v a => Int -> v s a -> v s a
VGM.take (Int
takeN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
untilWrap) (Mutable v RealWorld a -> Mutable v RealWorld a)
-> Mutable v RealWorld a -> Mutable v RealWorld a
forall a b. (a -> b) -> a -> b
$ RingBuffer v a -> Mutable v (PrimState IO) a
forall (v :: * -> *) a.
RingBuffer v a -> Mutable v (PrimState IO) a
ringBuffer RingBuffer v a
rb
        IO () -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
forall a.
IO a -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ())
-> IO ()
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) ()
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState IO) a -> Mutable v (PrimState IO) a -> IO ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(HasCallStack, PrimMonad m, MVector v a) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
VGM.copy Mutable v RealWorld a
Mutable v (PrimState IO) a
dest' Mutable v RealWorld a
Mutable v (PrimState IO) a
src'
    Int -> RingM IO (Mutable v) a ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
Int -> RingM m v a ()
advance Int
takeN
{-# INLINABLE concat #-}

-- | The maximum number of items the ring can contain
capacity :: (VG.Vector v a) => RingBuffer v a -> Int
capacity :: forall (v :: * -> *) a. Vector v a => RingBuffer v a -> Int
capacity RingBuffer v a
rb = Mutable v RealWorld a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.length (RingBuffer v a -> Mutable v (PrimState IO) a
forall (v :: * -> *) a.
RingBuffer v a -> Mutable v (PrimState IO) a
ringBuffer RingBuffer v a
rb)

-- | The maximum number of items the ring can contain
capacity' :: (VGM.MVector v a, MonadIO m) => RingM m v a Int
capacity' :: forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
capacity' = (v RealWorld a -> Int)
-> StateT RingState (ReaderT (v RealWorld a) m) Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks v RealWorld a -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.length

-- | The current filled length of the ring
length' :: (VGM.MVector v a, MonadIO m) => RingM m v a Int
length' :: forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
length' = do
    RingState Bool
full Int
pos <- StateT RingState (ReaderT (v RealWorld a) m) RingState
forall s (m :: * -> *). MonadState s m => m s
get
    if Bool
full
      then StateT RingState (ReaderT (v RealWorld a) m) Int
RingM m v a Int
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
capacity'
      else Int -> StateT RingState (ReaderT (v RealWorld a) m) Int
forall a. a -> StateT RingState (ReaderT (v RealWorld a) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
pos

-- | The current filled length of the ring
length :: (VG.Vector v a) => RingBuffer v a -> IO Int
length :: forall (v :: * -> *) a. Vector v a => RingBuffer v a -> IO Int
length RingBuffer v a
rb = RingBuffer v a -> RingM IO (Mutable v) a Int -> IO Int
forall (v :: * -> *) a (m :: * -> *) r.
(Vector v a, MonadIO m, MonadMask m) =>
RingBuffer v a -> RingM m (Mutable v) a r -> m r
withRing RingBuffer v a
rb RingM IO (Mutable v) a Int
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
length'

-- | Retrieve the \(n\)th most-recently added item of the ring
latest :: (VG.Vector v a) => RingBuffer v a -> Int -> IO (Maybe a)
latest :: forall (v :: * -> *) a.
Vector v a =>
RingBuffer v a -> Int -> IO (Maybe a)
latest RingBuffer v a
rb Int
n = RingBuffer v a -> RingM IO (Mutable v) a (Maybe a) -> IO (Maybe a)
forall (v :: * -> *) a (m :: * -> *) r.
(Vector v a, MonadIO m, MonadMask m) =>
RingBuffer v a -> RingM m (Mutable v) a r -> m r
withRing RingBuffer v a
rb (RingM IO (Mutable v) a (Maybe a) -> IO (Maybe a))
-> RingM IO (Mutable v) a (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
    Int
len <- StateT RingState (ReaderT (Mutable v RealWorld a) IO) Int
RingM IO (Mutable v) a Int
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
length'
    if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
      then Maybe a
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) (Maybe a)
forall a.
a -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
      else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) a
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> RingM IO (Mutable v) a a
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
Int -> RingM m v a a
latest' Int
n

latest' :: (VGM.MVector v a, MonadIO m) => Int -> RingM m v a a
latest' :: forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
Int -> RingM m v a a
latest' Int
n = do
    Int
len <- StateT RingState (ReaderT (v RealWorld a) m) Int
RingM m v a Int
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
length'
    Int
cap <- StateT RingState (ReaderT (v RealWorld a) m) Int
RingM m v a Int
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
capacity'
    Bool
-> StateT RingState (ReaderT (v RealWorld a) m) ()
-> StateT RingState (ReaderT (v RealWorld a) m) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len) (StateT RingState (ReaderT (v RealWorld a) m) ()
 -> StateT RingState (ReaderT (v RealWorld a) m) ())
-> StateT RingState (ReaderT (v RealWorld a) m) ()
-> StateT RingState (ReaderT (v RealWorld a) m) ()
forall a b. (a -> b) -> a -> b
$ String -> StateT RingState (ReaderT (v RealWorld a) m) ()
forall a. HasCallStack => String -> a
error String
"Data.RingBuffer.latest': invalid index"
    RingState Bool
_ Int
hd <- StateT RingState (ReaderT (v RealWorld a) m) RingState
forall s (m :: * -> *). MonadState s m => m s
get
    let idx :: Int
idx = (Int
hd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
cap
    v RealWorld a
buf <- StateT RingState (ReaderT (v RealWorld a) m) (v RealWorld a)
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO a -> StateT RingState (ReaderT (v RealWorld a) m) a
forall a. IO a -> StateT RingState (ReaderT (v RealWorld a) m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> StateT RingState (ReaderT (v RealWorld a) m) a)
-> IO a -> StateT RingState (ReaderT (v RealWorld a) m) a
forall a b. (a -> b) -> a -> b
$ v (PrimState IO) a -> Int -> IO a
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
VGM.unsafeRead v RealWorld a
v (PrimState IO) a
buf Int
idx
{-# INLINABLE latest' #-}

-- | Get the entire contents of the ring, with the most recently added element
-- at the head. Note that this is rather inefficient.
toList :: (VG.Vector v a) => RingBuffer v a -> IO [a]
toList :: forall (v :: * -> *) a. Vector v a => RingBuffer v a -> IO [a]
toList RingBuffer v a
rb = RingBuffer v a -> RingM IO (Mutable v) a [a] -> IO [a]
forall (v :: * -> *) a (m :: * -> *) r.
(Vector v a, MonadIO m, MonadMask m) =>
RingBuffer v a -> RingM m (Mutable v) a r -> m r
withRing RingBuffer v a
rb (RingM IO (Mutable v) a [a] -> IO [a])
-> RingM IO (Mutable v) a [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ do
    Int
len <- StateT RingState (ReaderT (Mutable v RealWorld a) IO) Int
RingM IO (Mutable v) a Int
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
length'
    (Int -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) a)
-> [Int]
-> StateT RingState (ReaderT (Mutable v RealWorld a) IO) [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Int -> StateT RingState (ReaderT (Mutable v RealWorld a) IO) a
Int -> RingM IO (Mutable v) a a
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
Int -> RingM m v a a
latest' [Int
0..Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
{-# INLINABLE toList #-}

-- | Execute the given action with the items of the ring.
-- Note that no references to the vector may leak out of the action as
-- it will later be mutated. Moreover, the items in the vector are in
-- no particular order.
withItems :: (MonadIO m, MonadMask m, VG.Vector v a)
          => RingBuffer v a -> (v a -> m b) -> m b
withItems :: forall (m :: * -> *) (v :: * -> *) a b.
(MonadIO m, MonadMask m, Vector v a) =>
RingBuffer v a -> (v a -> m b) -> m b
withItems RingBuffer v a
rb v a -> m b
action = RingBuffer v a -> RingM m (Mutable v) a b -> m b
forall (v :: * -> *) a (m :: * -> *) r.
(Vector v a, MonadIO m, MonadMask m) =>
RingBuffer v a -> RingM m (Mutable v) a r -> m r
withRing RingBuffer v a
rb (RingM m (Mutable v) a b -> m b) -> RingM m (Mutable v) a b -> m b
forall a b. (a -> b) -> a -> b
$ do
    v a
frozen <- IO (v a)
-> StateT RingState (ReaderT (Mutable v RealWorld a) m) (v a)
forall a.
IO a -> StateT RingState (ReaderT (Mutable v RealWorld a) m) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (v a)
 -> StateT RingState (ReaderT (Mutable v RealWorld a) m) (v a))
-> IO (v a)
-> StateT RingState (ReaderT (Mutable v RealWorld a) m) (v a)
forall a b. (a -> b) -> a -> b
$ Mutable v (PrimState IO) a -> IO (v a)
forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
VG.unsafeFreeze (RingBuffer v a -> Mutable v (PrimState IO) a
forall (v :: * -> *) a.
RingBuffer v a -> Mutable v (PrimState IO) a
ringBuffer RingBuffer v a
rb)
    Int
n <- StateT RingState (ReaderT (Mutable v RealWorld a) m) Int
RingM m (Mutable v) a Int
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, MonadIO m) =>
RingM m v a Int
length'
    ReaderT (Mutable v RealWorld a) m b
-> StateT RingState (ReaderT (Mutable v RealWorld a) m) b
forall (m :: * -> *) a. Monad m => m a -> StateT RingState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Mutable v RealWorld a) m b
 -> StateT RingState (ReaderT (Mutable v RealWorld a) m) b)
-> ReaderT (Mutable v RealWorld a) m b
-> StateT RingState (ReaderT (Mutable v RealWorld a) m) b
forall a b. (a -> b) -> a -> b
$ m b -> ReaderT (Mutable v RealWorld a) m b
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (Mutable v RealWorld a) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> ReaderT (Mutable v RealWorld a) m b)
-> m b -> ReaderT (Mutable v RealWorld a) m b
forall a b. (a -> b) -> a -> b
$ v a -> m b
action (Int -> v a -> v a
forall (v :: * -> *) a. Vector v a => Int -> v a -> v a
VG.take Int
n v a
frozen)