{-# LANGUAGE ParallelListComp #-}
-- | This accompanies the format-page.md documentation as a sanity check
-- and a precise reference. It is intended to demonstrate that the page
-- format works. It is also used as a reference implementation for tests of
-- the real implementation.
--
-- Logically, a page is a sequence of key,operation pairs (with optional
-- blobrefs), sorted by key, and its serialised form fits within a disk page.
--
-- This reference implementation covers serialisation and deserialisation
-- (not lookups) which do not rely on (or enforce) the keys being sorted.
--
module FormatPage (
    -- * Page types
    Key (..),
    Operation (..),
    Value (..),
    BlobRef (..),
    PageSerialised,
    PageIntermediate,

    -- * Page size
    PageSize (..),
    pageSizeEmpty,
    pageSizeAddElem,
    calcPageSize,

    -- * Encoding and decoding
    DiskPageSize(..),
    encodePage,
    decodePage,
    serialisePage,
    deserialisePage,

    -- * Overflow pages
    pageOverflowPrefixSuffixLen,
    pageDiskPages,
    pageSerialisedChunks,

    -- * Tests and generators
    tests,
    -- ** Generators and shrinkers
    genPageContentFits,
    genPageContentMaybeOverfull,
    genPageContentSingle,
    genPageContentNearFull,
    genPageContentMedium,
    MinKeySize(..),
    noMinKeySize,
    orderdKeyOps,
    shrinkKeyOps,
    shrinkOrderedKeyOps,
) where

import           Data.Bits
import           Data.Function (on)
import qualified Data.List as List
import           Data.Maybe (fromJust, fromMaybe)
import           Data.Word

import qualified Data.Binary.Get as Bin
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BSL

import           Control.Exception (assert)
import           Control.Monad

import           Test.QuickCheck hiding ((.&.))
import           Test.Tasty
import           Test.Tasty.QuickCheck (testProperty)


-------------------------------------------------------------------------------
-- Page content types
--

newtype Key   = Key   { Key -> ByteString
unKey   :: ByteString } deriving stock (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
/= :: Key -> Key -> Bool
Eq, Eq Key
Eq Key =>
(Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Key -> Key -> Ordering
compare :: Key -> Key -> Ordering
$c< :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
>= :: Key -> Key -> Bool
$cmax :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
min :: Key -> Key -> Key
Ord, Int -> Key -> ShowS
[Key] -> ShowS
Key -> String
(Int -> Key -> ShowS)
-> (Key -> String) -> ([Key] -> ShowS) -> Show Key
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Key -> ShowS
showsPrec :: Int -> Key -> ShowS
$cshow :: Key -> String
show :: Key -> String
$cshowList :: [Key] -> ShowS
showList :: [Key] -> ShowS
Show)
newtype Value = Value { Value -> ByteString
unValue :: ByteString } deriving stock (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)

data Operation = Insert  Value (Maybe BlobRef)
               | Mupsert Value
               | Delete
  deriving stock (Operation -> Operation -> Bool
(Operation -> Operation -> Bool)
-> (Operation -> Operation -> Bool) -> Eq Operation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
/= :: Operation -> Operation -> Bool
Eq, Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
(Int -> Operation -> ShowS)
-> (Operation -> String)
-> ([Operation] -> ShowS)
-> Show Operation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Operation -> ShowS
showsPrec :: Int -> Operation -> ShowS
$cshow :: Operation -> String
show :: Operation -> String
$cshowList :: [Operation] -> ShowS
showList :: [Operation] -> ShowS
Show)

data BlobRef = BlobRef Word64 Word32
  deriving stock (BlobRef -> BlobRef -> Bool
(BlobRef -> BlobRef -> Bool)
-> (BlobRef -> BlobRef -> Bool) -> Eq BlobRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlobRef -> BlobRef -> Bool
== :: BlobRef -> BlobRef -> Bool
$c/= :: BlobRef -> BlobRef -> Bool
/= :: BlobRef -> BlobRef -> Bool
Eq, Int -> BlobRef -> ShowS
[BlobRef] -> ShowS
BlobRef -> String
(Int -> BlobRef -> ShowS)
-> (BlobRef -> String) -> ([BlobRef] -> ShowS) -> Show BlobRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlobRef -> ShowS
showsPrec :: Int -> BlobRef -> ShowS
$cshow :: BlobRef -> String
show :: BlobRef -> String
$cshowList :: [BlobRef] -> ShowS
showList :: [BlobRef] -> ShowS
Show)

opHasBlobRef :: Operation -> Bool
opHasBlobRef :: Operation -> Bool
opHasBlobRef (Insert Value
_ (Just BlobRef
_blobref)) = Bool
True
opHasBlobRef Operation
_                          = Bool
False


-------------------------------------------------------------------------------
-- Disk page size
--

-- | A serialised page fits within chunks of memory of 4k, 8k, 16k, 32k or 64k.
--
data DiskPageSize = DiskPage4k  | DiskPage8k
                  | DiskPage16k | DiskPage32k
                  | DiskPage64k
  deriving stock (DiskPageSize -> DiskPageSize -> Bool
(DiskPageSize -> DiskPageSize -> Bool)
-> (DiskPageSize -> DiskPageSize -> Bool) -> Eq DiskPageSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiskPageSize -> DiskPageSize -> Bool
== :: DiskPageSize -> DiskPageSize -> Bool
$c/= :: DiskPageSize -> DiskPageSize -> Bool
/= :: DiskPageSize -> DiskPageSize -> Bool
Eq, Int -> DiskPageSize -> ShowS
[DiskPageSize] -> ShowS
DiskPageSize -> String
(Int -> DiskPageSize -> ShowS)
-> (DiskPageSize -> String)
-> ([DiskPageSize] -> ShowS)
-> Show DiskPageSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiskPageSize -> ShowS
showsPrec :: Int -> DiskPageSize -> ShowS
$cshow :: DiskPageSize -> String
show :: DiskPageSize -> String
$cshowList :: [DiskPageSize] -> ShowS
showList :: [DiskPageSize] -> ShowS
Show, Int -> DiskPageSize
DiskPageSize -> Int
DiskPageSize -> [DiskPageSize]
DiskPageSize -> DiskPageSize
DiskPageSize -> DiskPageSize -> [DiskPageSize]
DiskPageSize -> DiskPageSize -> DiskPageSize -> [DiskPageSize]
(DiskPageSize -> DiskPageSize)
-> (DiskPageSize -> DiskPageSize)
-> (Int -> DiskPageSize)
-> (DiskPageSize -> Int)
-> (DiskPageSize -> [DiskPageSize])
-> (DiskPageSize -> DiskPageSize -> [DiskPageSize])
-> (DiskPageSize -> DiskPageSize -> [DiskPageSize])
-> (DiskPageSize -> DiskPageSize -> DiskPageSize -> [DiskPageSize])
-> Enum DiskPageSize
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DiskPageSize -> DiskPageSize
succ :: DiskPageSize -> DiskPageSize
$cpred :: DiskPageSize -> DiskPageSize
pred :: DiskPageSize -> DiskPageSize
$ctoEnum :: Int -> DiskPageSize
toEnum :: Int -> DiskPageSize
$cfromEnum :: DiskPageSize -> Int
fromEnum :: DiskPageSize -> Int
$cenumFrom :: DiskPageSize -> [DiskPageSize]
enumFrom :: DiskPageSize -> [DiskPageSize]
$cenumFromThen :: DiskPageSize -> DiskPageSize -> [DiskPageSize]
enumFromThen :: DiskPageSize -> DiskPageSize -> [DiskPageSize]
$cenumFromTo :: DiskPageSize -> DiskPageSize -> [DiskPageSize]
enumFromTo :: DiskPageSize -> DiskPageSize -> [DiskPageSize]
$cenumFromThenTo :: DiskPageSize -> DiskPageSize -> DiskPageSize -> [DiskPageSize]
enumFromThenTo :: DiskPageSize -> DiskPageSize -> DiskPageSize -> [DiskPageSize]
Enum, DiskPageSize
DiskPageSize -> DiskPageSize -> Bounded DiskPageSize
forall a. a -> a -> Bounded a
$cminBound :: DiskPageSize
minBound :: DiskPageSize
$cmaxBound :: DiskPageSize
maxBound :: DiskPageSize
Bounded)

diskPageSizeBytes :: DiskPageSize -> Int
diskPageSizeBytes :: DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
DiskPage4k  = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
12::Int)
diskPageSizeBytes DiskPageSize
DiskPage8k  = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
13::Int)
diskPageSizeBytes DiskPageSize
DiskPage16k = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
14::Int)
diskPageSizeBytes DiskPageSize
DiskPage32k = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
15::Int)
diskPageSizeBytes DiskPageSize
DiskPage64k = Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
16::Int)


-------------------------------------------------------------------------------
-- Calculating the page size (incrementally)
--

data PageSize = PageSize {
                  PageSize -> Int
pageSizeElems :: !Int,
                  PageSize -> Int
pageSizeBlobs :: !Int,
                  PageSize -> Int
pageSizeBytes :: !Int,
                  PageSize -> DiskPageSize
pageSizeDisk  :: !DiskPageSize
                }
  deriving stock (PageSize -> PageSize -> Bool
(PageSize -> PageSize -> Bool)
-> (PageSize -> PageSize -> Bool) -> Eq PageSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageSize -> PageSize -> Bool
== :: PageSize -> PageSize -> Bool
$c/= :: PageSize -> PageSize -> Bool
/= :: PageSize -> PageSize -> Bool
Eq, Int -> PageSize -> ShowS
[PageSize] -> ShowS
PageSize -> String
(Int -> PageSize -> ShowS)
-> (PageSize -> String) -> ([PageSize] -> ShowS) -> Show PageSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageSize -> ShowS
showsPrec :: Int -> PageSize -> ShowS
$cshow :: PageSize -> String
show :: PageSize -> String
$cshowList :: [PageSize] -> ShowS
showList :: [PageSize] -> ShowS
Show)

pageSizeEmpty :: DiskPageSize -> PageSize
pageSizeEmpty :: DiskPageSize -> PageSize
pageSizeEmpty = Int -> Int -> Int -> DiskPageSize -> PageSize
PageSize Int
0 Int
0 Int
10

pageSizeAddElem :: (Key, Operation) -> PageSize -> Maybe PageSize
pageSizeAddElem :: (Key, Operation) -> PageSize -> Maybe PageSize
pageSizeAddElem (Key ByteString
key, Operation
op) (PageSize Int
n Int
b Int
sz DiskPageSize
dpgsz)
  | Int
sz' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz Bool -> Bool -> Bool
|| Int
n' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
              = PageSize -> Maybe PageSize
forall a. a -> Maybe a
Just (Int -> Int -> Int -> DiskPageSize -> PageSize
PageSize Int
n' Int
b' Int
sz' DiskPageSize
dpgsz)
  | Bool
otherwise = Maybe PageSize
forall a. Maybe a
Nothing
  where
    n' :: Int
n' = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
    b' :: Int
b' | Operation -> Bool
opHasBlobRef Operation
op = Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
       | Bool
otherwise       = Int
b
    sz' :: Int
sz' = Int
sz
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
64 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
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
32 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
+ (if Operation -> Bool
opHasBlobRef Operation
op then Int
12 else Int
0)   -- blobref entry
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2                                     -- key offsets
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (case Int
n of { Int
0 -> Int
4; Int
1 -> Int
0; Int
_ -> Int
2}) -- value offsets
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
key
        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (case Operation
op of
             Insert  (Value ByteString
v) Maybe BlobRef
_ -> ByteString -> Int
BS.length ByteString
v
             Mupsert (Value ByteString
v)   -> ByteString -> Int
BS.length ByteString
v
             Operation
Delete              -> Int
0)

calcPageSize :: DiskPageSize -> [(Key, Operation)] -> Maybe PageSize
calcPageSize :: DiskPageSize -> [(Key, Operation)] -> Maybe PageSize
calcPageSize DiskPageSize
dpgsz [(Key, Operation)]
kops =
    PageSize -> [(Key, Operation)] -> Maybe PageSize
go (DiskPageSize -> PageSize
pageSizeEmpty DiskPageSize
dpgsz) [(Key, Operation)]
kops
  where
    go :: PageSize -> [(Key, Operation)] -> Maybe PageSize
go !PageSize
pgsz [] = PageSize -> Maybe PageSize
forall a. a -> Maybe a
Just PageSize
pgsz
    go !PageSize
