module RewindableIndex.Index.VSplit
  ( SplitIndex(..)
  , new
  , newBoxed
  , newUnboxed
  , insert
  , insertL
  , size
  , rewind
  -- * Accessors
  , handle
  , storage
  , notifications
  , store
  , query
  , onInsert
  -- * Storage
  , Storage(..)
  , getBuffer
  , getEvents
  , k
  ) where

import Control.Lens ((%~), (&), (.~), (^.))
import Control.Lens.TH qualified as Lens
import Control.Monad.Primitive (PrimMonad, PrimState)
import Data.Foldable (foldlM)
import Data.Vector qualified as V
import Data.Vector.Generic qualified as VG
import Data.Vector.Generic.Mutable qualified as VGM
import Data.Vector.Unboxed qualified as VU

data Storage v m e = Storage
  { Storage v m e -> Mutable v (PrimState m) e
_events :: (VG.Mutable v) (PrimState m) e
  , Storage v m e -> Int
_cursor :: Int
  , Storage v m e -> Int
_eSize  :: Int
  , Storage v m e -> Int
_bSize  :: Int
  , Storage v m e -> Int
_k      :: Int
  }
$(Lens.makeLenses ''Storage)

maxSize
  :: VGM.MVector (VG.Mutable v) e
  => Storage v m e
  -> Int
maxSize :: Storage v m e -> Int
maxSize Storage v m e
store = Storage v m e
store Storage v m e
-> Getting
     (Mutable v (PrimState m) e)
     (Storage v m e)
     (Mutable v (PrimState m) e)
-> Mutable v (PrimState m) e
forall s a. s -> Getting a s a -> a
^. Getting
  (Mutable v (PrimState m) e)
  (Storage v m e)
  (Mutable v (PrimState m) e)
forall (v :: * -> *) (m :: * -> *) e (v :: * -> *) (m :: * -> *) e.
Lens
  (Storage v m e)
  (Storage v m e)
  (Mutable v (PrimState m) e)
  (Mutable v (PrimState m) e)
events Mutable v (PrimState m) e
-> (Mutable v (PrimState m) e -> Int) -> Int
forall a b. a -> (a -> b) -> b
& Mutable v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.length

isStorageFull
  :: VGM.MVector (VG.Mutable v) e
  => Storage v m e
  -> Bool
isStorageFull :: Storage v m e -> Bool
isStorageFull Storage v m e
store = Storage v m e -> Int
forall (v :: * -> *) e (m :: * -> *).
MVector (Mutable v) e =>
Storage v m e -> Int
maxSize Storage v m e
store Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Storage v m e
store Storage v m e -> Getting Int (Storage v m e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Storage v m e) Int
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
eSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Storage v m e
store Storage v m e -> Getting Int (Storage v m e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Storage v m e) Int
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
bSize

getBuffer
  :: forall v m e.
     VGM.MVector (VG.Mutable v) e
  => PrimMonad m
  => Show e
  => Storage v m e
  -> m [e]
getBuffer :: Storage v m e -> m [e]
getBuffer Storage v m e
store =
  let bufferEnd :: Int
bufferEnd   = Storage v m e
store Storage v m e -> Getting Int (Storage v m e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Storage v m e) Int
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
cursor Int -> Int -> Int
forall a. Num a => a -> a -> a
- Storage v m e
store Storage v m e -> Getting Int (Storage v m e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Storage v m e) Int
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
eSize
      bufferStart :: Int
bufferStart = Int
bufferEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Storage v m e
store Storage v m e -> Getting Int (Storage v m e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Storage v m e) Int
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
bSize
  in  [e] -> [e]
forall a. [a] -> [a]
reverse ([e] -> [e]) -> m [e] -> m [e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Storage v m e -> m [e]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Int -> Int -> Storage v m e -> m [e]
getInterval Int
bufferStart (Storage v m e
store Storage v m e -> Getting Int (Storage v m e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Storage v m e) Int
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
bSize) Storage v m e
store

getEvents
  :: forall v m e.
     VGM.MVector (VG.Mutable v) e
  => PrimMonad m
  => Show e
  => Storage v m e
  -> m [e]
getEvents :: Storage v m e -> m [e]
getEvents Storage v m e
store =
  let c :: Int
c   = Storage v m e
store Storage v m e -> Getting Int (Storage v m e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Storage v m e) Int
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
cursor
      esz :: Int
esz = Storage v m e
store Storage v m e -> Getting Int (Storage v m e) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Storage v m e) Int
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
eSize
  in  [e] -> [e]
