{-# OPTIONS_HADDOCK not-home #-}

-- | Create a single value page
--
module Database.LSMTree.Internal.PageAcc1 (
    singletonPage,
) where

import           Control.Monad.ST.Strict (ST, runST)
import qualified Data.Primitive as P
import qualified Data.Vector.Primitive as VP
import           Data.Word (Word16, Word32, Word64)
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.RawOverflowPage
import           Database.LSMTree.Internal.RawPage
import           Database.LSMTree.Internal.Serialise

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

-- | Create a singleton page, also returning the overflow value bytes.
singletonPage ::
       SerialisedKey
    -> Entry SerialisedValue BlobSpan
    -> (RawPage, [RawOverflowPage])
singletonPage :: SerialisedKey
-> Entry SerialisedValue BlobSpan -> (RawPage, [RawOverflowPage])
singletonPage SerialisedKey
k (Insert SerialisedValue
v) = (forall s. ST s (RawPage, [RawOverflowPage]))
-> (RawPage, [RawOverflowPage])
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (RawPage, [RawOverflowPage]))
 -> (RawPage, [RawOverflowPage]))
-> (forall s. ST s (RawPage, [RawOverflowPage]))
-> (RawPage, [RawOverflowPage])
forall a b. (a -> b) -> a -> b
$ do
    -- allocate bytearray
    MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newPinnedByteArray 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 (Word16
1  :: 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 (Word16
0  :: 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 (Word16
24 :: Word16)

    -- blobref and operation bitmap sizes in bytes
    -- P.writeByteArray ba 1 (0 :: Word64)
    -- P.writeByteArray ba 2 (0 :: Word64)

    -- no blob references

    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
12 (Word16
32 :: Word16) -- key offset
    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
13 (Word16
32 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ SerialisedKey -> Word16
sizeofKey16 SerialisedKey
k :: Word16) -- value offset
    MutableByteArray (PrimState (ST s)) -> Int -> Word32 -> 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
7  (Word32
32 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ SerialisedKey -> Word32
sizeofKey32 SerialisedKey
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ SerialisedValue -> Word32
sizeofValue32 SerialisedValue
v :: Word32) -- post value offset

    -- copy key
    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
32          ByteArray
kba Int
koff Int
klen

    -- copy value prefix
    let vlen' :: Int
vlen' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
vlen (Int
pageSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
klen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32)
    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
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
klen) ByteArray
vba Int
voff Int
vlen'

    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
    let !page :: RawPage
page          = ByteArray -> Int -> RawPage
unsafeMakeRawPage ByteArray
ba' Int
0
        !overflowPages :: [RawOverflowPage]
overflowPages = RawBytes -> [RawOverflowPage]
rawBytesToOverflowPages (Int -> RawBytes -> RawBytes
RB.drop Int
vlen' RawBytes
v')
    (RawPage, [RawOverflowPage]) -> ST s (RawPage, [RawOverflowPage])
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawPage
page, [RawOverflowPage]
overflowPages)
  where
    SerialisedKey      (RawBytes (VP.Vector Int
koff Int
klen ByteArray
kba)) = SerialisedKey
k
    SerialisedValue v' :: RawBytes
v'@(RawBytes (VP.Vector Int
voff Int
vlen ByteArray
vba)) = SerialisedValue
v

singletonPage SerialisedKey
k (InsertWithBlob SerialisedValue
v (BlobSpan Word64
w64 Word32
w32)) = (forall s. ST s (RawPage, [RawOverflowPage]))
-> (RawPage, [RawOverflowPage])
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (RawPage, [RawOverflowPage]))
 -> (RawPage, [RawOverflowPage]))