pgsz ((Key
key, Operation
op):[(Key, Operation)]
kops') =
      case (Key, Operation) -> PageSize -> Maybe PageSize
pageSizeAddElem (Key
key, Operation
op) PageSize
pgsz of
        Maybe PageSize
Nothing    -> Maybe PageSize
forall a. Maybe a
Nothing
        Just PageSize
pgsz' -> PageSize -> [(Key, Operation)] -> Maybe PageSize
go PageSize
pgsz' [(Key, Operation)]
kops'


-------------------------------------------------------------------------------
-- Page encoding and serialisation types
--

-- | A serialised page consists of either a single disk page or several
-- disk pages. The latter is a primary page followed by one or more overflow
-- pages. Each disk page (single or multi) uses the same 'DiskPageSize', which
-- should be known from context (e.g. configuration).
--
type PageSerialised = ByteString

data PageIntermediate =
     PageIntermediate {
       PageIntermediate -> Word16
pageNumKeys       :: !Word16,
       PageIntermediate -> Word16
pageNumBlobs      :: !Word16,
       PageIntermediate -> PageSizesOffsets
pageSizesOffsets  :: !PageSizesOffsets,
       PageIntermediate -> [Bool]
pageBlobRefBitmap :: [Bool],
       PageIntermediate -> [OperationEnum]
pageOperations    :: [OperationEnum],
       PageIntermediate -> [BlobRef]
pageBlobRefs      :: [BlobRef],
       PageIntermediate -> [Word16]
pageKeyOffsets    :: [Word16],
       PageIntermediate -> Either [Word16] (Word16, Word32)
pageValueOffsets  :: Either [Word16] (Word16, Word32),
       PageIntermediate -> ByteString
pageKeys          :: !ByteString,
       PageIntermediate -> ByteString
pageValues        :: !ByteString,
       PageIntermediate -> ByteString
pagePadding       :: !ByteString, -- ^ Padding to the 'DiskPageSize'
       PageIntermediate -> DiskPageSize
pageDiskPageSize  :: !DiskPageSize
     }
  deriving stock (PageIntermediate -> PageIntermediate -> Bool
(PageIntermediate -> PageIntermediate -> Bool)
-> (PageIntermediate -> PageIntermediate -> Bool)
-> Eq PageIntermediate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageIntermediate -> PageIntermediate -> Bool
== :: PageIntermediate -> PageIntermediate -> Bool
$c/= :: PageIntermediate -> PageIntermediate -> Bool
/= :: PageIntermediate -> PageIntermediate -> Bool
Eq, Int -> PageIntermediate -> ShowS
[PageIntermediate] -> ShowS
PageIntermediate -> String
(Int -> PageIntermediate -> ShowS)
-> (PageIntermediate -> String)
-> ([PageIntermediate] -> ShowS)
-> Show PageIntermediate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageIntermediate -> ShowS
showsPrec :: Int -> PageIntermediate -> ShowS
$cshow :: PageIntermediate -> String
show :: PageIntermediate -> String
$cshowList :: [PageIntermediate] -> ShowS
showList :: [PageIntermediate] -> ShowS
Show)

data OperationEnum = OpInsert | OpMupsert | OpDelete
  deriving stock (OperationEnum -> OperationEnum -> Bool
(OperationEnum -> OperationEnum -> Bool)
-> (OperationEnum -> OperationEnum -> Bool) -> Eq OperationEnum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OperationEnum -> OperationEnum -> Bool
== :: OperationEnum -> OperationEnum -> Bool
$c/= :: OperationEnum -> OperationEnum -> Bool
/= :: OperationEnum -> OperationEnum -> Bool
Eq, Int -> OperationEnum -> ShowS
[OperationEnum] -> ShowS
OperationEnum -> String
(Int -> OperationEnum -> ShowS)
-> (OperationEnum -> String)
-> ([OperationEnum] -> ShowS)
-> Show OperationEnum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OperationEnum -> ShowS
showsPrec :: Int -> OperationEnum -> ShowS
$cshow :: OperationEnum -> String
show :: OperationEnum -> String
$cshowList :: [OperationEnum] -> ShowS
showList :: [OperationEnum] -> ShowS
Show)

data PageSizesOffsets =
     PageSizesOffsets {
       PageSizesOffsets -> Word16
sizeDirectory     :: !Word16,
       PageSizesOffsets -> Word16
sizeBlobRefBitmap :: !Word16,
       PageSizesOffsets -> Word16
sizeOperations    :: !Word16,
       PageSizesOffsets -> Word16
sizeBlobRefs      :: !Word16,
       PageSizesOffsets -> Word16
sizeKeyOffsets    :: !Word16,
       PageSizesOffsets -> Word16
sizeValueOffsets  :: !Word16,
       PageSizesOffsets -> Word16
sizeKeys          :: !Word16,
       PageSizesOffsets -> Word32
sizeValues        :: !Word32,

       PageSizesOffsets -> Word16
offBlobRefBitmap  :: !Word16,
       PageSizesOffsets -> Word16
offOperations     :: !Word16,
       PageSizesOffsets -> Word16
offBlobRefs       :: !Word16,
       PageSizesOffsets -> Word16
offKeyOffsets     :: !Word16,
       PageSizesOffsets -> Word16
offValueOffsets   :: !Word16,
       PageSizesOffsets -> Word16
offKeys           :: !Word16,
       PageSizesOffsets -> Word16
offValues         :: !Word16,

       PageSizesOffsets -> Word32
sizePageUsed      :: !Word32, -- ^ The size in bytes actually used
       PageSizesOffsets -> Word32
sizePagePadding   :: !Word32, -- ^ The size in bytes of trailing padding
       PageSizesOffsets -> Word32
sizePageDiskPage  :: !Word32  -- ^ The size in bytes rounded up to a
                                     -- multiple of the disk page size.
     }
  deriving stock (PageSizesOffsets -> PageSizesOffsets -> Bool
(PageSizesOffsets -> PageSizesOffsets -> Bool)
-> (PageSizesOffsets -> PageSizesOffsets -> Bool)
-> Eq PageSizesOffsets
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageSizesOffsets -> PageSizesOffsets -> Bool
== :: PageSizesOffsets -> PageSizesOffsets -> Bool
$c/= :: PageSizesOffsets -> PageSizesOffsets -> Bool
/= :: PageSizesOffsets -> PageSizesOffsets -> Bool
Eq, Int -> PageSizesOffsets -> ShowS
[PageSizesOffsets] -> ShowS
PageSizesOffsets -> String
(Int -> PageSizesOffsets -> ShowS)
-> (PageSizesOffsets -> String)
-> ([PageSizesOffsets] -> ShowS)
-> Show PageSizesOffsets
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageSizesOffsets -> ShowS
showsPrec :: Int -> PageSizesOffsets -> ShowS
$cshow :: PageSizesOffsets -> String
show :: PageSizesOffsets -> String
$cshowList :: [PageSizesOffsets] -> ShowS
showList :: [PageSizesOffsets] -> ShowS
Show)


-------------------------------------------------------------------------------
-- Page encoding and serialisation
--

-- | Returns @Nothing@ if the size would be over-full for the given disk page
-- size.
--
calcPageSizeOffsets :: DiskPageSize  -- ^ underlying page size: 4k, 8k ... 64k
                    -> Int           -- ^ number of keys\/entries
                    -> Int           -- ^ number of blobs
                    -> Int           -- ^ total size of the keys
                    -> Int           -- ^ total size of the values
                    -> Maybe PageSizesOffsets
calcPageSizeOffsets :: DiskPageSize -> Int -> Int -> Int -> Int -> Maybe PageSizesOffsets
calcPageSizeOffsets DiskPageSize
dpgsz Int
n Int
b Int
sizeKeys Int
sizeValues
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
sizeKeys Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
sizeValues Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
  = Maybe PageSizesOffsets
forall a. Maybe a
Nothing

  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1 --single entries can use multiple disk pages
  , Int
sizePageUsed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
diskPageSize
  = Maybe PageSizesOffsets
forall a. Maybe a
Nothing

  | Bool
otherwise
  = PageSizesOffsets -> Maybe PageSizesOffsets
forall a. a -> Maybe a
Just PageSizesOffsets {
      -- having checked for not over-full, we can now guarantee all
      -- these conversions into smaller types will not overflow:
      sizeDirectory :: Word16
sizeDirectory     = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizeDirectory,
      sizeBlobRefBitmap :: Word16
sizeBlobRefBitmap = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizeBlobRefBitmap,
      sizeOperations :: Word16
sizeOperations    = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizeOperations,
      sizeBlobRefs :: Word16
sizeBlobRefs      = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizeBlobRefs,
      sizeKeyOffsets :: Word16
sizeKeyOffsets    = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizeKeyOffsets,
      sizeValueOffsets :: Word16
sizeValueOffsets  = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizeValueOffsets,
      sizeKeys :: Word16
sizeKeys          = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizeKeys,
      sizeValues :: Word32
sizeValues        = Int -> Word32
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizeValues,

      offBlobRefBitmap :: Word16
offBlobRefBitmap  = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
offBlobRefBitmap,
      offOperations :: Word16
offOperations     = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
offOperations,
      offBlobRefs :: Word16
offBlobRefs       = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
offBlobRefs,
      offKeyOffsets :: Word16
offKeyOffsets     = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
offKeyOffsets,
      offValueOffsets :: Word16
offValueOffsets   = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
offValueOffsets,
      offKeys :: Word16
offKeys           = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
offKeys,
      offValues :: Word16
offValues         = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
offValues,

      sizePageUsed :: Word32
sizePageUsed      = Int -> Word32
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizePageUsed,
      sizePagePadding :: Word32
sizePagePadding   = Int -> Word32
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizePagePadding,
      sizePageDiskPage :: Word32
sizePageDiskPage  = Int -> Word32
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
sizePageDiskPage
    }
  where
    sizeDirectory, sizeBlobRefBitmap,
      sizeOperations, sizeBlobRefs,
      sizeKeyOffsets, sizeValueOffsets :: Int
    sizeDirectory :: Int
sizeDirectory     = Int
8
    sizeBlobRefBitmap :: Int
sizeBlobRefBitmap = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Bits a => a -> a
complement Int
0x7
    sizeOperations :: Int
sizeOperations    = (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
3 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Bits a => a -> a
complement Int
0x7
    sizeBlobRefs :: Int
sizeBlobRefs      = (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
b
    sizeKeyOffsets :: Int
sizeKeyOffsets    = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n
    sizeValueOffsets :: Int
sizeValueOffsets  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1    = Int
6
                      | Bool
otherwise = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

    offBlobRefBitmap, offOperations, offBlobRefs,
      offKeyOffsets, offValueOffsets,
      offKeys, offValues :: Int
    offBlobRefBitmap :: Int
offBlobRefBitmap  =                    Int
sizeDirectory
    offOperations :: Int
offOperations     = Int
offBlobRefBitmap Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeBlobRefBitmap
    offBlobRefs :: Int
offBlobRefs       = Int
offOperations    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeOperations
    offKeyOffsets :: Int
offKeyOffsets     = Int
offBlobRefs      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeBlobRefs
    offValueOffsets :: Int
offValueOffsets   = Int
offKeyOffsets    Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeKeyOffsets
    offKeys :: Int
offKeys           = Int
offValueOffsets  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeValueOffsets
    offValues :: Int
offValues         = Int
offKeys          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeKeys

    sizePageUsed, sizePagePadding,
      sizePageDiskPage, diskPageSize :: Int
    sizePageUsed :: Int
sizePageUsed      = Int
offValues        Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizeValues
    sizePagePadding :: Int
sizePagePadding   = case Int
sizePageUsed Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
diskPageSize of
                          Int
0 -> Int
0
                          Int
p -> Int
diskPageSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
p
    sizePageDiskPage :: Int
sizePageDiskPage  = Int
sizePageUsed Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sizePagePadding
    diskPageSize :: Int
diskPageSize      = DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz

encodePage :: DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage :: DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage DiskPageSize
dpgsz [(Key, Operation)]
kops = do
    let pageNumKeys :: Int
pageNumKeys       = [(Key, Operation)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Key, Operation)]
kops
        pageNumBlobs :: Int
pageNumBlobs      = [(Key, Operation)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (((Key, Operation) -> Bool)
-> [(Key, Operation)] -> [(Key, Operation)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Operation -> Bool
opHasBlobRef (Operation -> Bool)
-> ((Key, Operation) -> Operation) -> (Key, Operation) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Operation) -> Operation
forall a b. (a, b) -> b
snd) [(Key, Operation)]
kops)
        keys :: [Key]
keys              = [ Key
k | (Key
k,Operation
_)  <- [(Key, Operation)]
kops ]
        values :: [Value]
values            = [ Value
v | (Key
_,Operation
op)  <- [(Key, Operation)]
kops
                            , let v :: Value
v = case Operation
op of
                                        Insert  Value
v' Maybe BlobRef
_ -> Value
v'
                                        Mupsert Value
v'   -> Value
v'
                                        Operation
Delete       -> ByteString -> Value
Value (ByteString
BS.empty)
                            ]

    pageSizesOffsets :: PageSizesOffsets
pageSizesOffsets@PageSizesOffsets {
      Word16
offKeys :: PageSizesOffsets -> Word16
offKeys :: Word16
offKeys, Word16
offValues :: PageSizesOffsets -> Word16
offValues :: Word16
offValues, Word32
sizePagePadding :: PageSizesOffsets -> Word32
sizePagePadding :: Word32
sizePagePadding
    } <- DiskPageSize -> Int -> Int -> Int -> Int -> Maybe PageSizesOffsets
calcPageSizeOffsets
           DiskPageSize
dpgsz
           Int
pageNumKeys Int
pageNumBlobs
           ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ ByteString -> Int
BS.length ByteString
k | Key   ByteString
k <- [Key]
keys ])
           ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ ByteString -> Int
BS.length ByteString
v | Value ByteString
v <- [Value]
values ])

    let pageBlobRefBitmap :: [Bool]
pageBlobRefBitmap = [ Operation -> Bool
opHasBlobRef Operation
op | (Key
_,Operation
op) <- [(Key, Operation)]
kops ]
        pageOperations :: [OperationEnum]
pageOperations    = [ Operation -> OperationEnum
toOperationEnum Operation
op | (Key
_,Operation
op) <- [(Key, Operation)]
kops ]
        pageBlobRefs :: [BlobRef]
pageBlobRefs      = [ BlobRef
blobref | (Key
_,Insert Value
_ (Just BlobRef
blobref)) <- [(Key, Operation)]
kops ]

        pageKeyOffsets :: [Word16]
pageKeyOffsets    = [Word16] -> [Word16]
forall a. HasCallStack => [a] -> [a]
init ([Word16] -> [Word16]) -> [Word16] -> [Word16]
forall a b. (a -> b) -> a -> b
$ (Word16 -> Key -> Word16) -> Word16 -> [Key] -> [Word16]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Word16
o Key
k -> Word16
o Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Key -> Word16
keyLen16 Key
k)
                                         Word16
offKeys [Key]
keys
        pageValueOffsets :: Either [Word16] (Word16, Word32)
pageValueOffsets  = case [Value]
values of
                              [Value
v] -> (Word16, Word32) -> Either [Word16] (Word16, Word32)
forall a b. b -> Either a b
Right (Word16
offValues,
                                            Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
offValues
                                            Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Value -> Word32
valLen32 Value
v)
                              [Value]
_   -> [Word16] -> Either [Word16] (Word16, Word32)
forall a b. a -> Either a b
Left  ((Word16 -> Value -> Word16) -> Word16 -> [Value] -> [Word16]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Word16
o Value
v -> Word16
o Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Value -> Word16
valLen16 Value
v)
                                                  Word16
offValues [Value]
values)
        pageKeys :: ByteString
pageKeys          = [ByteString] -> ByteString
BS.concat [ ByteString
k | Key   ByteString
k <- [Key]
keys ]
        pageValues :: ByteString
pageValues        = [ByteString] -> ByteString
BS.concat [ ByteString
v | Value ByteString
v <- [Value]
values ]
        pagePadding :: ByteString