forall a. [a] -> [a]
reverse ([e] -> [e]) -> m [e] -> m [e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Storage v m e -> m [e]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Int -> Int -> Storage v m e -> m [e]
getInterval (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
esz) Int
esz Storage v m e
store

getInterval
  :: forall v m e.
     VGM.MVector (VG.Mutable v) e
  => PrimMonad m
  => Show e
  => Int
  -> Int
  -> Storage v m e
  -> m [e]
getInterval :: Int -> Int -> Storage v m e -> m [e]
getInterval Int
start Int
size' Storage v m e
store
  | Int
size' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = [e] -> m [e]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  -- k underflows to the begining
  | Int
start Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = do
    Int -> Int -> Storage v m e -> m [e]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Int -> Int -> Storage v m e -> m [e]
getInterval (Storage v m e -> Int
forall (v :: * -> *) e (m :: * -> *).
MVector (Mutable v) e =>
Storage v m e -> Int
maxSize Storage v m e
store Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start) Int
size' Storage v m e
store
  -- buffer overflows to the start
  | Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Storage v m e -> Int
forall (v :: * -> *) e (m :: * -> *).
MVector (Mutable v) e =>
Storage v m e -> Int
maxSize Storage v m e
store =
    let endSize :: Int
endSize   = (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size') Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Storage v m e -> Int
forall (v :: * -> *) e (m :: * -> *).
MVector (Mutable v) e =>
Storage v m e -> Int
maxSize Storage v m e
store
        startSize :: Int
startSize = Int
size' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
endSize
    in  [e] -> [e] -> [e]
forall a. [a] -> [a] -> [a]
(++) ([e] -> [e] -> [e]) -> m [e] -> m ([e] -> [e])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Storage v m e -> m [e]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Int -> Int -> Storage v m e -> m [e]
getInterval Int
start Int
startSize Storage v m e
store
             m ([e] -> [e]) -> m [e] -> m [e]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> Storage v m e -> m [e]
forall (v :: * -> *) (m :: * -> *) e.
(MVector (Mutable v) e, PrimMonad m, Show e) =>
Int -> Int -> Storage v m e -> m [e]
getInterval Int
0 Int
endSize Storage v m e
store
  -- normal case
  | Bool
otherwise = do
    (e -> [e] -> [e]) -> [e] -> Mutable v (PrimState m) e -> m [e]
forall (m :: * -> *) (v :: * -> * -> *) a b.
(PrimMonad m, MVector v a) =>
(a -> b -> b) -> b -> v (PrimState m) a -> m b
VGM.foldr' (:) [] (Mutable v (PrimState m) e -> m [e])
-> Mutable v (PrimState m) e -> m [e]
forall a b. (a -> b) -> a -> b
$ Int
-> Int -> Mutable v (PrimState m) e -> Mutable v (PrimState m) e
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
VGM.slice Int
start Int
size' (Storage v m e
store Storage v m e
-> Getting
     (Mutable v (PrimState m) e)
     (Storage v m e)
     (Mutable v (PrimState m) e)
-> Mutable v (PrimState m) e
forall s a. s -> Getting a s a -> a
^. Getting
  (Mutable v (PrimState m) e)
  (Storage v m e)
  (Mutable v (PrimState m) e)
forall (v :: * -> *) (m :: * -> *) e (v :: * -> *) (m :: * -> *) e.
Lens
  (Storage v m e)
  (Storage v m e)
  (Mutable v (PrimState m) e)
  (Mutable v (PrimState m) e)
events)

data SplitIndex m h v e n q r = SplitIndex
  { SplitIndex m h v e n q r -> h
_handle        :: h
  , SplitIndex m h v e n q r -> Storage v m e
_storage       :: Storage v m e
  , SplitIndex m h v e n q r -> [n]
_notifications :: [n]
  , SplitIndex m h v e n q r -> SplitIndex m h v e n q r -> m ()
_store         :: SplitIndex m h v e n q r -> m ()
  , SplitIndex m h v e n q r
-> SplitIndex m h v e n q r -> q -> [e] -> m r
_query         :: SplitIndex m h v e n q r -> q -> [e] -> m r
  , SplitIndex m h v e n q r -> SplitIndex m h v e n q r -> e -> m [n]
_onInsert      :: SplitIndex m h v e n q r -> e -> m [n]
  }
$(Lens.makeLenses ''SplitIndex)

new
  :: Monad m
  => VGM.MVector (VG.Mutable v) e
  => (SplitIndex m h v e n q r -> q -> [e] -> m r)
  -> (SplitIndex m h v e n q r -> m ())
  -> (SplitIndex m h v e n q r -> e -> m [n])
  -> Int
  -> h
  -> (VG.Mutable v) (PrimState m) e
  -> m (Maybe (SplitIndex m h v e n q r))
new :: (SplitIndex m h v e n q r -> q -> [e] -> m r)
-> (SplitIndex m h v e n q r -> m ())
-> (SplitIndex m h v e n q r -> e -> m [n])
-> Int
-> h
-> Mutable v (PrimState m) e
-> m (Maybe (SplitIndex m h v e n q r))
new SplitIndex m h v e n q r -> q -> [e] -> m r
query' SplitIndex m h v e n q r -> m ()
store' SplitIndex m h v e n q r -> e -> m [n]
onInsert' Int
k' h
handle' Mutable v (PrimState m) e
vector
  | Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                  = Maybe (SplitIndex m h v e n q r)
-> m (Maybe (SplitIndex m h v e n q r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SplitIndex m h v e n q r)
forall a. Maybe a
Nothing
  -- The vector has to accomodate at least k + 1 elements.
  | Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Mutable v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.length Mutable v (PrimState m) e
vector = Maybe (SplitIndex m h v e n q r)
-> m (Maybe (SplitIndex m h v e n q r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SplitIndex m h v e n q r)
forall a. Maybe a
Nothing
  | Bool
otherwise = Maybe (SplitIndex m h v e n q r)
-> m (Maybe (SplitIndex m h v e n q r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SplitIndex m h v e n q r)
 -> m (Maybe (SplitIndex m h v e n q r)))
-> (SplitIndex m h v e n q r -> Maybe (SplitIndex m h v e n q r))
-> SplitIndex m h v e n q r
-> m (Maybe (SplitIndex m h v e n q r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SplitIndex m h v e n q r -> Maybe (SplitIndex m h v e n q r)
forall a. a -> Maybe a
Just (SplitIndex m h v e n q r -> m (Maybe (SplitIndex m h v e n q r)))
-> SplitIndex m h v e n q r -> m (Maybe (SplitIndex m h v e n q r))
forall a b. (a -> b) -> a -> b
$ SplitIndex :: forall (m :: * -> *) h (v :: * -> *) e n q r.
h
-> Storage v m e
-> [n]
-> (SplitIndex m h v e n q r -> m ())
-> (SplitIndex m h v e n q r -> q -> [e] -> m r)
-> (SplitIndex m h v e n q r -> e -> m [n])
-> SplitIndex m h v e n q r
SplitIndex
    { _handle :: h
_handle        = h
handle'
    , _storage :: Storage v m e
_storage       = Storage :: forall (v :: * -> *) (m :: * -> *) e.
Mutable v (PrimState m) e
-> Int -> Int -> Int -> Int -> Storage v m e
Storage { _events :: Mutable v (PrimState m) e
_events = Mutable v (PrimState m) e
vector
                               , _cursor :: Int
_cursor = Int
0
                               , _eSize :: Int
_eSize  = Int
0
                               , _bSize :: Int
_bSize  = Int
0
                               , _k :: Int
_k      = Int
k'
                               }
    , _notifications :: [n]
_notifications = []
    , _store :: SplitIndex m h v e n q r -> m ()
_store         = SplitIndex m h v e n q r -> m ()
store'
    , _query :: SplitIndex m h v e n q r -> q -> [e] -> m r
_query         = SplitIndex m h v e n q r -> q -> [e] -> m r
query'
    , _onInsert :: SplitIndex m h v e n q r -> e -> m [n]
_onInsert      = SplitIndex m h v e n q r -> e -> m [n]
onInsert'
    }

type BoxedIndex m h e n q r =
  SplitIndex m h V.Vector e n q r

newBoxed
  :: Monad m
  => PrimMonad m
  => (BoxedIndex m h e n q r -> q -> [e] -> m r)
  -> (BoxedIndex m h e n q r -> m ())
  -> (BoxedIndex m h e n q r -> e -> m [n])
  -> Int
  -> Int
  -> h
  -> m (Maybe (BoxedIndex m h e n q r))
newBoxed :: (BoxedIndex m h e n q r -> q -> [e] -> m r)
-> (BoxedIndex m h e n q r -> m ())
-> (BoxedIndex m h e n q r -> e -> m [n])
-> Int
-> Int
-> h
-> m (Maybe (BoxedIndex m h e n q r))
newBoxed BoxedIndex m h e n q r -> q -> [e] -> m r
query' BoxedIndex m h e n q r -> m ()
store' BoxedIndex m h e n q r -> e -> m [n]
onInsert' Int
k' Int
size' h
handle'
  | Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
size' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe (BoxedIndex m h e n q r)
-> m (Maybe (BoxedIndex m h e n q r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (BoxedIndex m h e n q r)
forall a. Maybe a
Nothing
  | Bool
otherwise = do
    MVector (PrimState m) e
v <- Int -> m (MVector (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VGM.new (Int
k' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size')
    (BoxedIndex m h e n q r -> q -> [e] -> m r)
-> (BoxedIndex m h e n q r -> m ())
-> (BoxedIndex m h e n q r -> e -> m [n])
-> Int
-> h
-> Mutable Vector (PrimState m) e
-> m (Maybe (BoxedIndex m h e n q r))
forall (m :: * -> *) (v :: * -> *) e h n q r.
(Monad m, MVector (Mutable v) e) =>
(SplitIndex m h v e n q r -> q -> [e] -> m r)
-> (SplitIndex m h v e n q r -> m ())
-> (SplitIndex m h v e n q r -> e -> m [n])
-> Int
-> h
-> Mutable v (PrimState m) e
-> m (Maybe (SplitIndex m h v e n q r))
new BoxedIndex m h e n q r -> q -> [e] -> m r
query' BoxedIndex m h e n q r -> m ()
store' BoxedIndex m h e n q r -> e -> m [n]
onInsert' Int
k' h
handle' MVector (PrimState m) e
Mutable Vector (PrimState m) e
v

type UnboxedIndex m h e n q r =
  SplitIndex m h VU.Vector e n q r

newUnboxed
  :: Monad m
  => PrimMonad m
  => VGM.MVector VU.MVector e
  => (UnboxedIndex m h e n q r -> q -> [e] -> m r)
  -> (UnboxedIndex m h e n q r -> m ())
  -> (UnboxedIndex m h e n q r -> e -> m [n])
  -> Int
  -> Int
  -> h
  -> m (Maybe (UnboxedIndex m h e n q r))
newUnboxed :: (UnboxedIndex m h e n q r -> q -> [e] -> m r)
-> (UnboxedIndex m h e n q r -> m ())
-> (UnboxedIndex m h e n q r -> e -> m [n])
-> Int
-> Int
-> h
-> m (Maybe (UnboxedIndex m h e n q r))
newUnboxed UnboxedIndex m h e n q r -> q -> [e] -> m r
query' UnboxedIndex m h e n q r -> m ()
store' UnboxedIndex m h e n q r -> e -> m [n]
onInsert' Int
k' Int
size' h
handle'
  | Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
size' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = Maybe (UnboxedIndex m h e n q r)
-> m (Maybe (UnboxedIndex m h e n q r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (UnboxedIndex m h e n q r)
forall a. Maybe a
Nothing
  | Bool
otherwise = do
    MVector (PrimState m) e
v <- Int -> m (MVector (PrimState m) e)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
VGM.new (Int
k' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size')
    (UnboxedIndex m h e n q r -> q -> [e] -> m r)
-> (UnboxedIndex m h e n q r -> m ())
-> (UnboxedIndex m h e n q r -> e -> m [n])
-> Int
-> h
-> Mutable Vector (PrimState m) e
-> m (Maybe (UnboxedIndex m h e n q r))
forall (m :: * -> *) (v :: * -> *) e h n q r.
(Monad m, MVector (Mutable v) e) =>
(SplitIndex m h v e n q r -> q -> [e] -> m r)
-> (SplitIndex m h v e n q r -> m ())
-> (SplitIndex m h v e n q r -> e -> m [n])
-> Int
-> h
-> Mutable v (PrimState m) e
-> m (Maybe (SplitIndex m h v e n q r))
new UnboxedIndex m h e n q r -> q -> [e] -> m r
query' UnboxedIndex m h e n q r -> m ()
store' UnboxedIndex m h e n q r -> e -> m [n]
onInsert' Int
k' h
handle' MVector (PrimState m) e
Mutable Vector (PrimState m) e
v

insert
  :: forall m h v e n q r.
     Monad m
  => PrimMonad m
  => VGM.MVector (VG.Mutable v) e
  => e
  -> SplitIndex m h v e n q r
  -> m (SplitIndex m h v e n q r)
insert :: e -> SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
insert e
e SplitIndex m h v e n q r
ix = do
    let es :: Mutable v (PrimState m) e
es = SplitIndex m h v e n q r
ix SplitIndex m h v e n q r
-> Getting
     (Mutable v (PrimState m) e)
     (SplitIndex m h v e n q r)
     (Mutable v (PrimState m) e)
-> Mutable v (PrimState m) e
forall s a. s -> Getting a s a -> a
^. (Storage v m e
 -> Const (Mutable v (PrimState m) e) (Storage v m e))
-> SplitIndex m h v e n q r
-> Const (Mutable v (PrimState m) e) (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage ((Storage v m e
  -> Const (Mutable v (PrimState m) e) (Storage v m e))
 -> SplitIndex m h v e n q r
 -> Const (Mutable v (PrimState m) e) (SplitIndex m h v e n q r))
-> ((Mutable v (PrimState m) e
     -> Const (Mutable v (PrimState m) e) (Mutable v (PrimState m) e))
    -> Storage v m e
    -> Const (Mutable v (PrimState m) e) (Storage v m e))
-> Getting
     (Mutable v (PrimState m) e)
     (SplitIndex m h v e n q r)
     (Mutable v (PrimState m) e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Mutable v (PrimState m) e
 -> Const (Mutable v (PrimState m) e) (Mutable v (PrimState m) e))
-> Storage v m e
-> Const (Mutable v (PrimState m) e) (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e (v :: * -> *) (m :: * -> *) e.
Lens
  (Storage v m e)
  (Storage v m e)
  (Mutable v (PrimState m) e)
  (Mutable v (PrimState m) e)
events
        c :: Int
c  = SplitIndex m h v e n q r
ix SplitIndex m h v e n q r
-> Getting Int (SplitIndex m h v e n q r) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Storage v m e -> Const Int (Storage v m e))
-> SplitIndex m h v e n q r -> Const Int (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage ((Storage v m e -> Const Int (Storage v m e))
 -> SplitIndex m h v e n q r
 -> Const Int (SplitIndex m h v e n q r))
-> ((Int -> Const Int Int)
    -> Storage v m e -> Const Int (Storage v m e))
-> Getting Int (SplitIndex m h v e n q r) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> Storage v m e -> Const Int (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
cursor
        vs :: Int
vs = Mutable v (PrimState m) e -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
VGM.length Mutable v (PrimState m) e
es
    Mutable v (PrimState m) e -> Int -> e -> m ()
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
VGM.unsafeWrite Mutable v (PrimState m) e
es Int
c e
e
    [n]
ns <- (SplitIndex m h v e n q r
ix SplitIndex m h v e n q r
-> Getting
     (SplitIndex m h v e n q r -> e -> m [n])
     (SplitIndex m h v e n q r)
     (SplitIndex m h v e n q r -> e -> m [n])
-> SplitIndex m h v e n q r
-> e
-> m [n]
forall s a. s -> Getting a s a -> a
^. Getting
  (SplitIndex m h v e n q r -> e -> m [n])
  (SplitIndex m h v e n q r)
  (SplitIndex m h v e n q r -> e -> m [n])
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens'
  (SplitIndex m h v e n q r) (SplitIndex m h v e n q r -> e -> m [n])
onInsert) SplitIndex m h v e n q r
ix e
e
    let ix' :: SplitIndex m h v e n q r
ix' = (Storage v m e -> Identity (Storage v m e))
-> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage            ((Storage v m e -> Identity (Storage v m e))
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> (Storage v m e -> Storage v m e)
-> SplitIndex m h v e n q r
-> SplitIndex m h v e n q r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Storage v m e -> Storage v m e
updateSizes                (SplitIndex m h v e n q r -> SplitIndex m h v e n q r)
-> SplitIndex m h v e n q r -> SplitIndex m h v e n q r
forall a b. (a -> b) -> a -> b
$
              ((Storage v m e -> Identity (Storage v m e))
-> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage ((Storage v m e -> Identity (Storage v m e))
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> ((Int -> Identity Int)
    -> Storage v m e -> Identity (Storage v m e))
-> (Int -> Identity Int)
-> SplitIndex m h v e n q r
-> Identity (SplitIndex m h v e n q r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> Storage v m e -> Identity (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
cursor) ((Int -> Identity Int)
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> (Int -> Int)
-> SplitIndex m h v e n q r
-> SplitIndex m h v e n q r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Int
c' -> (Int
c' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
vs) (SplitIndex m h v e n q r -> SplitIndex m h v e n q r)
-> SplitIndex m h v e n q r -> SplitIndex m h v e n q r
forall a b. (a -> b) -> a -> b
$
              ([n] -> Identity [n])
-> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) [n]
notifications      (([n] -> Identity [n])
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> ([n] -> [n])
-> SplitIndex m h v e n q r
-> SplitIndex m h v e n q r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([n]
ns[n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++)                     (SplitIndex m h v e n q r -> SplitIndex m h v e n q r)
-> SplitIndex m h v e n q r -> SplitIndex m h v e n q r
forall a b. (a -> b) -> a -> b
$ SplitIndex m h v e n q r
ix
    if Storage v m e -> Bool
forall (v :: * -> *) e (m :: * -> *).
MVector (Mutable v) e =>
Storage v m e -> Bool
isStorageFull (SplitIndex m h v e n q r
ix' SplitIndex m h v e n q r
-> Getting
     (Storage v m e) (SplitIndex m h v e n q r) (Storage v m e)
-> Storage v m e
forall s a. s -> Getting a s a -> a
^. Getting (Storage v m e) (SplitIndex m h v e n q r) (Storage v m e)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage)
    then SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Monad m =>
SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
storeEvents SplitIndex m h v e n q r
ix'
    else SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure        SplitIndex m h v e n q r
ix'

  where
    updateSizes :: Storage v m e -> Storage v m e
    updateSizes :: Storage v m e -> Storage v m e
updateSizes Storage v m e
st =
        -- Event sizes increase by one upto K
        (Int -> Identity Int) -> Storage v m e -> Identity (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
eSize ((Int -> Identity Int)
 -> Storage v m e -> Identity (Storage v m e))
-> (Int -> Int) -> Storage v m e -> Storage v m e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Int
sz -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Storage v m e
st Storage v m e
-> ((Int -> Const Int Int)
    -> Storage v m e -> Const Int (Storage v m e))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int)
-> Storage v m e -> Const Int (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
k))                        (Storage v m e -> Storage v m e) -> Storage v m e -> Storage v m e
forall a b. (a -> b) -> a -> b
$
        -- The buffer only grows when the event buffer is full
        (Int -> Identity Int) -> Storage v m e -> Identity (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
bSize ((Int -> Identity Int)
 -> Storage v m e -> Identity (Storage v m e))
-> (Int -> Int) -> Storage v m e -> Storage v m e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Int
sz -> if Storage v m e
st Storage v m e
-> ((Int -> Const Int Int)
    -> Storage v m e -> Const Int (Storage v m e))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int)
-> Storage v m e -> Const Int (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
eSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Storage v m e
st Storage v m e
-> ((Int -> Const Int Int)
    -> Storage v m e -> Const Int (Storage v m e))
-> Int
forall s a. s -> Getting a s a -> a
^. (Int -> Const Int Int)
-> Storage v m e -> Const Int (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
k then Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
sz) (Storage v m e -> Storage v m e) -> Storage v m e -> Storage v m e
forall a b. (a -> b) -> a -> b
$ Storage v m e
st

storeEvents
  :: Monad m
  => SplitIndex m h v e n q r
  -> m (SplitIndex m h v e n q r)
storeEvents :: SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
storeEvents SplitIndex m h v e n q r
ix = do
  -- TODO: Change store to store :: h -> [e] -> m () (?)
  SplitIndex m h v e n q r
ix SplitIndex m h v e n q r
-> (SplitIndex m h v e n q r -> m ()) -> m ()
forall a b. a -> (a -> b) -> b
& SplitIndex m h v e n q r
ix SplitIndex m h v e n q r
-> Getting
     (SplitIndex m h v e n q r -> m ())
     (SplitIndex m h v e n q r)
     (SplitIndex m h v e n q r -> m ())
-> SplitIndex m h v e n q r
-> m ()
forall s a. s -> Getting a s a -> a
^. Getting
  (SplitIndex m h v e n q r -> m ())
  (SplitIndex m h v e n q r)
  (SplitIndex m h v e n q r -> m ())
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (SplitIndex m h v e n q r -> m ())
store
  SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r))
-> SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
forall a b. (a -> b) -> a -> b
$
    ((Storage v m e -> Identity (Storage v m e))
-> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage ((Storage v m e -> Identity (Storage v m e))
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> ((Int -> Identity Int)
    -> Storage v m e -> Identity (Storage v m e))
-> (Int -> Identity Int)
-> SplitIndex m h v e n q r
-> Identity (SplitIndex m h v e n q r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> Storage v m e -> Identity (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
bSize) ((Int -> Identity Int)
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> Int -> SplitIndex m h v e n q r -> SplitIndex m h v e n q r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
0 (SplitIndex m h v e n q r -> SplitIndex m h v e n q r)
-> SplitIndex m h v e n q r -> SplitIndex m h v e n q r
forall a b. (a -> b) -> a -> b
$ SplitIndex m h v e n q r
ix

insertL
  :: PrimMonad m
  => VGM.MVector (VG.Mutable v) e
  => [e]
  -> SplitIndex m h v e n q r
  -> m (SplitIndex m h v e n q r)
insertL :: [e] -> SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
insertL [e]
es SplitIndex m h v e n q r
ix = (SplitIndex m h v e n q r -> e -> m (SplitIndex m h v e n q r))
-> SplitIndex m h v e n q r -> [e] -> m (SplitIndex m h v e n q r)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ((e -> SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r))
-> SplitIndex m h v e n q r -> e -> m (SplitIndex m h v e n q r)
forall a b c. (a -> b -> c) -> b -> a -> c
flip e -> SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
(Monad m, PrimMonad m, MVector (Mutable v) e) =>
e -> SplitIndex m h v e n q r -> m (SplitIndex m h v e n q r)
insert) SplitIndex m h v e n q r
ix [e]
es

size
  :: SplitIndex m h v e n q r
  -> Int
size :: SplitIndex m h v e n q r -> Int
size SplitIndex m h v e n q r
ix = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (SplitIndex m h v e n q r
ix SplitIndex m h v e n q r
-> Getting Int (SplitIndex m h v e n q r) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Storage v m e -> Const Int (Storage v m e))
-> SplitIndex m h v e n q r -> Const Int (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage ((Storage v m e -> Const Int (Storage v m e))
 -> SplitIndex m h v e n q r
 -> Const Int (SplitIndex m h v e n q r))
-> ((Int -> Const Int Int)
    -> Storage v m e -> Const Int (Storage v m e))
-> Getting Int (SplitIndex m h v e n q r) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> Storage v m e -> Const Int (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
eSize)

rewind
  :: VGM.MVector (VG.Mutable v) e
  => Int
  -> SplitIndex m h v e n q r
  -> Maybe (SplitIndex m h v e n q r)
rewind :: Int -> SplitIndex m h v e n q r -> Maybe (SplitIndex m h v e n q r)
rewind Int
n SplitIndex m h v e n q r
ix
  | SplitIndex m h v e n q r
ix SplitIndex m h v e n q r
-> Getting Int (SplitIndex m h v e n q r) Int -> Int
forall s a. s -> Getting a s a -> a
^. (Storage v m e -> Const Int (Storage v m e))
-> SplitIndex m h v e n q r -> Const Int (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage ((Storage v m e -> Const Int (Storage v m e))
 -> SplitIndex m h v e n q r
 -> Const Int (SplitIndex m h v e n q r))
-> ((Int -> Const Int Int)
    -> Storage v m e -> Const Int (Storage v m e))
-> Getting Int (SplitIndex m h v e n q r) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int)
-> Storage v m e -> Const Int (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
eSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = SplitIndex m h v e n q r -> Maybe (SplitIndex m h v e n q r)
forall a. a -> Maybe a
Just (SplitIndex m h v e n q r -> Maybe (SplitIndex m h v e n q r))
-> SplitIndex m h v e n q r -> Maybe (SplitIndex m h v e n q r)
forall a b. (a -> b) -> a -> b
$
    ((Storage v m e -> Identity (Storage v m e))
-> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage ((Storage v m e -> Identity (Storage v m e))
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> ((Int -> Identity Int)
    -> Storage v m e -> Identity (Storage v m e))
-> (Int -> Identity Int)
-> SplitIndex m h v e n q r
-> Identity (SplitIndex m h v e n q r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> Storage v m e -> Identity (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
cursor) ((Int -> Identity Int)
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> (Int -> Int)
-> SplitIndex m h v e n q r
-> SplitIndex m h v e n q r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Int
c -> Int -> Int
adjust (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)) (SplitIndex m h v e n q r -> SplitIndex m h v e n q r)
-> SplitIndex m h v e n q r -> SplitIndex m h v e n q r
forall a b. (a -> b) -> a -> b
$
    ((Storage v m e -> Identity (Storage v m e))
-> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage ((Storage v m e -> Identity (Storage v m e))
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> ((Int -> Identity Int)
    -> Storage v m e -> Identity (Storage v m e))
-> (Int -> Identity Int)
-> SplitIndex m h v e n q r
-> Identity (SplitIndex m h v e n q r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> Storage v m e -> Identity (Storage v m e)
forall (v :: * -> *) (m :: * -> *) e. Lens' (Storage v m e) Int
eSize ) ((Int -> Identity Int)
 -> SplitIndex m h v e n q r -> Identity (SplitIndex m h v e n q r))
-> (Int -> Int)
-> SplitIndex m h v e n q r
-> SplitIndex m h v e n q r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (\Int
sz -> Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)        (SplitIndex m h v e n q r -> SplitIndex m h v e n q r)
-> SplitIndex m h v e n q r -> SplitIndex m h v e n q r
forall a b. (a -> b) -> a -> b
$ SplitIndex m h v e n q r
ix
  | Bool
otherwise = Maybe (SplitIndex m h v e n q r)
forall a. Maybe a
Nothing
    where
      adjust :: Int -> Int
      adjust :: Int -> Int
adjust Int
p
        | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Storage v m e -> Int
forall (v :: * -> *) e (m :: * -> *).
MVector (Mutable v) e =>
Storage v m e -> Int
maxSize (SplitIndex m h v e n q r
ix SplitIndex m h v e n q r
-> Getting
     (Storage v m e) (SplitIndex m h v e n q r) (Storage v m e)
-> Storage v m e
forall s a. s -> Getting a s a -> a
^. Getting (Storage v m e) (SplitIndex m h v e n q r) (Storage v m e)
forall (m :: * -> *) h (v :: * -> *) e n q r.
Lens' (SplitIndex m h v e n q r) (Storage v m e)
storage) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
p
        | Bool
otherwise = Int
p