-> (forall s. ST s (RawPage, [RawOverflowPage]))
-> (RawPage, [RawOverflowPage])
forall a b. (a -> b) -> a -> b
$ do
    -- allocate bytearray
    MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newPinnedByteArray 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 (Word16
1  :: 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 (Word16
1  :: 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 (Word16
36 :: Word16)

    -- blobref and operation bitmap sizes in bytes
    MutableByteArray (PrimState (ST s)) -> Int -> Word64 -> 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 (Word64
1 :: Word64)
    -- P.writeByteArray ba 2 (0 :: Word64)

    -- blob references
    MutableByteArray (PrimState (ST s)) -> Int -> Word64 -> 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
3 Word64
w64
    MutableByteArray (PrimState (ST s)) -> Int -> Word32 -> 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
8 Word32
w32

    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
18 (Word16
44 :: Word16) -- key offset
    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
19 (Word16
44 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ SerialisedKey -> Word16
sizeofKey16 SerialisedKey
k :: Word16) -- value offset
    MutableByteArray (PrimState (ST s)) -> Int -> Word32 -> 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
10  (Word32
44 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ SerialisedKey -> Word32
sizeofKey32 SerialisedKey
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ SerialisedValue -> Word32
sizeofValue32 SerialisedValue
v :: Word32) -- post value offset

    -- copy key
    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
44          ByteArray
kba Int
koff Int
klen

    -- copy value prefix
    let vlen' :: Int
vlen' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
vlen (Int
pageSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
klen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
44)
    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
44 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
klen) ByteArray
vba Int
voff Int
vlen'

    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
    let !page :: RawPage
page          = ByteArray -> Int -> RawPage
unsafeMakeRawPage ByteArray
ba' Int
0
        !overflowPages :: [RawOverflowPage]
overflowPages = RawBytes -> [RawOverflowPage]
rawBytesToOverflowPages (Int -> RawBytes -> RawBytes
RB.drop Int
vlen' RawBytes
v')
    (RawPage, [RawOverflowPage]) -> ST s (RawPage, [RawOverflowPage])
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawPage
page, [RawOverflowPage]
overflowPages)
  where
    SerialisedKey      (RawBytes (VP.Vector Int
koff Int
klen ByteArray
kba)) = SerialisedKey
k
    SerialisedValue v' :: RawBytes
v'@(RawBytes (VP.Vector Int
voff Int
vlen ByteArray
vba)) = SerialisedValue
v

singletonPage SerialisedKey
k (Mupdate SerialisedValue
v) = (forall s. ST s (RawPage, [RawOverflowPage]))
-> (RawPage, [RawOverflowPage])
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (RawPage, [RawOverflowPage]))
 -> (RawPage, [RawOverflowPage]))
-> (forall s. ST s (RawPage, [RawOverflowPage]))
-> (RawPage, [RawOverflowPage])
forall a b. (a -> b) -> a -> b
$ do
    -- allocate bytearray
    MutableByteArray s
ba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
P.newPinnedByteArray 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 (Word16
1  :: 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 (Word16
0  :: 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 (Word16
24 :: Word16)

    -- blobref and operation bitmap sizes in bytes
    -- P.writeByteArray ba 1 (0 :: Word64)
    MutableByteArray (PrimState (ST s)) -> Int -> Word64 -> 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 (Word64
1 :: Word64)

    -- no blob references

    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
12 (Word16
32 :: Word16) -- key offset
    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
13 (Word16
32 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ SerialisedKey -> Word16
sizeofKey16 SerialisedKey
k :: Word16) -- value offset
    MutableByteArray (PrimState (ST s)) -> Int -> Word32 -> 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
7  (Word32
32 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ SerialisedKey -> Word32
sizeofKey32 SerialisedKey
k Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ SerialisedValue -> Word32
sizeofValue32 SerialisedValue
v :: Word32) -- post value offset

    -- copy key
    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
32          ByteArray
kba Int
koff Int
klen

    -- copy value prefix
    let vlen' :: Int
vlen' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
vlen (Int
pageSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
klen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
32)
    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
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
klen) ByteArray
vba Int
voff Int
vlen'

    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
    let !page :: RawPage
page          = ByteArray -> Int -> RawPage
unsafeMakeRawPage ByteArray
ba' Int
0
        !overflowPages :: [RawOverflowPage]
overflowPages = RawBytes -> [RawOverflowPage]
rawBytesToOverflowPages (Int -> RawBytes -> RawBytes
RB.drop Int
vlen' RawBytes
v')
    (RawPage, [RawOverflowPage]) -> ST s (RawPage, [RawOverflowPage])
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawPage
page, [RawOverflowPage]
overflowPages)
  where
    SerialisedKey      (RawBytes (VP.Vector Int
koff Int
klen ByteArray
kba)) = SerialisedKey
k
    SerialisedValue v' :: RawBytes
v'@(RawBytes (VP.Vector Int
voff Int
vlen ByteArray
vba)) = SerialisedValue
v

singletonPage SerialisedKey
_ Entry SerialisedValue BlobSpan
Delete = [Char] -> (RawPage, [RawOverflowPage])
forall a. HasCallStack => [Char] -> a
error [Char]
"singletonPage: unexpected Delete entry"