{-# OPTIONS_HADDOCK not-home #-}

-- | Page accumulator.
--
module Database.LSMTree.Internal.PageAcc (
    -- * Incrementally accumulating a single page.
    PageAcc (..),
    newPageAcc,
    resetPageAcc,
    pageAccAddElem,
    serialisePageAcc,
    -- ** Inspection
    keysCountPageAcc,
    indexKeyPageAcc,
    -- ** Entry sizes
    entryWouldFitInPage,
    sizeofEntry,
) where

import           Control.Monad.ST.Strict (ST)
import           Data.Bits (unsafeShiftL, (.|.))
import qualified Data.Primitive as P
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Primitive as VP
import           Data.Word (Word16, Word32, Word64)
import           Database.LSMTree.Internal.BitMath
import           Database.LSMTree.Internal.BlobRef (BlobSpan (..))
import           Database.LSMTree.Internal.Entry (Entry (..))
import           Database.LSMTree.Internal.RawBytes (RawBytes (..))
import qualified Database.LSMTree.Internal.RawBytes as RB
import           Database.LSMTree.Internal.RawPage
import           Database.LSMTree.Internal.Serialise

-- |
--
-- The delete operations take the least amount of space, as there's only the key.
--
-- A smallest page is with empty key:
--
-- >>> import FormatPage
-- >>> let Just page0 = pageSizeAddElem (Key "", Delete) (pageSizeEmpty DiskPage4k)
-- >>> page0
-- PageSize {pageSizeElems = 1, pageSizeBlobs = 0, pageSizeBytes = 32, pageSizeDisk = DiskPage4k}
--
-- Then we can add pages with a single byte key, e.g.
--
-- >>> pageSizeAddElem (Key "a", Delete) page0
-- Just (PageSize {pageSizeElems = 2, pageSizeBlobs = 0, pageSizeBytes = 35, pageSizeDisk = DiskPage4k})
--
-- i.e. roughly 3-4 bytes (when we get to 32/64 elements we add more bytes for bitmaps).
-- (key and value offset is together 4 bytes: so it's at least 4, the encoding of single element page takes more space).
--
-- If we write as small program, adding single byte keys to a page size:
--
-- >>> let calc s ps = case pageSizeAddElem (Key "x", Delete) ps of { Nothing -> s; Just ps' -> calc (s + 1) ps' }
-- >>> calc 1 page0
-- 759
--
-- I.e. we can have a 4096 byte page with at most 759 keys, assuming keys are
-- length 1 or longer, but without assuming that there are no duplicate keys.
--
-- And 759 rounded to the next multiple of 64 (for the bitmaps) is 768.
--
-- 'PageAcc' can hold up to 759 elements, but most likely 'pageAccAddElem' will make it overflow sooner.
-- Having an upper bound allows us to allocate all memory for the accumulator in advance.
--
-- We don't store or calculate individual key nor value offsets in 'PageAcc', as these will be naturally calculated during serialisation ('serialisePageAcc').
--
data PageAcc s = PageAcc
    { forall s. PageAcc s -> MutablePrimArray s Int
paDir         :: !(P.MutablePrimArray s Int)      -- ^ various counters (directory + extra counters). It is convenient to have counters as 'Int', as all indexing uses 'Int's.
    , forall s. PageAcc s -> MutablePrimArray s Word64
paOpMap       :: !(P.MutablePrimArray s Word64)   -- ^ operations crumb map
    , forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefsMap :: !(P.MutablePrimArray s Word64)   -- ^ blob reference bitmap
    , forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefs1   :: !(P.MutablePrimArray s Word64)   -- ^ blob spans 64 bit part (offset)
    , forall s. PageAcc s -> MutablePrimArray s Word32
paBlobRefs2   :: !(P.MutablePrimArray s Word32)   -- ^ blob spans 32 bit part (size)
    , forall s. PageAcc s -> MVector s SerialisedKey
paKeys        :: !(V.MVector s SerialisedKey)     -- ^ keys
    , forall s. PageAcc s -> MVector s SerialisedValue
paValues      :: !(V.MVector s SerialisedValue)   -- ^ values
    }

-------------------------------------------------------------------------------
-- Constants
-------------------------------------------------------------------------------

keysCountIdx :: Int
keysCountIdx :: Int
keysCountIdx = Int
0
{-# INLINE keysCountIdx #-}

blobRefCountIdx :: Int
blobRefCountIdx :: Int
blobRefCountIdx = Int
1
{-# INLINE blobRefCountIdx #-}

byteSizeIdx :: Int
byteSizeIdx :: Int
byteSizeIdx = Int
2
{-# INLINE byteSizeIdx #-}

keysSizeIdx :: Int
keysSizeIdx :: Int
keysSizeIdx = Int
3
{-# INLINE keysSizeIdx #-}

pageSize :: Int
pageSize :: Int
pageSize = Int
4096
{-# INLINE pageSize #-}

-- | See calculation in 'PageAcc' comments.
maxKeys :: Int
maxKeys :: Int
maxKeys = Int
759
{-# INLINE maxKeys #-}

-- | See calculation in 'PageAcc' comments.
maxOpMap :: Int
maxOpMap :: Int
maxOpMap = Int
24 -- 768 / 32
{-# INLINE maxOpMap #-}

-- | See calculation in 'PageAcc' comments.
maxBlobRefsMap :: Int
maxBlobRefsMap :: Int
maxBlobRefsMap = Int
12 -- 768 / 64
{-# INLINE maxBlobRefsMap #-}

-------------------------------------------------------------------------------
-- Entry operations
-------------------------------------------------------------------------------

-- | Calculate the total byte size of key, value and optional blobspan.
--
-- To fit into single page this has to be at most 4064. If the entry is larger,
-- the 'pageAccAddElem' is guaranteed to return 'False'.
--
-- In other words, if you have a large entry (i.e. Insert with big value),
-- don't use the 'PageAcc', but construct the single value page directly,
-- using 'Database.LSMTree.Internal.PageAcc1.singletonPage'.
--
-- If it's not known from context, use 'entryWouldFitInPage' to determine if
-- you're in the small or large case.
--
-- Checking entry size allows us to use 'Word16' arithmetic, we don't need to
-- worry about overflows.
--
sizeofEntry :: SerialisedKey -> Entry SerialisedValue b -> Int
sizeofEntry :: forall b. SerialisedKey -> Entry SerialisedValue b -> Int
sizeofEntry SerialisedKey
k Entry SerialisedValue b
Delete               = SerialisedKey -> Int
sizeofKey SerialisedKey
k
sizeofEntry SerialisedKey
k (Mupdate SerialisedValue
v)          = SerialisedKey -> Int
sizeofKey SerialisedKey
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SerialisedValue -> Int
sizeofValue SerialisedValue
v
sizeofEntry SerialisedKey
k (Insert SerialisedValue
v)           = SerialisedKey -> Int
sizeofKey SerialisedKey
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SerialisedValue -> Int
sizeofValue SerialisedValue
v
sizeofEntry SerialisedKey
k (InsertWithBlob SerialisedValue
v b
_) = SerialisedKey -> Int
sizeofKey SerialisedKey
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SerialisedValue -> Int
sizeofValue SerialisedValue
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12

-- | Determine if the key, value and optional blobspan would fit within a
-- single page. If it does, then it's appropriate to use 'pageAccAddElem', but
-- otherwise use 'Database.LSMTree.Internal.PageAcc1.singletonPage'.
--
-- If 'entryWouldFitInPage' is @True@ and the 'PageAcc' is empty (i.e. using
--'resetPageAcc') then 'pageAccAddElem' is guaranteed to succeed.
--
entryWouldFitInPage :: SerialisedKey -> Entry SerialisedValue b -> Bool
entryWouldFitInPage :: forall b. SerialisedKey -> Entry SerialisedValue b -> Bool
entryWouldFitInPage SerialisedKey
k Entry SerialisedValue b
e = SerialisedKey -> Entry SerialisedValue b -> Int
forall b. SerialisedKey -> Entry SerialisedValue b -> Int
sizeofEntry SerialisedKey
k Entry SerialisedValue b
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
pageSize

-- | Whether 'Entry' adds a blob reference
hasBlobRef :: Entry a b -> Bool
hasBlobRef :: forall a b. Entry a b -> Bool
hasBlobRef (InsertWithBlob a
_ b
_) = Bool
True
hasBlobRef Entry a b
_                    = Bool
False

-- | Entry's operations crumb. We return 'Word64' as we'd write that.
entryCrumb :: Entry SerialisedValue BlobSpan -> Word64
entryCrumb :: Entry SerialisedValue BlobSpan -> Word64
entryCrumb Insert {}         = Word64
0
entryCrumb InsertWithBlob {} = Word64
0
entryCrumb Mupdate {}        = Word64
1
entryCrumb Delete {}         = Word64
2

-- | Entry value. Return 'emptyValue' for 'Delete'
-- (the empty value is in the page even for 'Delete's)
entryValue :: Entry SerialisedValue BlobSpan -> SerialisedValue
entryValue :: Entry SerialisedValue BlobSpan -> SerialisedValue
entryValue (Insert SerialisedValue
v)           = SerialisedValue
v
entryValue (InsertWithBlob SerialisedValue
v BlobSpan
_) = SerialisedValue
v
entryValue (Mupdate SerialisedValue
v)          = SerialisedValue
v
entryValue Entry SerialisedValue BlobSpan
Delete               = SerialisedValue
emptyValue

emptyValue :: SerialisedValue
emptyValue :: SerialisedValue
emptyValue = RawBytes -> SerialisedValue
SerialisedValue ([Word8] -> RawBytes
RB.pack [])

-------------------------------------------------------------------------------
-- PageAcc functions
-------------------------------------------------------------------------------

-- | Create new 'PageAcc'.
--
-- The create 'PageAcc' will be empty.
newPageAcc :: ST s (PageAcc s)
newPageAcc :: forall s. ST s (PageAcc s)
newPageAcc = do
    MutablePrimArray s Int
paDir          <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
P.newPrimArray Int
4
    MutablePrimArray s Word64
paOpMap        <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word64)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
P.newPrimArray Int
maxOpMap
    MutablePrimArray s Word64
paBlobRefsMap  <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word64)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
P.newPrimArray Int
maxBlobRefsMap
    MutablePrimArray s Word64
paBlobRefs1    <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word64)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
P.newPrimArray Int
maxKeys
    MutablePrimArray s Word32
paBlobRefs2    <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word32)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
P.newPrimArray Int
maxKeys
    MVector s SerialisedKey
paKeys         <- Int -> ST s (MVector (PrimState (ST s)) SerialisedKey)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
VM.new Int
maxKeys
    MVector s SerialisedValue
paValues       <- Int -> ST s (MVector (PrimState (ST s)) SerialisedValue)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> m (MVector (PrimState m) a)
VM.new Int
maxKeys

    -- reset the memory, as it's not initialized
    let page :: PageAcc s
page = PageAcc {MutablePrimArray s Int
MutablePrimArray s Word32
MutablePrimArray s Word64
MVector s SerialisedValue
MVector s SerialisedKey
paDir :: MutablePrimArray s Int
paOpMap :: MutablePrimArray s Word64
paBlobRefsMap :: MutablePrimArray s Word64
paBlobRefs1 :: MutablePrimArray s Word64
paBlobRefs2 :: MutablePrimArray s Word32
paKeys :: MVector s SerialisedKey
paValues :: MVector s SerialisedValue
paDir :: MutablePrimArray s Int
paOpMap :: MutablePrimArray s Word64
paBlobRefsMap :: MutablePrimArray s Word64
paBlobRefs1 :: MutablePrimArray s Word64
paBlobRefs2 :: MutablePrimArray s Word32
paKeys :: MVector s SerialisedKey
paValues :: MVector s SerialisedValue
..}
    PageAcc s -> Int -> ST s ()
forall s. PageAcc s -> Int -> ST s ()
resetPageAccN PageAcc s
page Int
maxKeys
    PageAcc s -> ST s (PageAcc s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return PageAcc s
page

dummyKey :: SerialisedKey
dummyKey :: SerialisedKey
dummyKey = RawBytes -> SerialisedKey
SerialisedKey RawBytes
forall a. Monoid a => a
mempty

dummyValue :: SerialisedValue
dummyValue :: SerialisedValue
dummyValue = RawBytes -> SerialisedValue
SerialisedValue RawBytes
forall a. Monoid a => a
mempty

-- | Reuse 'PageAcc' for constructing new page, the old data will be reset.
resetPageAcc :: PageAcc s
    -> ST s ()
resetPageAcc :: forall s. PageAcc s -> ST s ()
resetPageAcc PageAcc s
pa = do
    !Int
n <- PageAcc s -> ST s Int
forall s. PageAcc s -> ST s Int
keysCountPageAcc PageAcc s
pa
    PageAcc s -> Int -> ST s ()
forall s. PageAcc s -> Int -> ST s ()
resetPageAccN PageAcc s
pa Int
n

-- | Reset the page for the given number of key\/value pairs. This does not
-- check whether the given number exceeds 'maxKeys', in which case behaviour is
-- undefined.
resetPageAccN :: PageAcc s -> Int -> ST s ()
resetPageAccN :: forall s. PageAcc s -> Int -> ST s ()
resetPageAccN PageAcc {MutablePrimArray s Int
MutablePrimArray s Word32
MutablePrimArray s Word64
MVector s SerialisedValue
MVector s SerialisedKey
paDir :: forall s. PageAcc s -> MutablePrimArray s Int
paOpMap :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefsMap :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefs1 :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefs2 :: forall s. PageAcc s -> MutablePrimArray s Word32
paKeys :: forall s. PageAcc s -> MVector s SerialisedKey
paValues :: forall s. PageAcc s -> MVector s SerialisedValue
paDir :: MutablePrimArray s Int
paOpMap :: MutablePrimArray s Word64
paBlobRefsMap :: MutablePrimArray s Word64
paBlobRefs1 :: MutablePrimArray s Word64
paBlobRefs2 :: MutablePrimArray s Word32
paKeys :: MVector s SerialisedKey
paValues :: MVector s SerialisedValue
..} !Int
n = do
    MutablePrimArray (PrimState (ST s)) Int
-> Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
P.setPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
0 Int
4 Int
0
    MutablePrimArray (PrimState (ST s)) Word64
-> Int -> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
P.setPrimArray MutablePrimArray s Word64
MutablePrimArray (PrimState (ST s)) Word64
paOpMap Int
0 Int
maxOpMap Word64
0
    MutablePrimArray (PrimState (ST s)) Word64
-> Int -> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> Int -> a -> m ()
P.setPrimArray MutablePrimArray s Word64
MutablePrimArray (PrimState (ST s)) Word64
paBlobRefsMap Int
0 Int
maxBlobRefsMap Word64
0

    -- we don't need to clear these, we set what we need.
    -- P.setPrimArray paBlobRefs1 0 maxKeys 0
    -- P.setPrimArray paBlobRefs1 0 maxKeys 0

    MVector (PrimState (ST s)) SerialisedKey
-> SerialisedKey -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> a -> m ()
VM.set (Int -> Int -> MVector s SerialisedKey -> MVector s SerialisedKey
forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice Int
0 Int
n MVector s SerialisedKey
paKeys) (SerialisedKey -> ST s ()) -> SerialisedKey -> ST s ()
forall a b. (a -> b) -> a -> b
$! SerialisedKey
dummyKey
    MVector (PrimState (ST s)) SerialisedValue
-> SerialisedValue -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> a -> m ()
VM.set (Int
-> Int -> MVector s SerialisedValue -> MVector s SerialisedValue
forall s a. Int -> Int -> MVector s a -> MVector s a
VM.slice Int
0 Int
n MVector s SerialisedValue
paValues) (SerialisedValue -> ST s ()) -> SerialisedValue -> ST s ()
forall a b. (a -> b) -> a -> b
$! SerialisedValue
dummyValue

    -- initial size is 8 bytes for directory and 2 bytes for last value offset.
    MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
P.writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
byteSizeIdx Int
10

-- | Add an entry to 'PageAcc'.
--
pageAccAddElem ::
       PageAcc s
    -> SerialisedKey
    -> Entry SerialisedValue BlobSpan
    -> ST s Bool   -- ^ 'True' if value was successfully added.
pageAccAddElem :: forall s.
PageAcc s
-> SerialisedKey -> Entry SerialisedValue BlobSpan -> ST s Bool
pageAccAddElem PageAcc {MutablePrimArray s Int
MutablePrimArray s Word32
MutablePrimArray s Word64
MVector s SerialisedValue
MVector s SerialisedKey
paDir :: forall s. PageAcc s -> MutablePrimArray s Int
paOpMap :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefsMap :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefs1 :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefs2 :: forall s. PageAcc s -> MutablePrimArray s Word32
paKeys :: forall s. PageAcc s -> MVector s SerialisedKey
paValues :: forall s. PageAcc s -> MVector s SerialisedValue
paDir :: MutablePrimArray s Int
paOpMap :: MutablePrimArray s Word64
paBlobRefsMap :: MutablePrimArray s Word64
paBlobRefs1 :: MutablePrimArray s Word64
paBlobRefs2 :: MutablePrimArray s Word32
paKeys :: MVector s SerialisedKey
paValues :: MVector s SerialisedValue
..} SerialisedKey
k Entry SerialisedValue BlobSpan
e
    -- quick short circuit: if the entry is bigger than page: no luck.
    | SerialisedKey -> Entry SerialisedValue BlobSpan -> Int
forall b. SerialisedKey -> Entry SerialisedValue b -> Int
sizeofEntry SerialisedKey
k Entry SerialisedValue BlobSpan
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
pageSize = Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    | Bool
otherwise = do
        Int
n <- MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
keysCountIdx
        Int
b <- MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
blobRefCountIdx
        Int
s <- MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
byteSizeIdx

        let !n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        let !b' :: Int
b' = if Entry SerialisedValue BlobSpan -> Bool
forall a b. Entry a b -> Bool
hasBlobRef Entry SerialisedValue BlobSpan
e then Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
b

        let !s' :: Int
s' = Int
s
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Int -> Int
forall a. (Bits a, Num a) => a -> a
mod64 Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
8 else Int
0)         -- blobrefs bitmap
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Int -> Int
forall a. (Bits a, Num a) => a -> a
mod32 Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
8 else Int
0)         -- operations bitmap
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (case Int
n of { Int
0 -> Int
6; Int
1 -> Int
2; Int
_ -> Int
4 })  -- key and value offsets
               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SerialisedKey -> Entry SerialisedValue BlobSpan -> Int
forall b. SerialisedKey -> Entry SerialisedValue b -> Int
sizeofEntry SerialisedKey
k Entry SerialisedValue BlobSpan
e

        if Int
s' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
pageSize Bool -> Bool -> Bool
|| -- check for size overflow
           Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
maxKeys     -- check for buffer overflow
        then Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        else do
            -- key sizes
            Int
ks <- MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
keysSizeIdx
            let !ks' :: Int
ks' = Int
ks Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SerialisedKey -> Int
sizeofKey SerialisedKey
k

            MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
P.writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
keysCountIdx Int
n'
            MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
P.writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
blobRefCountIdx Int
b'
            MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
P.writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
keysSizeIdx Int
ks'
            MutablePrimArray (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
P.writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
byteSizeIdx Int
s'

            -- blob reference
            case Entry SerialisedValue BlobSpan
e of
                InsertWithBlob SerialisedValue
_ (BlobSpan Word64
w64 Word32
w32) -> do
                    MutablePrimArray s Word64 -> Int -> ST s ()
forall s. MutablePrimArray s Word64 -> Int -> ST s ()
setBlobRef MutablePrimArray s Word64
paBlobRefsMap Int
n
                    MutablePrimArray (PrimState (ST s)) Word64
-> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
P.writePrimArray MutablePrimArray s Word64
MutablePrimArray (PrimState (ST s)) Word64
paBlobRefs1 Int
b Word64
w64
                    MutablePrimArray (PrimState (ST s)) Word32
-> Int -> Word32 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
P.writePrimArray MutablePrimArray s Word32
MutablePrimArray (PrimState (ST s)) Word32
paBlobRefs2 Int
b Word32
w32
                Entry SerialisedValue BlobSpan
_ -> () -> ST s ()
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

            -- operation
            MutablePrimArray s Word64 -> Int -> Word64 -> ST s ()
forall s. MutablePrimArray s Word64 -> Int -> Word64 -> ST s ()
setOperation MutablePrimArray s Word64
paOpMap Int
n (Entry SerialisedValue BlobSpan -> Word64
entryCrumb Entry SerialisedValue BlobSpan
e)

            -- keys and values
            MVector (PrimState (ST s)) SerialisedKey
-> Int -> SerialisedKey -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector s SerialisedKey
MVector (PrimState (ST s)) SerialisedKey
paKeys Int
n SerialisedKey
k
            MVector (PrimState (ST s)) SerialisedValue
-> Int -> SerialisedValue -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> a -> m ()
VM.write MVector s SerialisedValue
MVector (PrimState (ST s)) SerialisedValue
paValues Int
n (SerialisedValue -> ST s ()) -> SerialisedValue -> ST s ()
forall a b. (a -> b) -> a -> b
$! Entry SerialisedValue BlobSpan -> SerialisedValue
entryValue Entry SerialisedValue BlobSpan
e

            Bool -> ST s Bool
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

setBlobRef :: P.MutablePrimArray s Word64 -> Int -> ST s ()
setBlobRef :: forall s. MutablePrimArray s Word64 -> Int -> ST s ()
setBlobRef MutablePrimArray s Word64
arr Int
i = do
    let !j :: Int
j = Int -> Int
forall a. Bits a => a -> a
div64 Int
i
    let !k :: Int
k = Int -> Int
forall a. (Bits a, Num a) => a -> a
mod64 Int
i
    Word64
w64 <- MutablePrimArray (PrimState (ST s)) Word64 -> Int -> ST s Word64
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Word64
MutablePrimArray (PrimState (ST s)) Word64
arr Int
j
    let w64' :: Word64
w64' = Word64
w64 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL Word64
1 Int
k
    MutablePrimArray (PrimState (ST s)) Word64
-> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
P.writePrimArray MutablePrimArray s Word64
MutablePrimArray (PrimState (ST s)) Word64
arr Int
j (Word64 -> ST s ()) -> Word64 -> ST s ()
forall a b. (a -> b) -> a -> b
$! Word64
w64'

setOperation :: P.MutablePrimArray s Word64 -> Int -> Word64 -> ST s ()
setOperation :: forall s. MutablePrimArray s Word64 -> Int -> Word64 -> ST s ()
setOperation MutablePrimArray s Word64
arr Int
i Word64
crumb = do
    let !j :: Int
j = Int -> Int
forall a. Bits a => a -> a
div32 Int
i
    let !k :: Int
k = Int -> Int
forall a. (Bits a, Num a) => a -> a
mod32 Int
i
    Word64
w64 <- MutablePrimArray (PrimState (ST s)) Word64 -> Int -> ST s Word64
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Word64
MutablePrimArray (PrimState (ST s)) Word64
arr Int
j
    let w64' :: Word64
w64' = Word64
w64 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL Word64
crumb (Int -> Int
forall a. Bits a => a -> a
mul2 Int
k)
    MutablePrimArray (PrimState (ST s)) Word64
-> Int -> Word64 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
P.writePrimArray MutablePrimArray s Word64
MutablePrimArray (PrimState (ST s)) Word64
arr Int
j (Word64 -> ST s ()) -> Word64 -> ST s ()
forall a b. (a -> b) -> a -> b
$! Word64
w64'

-- | Convert mutable 'PageAcc' accumulator to concrete 'RawPage'.
--
-- After this operation 'PageAcc' argument can be reset with 'resetPageAcc',
-- and reused.
serialisePageAcc :: PageAcc s -> ST s RawPage
serialisePageAcc :: forall s. PageAcc s -> ST s RawPage
serialisePageAcc page :: PageAcc s
page@PageAcc {MutablePrimArray s Int
MutablePrimArray s Word32
MutablePrimArray s Word64
MVector s SerialisedValue
MVector s SerialisedKey
paDir :: forall s. PageAcc s -> MutablePrimArray s Int
paOpMap :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefsMap :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefs1 :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefs2 :: forall s. PageAcc s -> MutablePrimArray s Word32
paKeys :: forall s. PageAcc s -> MVector s SerialisedKey
paValues :: forall s. PageAcc s -> MVector s SerialisedValue
paDir :: MutablePrimArray s Int
paOpMap :: MutablePrimArray s Word64
paBlobRefsMap :: MutablePrimArray s Word64
paBlobRefs1 :: MutablePrimArray s Word64
paBlobRefs2 :: MutablePrimArray s Word32
paKeys :: MVector s SerialisedKey
paValues :: MVector s SerialisedValue
..} = do
    Int
size <- MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
keysCountIdx
    case Int
size of
        Int
0 -> RawPage -> ST s RawPage
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return RawPage
emptyRawPage
        Int
_ -> Int -> PageAcc s -> ST s RawPage
forall s. Int -> PageAcc s -> ST s RawPage
serialisePageAccN Int
size PageAcc s
page

-- | Serialise non-empty page.
serialisePageAccN :: forall s. Int -> PageAcc s -> ST s RawPage
serialisePageAccN :: forall s. Int -> PageAcc s -> ST s RawPage
serialisePageAccN Int
size PageAcc {MutablePrimArray s Int
MutablePrimArray s Word32
MutablePrimArray s Word64
MVector s SerialisedValue
MVector s SerialisedKey
paDir :: forall s. PageAcc s -> MutablePrimArray s Int
paOpMap :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefsMap :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefs1 :: forall s. PageAcc s -> MutablePrimArray s Word64
paBlobRefs2 :: forall s. PageAcc s -> MutablePrimArray s Word32
paKeys :: forall s. PageAcc s -> MVector s SerialisedKey
paValues :: forall s. PageAcc s -> MVector s SerialisedValue
paDir :: MutablePrimArray s Int
paOpMap :: MutablePrimArray s Word64
paBlobRefsMap :: MutablePrimArray s Word64
paBlobRefs1 :: MutablePrimArray s Word64
paBlobRefs2 :: MutablePrimArray s Word32
paKeys :: MVector s SerialisedKey
paValues :: MVector s SerialisedValue
..} = do
    Int
b  <- MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
blobRefCountIdx
    Int
ks <- MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
keysSizeIdx

    -- keys offsets offset
    let ko0 :: Int
        !ko0 :: Int
ko0 = Int
8
             Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Bits a => a -> a
mul8 (Int -> Int
forall a. (Bits a, Num a) => a -> a
ceilDiv64 Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. (Bits a, Num a) => a -> a
ceilDiv64 (Int -> Int
forall a. Bits a => a -> a
mul2 Int
size)) -- blob and operations bitmaps
             Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Bits a => a -> a
mul8 Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Bits a => a -> a
mul4 Int
b                               -- blob refs

    -- values offset offset
    let vo0 :: Int
        !vo0 :: Int
vo0 = Int
ko0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Bits a => a -> a
mul2 Int
size

    -- keys data offset
    let kd0 :: Int
        !kd0 :: Int
kd0 = Int
vo0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Int
6 else Int -> Int
forall a. Bits a => a -> a
mul2 (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

    -- values data offset
    let vd0 :: Int
        !vd0 :: Int
vd0 = Int
kd0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ks

    -- allocate bytearray
    MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newByteArray Int
pageSize :: ST s (P.MutableByteArray s)
    MutableByteArray (PrimState (ST s))
-> Int -> Int -> Word8 -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Int -> Word8 -> m ()
P.fillByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
0 Int
pageSize Word8
0

    -- directory: 64 bytes
    MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
0 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size :: Word16)
    MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
1 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b :: Word16)
    MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
2 (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ko0 :: Word16)

    -- blobref and operation bitmap sizes in bytes
    let !blobRefMapSize :: Int
blobRefMapSize = Int -> Int
forall a. Bits a => a -> a
mul8 (Int -> Int
forall a. (Bits a, Num a) => a -> a
ceilDiv64 Int
size)
    let !opMapSize :: Int
opMapSize      = Int -> Int
forall a. Bits a => a -> a
mul8 (Int -> Int
forall a. (Bits a, Num a) => a -> a
ceilDiv64 (Int -> Int
forall a. Bits a => a -> a
mul2 Int
size))

    -- traceM $ "sizes " ++ show (blobRefMapSize, opMapSize)

    MutableByteArray (PrimState (ST s))
-> Int
-> MutableByteArray (PrimState (ST s))
-> Int
-> Int
-> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
P.copyMutableByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
8                    (MutablePrimArray s Word64 -> MutableByteArray s
forall s a. MutablePrimArray s a -> MutableByteArray s
primToByte MutablePrimArray s Word64
paBlobRefsMap) Int
0 Int
blobRefMapSize
    MutableByteArray (PrimState (ST s))
-> Int
-> MutableByteArray (PrimState (ST s))
-> Int
-> Int
-> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
P.copyMutableByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blobRefMapSize) (MutablePrimArray s Word64 -> MutableByteArray s
forall s a. MutablePrimArray s a -> MutableByteArray s
primToByte MutablePrimArray s Word64
paOpMap)       Int
0 Int
opMapSize

    -- blob references
    MutableByteArray (PrimState (ST s))
-> Int
-> MutableByteArray (PrimState (ST s))
-> Int
-> Int
-> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
P.copyMutableByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blobRefMapSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
opMapSize)          (MutablePrimArray s Word64 -> MutableByteArray s
forall s a. MutablePrimArray s a -> MutableByteArray s
primToByte MutablePrimArray s Word64
paBlobRefs1) Int
0 (Int -> Int
forall a. Bits a => a -> a
mul8 Int
b)
    MutableByteArray (PrimState (ST s))
-> Int
-> MutableByteArray (PrimState (ST s))
-> Int
-> Int
-> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
P.copyMutableByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
blobRefMapSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
opMapSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Bits a => a -> a
mul8 Int
b) (MutablePrimArray s Word32 -> MutableByteArray s
forall s a. MutablePrimArray s a -> MutableByteArray s
primToByte MutablePrimArray s Word32
paBlobRefs2) Int
0 (Int -> Int
forall a. Bits a => a -> a
mul4 Int
b)

    -- traceM $ "preloop " ++ show (ko0, kd0, vd0)

    let loop :: Int -> Int -> Int -> Int -> Int -> ST s ()
        loop :: Int -> Int -> Int -> Int -> Int -> ST s ()
loop !Int
i !Int
ko !Int
vo !Int
kd !Int
vd
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
size = do
                  -- past last value offset.
                  -- Note: we don't need to write this offset as Word32
                  -- even in size == 1 case, as preconditions require the
                  -- entries to fit into page, i.e. fit into Word16.
                  MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba (Int -> Int
forall a. Bits a => a -> a
div2 Int
vo) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vd :: Word16)

            | Bool
otherwise = do
                  -- traceM $ "loop " ++ show (i, ko, kd, vo, vd)

                  SerialisedKey   (RawBytes (VP.Vector Int
koff Int
klen ByteArray
kba)) <- MVector (PrimState (ST s)) SerialisedKey
-> Int -> ST s SerialisedKey
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
VM.read MVector s SerialisedKey
MVector (PrimState (ST s)) SerialisedKey
paKeys Int
i
                  SerialisedValue (RawBytes (VP.Vector Int
voff Int
vlen ByteArray
vba)) <- MVector (PrimState (ST s)) SerialisedValue
-> Int -> ST s SerialisedValue
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
VM.read MVector s SerialisedValue
MVector (PrimState (ST s)) SerialisedValue
paValues Int
i

                  -- key and value offsets
                  MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba (Int -> Int
forall a. Bits a => a -> a
div2 Int
ko) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
kd :: Word16)
                  MutableByteArray (PrimState (ST s)) -> Int -> Word16 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