pagePadding       = Int -> Word8 -> ByteString
BS.replicate (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sizePagePadding) Word8
0
        pageDiskPageSize :: DiskPageSize
pageDiskPageSize  = DiskPageSize
dpgsz

    PageIntermediate -> Maybe PageIntermediate
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PageIntermediate {
      pageNumKeys :: Word16
pageNumKeys  = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
pageNumKeys,
      pageNumBlobs :: Word16
pageNumBlobs = Int -> Word16
forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked Int
pageNumBlobs,
      [Bool]
[Word16]
[OperationEnum]
[BlobRef]
Either [Word16] (Word16, Word32)
ByteString
PageSizesOffsets
DiskPageSize
pageSizesOffsets :: PageSizesOffsets
pageBlobRefBitmap :: [Bool]
pageOperations :: [OperationEnum]
pageBlobRefs :: [BlobRef]
pageKeyOffsets :: [Word16]
pageValueOffsets :: Either [Word16] (Word16, Word32)
pageKeys :: ByteString
pageValues :: ByteString
pagePadding :: ByteString
pageDiskPageSize :: DiskPageSize
pageSizesOffsets :: PageSizesOffsets
pageBlobRefBitmap :: [Bool]
pageOperations :: [OperationEnum]
pageBlobRefs :: [BlobRef]
pageKeyOffsets :: [Word16]
pageValueOffsets :: Either [Word16] (Word16, Word32)
pageKeys :: ByteString
pageValues :: ByteString
pagePadding :: ByteString
pageDiskPageSize :: DiskPageSize
..
    }
  where
    toOperationEnum :: Operation -> OperationEnum
toOperationEnum Insert{}  = OperationEnum
OpInsert
    toOperationEnum Mupsert{} = OperationEnum
OpMupsert
    toOperationEnum Delete{}  = OperationEnum
OpDelete

    keyLen16 :: Key -> Word16
    valLen16 :: Value -> Word16
    valLen32 :: Value -> Word32
    keyLen16 :: Key -> Word16
keyLen16 (Key   ByteString
k) = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
k
    valLen16 :: Value -> Word16
valLen16 (Value ByteString
v) = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
v
    valLen32 :: Value -> Word32
valLen32 (Value ByteString
v) = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
v

serialisePage :: PageIntermediate -> PageSerialised
serialisePage :: PageIntermediate -> ByteString
serialisePage PageIntermediate{pageSizesOffsets :: PageIntermediate -> PageSizesOffsets
pageSizesOffsets = PageSizesOffsets{Word16
Word32
sizeDirectory :: PageSizesOffsets -> Word16
sizeBlobRefBitmap :: PageSizesOffsets -> Word16
sizeOperations :: PageSizesOffsets -> Word16
sizeBlobRefs :: PageSizesOffsets -> Word16
sizeKeyOffsets :: PageSizesOffsets -> Word16
sizeValueOffsets :: PageSizesOffsets -> Word16
sizeKeys :: PageSizesOffsets -> Word16
sizeValues :: PageSizesOffsets -> Word32
offBlobRefBitmap :: PageSizesOffsets -> Word16
offOperations :: PageSizesOffsets -> Word16
offBlobRefs :: PageSizesOffsets -> Word16
offKeyOffsets :: PageSizesOffsets -> Word16
offValueOffsets :: PageSizesOffsets -> Word16
offKeys :: PageSizesOffsets -> Word16
offValues :: PageSizesOffsets -> Word16
sizePageUsed :: PageSizesOffsets -> Word32
sizePagePadding :: PageSizesOffsets -> Word32
sizePageDiskPage :: PageSizesOffsets -> Word32
sizeDirectory :: Word16
sizeBlobRefBitmap :: Word16
sizeOperations :: Word16
sizeBlobRefs :: Word16
sizeKeyOffsets :: Word16
sizeValueOffsets :: Word16
sizeKeys :: Word16
sizeValues :: Word32
offBlobRefBitmap :: Word16
offOperations :: Word16
offBlobRefs :: Word16
offKeyOffsets :: Word16
offValueOffsets :: Word16
offKeys :: Word16
offValues :: Word16
sizePageUsed :: Word32
sizePagePadding :: Word32
sizePageDiskPage :: Word32
..}, [Bool]
[Word16]
[OperationEnum]
[BlobRef]
Word16
Either [Word16] (Word16, Word32)
ByteString
DiskPageSize
pageNumKeys :: PageIntermediate -> Word16
pageNumBlobs :: PageIntermediate -> Word16
pageBlobRefBitmap :: PageIntermediate -> [Bool]
pageOperations :: PageIntermediate -> [OperationEnum]
pageBlobRefs :: PageIntermediate -> [BlobRef]
pageKeyOffsets :: PageIntermediate -> [Word16]
pageValueOffsets :: PageIntermediate -> Either [Word16] (Word16, Word32)
pageKeys :: PageIntermediate -> ByteString
pageValues :: PageIntermediate -> ByteString
pagePadding :: PageIntermediate -> ByteString
pageDiskPageSize :: PageIntermediate -> DiskPageSize
pageNumKeys :: Word16
pageNumBlobs :: Word16
pageBlobRefBitmap :: [Bool]
pageOperations :: [OperationEnum]
pageBlobRefs :: [BlobRef]
pageKeyOffsets :: [Word16]
pageValueOffsets :: Either [Word16] (Word16, Word32)
pageKeys :: ByteString
pageValues :: ByteString
pagePadding :: ByteString
pageDiskPageSize :: DiskPageSize
..} =
    ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$

    -- the top level directory
    Word16 -> Builder
BB.word16LE Word16
pageNumKeys
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BB.word16LE Word16
pageNumBlobs
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BB.word16LE Word16
offKeyOffsets
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BB.word16LE Word16
0 --spare
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Word64 -> Builder
BB.word64LE Word64
w | Word64
w <- [Bool] -> [Word64]
toBitmap [Bool]
pageBlobRefBitmap ]
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Word64 -> Builder
BB.word64LE Word64
w | Word64
w <- [Bool] -> [Word64]
toBitmap ([Bool] -> [Word64])
-> ([OperationEnum] -> [Bool]) -> [OperationEnum] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OperationEnum -> [Bool]) -> [OperationEnum] -> [Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap OperationEnum -> [Bool]
opEnumToBits
                                            ([OperationEnum] -> [Word64]) -> [OperationEnum] -> [Word64]
forall a b. (a -> b) -> a -> b
$ [OperationEnum]
pageOperations ]
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Word64 -> Builder
BB.word64LE Word64
w64 | BlobRef Word64
w64 Word32
_w32 <- [BlobRef]
pageBlobRefs ]
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Word32 -> Builder
BB.word32LE Word32
w32 | BlobRef Word64
_w64 Word32
w32 <- [BlobRef]
pageBlobRefs ]
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Word16 -> Builder
BB.word16LE Word16
off | Word16
off <- [Word16]
pageKeyOffsets ]
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case Either [Word16] (Word16, Word32)
pageValueOffsets of
      Left   [Word16]
offsets -> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat [ Word16 -> Builder
BB.word16LE Word16
off | Word16
off <- [Word16]
offsets ]
      Right (Word16
offset1, Word32
offset2) -> Word16 -> Builder
BB.word16LE Word16
offset1
                               Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BB.word32LE Word32
offset2
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
pageKeys
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
pageValues
 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BB.byteString ByteString
pagePadding
  where
    opEnumToBits :: OperationEnum -> [Bool]
opEnumToBits OperationEnum
OpInsert  = [Bool
False, Bool
False]
    opEnumToBits OperationEnum
OpMupsert = [Bool
True,  Bool
False]
    opEnumToBits OperationEnum
OpDelete  = [Bool
False, Bool
True]

deserialisePage :: DiskPageSize -> PageSerialised -> PageIntermediate
deserialisePage :: DiskPageSize -> ByteString -> PageIntermediate
deserialisePage DiskPageSize
dpgsz ByteString
p =
    (Get PageIntermediate -> ByteString -> PageIntermediate)
-> ByteString -> Get PageIntermediate -> PageIntermediate
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get PageIntermediate -> ByteString -> PageIntermediate
forall a. Get a -> ByteString -> a
Bin.runGet (ByteString -> ByteString
BSL.fromStrict ByteString
p) (Get PageIntermediate -> PageIntermediate)
-> Get PageIntermediate -> PageIntermediate
forall a b. (a -> b) -> a -> b
$ do
      Int
pageNumKeys       <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Bin.getWord16le
      Int
pageNumBlobs      <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Bin.getWord16le
      Word16
offsetKeyOffsets  <-                  Get Word16
Bin.getWord16le
      Word16
_                 <-                  Get Word16
Bin.getWord16le

      let sizeWord64BlobRefBitmap :: Int
          sizeWord64BlobRefBitmap :: Int
sizeWord64BlobRefBitmap = (Int
pageNumKeys Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6

          sizeWord64Operations :: Int
          sizeWord64Operations :: Int
sizeWord64Operations = (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
pageNumKeys Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
63) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
6

      [Bool]
pageBlobRefBitmap <- Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take Int
pageNumKeys ([Bool] -> [Bool]) -> ([Word64] -> [Bool]) -> [Word64] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> [Bool]
fromBitmap ([Word64] -> [Bool]) -> Get [Word64] -> Get [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             Int -> Get Word64 -> Get [Word64]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
sizeWord64BlobRefBitmap Get Word64
Bin.getWord64le
      [OperationEnum]
pageOperations    <- Int -> [OperationEnum] -> [OperationEnum]
forall a. Int -> [a] -> [a]
take Int
pageNumKeys ([OperationEnum] -> [OperationEnum])
-> ([Word64] -> [OperationEnum]) -> [Word64] -> [OperationEnum]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [OperationEnum]
opBitsToEnum ([Bool] -> [OperationEnum])
-> ([Word64] -> [Bool]) -> [Word64] -> [OperationEnum]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> [Bool]
fromBitmap ([Word64] -> [OperationEnum])
-> Get [Word64] -> Get [OperationEnum]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                             Int -> Get Word64 -> Get [Word64]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
sizeWord64Operations Get Word64
Bin.getWord64le
      [Word64]
pageBlobRefsW64   <- Int -> Get Word64 -> Get [Word64]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
pageNumBlobs Get Word64
Bin.getWord64le
      [Word32]
pageBlobRefsW32   <- Int -> Get Word32 -> Get [Word32]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
pageNumBlobs Get Word32
Bin.getWord32le
      let pageBlobRefs :: [BlobRef]
pageBlobRefs   = (Word64 -> Word32 -> BlobRef) -> [Word64] -> [Word32] -> [BlobRef]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Word64 -> Word32 -> BlobRef
BlobRef [Word64]
pageBlobRefsW64 [Word32]
pageBlobRefsW32

      [Word16]
pageKeyOffsets    <- Int -> Get Word16 -> Get [Word16]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
pageNumKeys Get Word16
Bin.getWord16le
      Either [Word16] (Word16, Word32)
pageValueOffsets  <-
        if Int
pageNumKeys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
         then (Word16, Word32) -> Either [Word16] (Word16, Word32)
forall a b. b -> Either a b
Right ((Word16, Word32) -> Either [Word16] (Word16, Word32))
-> Get (Word16, Word32) -> Get (Either [Word16] (Word16, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (Word16 -> Word32 -> (Word16, Word32))
-> Get Word16 -> Get (Word32 -> (Word16, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Bin.getWord16le
                             Get (Word32 -> (Word16, Word32))
-> Get Word32 -> Get (Word16, Word32)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
Bin.getWord32le)
         else [Word16] -> Either [Word16] (Word16, Word32)
forall a b. a -> Either a b
Left ([Word16] -> Either [Word16] (Word16, Word32))
-> Get [Word16] -> Get (Either [Word16] (Word16, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get Word16 -> Get [Word16]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
pageNumKeys Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Get Word16
Bin.getWord16le

      let sizeKeys :: Int
          sizeKeys :: Int
sizeKeys
            | Int
pageNumKeys Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (([Word16] -> Word16)
-> ((Word16, Word32) -> Word16)
-> Either [Word16] (Word16, Word32)
-> Word16
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Word16] -> Word16
forall a. HasCallStack => [a] -> a
head (Word16, Word32) -> Word16
forall a b. (a, b) -> a
fst Either [Word16] (Word16, Word32)
pageValueOffsets)
              Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word16] -> Word16
forall a. HasCallStack => [a] -> a
head [Word16]
pageKeyOffsets)
            | Bool
otherwise       = Int
0

          sizeValues :: Int
          sizeValues :: Int
sizeValues
            | Int
pageNumKeys Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
            = ([Word16] -> Int)
-> ((Word16, Word32) -> Int)
-> Either [Word16] (Word16, Word32)
-> Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> ([Word16] -> Word16) -> [Word16] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word16] -> Word16
forall a. HasCallStack => [a] -> a
last) (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int)
-> ((Word16, Word32) -> Word32) -> (Word16, Word32) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16, Word32) -> Word32
forall a b. (a, b) -> b
snd) Either [Word16] (Word16, Word32)
pageValueOffsets
              Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (([Word16] -> Word16)
-> ((Word16, Word32) -> Word16)
-> Either [Word16] (Word16, Word32)
-> Word16
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Word16] -> Word16
forall a. HasCallStack => [a] -> a
head (Word16, Word32) -> Word16
forall a b. (a, b) -> a
fst Either [Word16] (Word16, Word32)
pageValueOffsets)
            | Bool
otherwise = Int
0
      ByteString
pageKeys   <- Int -> Get ByteString
Bin.getByteString Int
sizeKeys
      ByteString
pageValues <- Int -> Get ByteString
Bin.getByteString Int
sizeValues
      ByteString
pagePadding <- ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
Bin.getRemainingLazyByteString

      let pageSizesOffsets :: PageSizesOffsets
pageSizesOffsets =
            PageSizesOffsets -> Maybe PageSizesOffsets -> PageSizesOffsets
forall a. a -> Maybe a -> a
fromMaybe (String -> PageSizesOffsets
forall a. HasCallStack => String -> a
error String
"deserialisePage: disk page overflow") (Maybe PageSizesOffsets -> PageSizesOffsets)
-> Maybe PageSizesOffsets -> PageSizesOffsets
forall a b. (a -> b) -> a -> b
$
              DiskPageSize -> Int -> Int -> Int -> Int -> Maybe PageSizesOffsets