P.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba (Int -> Int
forall a. Bits a => a -> a
div2 Int
vo) (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vd :: Word16)

                  -- key and value data
                  MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
P.copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
kd ByteArray
kba Int
koff Int
klen
                  MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
P.copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba Int
vd ByteArray
vba Int
voff Int
vlen

                  Int -> Int -> Int -> Int -> Int -> ST s ()
loop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
ko Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
vo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
kd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
klen) (Int
vd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vlen)

    Int -> Int -> Int -> Int -> Int -> ST s ()
loop Int
0 Int
ko0 Int
vo0 Int
kd0 Int
vd0

    ByteArray
ba' <- MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
P.unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
ba
    RawPage -> ST s RawPage
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteArray -> Int -> RawPage
makeRawPage ByteArray
ba' Int
0)


keysCountPageAcc :: PageAcc s -> ST s Int
keysCountPageAcc :: forall s. PageAcc s -> ST s Int
keysCountPageAcc PageAcc {MutablePrimArray s Int
paDir :: forall s. PageAcc s -> MutablePrimArray s Int
paDir :: MutablePrimArray s Int
paDir} = MutablePrimArray (PrimState (ST s)) Int -> Int -> ST s Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
P.readPrimArray MutablePrimArray s Int
MutablePrimArray (PrimState (ST s)) Int
paDir Int
keysCountIdx

indexKeyPageAcc :: PageAcc s -> Int -> ST s SerialisedKey
indexKeyPageAcc :: forall s. PageAcc s -> Int -> ST s SerialisedKey
indexKeyPageAcc PageAcc {MVector s SerialisedKey
paKeys :: forall s. PageAcc s -> MVector s SerialisedKey
paKeys :: MVector s SerialisedKey
paKeys} Int
ix = MVector (PrimState (ST s)) SerialisedKey
-> Int -> ST s SerialisedKey
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Int -> m a
VM.read MVector s SerialisedKey
MVector (PrimState (ST s)) SerialisedKey
paKeys Int
ix

-------------------------------------------------------------------------------
-- Utils
-------------------------------------------------------------------------------

-- | Extract underlying bytearray fromn 'P.MutableByteArray',
-- so we can copy its contents.
primToByte :: P.MutablePrimArray s a -> P.MutableByteArray s
primToByte :: forall s a. MutablePrimArray s a -> MutableByteArray s
primToByte (P.MutablePrimArray MutableByteArray# s
ba) = MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
P.MutableByteArray MutableByteArray# s
ba