calcPageSizeOffsets
                DiskPageSize
dpgsz
                Int
pageNumKeys Int
pageNumBlobs
                Int
sizeKeys Int
sizeValues

      Bool -> Get PageIntermediate -> Get PageIntermediate
forall a. HasCallStack => Bool -> a -> a
assert (Word16
offsetKeyOffsets Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== PageSizesOffsets -> Word16
offKeyOffsets PageSizesOffsets
pageSizesOffsets) (Get PageIntermediate -> Get PageIntermediate)
-> Get PageIntermediate -> Get PageIntermediate
forall a b. (a -> b) -> a -> b
$
        PageIntermediate -> Get PageIntermediate
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return PageIntermediate {
          pageNumKeys :: Word16
pageNumKeys      = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pageNumKeys,
          pageNumBlobs :: Word16
pageNumBlobs     = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pageNumBlobs,
          pageDiskPageSize :: DiskPageSize
pageDiskPageSize = DiskPageSize
dpgsz,
          [Bool]
[Word16]
[OperationEnum]
[BlobRef]
Either [Word16] (Word16, Word32)
ByteString
PageSizesOffsets
pageSizesOffsets :: PageSizesOffsets
pageBlobRefBitmap :: [Bool]
pageOperations :: [OperationEnum]
pageBlobRefs :: [BlobRef]
pageKeyOffsets :: [Word16]
pageValueOffsets :: Either [Word16] (Word16, Word32)
pageKeys :: ByteString
pageValues :: ByteString
pagePadding :: ByteString
pageBlobRefBitmap :: [Bool]
pageOperations :: [OperationEnum]
pageBlobRefs :: [BlobRef]
pageKeyOffsets :: [Word16]
pageValueOffsets :: Either [Word16] (Word16, Word32)
pageKeys :: ByteString
pageValues :: ByteString
pagePadding :: ByteString
pageSizesOffsets :: PageSizesOffsets
..
        }
  where
    opBitsToEnum :: [Bool] -> [OperationEnum]
opBitsToEnum (Bool
False:Bool
False:[Bool]
bits) = OperationEnum
OpInsert  OperationEnum -> [OperationEnum] -> [OperationEnum]
forall a. a -> [a] -> [a]
: [Bool] -> [OperationEnum]
opBitsToEnum [Bool]
bits
    opBitsToEnum (Bool
True: Bool
False:[Bool]
bits) = OperationEnum
OpMupsert OperationEnum -> [OperationEnum] -> [OperationEnum]
forall a. a -> [a] -> [a]
: [Bool] -> [OperationEnum]
opBitsToEnum [Bool]
bits
    opBitsToEnum (Bool
False:Bool
True :[Bool]
bits) = OperationEnum
OpDelete  OperationEnum -> [OperationEnum] -> [OperationEnum]
forall a. a -> [a] -> [a]
: [Bool] -> [OperationEnum]
opBitsToEnum [Bool]
bits
    opBitsToEnum []                 = []
    opBitsToEnum [Bool]
_                  = String -> [OperationEnum]
forall a. HasCallStack => String -> a
error String
"opBitsToEnum"

decodePage :: PageIntermediate -> [(Key, Operation)]
decodePage :: PageIntermediate -> [(Key, Operation)]
decodePage PageIntermediate{pageSizesOffsets :: PageIntermediate -> PageSizesOffsets
pageSizesOffsets = PageSizesOffsets{Word16
Word32
sizeDirectory :: PageSizesOffsets -> Word16
sizeBlobRefBitmap :: PageSizesOffsets -> Word16
sizeOperations :: PageSizesOffsets -> Word16
sizeBlobRefs :: PageSizesOffsets -> Word16
sizeKeyOffsets :: PageSizesOffsets -> Word16
sizeValueOffsets :: PageSizesOffsets -> Word16
sizeKeys :: PageSizesOffsets -> Word16
sizeValues :: PageSizesOffsets -> Word32
offBlobRefBitmap :: PageSizesOffsets -> Word16
offOperations :: PageSizesOffsets -> Word16
offBlobRefs :: PageSizesOffsets -> Word16
offKeyOffsets :: PageSizesOffsets -> Word16
offValueOffsets :: PageSizesOffsets -> Word16
offKeys :: PageSizesOffsets -> Word16
offValues :: PageSizesOffsets -> Word16
sizePageUsed :: PageSizesOffsets -> Word32
sizePagePadding :: PageSizesOffsets -> Word32
sizePageDiskPage :: PageSizesOffsets -> Word32
sizeDirectory :: Word16
sizeBlobRefBitmap :: Word16
sizeOperations :: Word16
sizeBlobRefs :: Word16
sizeKeyOffsets :: Word16
sizeValueOffsets :: Word16
sizeKeys :: Word16
sizeValues :: Word32
offBlobRefBitmap :: Word16
offOperations :: Word16
offBlobRefs :: Word16
offKeyOffsets :: Word16
offValueOffsets :: Word16
offKeys :: Word16
offValues :: Word16
sizePageUsed :: Word32
sizePagePadding :: Word32
sizePageDiskPage :: Word32
..}, [Bool]
[Word16]
[OperationEnum]
[BlobRef]
Word16
Either [Word16] (Word16, Word32)
ByteString
DiskPageSize
pageNumKeys :: PageIntermediate -> Word16
pageNumBlobs :: PageIntermediate -> Word16
pageBlobRefBitmap :: PageIntermediate -> [Bool]
pageOperations :: PageIntermediate -> [OperationEnum]
pageBlobRefs :: PageIntermediate -> [BlobRef]
pageKeyOffsets :: PageIntermediate -> [Word16]
pageValueOffsets :: PageIntermediate -> Either [Word16] (Word16, Word32)
pageKeys :: PageIntermediate -> ByteString
pageValues :: PageIntermediate -> ByteString
pagePadding :: PageIntermediate -> ByteString
pageDiskPageSize :: PageIntermediate -> DiskPageSize
pageNumKeys :: Word16
pageNumBlobs :: Word16
pageBlobRefBitmap :: [Bool]
pageOperations :: [OperationEnum]
pageBlobRefs :: [BlobRef]
pageKeyOffsets :: [Word16]
pageValueOffsets :: Either [Word16] (Word16, Word32)
pageKeys :: ByteString
pageValues :: ByteString
pagePadding :: ByteString
pageDiskPageSize :: DiskPageSize
..} =
    [ let op :: Operation
op      = case OperationEnum
opEnum of
                      OperationEnum
OpInsert  -> Value -> Maybe BlobRef -> Operation
Insert  (ByteString -> Value
Value ByteString
value) Maybe BlobRef
mblobref
                      OperationEnum
OpMupsert -> Value -> Operation
Mupsert (ByteString -> Value
Value ByteString
value)
                      OperationEnum
OpDelete  -> Operation
Delete
          mblobref :: Maybe BlobRef
mblobref | Bool
hasBlobref = BlobRef -> Maybe BlobRef
forall a. a -> Maybe a
Just ([BlobRef]
pageBlobRefs [BlobRef] -> Int -> BlobRef
forall a. HasCallStack => [a] -> Int -> a
!! Int
idxBlobref)
                   | Bool
otherwise  = Maybe BlobRef
forall a. Maybe a
Nothing
       in (ByteString -> Key
Key ByteString
key, Operation
op)
    | OperationEnum
opEnum     <- [OperationEnum]
pageOperations
    | Bool
hasBlobref <- [Bool]
pageBlobRefBitmap
    | Int
idxBlobref <- (Int -> Bool -> Int) -> Int -> [Bool] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\Int
o Bool
b -> if Bool
b then Int
oInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 else Int
o) Int
0 [Bool]
pageBlobRefBitmap
    | (Word16, Word16)
keySpan    <- [Word16] -> [(Word16, Word16)]
forall {b}. [b] -> [(b, b)]
spans ([Word16] -> [(Word16, Word16)]) -> [Word16] -> [(Word16, Word16)]
forall a b. (a -> b) -> a -> b
$ [Word16]
pageKeyOffsets
                         [Word16] -> [Word16] -> [Word16]
forall a. [a] -> [a] -> [a]
++ ([Word16] -> [Word16])
-> ((Word16, Word32) -> [Word16])
-> Either [Word16] (Word16, Word32)
-> [Word16]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int -> [Word16] -> [Word16]
forall a. Int -> [a] -> [a]
take Int
1) ((Word16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
:[]) (Word16 -> [Word16])
-> ((Word16, Word32) -> Word16) -> (Word16, Word32) -> [Word16]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16, Word32) -> Word16
forall a b. (a, b) -> a
fst) Either [Word16] (Word16, Word32)
pageValueOffsets
    , let key :: ByteString
key     = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ (Word16, Word16) -> Word16
forall a b. (a, b) -> b
snd (Word16, Word16)
keySpan Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- (Word16, Word16) -> Word16
forall a b. (a, b) -> a
fst (Word16, Word16)
keySpan)
                  (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ (Word16, Word16) -> Word16
forall a b. (a, b) -> a
fst (Word16, Word16)
keySpan Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
offKeys)
                  (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
pageKeys
    | (Word32, Word32)
valSpan    <- [Word32] -> [(Word32, Word32)]
forall {b}. [b] -> [(b, b)]
spans ([Word32] -> [(Word32, Word32)]) -> [Word32] -> [(Word32, Word32)]
forall a b. (a -> b) -> a -> b
$ case Either [Word16] (Word16, Word32)
pageValueOffsets of
                              Left [Word16]
offs          -> (Word16 -> Word32) -> [Word16] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Word16]
offs
                              Right (Word16
off1, Word32
off2) -> [ Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
off1, Word32
off2 ]
    , let value :: ByteString
value   = Int -> ByteString -> ByteString
BS.take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Word32, Word32) -> Word32
forall a b. (a, b) -> b
snd (Word32, Word32)
valSpan Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- (Word32, Word32) -> Word32
forall a b. (a, b) -> a
fst (Word32, Word32)
valSpan)
                  (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
BS.drop (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ (Word32, Word32) -> Word32
forall a b. (a, b) -> a
fst (Word32, Word32)
valSpan Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
offValues)
                  (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
pageValues

    ]
  where
    spans :: [b] -> [(b, b)]
spans [b]
xs = [b] -> [b] -> [(b, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [b]
xs (Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
drop Int
1 [b]
xs)

toBitmap :: [Bool] -> [Word64]
toBitmap :: [Bool] -> [Word64]
toBitmap =
    ([Bool] -> Word64) -> [[Bool]] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map [Bool] -> Word64
toWord64 ([[Bool]] -> [Word64])
-> ([Bool] -> [[Bool]]) -> [Bool] -> [Word64]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [[Bool]]
forall {a}. [a] -> [[a]]
group64
  where
    toWord64 :: [Bool] -> Word64
    toWord64 :: [Bool] -> Word64
toWord64 = (Word64 -> (Int, Bool) -> Word64)
-> Word64 -> [(Int, Bool)] -> Word64
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (\Word64
w (Int
n,Bool
b) -> if Bool
b then Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
setBit Word64
w Int
n else Word64
w) Word64
0
             ([(Int, Bool)] -> Word64)
-> ([Bool] -> [(Int, Bool)]) -> [Bool] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Bool] -> [(Int, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..]
    group64 :: [a] -> [[a]]
group64  = ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (\[a]
xs -> if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
                                 then Maybe ([a], [a])
forall a. Maybe a
Nothing
                                 else ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
64 [a]
xs))

fromBitmap :: [Word64] -> [Bool]
fromBitmap :: [Word64] -> [Bool]
fromBitmap =
    (Word64 -> [Bool]) -> [Word64] -> [Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word64 -> [Bool]
fromWord64
  where
    fromWord64 :: Word64 -> [Bool]
    fromWord64 :: Word64 -> [Bool]
fromWord64 Word64
w = [ Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
w Int
i | Int
i <- [Int
0..Int
63] ]

fromIntegralChecked :: (Integral a, Integral b) => a -> b
fromIntegralChecked :: forall a b. (Integral a, Integral b) => a -> b
fromIntegralChecked a
x
  | let x' :: b
x' = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
  , b -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
x' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
  = b
x'

  | Bool
otherwise
  = String -> b
forall a. HasCallStack => String -> a
error String
"fromIntegralChecked: conversion failed"

-- | If a page uses overflow pages, return the:
--
-- 1. value prefix length (within the first page)
-- 2. value suffix length (within the overflow pages)
--
pageOverflowPrefixSuffixLen :: PageIntermediate -> Maybe (Int, Int)
pageOverflowPrefixSuffixLen :: PageIntermediate -> Maybe (Int, Int)
pageOverflowPrefixSuffixLen PageIntermediate
p =
    case PageIntermediate -> Either [Word16] (Word16, Word32)
pageValueOffsets PageIntermediate
p of
      Right (Word16
offStart, Word32
offEnd)
        | let page1End :: Int
page1End = DiskPageSize -> Int
diskPageSizeBytes (PageIntermediate -> DiskPageSize
pageDiskPageSize PageIntermediate
p)
        , Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offEnd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
page1End
        , let prefixlen, suffixlen :: Int
              prefixlen :: Int
prefixlen = Int
page1End Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
offStart
              suffixlen :: Int
suffixlen = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
page1End
        -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
prefixlen, Int
suffixlen)
      Either [Word16] (Word16, Word32)
_ -> Maybe (Int, Int)
forall a. Maybe a
Nothing

-- | The total number of disk pages, including any overflow pages.
--
pageDiskPages :: PageIntermediate -> Int
pageDiskPages :: PageIntermediate -> Int
pageDiskPages PageIntermediate
p =
    Int
nbytes Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` DiskPageSize -> Int
diskPageSizeBytes (PageIntermediate -> DiskPageSize
pageDiskPageSize PageIntermediate
p)
  where
    nbytes :: Int
nbytes = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PageSizesOffsets -> Word32
sizePageDiskPage (PageIntermediate -> PageSizesOffsets
pageSizesOffsets PageIntermediate
p))

pageSerialisedChunks :: DiskPageSize -> PageSerialised -> [ByteString]
pageSerialisedChunks :: DiskPageSize -> ByteString -> [ByteString]
pageSerialisedChunks DiskPageSize
dpgsz =
    (ByteString -> Maybe (ByteString, ByteString))
-> ByteString -> [ByteString]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr (\ByteString
p -> if ByteString -> Bool
BS.null ByteString
p then Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing
                                else (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. a -> Maybe a
Just (Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
dpgszBytes ByteString
p))
  where
    dpgszBytes :: Int
dpgszBytes = DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz

-------------------------------------------------------------------------------
-- Test types and generators
--

data PageContentFits = PageContentFits DiskPageSize [(Key, Operation)]
  deriving stock Int -> PageContentFits -> ShowS
[PageContentFits] -> ShowS
PageContentFits -> String
(Int -> PageContentFits -> ShowS)
-> (PageContentFits -> String)
-> ([PageContentFits] -> ShowS)
-> Show PageContentFits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageContentFits -> ShowS
showsPrec :: Int -> PageContentFits -> ShowS
$cshow :: PageContentFits -> String
show :: PageContentFits -> String
$cshowList :: [PageContentFits] -> ShowS
showList :: [PageContentFits] -> ShowS
Show

data PageContentMaybeOverfull = PageContentMaybeOverfull DiskPageSize
                                                         [(Key, Operation)]
  deriving stock Int -> PageContentMaybeOverfull -> ShowS
[PageContentMaybeOverfull] -> ShowS
PageContentMaybeOverfull -> String
(Int -> PageContentMaybeOverfull -> ShowS)
-> (PageContentMaybeOverfull -> String)
-> ([PageContentMaybeOverfull] -> ShowS)
-> Show PageContentMaybeOverfull
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageContentMaybeOverfull -> ShowS
showsPrec :: Int -> PageContentMaybeOverfull -> ShowS
$cshow :: PageContentMaybeOverfull -> String
show :: PageContentMaybeOverfull -> String
$cshowList :: [PageContentMaybeOverfull] -> ShowS
showList :: [PageContentMaybeOverfull] -> ShowS
Show

data PageContentSingle = PageContentSingle DiskPageSize Key Operation
  deriving stock Int -> PageContentSingle -> ShowS
[PageContentSingle] -> ShowS
PageContentSingle -> String
(Int -> PageContentSingle -> ShowS)
-> (PageContentSingle -> String)
-> ([PageContentSingle] -> ShowS)
-> Show PageContentSingle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageContentSingle -> ShowS
showsPrec :: Int -> PageContentSingle -> ShowS
$cshow :: PageContentSingle -> String
show :: PageContentSingle -> String
$cshowList :: [PageContentSingle] -> ShowS
showList :: [PageContentSingle] -> ShowS
Show

instance Arbitrary PageContentFits where
    arbitrary :: Gen PageContentFits
arbitrary = do
      DiskPageSize
dpgsz <- Gen DiskPageSize
forall a. Arbitrary a => Gen a
arbitrary
      [(Key, Operation)]
kops  <- DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentFits DiskPageSize
dpgsz MinKeySize
noMinKeySize
      PageContentFits -> Gen PageContentFits
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiskPageSize -> [(Key, Operation)] -> PageContentFits
PageContentFits DiskPageSize
dpgsz [(Key, Operation)]
kops)

instance Arbitrary PageContentMaybeOverfull where
    arbitrary :: Gen PageContentMaybeOverfull
arbitrary = do
      DiskPageSize
dpgsz <- Gen DiskPageSize
forall a. Arbitrary a => Gen a
arbitrary
      [(Key, Operation)]
kops  <- DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentMaybeOverfull DiskPageSize
dpgsz MinKeySize
noMinKeySize
      PageContentMaybeOverfull -> Gen PageContentMaybeOverfull
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiskPageSize -> [(Key, Operation)] -> PageContentMaybeOverfull
PageContentMaybeOverfull DiskPageSize
dpgsz [(Key, Operation)]
kops)

instance Arbitrary PageContentSingle where
    arbitrary :: Gen PageContentSingle
arbitrary = do
      DiskPageSize
dpgsz <- Gen DiskPageSize
forall a. Arbitrary a => Gen a
arbitrary
      (Key
k,Operation
op) <- DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingle DiskPageSize
dpgsz MinKeySize
noMinKeySize
      PageContentSingle -> Gen PageContentSingle
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DiskPageSize -> Key -> Operation -> PageContentSingle
PageContentSingle DiskPageSize
dpgsz Key
k Operation
op)

-- | In some use cases it is necessary to generate 'Keys' that are at least of
-- some minimum length. Use 'noMinKeySize' if no such constraint is need.
newtype MinKeySize = MinKeySize Int
  deriving stock Int -> MinKeySize -> ShowS
[MinKeySize] -> ShowS
MinKeySize -> String
(Int -> MinKeySize -> ShowS)
-> (MinKeySize -> String)
-> ([MinKeySize] -> ShowS)
-> Show MinKeySize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MinKeySize -> ShowS
showsPrec :: Int -> MinKeySize -> ShowS
$cshow :: MinKeySize -> String
show :: MinKeySize -> String
$cshowList :: [MinKeySize] -> ShowS
showList :: [MinKeySize] -> ShowS
Show

-- | No minimum key size: @MinKeySize 0@.
noMinKeySize :: MinKeySize
noMinKeySize :: MinKeySize
noMinKeySize = Int -> MinKeySize
MinKeySize Int
0

-- | Generate a test case consisting of a key\/operation sequence that is
-- guaranteed to fit into a given disk page size.
--
-- The distribution is designed to cover:
--
-- * small pages
-- * medium sized pages
-- * nearly full pages
-- * plus single key pages (possibly using one or more overflow pages)
-- * a corner case of a single large key\/operation pair followed by some small
--   key op pairs.
--
-- The keys are /not/ ordered: use 'orderdKeyOps' to sort and de-duplicate them
-- if that is needed (but note this will change the order of key sizes).
--
genPageContentFits :: DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentFits :: DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentFits DiskPageSize
dpgsz MinKeySize
minkeysz =
    [(Int, Gen [(Key, Operation)])] -> Gen [(Key, Operation)]
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
6, DiskPageSize -> Gen Key -> Gen Value -> Gen [(Key, Operation)]
genPageContentMedium           DiskPageSize
dpgsz Gen Key
genkey Gen Value
genval)
      , (Int
2, ((Key, Operation) -> [(Key, Operation)] -> [(Key, Operation)]
forall a. a -> [a] -> [a]
:[]) ((Key, Operation) -> [(Key, Operation)])
-> Gen (Key, Operation) -> Gen [(Key, Operation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingle DiskPageSize
dpgsz MinKeySize
minkeysz)
      , (Int
1, DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentLargeSmallFits   DiskPageSize
dpgsz MinKeySize
minkeysz)
      ]
  where
    genkey :: Gen Key
genkey = DiskPageSize -> MinKeySize -> Gen Key
genKeyMinSize DiskPageSize
dpgsz MinKeySize
minkeysz
    genval :: Gen Value
genval = Gen Value
forall a. Arbitrary a => Gen a
arbitrary

-- | Generate a test case consisting of a key\/operation sequence that is /not/
-- guaranteed to fit into a given disk page size.
--
-- These test cases are useful for checking the boundary conditions for what
-- can fit into a disk page. This covers a similar distribution to
-- 'genPageContentFits' but also includes about 20% of pages that are over full,
-- including the corner case of a large key ops pair followed by smaller key op
-- pairs (again possibly over full).
--
-- The keys are /not/ ordered: use 'orderdKeyOps' to sort and de-duplicate them
-- if that is needed.
--
genPageContentMaybeOverfull :: DiskPageSize
                            -> MinKeySize -> Gen [(Key, Operation)]
genPageContentMaybeOverfull :: DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentMaybeOverfull DiskPageSize
dpgsz MinKeySize
minkeysz =
    [(Int, Gen [(Key, Operation)])] -> Gen [(Key, Operation)]
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
6, DiskPageSize -> Gen Key -> Gen Value -> Gen [(Key, Operation)]
genPageContentMedium             DiskPageSize
dpgsz Gen Key
genkey Gen Value
genval)
      , (Int
1, ((Key, Operation) -> [(Key, Operation)] -> [(Key, Operation)]
forall a. a -> [a] -> [a]
:[]) ((Key, Operation) -> [(Key, Operation)])
-> Gen (Key, Operation) -> Gen [(Key, Operation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingle   DiskPageSize
dpgsz MinKeySize
minkeysz)
      , (Int
1, DiskPageSize -> Gen Key -> Gen Value -> Gen [(Key, Operation)]
genPageContentOverfull           DiskPageSize
dpgsz Gen Key
genkey Gen Value
genval)
      , (Int
1, DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentLargeSmallOverfull DiskPageSize
dpgsz MinKeySize
minkeysz)
      ]
  where
    genkey :: Gen Key
genkey = DiskPageSize -> MinKeySize -> Gen Key
genKeyMinSize DiskPageSize
dpgsz MinKeySize
minkeysz
    genval :: Gen Value
genval = Gen Value
forall a. Arbitrary a => Gen a
arbitrary

-- | Generate a test case consisting of a single key\/operation pair.
--
genPageContentSingle :: DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingle :: DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingle DiskPageSize
dpgsz MinKeySize
minkeysz =
    [Gen (Key, Operation)] -> Gen (Key, Operation)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Gen Key -> Gen Value -> Gen (Key, Operation)
genPageContentSingleSmall     Gen Key
genkey Gen Value
genval
      , DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingleNearFull  DiskPageSize
dpgsz MinKeySize
minkeysz
      , DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingleMultiPage DiskPageSize
dpgsz MinKeySize
minkeysz
      ]
  where
    genkey :: Gen Key
genkey = DiskPageSize -> MinKeySize -> Gen Key
genKeyMinSize DiskPageSize
dpgsz MinKeySize
minkeysz
    genval :: Gen Value
genval = Gen Value
forall a. Arbitrary a => Gen a
arbitrary

-- | This generates a reasonable \"middle\" distribution of page sizes
-- (relative to the given disk page size). In particular it covers:
--
-- * small pages (~45% for 4k pages, ~15% for 64k pages)
-- * near-maximum pages (~20% for 4k pages, ~20% for 64k pages)
-- * some in between (~35% for 4k pages, ~60% for 64k pages)
--
-- The numbers above are when used with the normal 'arbitrary' 'Key' and
-- 'Value' generators. And with these generators, it tends to use lots of
-- small-to-medium size keys and values, rather than a few huge ones.
--
genPageContentMedium :: DiskPageSize
                     -> Gen Key
                     -> Gen Value
                     -> Gen [(Key, Operation)]
genPageContentMedium :: DiskPageSize -> Gen Key -> Gen Value -> Gen [(Key, Operation)]
genPageContentMedium DiskPageSize
dpgsz Gen Key
genkey Gen Value
genval =
  DiskPageSize -> [(Key, Operation)] -> [(Key, Operation)]
takePageContentFits DiskPageSize
dpgsz ([(Key, Operation)] -> [(Key, Operation)])
-> Gen [(Key, Operation)] -> Gen [(Key, Operation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    (Int -> Int) -> Gen [(Key, Operation)] -> Gen [(Key, Operation)]
forall a. (Int -> Int) -> Gen a -> Gen a
scale Int -> Int
scaleForDiskPageSize
      (Gen (Key, Operation) -> Gen [(Key, Operation)]
forall a. Gen a -> Gen [a]
listOf (Gen Key -> Gen Value -> Gen (Key, Operation)
genPageContentSingleSmall Gen Key
genkey Gen Value
genval))
  where
    scaleForDiskPageSize :: Int -> Int
    scaleForDiskPageSize :: Int -> Int
scaleForDiskPageSize Int
sz =
      Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Float -> Int) -> Float -> Int
forall a b. (a -> b) -> a -> b
$
        Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz Float -> Float -> Float
forall a. Floating a => a -> a -> a
** (Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DiskPageSize -> Int
forall a. Enum a => a -> Int
fromEnum DiskPageSize
dpgsz) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
10 :: Float)

takePageContentFits :: DiskPageSize -> [(Key, Operation)] -> [(Key, Operation)]
takePageContentFits :: DiskPageSize -> [(Key, Operation)] -> [(Key, Operation)]
takePageContentFits DiskPageSize
dpgsz = PageSize -> [(Key, Operation)] -> [(Key, Operation)]
go (DiskPageSize -> PageSize
pageSizeEmpty DiskPageSize
dpgsz)
  where
    go :: PageSize -> [(Key, Operation)] -> [(Key, Operation)]
go PageSize
_sz [] = []
    go PageSize
sz ((Key, Operation)
kop:[(Key, Operation)]
kops)
      | Just PageSize
sz' <- (Key, Operation) -> PageSize -> Maybe PageSize
pageSizeAddElem (Key, Operation)
kop PageSize
sz = (Key, Operation)
kop (Key, Operation) -> [(Key, Operation)] -> [(Key, Operation)]
forall a. a -> [a] -> [a]
: PageSize -> [(Key, Operation)] -> [(Key, Operation)]
go PageSize
sz' [(Key, Operation)]
kops
      | Bool
otherwise                          = []

-- | Generate only pages that are nearly full. This isn't the maximum possible
-- size, but where adding one more randomly-chosen key\/op pair would not fit
-- (but perhaps a smaller pair would still fit).
--
-- Consider if you really need this: the 'genPageContentMedium' also includes
-- these cases naturally as part of its distribution. On the other hand, this
-- can be good for generating benchmark data.
--
genPageContentNearFull :: DiskPageSize
                       -> Gen Key
                       -> Gen Value
                       -> Gen [(Key, Operation)]
genPageContentNearFull :: DiskPageSize -> Gen Key -> Gen Value -> Gen [(Key, Operation)]
genPageContentNearFull DiskPageSize
dpgsz Gen Key
genkey Gen Value
genval =
    --relies on first item being the one triggering over-full:
    Int -> [(Key, Operation)] -> [(Key, Operation)]
forall a. Int -> [a] -> [a]
drop Int
1 ([(Key, Operation)] -> [(Key, Operation)])
-> Gen [(Key, Operation)] -> Gen [(Key, Operation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiskPageSize -> Gen Key -> Gen Value -> Gen [(Key, Operation)]
genPageContentOverfull DiskPageSize
dpgsz Gen Key
genkey Gen Value
genval

-- | Generate pages that are just slightly over-full. This is where the last
-- key\/op pair takes it just over the disk page size (but this element is
-- first in the sequence).
--
genPageContentOverfull :: DiskPageSize
                       -> Gen Key
                       -> Gen Value
                       -> Gen [(Key, Operation)]
genPageContentOverfull :: DiskPageSize -> Gen Key -> Gen Value -> Gen [(Key, Operation)]
genPageContentOverfull DiskPageSize
dpgsz Gen Key
genkey Gen Value
genval =
    [(Key, Operation)] -> PageSize -> Gen [(Key, Operation)]
go [] (DiskPageSize -> PageSize
pageSizeEmpty DiskPageSize
dpgsz)
  where
    go :: [(Key, Operation)] -> PageSize -> Gen [(Key, Operation)]
    go :: [(Key, Operation)] -> PageSize -> Gen [(Key, Operation)]
go [(Key, Operation)]
kops PageSize
sz = do
      (Key, Operation)
kop <- Gen Key -> Gen Value -> Gen (Key, Operation)
genPageContentSingleSmall Gen Key
genkey Gen Value
genval
      case (Key, Operation) -> PageSize -> Maybe PageSize
pageSizeAddElem (Key, Operation)
kop PageSize
sz of
         -- include as the /first/ element, the one that will make it overfull:
        Maybe PageSize
Nothing  -> [(Key, Operation)] -> Gen [(Key, Operation)]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Key, Operation)
kop(Key, Operation) -> [(Key, Operation)] -> [(Key, Operation)]
forall a. a -> [a] -> [a]
:[(Key, Operation)]
kops) -- not reversed!
        Just PageSize
sz' -> [(Key, Operation)] -> PageSize -> Gen [(Key, Operation)]
go ((Key, Operation)
kop(Key, Operation) -> [(Key, Operation)] -> [(Key, Operation)]
forall a. a -> [a] -> [a]
:[(Key, Operation)]
kops) PageSize
sz'

genPageContentLargeSmallFits :: DiskPageSize
                             -> MinKeySize
                             -> Gen [(Key, Operation)]
genPageContentLargeSmallFits :: DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentLargeSmallFits DiskPageSize
dpgsz MinKeySize
minkeysz =
    DiskPageSize -> [(Key, Operation)] -> [(Key, Operation)]
takePageContentFits DiskPageSize
dpgsz ([(Key, Operation)] -> [(Key, Operation)])
-> Gen [(Key, Operation)] -> Gen [(Key, Operation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentLargeSmallOverfull DiskPageSize
dpgsz MinKeySize
minkeysz

genPageContentLargeSmallOverfull :: DiskPageSize
                                 -> MinKeySize
                                 -> Gen [(Key, Operation)]
genPageContentLargeSmallOverfull :: DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentLargeSmallOverfull DiskPageSize
dpgsz (MinKeySize Int
minkeysz) =
    (\(Key, Operation)
large [(Key, Operation)]
small -> (Key, Operation)
large (Key, Operation) -> [(Key, Operation)] -> [(Key, Operation)]
forall a. a -> [a] -> [a]
: [(Key, Operation)]
small)
      ((Key, Operation) -> [(Key, Operation)] -> [(Key, Operation)])
-> Gen (Key, Operation)
-> Gen ([(Key, Operation)] -> [(Key, Operation)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Int, Int) -> Gen (Key, Operation)
genPageContentSingleOfSize Gen (Int, Int)
genKeyValSizes
      Gen ([(Key, Operation)] -> [(Key, Operation)])
-> Gen [(Key, Operation)] -> Gen [(Key, Operation)]
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [(Key, Operation)]
forall a. Arbitrary a => Gen a
arbitrary
  where
    genKeyValSizes :: Gen (Int, Int)
genKeyValSizes = do
      let size :: Int
size = DiskPageSize -> Int
maxKeySize DiskPageSize
dpgsz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
100
      Int
split <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
minkeysz, Int
size)
      (Int, Int) -> Gen (Int, Int)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
split, Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
split)

genPageContentSingleOfSize :: Gen (Int, Int) -> Gen (Key, Operation)
genPageContentSingleOfSize :: Gen (Int, Int) -> Gen (Key, Operation)
genPageContentSingleOfSize Gen (Int, Int)
genKeyValSizes = do
    (Int
keySize, Int
valSize) <- Gen (Int, Int)
genKeyValSizes
    Key
key <- ByteString -> Key
Key   (ByteString -> Key) -> ([Word8] -> ByteString) -> [Word8] -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Key) -> Gen [Word8] -> Gen Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
keySize Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
    Value
val <- ByteString -> Value
Value (ByteString -> Value)
-> ([Word8] -> ByteString) -> [Word8] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Value) -> Gen [Word8] -> Gen Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
valSize Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
    Operation
op  <- [Gen Operation] -> Gen Operation
forall a. HasCallStack => [Gen a] -> Gen a
oneof  -- no delete
             [ Value -> Maybe BlobRef -> Operation
Insert Value
val (Maybe BlobRef -> Operation)
-> Gen (Maybe BlobRef) -> Gen Operation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe BlobRef)
forall a. Arbitrary a => Gen a
arbitrary
             , Operation -> Gen Operation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Operation
Mupsert Value
val) ]
    (Key, Operation) -> Gen (Key, Operation)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key
key, Operation
op)

genPageContentSingleSmall :: Gen Key -> Gen Value -> Gen (Key, Operation)
genPageContentSingleSmall :: Gen Key -> Gen Value -> Gen (Key, Operation)
genPageContentSingleSmall Gen Key
genkey Gen Value
genval =
    (,) (Key -> Operation -> (Key, Operation))
-> Gen Key -> Gen (Operation -> (Key, Operation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Key
genkey Gen (Operation -> (Key, Operation))
-> Gen Operation -> Gen (Key, Operation)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Value -> Gen Operation
genOperation Gen Value
genval

-- | Generate pages around the disk page size, above and below.
--
-- The key is always within the min key size given and max key size for the
-- page size.
genPageContentSingleNearFull :: DiskPageSize
                             -> MinKeySize
                             -> Gen (Key, Operation)
genPageContentSingleNearFull :: DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingleNearFull DiskPageSize
dpgsz (MinKeySize Int
minkeysize) =
    Gen (Int, Int) -> Gen (Key, Operation)
genPageContentSingleOfSize Gen (Int, Int)
genKeyValSizes
  where
    genKeyValSizes :: Gen (Int, Int)
genKeyValSizes = do
      let maxkeysize :: Int
maxkeysize = DiskPageSize -> Int
maxKeySize DiskPageSize
dpgsz
      Int
size  <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
maxkeysize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
15, Int
maxkeysize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
15)
      Int
split <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
minkeysize, Int
maxkeysize Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
size)
      (Int, Int) -> Gen (Int, Int)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
split, Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
split)

genPageContentSingleMultiPage :: DiskPageSize
                              -> MinKeySize
                              -> Gen (Key, Operation)
genPageContentSingleMultiPage :: DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingleMultiPage DiskPageSize
dpgsz (MinKeySize Int
minkeysz) =
    Gen (Int, Int) -> Gen (Key, Operation)
genPageContentSingleOfSize Gen (Int, Int)
genKeyValSizes
  where
    genKeyValSizes :: Gen (Int, Int)
genKeyValSizes =
      (,) (Int -> Int -> (Int, Int)) -> Gen Int -> Gen (Int -> (Int, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
minkeysz, DiskPageSize -> Int
maxKeySize DiskPageSize
dpgsz)
          Gen (Int -> (Int, Int)) -> Gen Int -> Gen (Int, Int)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3)

genKeyOfSize :: Gen Int -> Gen Key
genKeyOfSize :: Gen Int -> Gen Key
genKeyOfSize Gen Int
genSize =
    Gen Int
genSize Gen Int -> (Int -> Gen Key) -> Gen Key
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> ByteString -> Key
Key (ByteString -> Key) -> ([Word8] -> ByteString) -> [Word8] -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Key) -> Gen [Word8] -> Gen Key
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

genKeyMinSize :: DiskPageSize -> MinKeySize -> Gen Key
genKeyMinSize :: DiskPageSize -> MinKeySize -> Gen Key
genKeyMinSize DiskPageSize
dpgsz (MinKeySize Int
minsz) =
    Gen Int -> Gen Key
genKeyOfSize
      (Gen Int
getSize Gen Int -> (Int -> Gen Int) -> Gen Int
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
sz -> (Int, Int) -> Gen Int
chooseInt (Int
minsz, Int
sz Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` DiskPageSize -> Int
maxKeySize DiskPageSize
dpgsz))

instance Arbitrary Key where
  arbitrary :: Gen Key
arbitrary =
    Gen Int -> Gen Key
genKeyOfSize
      (Gen Int
getSize Gen Int -> (Int -> Gen Int) -> Gen Int
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
sz -> (Int, Int) -> Gen Int
chooseInt (Int
0, Int
sz Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` DiskPageSize -> Int
maxKeySize DiskPageSize
DiskPage4k))

  shrink :: Key -> [Key]
shrink = (ByteString -> Key)
-> (Key -> ByteString)
-> (ByteString -> [ByteString])
-> Key
-> [Key]
forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy ByteString -> Key
Key Key -> ByteString
unKey ByteString -> [ByteString]
shrinkOpaqueByteString

genValueOfSize :: Gen Int -> Gen Value
genValueOfSize :: Gen Int -> Gen Value
genValueOfSize Gen Int
genSize =
    Gen Int
genSize Gen Int -> (Int -> Gen Value) -> Gen Value
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
n -> ByteString -> Value
Value (ByteString -> Value)
-> ([Word8] -> ByteString) -> [Word8] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Value) -> Gen [Word8] -> Gen Value
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary Value where
  arbitrary :: Gen Value
arbitrary = Gen Int -> Gen Value
genValueOfSize (Gen Int
getSize Gen Int -> (Int -> Gen Int) -> Gen Int
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
sz -> (Int, Int) -> Gen Int
chooseInt (Int
0, Int
sz))

  shrink :: Value -> [Value]
shrink = (ByteString -> Value)
-> (Value -> ByteString)
-> (ByteString -> [ByteString])
-> Value
-> [Value]
forall a b. (a -> b) -> (b -> a) -> (a -> [a]) -> b -> [b]
shrinkMapBy ByteString -> Value
Value Value -> ByteString
unValue ByteString -> [ByteString]
shrinkOpaqueByteString

genOperation :: Gen Value -> Gen Operation
genOperation :: Gen Value -> Gen Operation
genOperation Gen Value
genval =
    [Gen Operation] -> Gen Operation
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Value -> Maybe BlobRef -> Operation
Insert  (Value -> Maybe BlobRef -> Operation)
-> Gen Value -> Gen (Maybe BlobRef -> Operation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Value
genval Gen (Maybe BlobRef -> Operation)
-> Gen (Maybe BlobRef) -> Gen Operation
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe BlobRef)
forall a. Arbitrary a => Gen a
arbitrary
      , Value -> Operation
Mupsert (Value -> Operation) -> Gen Value -> Gen Operation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Value
genval
      , Operation -> Gen Operation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Operation
Delete
      ]

instance Arbitrary Operation where
  arbitrary :: Gen Operation
arbitrary = Gen Value -> Gen Operation
genOperation Gen Value
forall a. Arbitrary a => Gen a
arbitrary

  shrink :: Operation -> [Operation]
  shrink :: Operation -> [Operation]
shrink Operation
Delete        = []
  shrink (Insert Value
v Maybe BlobRef
mb) = Operation
Delete
                       Operation -> [Operation] -> [Operation]
forall a. a -> [a] -> [a]
: [ Value -> Maybe BlobRef -> Operation
Insert  Value
v' Maybe BlobRef
mb' | (Value
v', Maybe BlobRef
mb') <- (Value, Maybe BlobRef) -> [(Value, Maybe BlobRef)]
forall a. Arbitrary a => a -> [a]
shrink (Value
v, Maybe BlobRef
mb) ]
  shrink (Mupsert Value
v)   = Value -> Maybe BlobRef -> Operation
Insert Value
v Maybe BlobRef
forall a. Maybe a
Nothing
                       Operation -> [Operation] -> [Operation]
forall a. a -> [a] -> [a]
: [ Value -> Operation
Mupsert Value
v' | Value
v' <- Value -> [Value]
forall a. Arbitrary a => a -> [a]
shrink Value
v ]

instance Arbitrary BlobRef where
  arbitrary :: Gen BlobRef
arbitrary = Word64 -> Word32 -> BlobRef
BlobRef (Word64 -> Word32 -> BlobRef)
-> Gen Word64 -> Gen (Word32 -> BlobRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen (Word32 -> BlobRef) -> Gen Word32 -> Gen BlobRef
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary

  shrink :: BlobRef -> [BlobRef]
shrink (BlobRef Word64
0 Word32
0) = []
  shrink (BlobRef Word64
_ Word32
_) = [Word64 -> Word32 -> BlobRef
BlobRef Word64
0 Word32
0]

instance Arbitrary DiskPageSize where
  arbitrary :: Gen DiskPageSize
arbitrary = (Int -> Int) -> Gen DiskPageSize -> Gen DiskPageSize
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5) (Gen DiskPageSize -> Gen DiskPageSize)
-> Gen DiskPageSize -> Gen DiskPageSize
forall a b. (a -> b) -> a -> b
$ [DiskPageSize] -> Gen DiskPageSize
forall a. HasCallStack => [a] -> Gen a
growingElements [DiskPageSize
forall a. Bounded a => a
minBound..]
  shrink :: DiskPageSize -> [DiskPageSize]
shrink    = DiskPageSize -> [DiskPageSize]
forall a. (Bounded a, Enum a, Eq a) => a -> [a]
shrinkBoundedEnum

-- | Sort and de-duplicate a key\/operation sequence to ensure the sequence is
-- strictly ascending by key.
--
-- If you need this in a QC generator, you will need 'shrinkOrderedKeyOps' in
-- the corresponding shrinker.
--
orderdKeyOps :: [(Key, Operation)] -> [(Key, Operation)]
orderdKeyOps :: [(Key, Operation)] -> [(Key, Operation)]
orderdKeyOps =
    ((Key, Operation) -> (Key, Operation) -> Bool)
-> [(Key, Operation)] -> [(Key, Operation)]
forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy (Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Key -> Key -> Bool)
-> ((Key, Operation) -> Key)
-> (Key, Operation)
-> (Key, Operation)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Key, Operation) -> Key
forall a b. (a, b) -> a
fst)
  ([(Key, Operation)] -> [(Key, Operation)])
-> ([(Key, Operation)] -> [(Key, Operation)])
-> [(Key, Operation)]
-> [(Key, Operation)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Key, Operation) -> (Key, Operation) -> Ordering)
-> [(Key, Operation)] -> [(Key, Operation)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (Key -> Key -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Key -> Key -> Ordering)
-> ((Key, Operation) -> Key)
-> (Key, Operation)
-> (Key, Operation)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Key, Operation) -> Key
forall a b. (a, b) -> a
fst)

-- | Shrink a key\/operation sequence (without regard to key order).
shrinkKeyOps :: [(Key, Operation)] -> [[(Key, Operation)]]
shrinkKeyOps :: [(Key, Operation)] -> [[(Key, Operation)]]
shrinkKeyOps = [(Key, Operation)] -> [[(Key, Operation)]]
forall a. Arbitrary a => a -> [a]
shrink
  -- It turns out that the generic list shrink is actually good enough,
  -- but only because we've got carefully chosen shrinkers for Key and Value.
  -- Without those special shrinkers, this one would blow up.

-- | Shrink a key\/operation sequence, preserving key order.
shrinkOrderedKeyOps :: [(Key, Operation)] -> [[(Key, Operation)]]
shrinkOrderedKeyOps :: [(Key, Operation)] -> [[(Key, Operation)]]
shrinkOrderedKeyOps = ([(Key, Operation)] -> [(Key, Operation)])
-> [[(Key, Operation)]] -> [[(Key, Operation)]]
forall a b. (a -> b) -> [a] -> [b]
map [(Key, Operation)] -> [(Key, Operation)]
orderdKeyOps ([[(Key, Operation)]] -> [[(Key, Operation)]])
-> ([(Key, Operation)] -> [[(Key, Operation)]])
-> [(Key, Operation)]
-> [[(Key, Operation)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Operation)] -> [[(Key, Operation)]]
forall a. Arbitrary a => a -> [a]
shrink

-- | Shrink 'ByteString's that are used as opaque blobs, where their value
-- is generally not used, except for ordering. We minimise the number of
-- alternative shrinks, to help minimise the number of shrinks when lots
-- of such values are used, e.g. in key\/value containers.
--
-- This tries only three alternatives:
--
-- * take the first half
-- * take everything but the final byte
-- * replace the last (non-space) character by a space
--
-- > > shrinkOpaqueByteString "hello world!"
-- > ["hello ","hello world", "hello world "]
--
-- Using space as the replacement character makes the resulting strings
-- printable and shorter than lots of @\NUL\NUL\NUL@, which makes for test
-- failure cases that are easier to read.
--
shrinkOpaqueByteString :: ByteString -> [ByteString]
shrinkOpaqueByteString :: ByteString -> [ByteString]
shrinkOpaqueByteString ByteString
bs =
    [ Int -> ByteString -> ByteString
BS.take (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 ]
 [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.init ByteString
bs                        | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ]
 [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BSC.spanEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') ByteString
bs of
      (ByteString
prefix, ByteString
spaces)
        | ByteString -> Bool
BS.null ByteString
prefix -> []
        | Bool
otherwise      -> [ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.init ByteString
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Char -> ByteString -> ByteString
BSC.cons Char
' ' ByteString
spaces ]

-------------------------------------------------------------------------------
-- Tests
--

tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"FormatPage"
    [ String -> ([Bool] -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"to/from bitmap" [Bool] -> Bool
prop_toFromBitmap
    , String -> Bool -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"maxKeySize" Bool
prop_maxKeySize

    , let dpgsz :: DiskPageSize
dpgsz = DiskPageSize
DiskPage4k in
      String -> [TestTree] -> TestTree
testGroup String
"size distribution"
      [ String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"genPageContentFits" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
        Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        String -> [(String, Double)] -> Property -> Property
forall prop.
Testable prop =>
String -> [(String, Double)] -> prop -> Property
coverTable String
"page size in bytes"
          [(String
"0 <= n < 512",Double
10)
          ,(String
"3k < n <= 4k", Double
5)] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        String -> [(String, Double)] -> Property -> Property
forall prop.
Testable prop =>
String -> [(String, Double)] -> prop -> Property
coverTable String
"page size in disk pages"
          [(String
"1 page",  Double
50)
          ,(String
"2 pages",  Double
0.5)
          ,(String
"3+ pages", Double
0.5)] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        Gen [(Key, Operation)]
-> ([(Key, Operation)] -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentFits DiskPageSize
dpgsz MinKeySize
noMinKeySize) (([(Key, Operation)] -> Property) -> Property)
-> ([(Key, Operation)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
          DiskPageSize -> Property -> [(Key, Operation)] -> Property
prop_size_distribution DiskPageSize
dpgsz (Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False)

      , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"genPageContentMaybeOverfull" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
        Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        Gen [(Key, Operation)]
-> ([(Key, Operation)] -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (DiskPageSize -> MinKeySize -> Gen [(Key, Operation)]
genPageContentMaybeOverfull DiskPageSize
dpgsz MinKeySize
noMinKeySize) (([(Key, Operation)] -> Property) -> Property)
-> ([(Key, Operation)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
          DiskPageSize -> Property -> [(Key, Operation)] -> Property
prop_size_distribution DiskPageSize
dpgsz
            (Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
10 Bool
True String
"over-full" (Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True))

      , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"genPageContentSingle" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
        Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        String -> [(String, Double)] -> Property -> Property
forall prop.
Testable prop =>
String -> [(String, Double)] -> prop -> Property
coverTable String
"page size in disk pages"
          [(String
"1 page",  Double
10)
          ,(String
"2 pages",  Double
2)
          ,(String
"3+ pages", Double
2)] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        Gen [(Key, Operation)]
-> ([(Key, Operation)] -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (((Key, Operation) -> [(Key, Operation)] -> [(Key, Operation)]
forall a. a -> [a] -> [a]
:[]) ((Key, Operation) -> [(Key, Operation)])
-> Gen (Key, Operation) -> Gen [(Key, Operation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DiskPageSize -> MinKeySize -> Gen (Key, Operation)
genPageContentSingle DiskPageSize
dpgsz MinKeySize
noMinKeySize) (([(Key, Operation)] -> Property) -> Property)
-> ([(Key, Operation)] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$
          DiskPageSize -> Property -> [(Key, Operation)] -> Property
prop_size_distribution DiskPageSize
dpgsz (Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False)
      ]
    , String -> (PageContentMaybeOverfull -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"size 0" PageContentMaybeOverfull -> Bool
prop_size0
    , String -> (PageContentFits -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"size 1" PageContentFits -> Bool
prop_size1
    , String -> (PageContentFits -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"size 2" PageContentFits -> Bool
prop_size2
    , String -> (PageContentFits -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"size 3" PageContentFits -> Bool
prop_size3
    , String -> (PageContentFits -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"encode/decode" PageContentFits -> Property
prop_encodeDecode
    , String -> (PageContentFits -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"serialise/deserialise" PageContentFits -> Bool
prop_serialiseDeserialise
    , String -> (PageContentFits -> Bool) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"encode/serialise/deserialise/decode"
                   PageContentFits -> Bool
prop_encodeSerialiseDeserialiseDecode
    , String -> (PageContentSingle -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"overflow pages" PageContentSingle -> Property
prop_overflowPages
    ]

prop_toFromBitmap :: [Bool] -> Bool
prop_toFromBitmap :: [Bool] -> Bool
prop_toFromBitmap [Bool]
bits =
    [Bool]
bits [Bool] -> [Bool] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> [Bool] -> [Bool]
forall a. Int -> [a] -> [a]
take ([Bool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Bool]
bits) ([Bool] -> [Bool]
roundTrip [Bool]
bits)
  where
    roundTrip :: [Bool] -> [Bool]
roundTrip = [Word64] -> [Bool]
fromBitmap ([Word64] -> [Bool]) -> ([Bool] -> [Word64]) -> [Bool] -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bool] -> [Word64]
toBitmap

prop_size_distribution :: DiskPageSize
                       -> Property -- ^ over-full sub-property
                       -> [(Key, Operation)]
                       -> Property
prop_size_distribution :: DiskPageSize -> Property -> [(Key, Operation)] -> Property
prop_size_distribution DiskPageSize
dpgsz Property
propOverfull [(Key, Operation)]
p =
  case DiskPageSize -> [(Key, Operation)] -> Maybe PageSize
calcPageSize DiskPageSize
dpgsz [(Key, Operation)]
p of
    Maybe PageSize
Nothing -> Property
propOverfull
    Just PageSize{Int
pageSizeElems :: PageSize -> Int
pageSizeElems :: Int
pageSizeElems, Int
pageSizeBlobs :: PageSize -> Int
pageSizeBlobs :: Int
pageSizeBlobs, Int
pageSizeBytes :: PageSize -> Int
pageSizeBytes :: Int
pageSizeBytes} ->
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"page size in elements"
        [ Int -> String
showNumElems Int
pageSizeElems ] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"page number of blobs"
        [ Int -> String
showNumElems Int
pageSizeBlobs ] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"page size in bytes"
        [ Int -> String
showPageSizeBytes Int
pageSizeBytes ] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"page size in disk pages"
        [ Int -> String
showPageSizeDiskPages Int
pageSizeBytes ] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"key size in bytes"
        [ Int -> String
showKeyValueSizeBytes (ByteString -> Int
BS.length ByteString
k) | (Key ByteString
k, Operation
_) <- [(Key, Operation)]
p ] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"value size in bytes"
        [ Int -> String
showKeyValueSizeBytes (ByteString -> Int
BS.length ByteString
v)
        | (Key
_, Operation
op) <- [(Key, Operation)]
p
        , Value ByteString
v <- case Operation
op of
                       Insert  Value
v Maybe BlobRef
_ -> [Value
v]
                       Mupsert Value
v   -> [Value
v]
                       Operation
Delete      -> []
        ] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ (if Int
pageSizeElems Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                     then Int
pageSizeBytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
dpgszBytes
                     else Bool
True)
              Bool -> Bool -> Bool
&& (Int
pageSizeElems Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Key, Operation)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Key, Operation)]
p)
              Bool -> Bool -> Bool
&& (Int
pageSizeBlobs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Key, Operation)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (((Key, Operation) -> Bool)
-> [(Key, Operation)] -> [(Key, Operation)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Operation -> Bool
opHasBlobRef (Operation -> Bool)
-> ((Key, Operation) -> Operation) -> (Key, Operation) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Operation) -> Operation
forall a b. (a, b) -> b
snd) [(Key, Operation)]
p))
  where
    dpgszBytes :: Int
dpgszBytes = DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz

    showNumElems :: Int -> String
    showNumElems :: Int -> String
showNumElems Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1    = Int -> String
forall a. Show a => a -> String
show Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10    = String
"1 < n < 10"
      | Bool
otherwise = Int -> Int -> String
nearest Int
10 Int
n

    showPageSizeBytes :: Int -> String
    showPageSizeBytes :: Int -> String
showPageSizeBytes Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4096  = Int -> String
nearest4k Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1024  = Int -> String
nearest1k Int
n
      | Bool
otherwise = Int -> Int -> String
nearest Int
512 Int
n

    showPageSizeDiskPages :: Int -> String
    showPageSizeDiskPages :: Int -> String
showPageSizeDiskPages Int
n
      | Int
npgs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = String
"1 page"
      | Int
npgs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = String
"2 pages"
      | Bool
otherwise = String
"3+ pages"
      where
        npgs :: Int
npgs = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dpgszBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
dpgszBytes

    showKeyValueSizeBytes :: Int -> String
    showKeyValueSizeBytes :: Int -> String
showKeyValueSizeBytes Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
20    = Int -> Int -> String
nearest Int
5 Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
100   = String
"20 <= n < 100"
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1024  = Int -> Int -> String
nearest Int
100 Int
n
      | Bool
otherwise = Int -> String
nearest1k Int
n

    nearest :: Int -> Int -> String
    nearest :: Int -> Int -> String
nearest Int
m Int
n = Int -> String
forall a. Show a => a -> String
show ((Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
m) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" <= n < "
               String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ((Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
m) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m)

    nearest1k, nearest4k :: Int -> String
    nearest1k :: Int -> String
nearest1k Int
n = Int -> String
forall a. Show a => a -> String
show ((Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1024) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"k < n <= "
               String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ((Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"k"
    nearest4k :: Int -> String
nearest4k Int
n = Int -> String
forall a. Show a => a -> String
show (((Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4096) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"k < n <= "
               String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (((Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4096) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"k"

-- | The maximum size of key that is guaranteed to always fit in an empty
-- 4k page. So this is a worst case maximum size: this size key will fit
-- irrespective of the corresponding operation, including the possibility
-- that the key\/op pair has a blob reference.
maxKeySize :: DiskPageSize -> Int
maxKeySize :: DiskPageSize -> Int
maxKeySize DiskPageSize
dpgsz = DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pageSizeOverhead

pageSizeOverhead :: Int
pageSizeOverhead :: Int
pageSizeOverhead =
    (PageSize -> Int
pageSizeBytes (PageSize -> Int)
-> ([(Key, Operation)] -> PageSize) -> [(Key, Operation)] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PageSize -> PageSize
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PageSize -> PageSize)
-> ([(Key, Operation)] -> Maybe PageSize)
-> [(Key, Operation)]
-> PageSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiskPageSize -> [(Key, Operation)] -> Maybe PageSize
calcPageSize DiskPageSize
DiskPage4k)
      [(ByteString -> Key
Key ByteString
BS.empty, Value -> Maybe BlobRef -> Operation
Insert (ByteString -> Value
Value ByteString
BS.empty) (BlobRef -> Maybe BlobRef
forall a. a -> Maybe a
Just (Word64 -> Word32 -> BlobRef
BlobRef Word64
0 Word32
0)))]
    -- the page size passed to calcPageSize here is irrelevant

prop_maxKeySize :: Bool
prop_maxKeySize :: Bool
prop_maxKeySize = DiskPageSize -> Int
maxKeySize DiskPageSize
DiskPage4k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4052

-- | The 'calcPageSize' and 'calcPageSizeOffsets' (used by 'encodePage') had
-- better agree with each other!
--
-- The 'calcPageSize' uses the incremental 'PageSize' API, to work out the page
-- size, element by element, while 'calcPageSizeOffsets' is a bulk operation
-- used by 'encodePage'. It's critical that they agree on how many elements can
-- fit into a page.
--
prop_size0 :: PageContentMaybeOverfull -> Bool
prop_size0 :: PageContentMaybeOverfull -> Bool
prop_size0 (PageContentMaybeOverfull DiskPageSize
dpgsz [(Key, Operation)]
p) =
    case (DiskPageSize -> [(Key, Operation)] -> Maybe PageSize
calcPageSize DiskPageSize
dpgsz [(Key, Operation)]
p, DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage DiskPageSize
dpgsz [(Key, Operation)]
p) of
        (Maybe PageSize
Nothing, Maybe PageIntermediate
Nothing) -> Bool
True
        (Maybe PageSize
Nothing, Just{})  -> Bool
False -- they disagree!
        (Just{}, Maybe PageIntermediate
Nothing)  -> Bool
False -- they disagree!
        (Just PageSize{Int
DiskPageSize
pageSizeElems :: PageSize -> Int
pageSizeBlobs :: PageSize -> Int
pageSizeBytes :: PageSize -> Int
pageSizeDisk :: PageSize -> DiskPageSize
pageSizeElems :: Int
pageSizeBlobs :: Int
pageSizeBytes :: Int
pageSizeDisk :: DiskPageSize
..},
         Just PageIntermediate{pageSizesOffsets :: PageIntermediate -> PageSizesOffsets
pageSizesOffsets = PageSizesOffsets{Word16
Word32
sizeDirectory :: PageSizesOffsets -> Word16
sizeBlobRefBitmap :: PageSizesOffsets -> Word16
sizeOperations :: PageSizesOffsets -> Word16
sizeBlobRefs :: PageSizesOffsets -> Word16
sizeKeyOffsets :: PageSizesOffsets -> Word16
sizeValueOffsets :: PageSizesOffsets -> Word16
sizeKeys :: PageSizesOffsets -> Word16
sizeValues :: PageSizesOffsets -> Word32
offBlobRefBitmap :: PageSizesOffsets -> Word16
offOperations :: PageSizesOffsets -> Word16
offBlobRefs :: PageSizesOffsets -> Word16
offKeyOffsets :: PageSizesOffsets -> Word16
offValueOffsets :: PageSizesOffsets -> Word16
offKeys :: PageSizesOffsets -> Word16
offValues :: PageSizesOffsets -> Word16
sizePageUsed :: PageSizesOffsets -> Word32
sizePagePadding :: PageSizesOffsets -> Word32
sizePageDiskPage :: PageSizesOffsets -> Word32
sizeDirectory :: Word16
sizeBlobRefBitmap :: Word16
sizeOperations :: Word16
sizeBlobRefs :: Word16
sizeKeyOffsets :: Word16
sizeValueOffsets :: Word16
sizeKeys :: Word16
sizeValues :: Word32
offBlobRefBitmap :: Word16
offOperations :: Word16
offBlobRefs :: Word16
offKeyOffsets :: Word16
offValueOffsets :: Word16
offKeys :: Word16
offValues :: Word16
sizePageUsed :: Word32
sizePagePadding :: Word32
sizePageDiskPage :: Word32
..}, [Bool]
[Word16]
[OperationEnum]
[BlobRef]
Word16
Either [Word16] (Word16, Word32)
ByteString
DiskPageSize
pageNumKeys :: PageIntermediate -> Word16
pageNumBlobs :: PageIntermediate -> Word16
pageBlobRefBitmap :: PageIntermediate -> [Bool]
pageOperations :: PageIntermediate -> [OperationEnum]
pageBlobRefs :: PageIntermediate -> [BlobRef]
pageKeyOffsets :: PageIntermediate -> [Word16]
pageValueOffsets :: PageIntermediate -> Either [Word16] (Word16, Word32)
pageKeys :: PageIntermediate -> ByteString
pageValues :: PageIntermediate -> ByteString
pagePadding :: PageIntermediate -> ByteString
pageDiskPageSize :: PageIntermediate -> DiskPageSize
pageNumKeys :: Word16
pageNumBlobs :: Word16
pageBlobRefBitmap :: [Bool]
pageOperations :: [OperationEnum]
pageBlobRefs :: [BlobRef]
pageKeyOffsets :: [Word16]
pageValueOffsets :: Either [Word16] (Word16, Word32)
pageKeys :: ByteString
pageValues :: ByteString
pagePadding :: ByteString
pageDiskPageSize :: DiskPageSize
..}) ->
              Int
pageSizeElems Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
pageNumKeys
           Bool -> Bool -> Bool
&& Int
pageSizeBlobs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
pageNumBlobs
           Bool -> Bool -> Bool
&& Int
pageSizeBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sizePageUsed
           Bool -> Bool -> Bool
&& DiskPageSize
pageSizeDisk  DiskPageSize -> DiskPageSize -> Bool
forall a. Eq a => a -> a -> Bool
== DiskPageSize
pageDiskPageSize
           Bool -> Bool -> Bool
&& DiskPageSize
pageSizeDisk  DiskPageSize -> DiskPageSize -> Bool
forall a. Eq a => a -> a -> Bool
== DiskPageSize
dpgsz

prop_size1 :: PageContentFits -> Bool
prop_size1 :: PageContentFits -> Bool
prop_size1 (PageContentFits DiskPageSize
dpgsz [(Key, Operation)]
p) =
    Word32
sizePageUsed Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
 Bool -> Bool -> Bool
&& Word32
sizePageUsed Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
sizePagePadding Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
sizePageDiskPage
 Bool -> Bool -> Bool
&& if PageIntermediate -> Word16
pageNumKeys PageIntermediate
p' Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
1
      then Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sizePageDiskPage Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
      else Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sizePageDiskPage Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz
  where
    Just PageIntermediate
p' = DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage DiskPageSize
dpgsz [(Key, Operation)]
p
    PageSizesOffsets{Word16
Word32
sizeDirectory :: PageSizesOffsets -> Word16
sizeBlobRefBitmap :: PageSizesOffsets -> Word16
sizeOperations :: PageSizesOffsets -> Word16
sizeBlobRefs :: PageSizesOffsets -> Word16
sizeKeyOffsets :: PageSizesOffsets -> Word16
sizeValueOffsets :: PageSizesOffsets -> Word16
sizeKeys :: PageSizesOffsets -> Word16
sizeValues :: PageSizesOffsets -> Word32
offBlobRefBitmap :: PageSizesOffsets -> Word16
offOperations :: PageSizesOffsets -> Word16
offBlobRefs :: PageSizesOffsets -> Word16
offKeyOffsets :: PageSizesOffsets -> Word16
offValueOffsets :: PageSizesOffsets -> Word16
offKeys :: PageSizesOffsets -> Word16
offValues :: PageSizesOffsets -> Word16
sizePageUsed :: PageSizesOffsets -> Word32
sizePagePadding :: PageSizesOffsets -> Word32
sizePageDiskPage :: PageSizesOffsets -> Word32
sizePageUsed :: Word32
sizePagePadding :: Word32
sizePageDiskPage :: Word32
sizeDirectory :: Word16
sizeBlobRefBitmap :: Word16
sizeOperations :: Word16
sizeBlobRefs :: Word16
sizeKeyOffsets :: Word16
sizeValueOffsets :: Word16
sizeKeys :: Word16
sizeValues :: Word32
offBlobRefBitmap :: Word16
offOperations :: Word16
offBlobRefs :: Word16
offKeyOffsets :: Word16
offValueOffsets :: Word16
offKeys :: Word16
offValues :: Word16
..} = PageIntermediate -> PageSizesOffsets
pageSizesOffsets PageIntermediate
p'

prop_size2 :: PageContentFits -> Bool
prop_size2 :: PageContentFits -> Bool
prop_size2 (PageContentFits DiskPageSize
dpgsz [(Key, Operation)]
p) =
    ByteString -> Int
BS.length (PageIntermediate -> ByteString
serialisePage PageIntermediate
p')
 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PageSizesOffsets -> Word32
sizePageDiskPage (PageIntermediate -> PageSizesOffsets
pageSizesOffsets PageIntermediate
p'))
  where
    Just PageIntermediate
p' = DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage DiskPageSize
dpgsz [(Key, Operation)]
p

prop_size3 :: PageContentFits -> Bool
prop_size3 :: PageContentFits -> Bool
prop_size3 (PageContentFits DiskPageSize
dpgsz [(Key, Operation)]
p) =
  case (DiskPageSize -> [(Key, Operation)] -> Maybe PageSize
calcPageSize DiskPageSize
dpgsz [(Key, Operation)]
p, DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage DiskPageSize
dpgsz [(Key, Operation)]
p) of
    (Just PageSize{Int
pageSizeBytes :: PageSize -> Int
pageSizeBytes :: Int
pageSizeBytes}, Just PageIntermediate
p') ->
      Int
pageSizeBytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int)
-> (PageIntermediate -> Word32) -> PageIntermediate -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageSizesOffsets -> Word32
sizePageUsed (PageSizesOffsets -> Word32)
-> (PageIntermediate -> PageSizesOffsets)
-> PageIntermediate
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageIntermediate -> PageSizesOffsets
pageSizesOffsets) PageIntermediate
p'
    (Maybe PageSize, Maybe PageIntermediate)
_ -> Bool
False

prop_encodeDecode :: PageContentFits -> Property
prop_encodeDecode :: PageContentFits -> Property
prop_encodeDecode (PageContentFits DiskPageSize
dpgsz [(Key, Operation)]
p) =
    [(Key, Operation)]
p [(Key, Operation)] -> [(Key, Operation)] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== PageIntermediate -> [(Key, Operation)]
decodePage PageIntermediate
p'
  where
    Just PageIntermediate
p' = DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage DiskPageSize
dpgsz [(Key, Operation)]
p

prop_serialiseDeserialise :: PageContentFits -> Bool
prop_serialiseDeserialise :: PageContentFits -> Bool
prop_serialiseDeserialise (PageContentFits DiskPageSize
dpgsz [(Key, Operation)]
p) =
    PageIntermediate
p' PageIntermediate -> PageIntermediate -> Bool
forall a. Eq a => a -> a -> Bool
== PageIntermediate -> PageIntermediate
roundTrip PageIntermediate
p'
  where
    Just PageIntermediate
p'   = DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage DiskPageSize
dpgsz [(Key, Operation)]
p
    roundTrip :: PageIntermediate -> PageIntermediate
roundTrip = DiskPageSize -> ByteString -> PageIntermediate
deserialisePage DiskPageSize
dpgsz (ByteString -> PageIntermediate)
-> (PageIntermediate -> ByteString)
-> PageIntermediate
-> PageIntermediate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageIntermediate -> ByteString
serialisePage

prop_encodeSerialiseDeserialiseDecode :: PageContentFits -> Bool
prop_encodeSerialiseDeserialiseDecode :: PageContentFits -> Bool
prop_encodeSerialiseDeserialiseDecode (PageContentFits DiskPageSize
dpgsz [(Key, Operation)]
p) =
    [(Key, Operation)]
p [(Key, Operation)] -> [(Key, Operation)] -> Bool
forall a. Eq a => a -> a -> Bool
== PageIntermediate -> [(Key, Operation)]
roundTrip PageIntermediate
p'
  where
    Just PageIntermediate
p'   = DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage DiskPageSize
dpgsz [(Key, Operation)]
p
    roundTrip :: PageIntermediate -> [(Key, Operation)]
roundTrip = PageIntermediate -> [(Key, Operation)]
decodePage (PageIntermediate -> [(Key, Operation)])
-> (PageIntermediate -> PageIntermediate)
-> PageIntermediate
-> [(Key, Operation)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiskPageSize -> ByteString -> PageIntermediate
deserialisePage DiskPageSize
dpgsz (ByteString -> PageIntermediate)
-> (PageIntermediate -> ByteString)
-> PageIntermediate
-> PageIntermediate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PageIntermediate -> ByteString
serialisePage

prop_overflowPages :: PageContentSingle -> Property
prop_overflowPages :: PageContentSingle -> Property
prop_overflowPages (PageContentSingle DiskPageSize
dpgsz Key
k Operation
op) =
    String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (String
"pages " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
ps)) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz) (Int -> Bool) -> (ByteString -> Int) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length) [ByteString]
ps
 Bool -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. PageIntermediate -> Int
pageDiskPages PageIntermediate
p Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
ps
 Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. case PageIntermediate -> Maybe (Int, Int)
pageOverflowPrefixSuffixLen PageIntermediate
p of
        Maybe (Int, Int)
Nothing -> [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
ps Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int
1
        Just (Int
prefixlen, Int
suffixlen) ->
              Int
prefixlen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
suffixlen Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString -> Int
BS.length (Value -> ByteString
unValue Value
v)
         Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.     ByteString -> Value
Value (Int -> ByteString -> ByteString
BS.drop (Int
dpgszBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
prefixlen) ([ByteString] -> ByteString
forall a. HasCallStack => [a] -> a
head [ByteString]
ps)
                      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> ByteString -> ByteString
BS.take Int
suffixlen ([ByteString] -> ByteString
BS.concat (Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
1 [ByteString]
ps)))
              Value -> Value -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Value
v
  where
    Just PageIntermediate
p = DiskPageSize -> [(Key, Operation)] -> Maybe PageIntermediate
encodePage DiskPageSize
dpgsz [(Key
k, Operation
op)]
    ps :: [ByteString]
ps     = DiskPageSize -> ByteString -> [ByteString]
pageSerialisedChunks DiskPageSize
dpgsz (PageIntermediate -> ByteString
serialisePage PageIntermediate
p)
    v :: Value
v      = case Operation
op of
               Insert  Value
v' Maybe BlobRef
_ -> Value
v'
               Mupsert Value
v'   -> Value
v'
               Operation
Delete       -> String -> Value
forall a. HasCallStack => String -> a
error String
"unexpected"
    dpgszBytes :: Int
dpgszBytes = DiskPageSize -> Int
diskPageSizeBytes DiskPageSize
dpgsz