{-# OPTIONS_GHC -Wno-orphans #-}
{- HLINT ignore "Use camelCase" -}

module Database.LSMTree.Extras.Generators (
    -- * WithSerialised
    WithSerialised (..)
    -- * A (logical\/true) page
    -- ** A true page
  , TruePageSummary (..)
  , flattenLogicalPageSummary
    -- ** A logical page
  , LogicalPageSummary (..)
  , shrinkLogicalPageSummary
  , toAppend
    -- * Sequences of (logical\/true) pages
  , Pages (..)
    -- ** Sequences of true pages
  , TruePageSummaries
  , flattenLogicalPageSummaries
    -- ** Sequences of logical pages
  , LogicalPageSummaries
  , toAppends
  , labelPages
  , shrinkPages
  , genPages
  , mkPages
  , pagesInvariant
    -- * Chunking size
  , ChunkSize (..)
  , chunkSizeInvariant
    -- * Serialised keys\/values\/blobs
  , genRawBytes
  , genRawBytesN
  , genRawBytesSized
  , packRawBytesPinnedOrUnpinned
  , LargeRawBytes (..)
  , isKeyForIndexCompact
  , KeyForIndexCompact (..)
  , BiasedKey (..)
    -- * helpers
  , shrinkVec
  ) where

import           Control.DeepSeq (NFData)
import           Control.Exception (assert)
import           Data.Coerce (coerce)
import           Data.Containers.ListUtils (nubOrd)
import           Data.Function ((&))
import           Data.List (nub, sort)
import qualified Data.Primitive.ByteArray as BA
import qualified Data.Vector.Primitive as VP
import           Data.Word
import qualified Database.LSMTree as Unified
import           Database.LSMTree.Common (Range (..))
import           Database.LSMTree.Extras
import           Database.LSMTree.Extras.Index (Append (..))
import           Database.LSMTree.Extras.Orphans ()
import           Database.LSMTree.Internal.BlobRef (BlobSpan (..))
import           Database.LSMTree.Internal.Entry (Entry (..), NumEntries (..))
import qualified Database.LSMTree.Internal.Merge as Merge
import           Database.LSMTree.Internal.Page (PageNo (..))
import           Database.LSMTree.Internal.RawBytes (RawBytes (RawBytes))
import qualified Database.LSMTree.Internal.RawBytes as RB
import           Database.LSMTree.Internal.Serialise
import qualified Database.LSMTree.Internal.Serialise.Class as S.Class
import           Database.LSMTree.Internal.Unsliced (Unsliced, fromUnslicedKey,
                     makeUnslicedKey)
import           Database.LSMTree.Internal.Vector (mkPrimVector)
import qualified Database.LSMTree.Monoidal as Monoidal
import qualified Database.LSMTree.Normal as Normal
import           GHC.Generics (Generic)
import qualified Test.QuickCheck as QC
import           Test.QuickCheck (Arbitrary (..), Arbitrary1 (..),
                     Arbitrary2 (..), Gen, Property, elements, frequency)
import           Test.QuickCheck.Gen (genDouble)
import           Test.QuickCheck.Instances ()

{-------------------------------------------------------------------------------
  Common LSMTree types
-------------------------------------------------------------------------------}

instance (Arbitrary v, Arbitrary b) => Arbitrary (Unified.Update v b) where
  arbitrary :: Gen (Update v b)
arbitrary = Gen (Update v b)
forall (f :: * -> * -> *) a b.
(Arbitrary2 f, Arbitrary a, Arbitrary b) =>
Gen (f a b)
QC.arbitrary2
  shrink :: Update v b -> [Update v b]
shrink = Update v b -> [Update v b]
forall (f :: * -> * -> *) a b.
(Arbitrary2 f, Arbitrary a, Arbitrary b) =>
f a b -> [f a b]
QC.shrink2

instance Arbitrary2 Unified.Update where
  liftArbitrary2 :: forall a b. Gen a -> Gen b -> Gen (Update a b)
liftArbitrary2 Gen a
genVal Gen b
genBlob = [(Int, Gen (Update a b))] -> Gen (Update a b)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
10, a -> Maybe b -> Update a b
forall v b. v -> Maybe b -> Update v b
Unified.Insert (a -> Maybe b -> Update a b)
-> Gen a -> Gen (Maybe b -> Update a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genVal Gen (Maybe b -> Update a b) -> Gen (Maybe b) -> Gen (Update a b)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen b -> Gen (Maybe b)
forall a. Gen a -> Gen (Maybe a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen b
genBlob)
    , (Int
5, a -> Update a b
forall v b. v -> Update v b
Unified.Mupsert (a -> Update a b) -> Gen a -> Gen (Update a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genVal)
    , (Int
1, Update a b -> Gen (Update a b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Update a b
forall v b. Update v b
Unified.Delete)
    ]

  liftShrink2 :: forall a b. (a -> [a]) -> (b -> [b]) -> Update a b -> [Update a b]
liftShrink2 a -> [a]
shrinkVal b -> [b]
shrinkBlob = \case
    Unified.Insert a
v Maybe b
blob ->
        Update a b
forall v b. Update v b
Unified.Delete
      Update a b -> [Update a b] -> [Update a b]
forall a. a -> [a] -> [a]
: ((a, Maybe b) -> Update a b) -> [(a, Maybe b)] -> [Update a b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Maybe b -> Update a b) -> (a, Maybe b) -> Update a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Maybe b -> Update a b
forall v b. v -> Maybe b -> Update v b
Unified.Insert)
            ((a -> [a])
-> (Maybe b -> [Maybe b]) -> (a, Maybe b) -> [(a, Maybe b)]
forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2 a -> [a]
shrinkVal ((b -> [b]) -> Maybe b -> [Maybe b]
forall a. (a -> [a]) -> Maybe a -> [Maybe a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink b -> [b]
shrinkBlob) (a
v, Maybe b
blob))
    Unified.Mupsert a
v -> a -> Maybe b -> Update a b
forall v b. v -> Maybe b -> Update v b
Unified.Insert a
v Maybe b
forall a. Maybe a
Nothing Update a b -> [Update a b] -> [Update a b]
forall a. a -> [a] -> [a]
: (a -> Update a b) -> [a] -> [Update a b]
forall a b. (a -> b) -> [a] -> [b]
map a -> Update a b
forall v b. v -> Update v b
Unified.Mupsert (a -> [a]
shrinkVal a
v)
    Update a b
Unified.Delete -> []

instance (Arbitrary v, Arbitrary b) => Arbitrary (Normal.Update v b) where
  arbitrary :: Gen (Update v b)
arbitrary = Gen (Update v b)
forall (f :: * -> * -> *) a b.
(Arbitrary2 f, Arbitrary a, Arbitrary b) =>
Gen (f a b)
QC.arbitrary2
  shrink :: Update v b -> [Update v b]
shrink = Update v b -> [Update v b]
forall (f :: * -> * -> *) a b.
(Arbitrary2 f, Arbitrary a, Arbitrary b) =>
f a b -> [f a b]
QC.shrink2

instance Arbitrary2 Normal.Update where
  liftArbitrary2 :: forall a b. Gen a -> Gen b -> Gen (Update a b)
liftArbitrary2 Gen a
genVal Gen b
genBlob = [(Int, Gen (Update a b))] -> Gen (Update a b)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
10, a -> Maybe b -> Update a b
forall v b. v -> Maybe b -> Update v b
Normal.Insert (a -> Maybe b -> Update a b)
-> Gen a -> Gen (Maybe b -> Update a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genVal Gen (Maybe b -> Update a b) -> Gen (Maybe b) -> Gen (Update a b)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen b -> Gen (Maybe b)
forall a. Gen a -> Gen (Maybe a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen b
genBlob)
    , (Int
1, Update a b -> Gen (Update a b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Update a b
forall v b. Update v b
Normal.Delete)
    ]

  liftShrink2 :: forall a b. (a -> [a]) -> (b -> [b]) -> Update a b -> [Update a b]
liftShrink2 a -> [a]
shrinkVal b -> [b]
shrinkBlob = \case
    Normal.Insert a
v Maybe b
blob ->
        Update a b
forall v b. Update v b
Normal.Delete
      Update a b -> [Update a b] -> [Update a b]
forall a. a -> [a] -> [a]
: ((a, Maybe b) -> Update a b) -> [(a, Maybe b)] -> [Update a b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Maybe b -> Update a b) -> (a, Maybe b) -> Update a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> Maybe b -> Update a b
forall v b. v -> Maybe b -> Update v b
Normal.Insert)
            ((a -> [a])
-> (Maybe b -> [Maybe b]) -> (a, Maybe b) -> [(a, Maybe b)]
forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2 a -> [a]
shrinkVal ((b -> [b]) -> Maybe b -> [Maybe b]
forall a. (a -> [a]) -> Maybe a -> [Maybe a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink b -> [b]
shrinkBlob) (a
v, Maybe b
blob))
    Update a b
Normal.Delete ->
      []

instance (Arbitrary v) => Arbitrary (Monoidal.Update v) where
  arbitrary :: Gen (Update v)
arbitrary = Gen (Update v)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
QC.arbitrary1
  shrink :: Update v -> [Update v]
shrink = Update v -> [Update v]
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
QC.shrink1

instance Arbitrary1 Monoidal.Update where
  liftArbitrary :: forall a. Gen a -> Gen (Update a)
liftArbitrary Gen a
genVal = [(Int, Gen (Update a))] -> Gen (Update a)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
10, a -> Update a
forall v. v -> Update v
Monoidal.Insert (a -> Update a) -> Gen a -> Gen (Update a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genVal)
    , (Int
5, a -> Update a
forall v. v -> Update v
Monoidal.Mupsert (a -> Update a) -> Gen a -> Gen (Update a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genVal)
    , (Int
1, Update a -> Gen (Update a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Update a
forall v. Update v
Monoidal.Delete)
    ]

  liftShrink :: forall a. (a -> [a]) -> Update a -> [Update a]
liftShrink a -> [a]
shrinkVal = \case
    Monoidal.Insert a
v  -> Update a
forall v. Update v
Monoidal.Delete Update a -> [Update a] -> [Update a]
forall a. a -> [a] -> [a]
: (a -> Update a) -> [a] -> [Update a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Update a
forall v. v -> Update v
Monoidal.Insert (a -> [a]
shrinkVal a
v)
    Monoidal.Mupsert a
v -> a -> Update a
forall v. v -> Update v
Monoidal.Insert a
v Update a -> [Update a] -> [Update a]
forall a. a -> [a] -> [a]
: (a -> Update a) -> [a] -> [Update a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Update a
forall v. v -> Update v
Monoidal.Mupsert (a -> [a]
shrinkVal a
v)
    Update a
Monoidal.Delete    -> []

instance (Arbitrary k, Ord k) => Arbitrary (Range k) where
  arbitrary :: Gen (Range k)
arbitrary = do
    k
key1 <- Gen k
forall a. Arbitrary a => Gen a
arbitrary
    k
key2 <- Gen k
forall a. Arbitrary a => Gen a
arbitrary Gen k -> (k -> Bool) -> Gen k
forall a. Gen a -> (a -> Bool) -> Gen a
`QC.suchThat` (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
/= k
key1)
    (k
lb, k
ub) <- [(Int, Gen (k, k))] -> Gen (k, k)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
1, (k, k) -> Gen (k, k)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k
key1, k
key1))                    -- lb == ub
      , (Int
1, (k, k) -> Gen (k, k)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k -> k -> k
forall a. Ord a => a -> a -> a
max k
key1 k
key2, k -> k -> k
forall a. Ord a => a -> a -> a
min k
key1 k
key2))  -- lb > ub
      , (Int
8, (k, k) -> Gen (k, k)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (k -> k -> k
forall a. Ord a => a -> a -> a
min k
key1 k
key2, k -> k -> k
forall a. Ord a => a -> a -> a
max k
key1 k
key2))  -- lb < ub
      ]
    [Range k] -> Gen (Range k)
forall a. HasCallStack => [a] -> Gen a
elements
      [ k -> k -> Range k
forall k. k -> k -> Range k
FromToExcluding k
lb k
ub
      , k -> k -> Range k
forall k. k -> k -> Range k
FromToIncluding k
lb k
ub
      ]

  shrink :: Range k -> [Range k]
shrink (FromToExcluding k
f k
t) =
    (k -> k -> Range k) -> (k, k) -> Range k
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> k -> Range k
forall k. k -> k -> Range k
FromToExcluding ((k, k) -> Range k) -> [(k, k)] -> [Range k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (k, k) -> [(k, k)]
forall a. Arbitrary a => a -> [a]
shrink (k
f, k
t)
  shrink (FromToIncluding k
f k
t) =
    (k -> k -> Range k) -> (k, k) -> Range k
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> k -> Range k
forall k. k -> k -> Range k
FromToIncluding ((k, k) -> Range k) -> [(k, k)] -> [Range k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (k, k) -> [(k, k)]
forall a. Arbitrary a => a -> [a]
shrink (k
f, k
t)

{-------------------------------------------------------------------------------
  Entry
-------------------------------------------------------------------------------}

instance (Arbitrary v, Arbitrary b) => Arbitrary (Entry v b) where
  arbitrary :: Gen (Entry v b)
arbitrary = Gen (Entry v b)
forall (f :: * -> * -> *) a b.
(Arbitrary2 f, Arbitrary a, Arbitrary b) =>
Gen (f a b)
QC.arbitrary2
  shrink :: Entry v b -> [Entry v b]
shrink = Entry v b -> [Entry v b]
forall (f :: * -> * -> *) a b.
(Arbitrary2 f, Arbitrary a, Arbitrary b) =>
f a b -> [f a b]
QC.shrink2

instance Arbitrary2 Entry where
  liftArbitrary2 :: forall a b. Gen a -> Gen b -> Gen (Entry a b)
liftArbitrary2 Gen a
genVal Gen b
genBlob = [(Int, Gen (Entry a b))] -> Gen (Entry a b)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
5, a -> Entry a b
forall v b. v -> Entry v b
Insert (a -> Entry a b) -> Gen a -> Gen (Entry a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genVal)
    , (Int
1, a -> b -> Entry a b
forall v b. v -> b -> Entry v b
InsertWithBlob (a -> b -> Entry a b) -> Gen a -> Gen (b -> Entry a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genVal Gen (b -> Entry a b) -> Gen b -> Gen (Entry a b)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen b
genBlob)
    , (Int
1, a -> Entry a b
forall v b. v -> Entry v b
Mupdate (a -> Entry a b) -> Gen a -> Gen (Entry a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
genVal)
    , (Int
1, Entry a b -> Gen (Entry a b)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry a b
forall v b. Entry v b
Delete)
    ]

  liftShrink2 :: forall a b. (a -> [a]) -> (b -> [b]) -> Entry a b -> [Entry a b]
liftShrink2 a -> [a]
shrinkVal b -> [b]
shrinkBlob = \case
    Insert a
v           -> Entry a b
forall v b. Entry v b
Delete Entry a b -> [Entry a b] -> [Entry a b]
forall a. a -> [a] -> [a]
: (a -> Entry a b
forall v b. v -> Entry v b
Insert (a -> Entry a b) -> [a] -> [Entry a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
shrinkVal a
v)
    InsertWithBlob a
v b
b -> [Entry a b
forall v b. Entry v b
Delete, a -> Entry a b
forall v b. v -> Entry v b
Insert a
v]
                       [Entry a b] -> [Entry a b] -> [Entry a b]
forall a. [a] -> [a] -> [a]
++ ((a, b) -> Entry a b) -> [(a, b)] -> [Entry a b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b -> Entry a b) -> (a, b) -> Entry a b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> Entry a b
forall v b. v -> b -> Entry v b
InsertWithBlob)
                            ((a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
forall a b. (a -> [a]) -> (b -> [b]) -> (a, b) -> [(a, b)]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2 a -> [a]
shrinkVal b -> [b]
shrinkBlob (a
v, b
b))
    Mupdate a
v          -> Entry a b
forall v b. Entry v b
Delete Entry a b -> [Entry a b] -> [Entry a b]
forall a. a -> [a] -> [a]
: a -> Entry a b
forall v b. v -> Entry v b
Insert a
v Entry a b -> [Entry a b] -> [Entry a b]
forall a. a -> [a] -> [a]
: (a -> Entry a b
forall v b. v -> Entry v b
Mupdate (a -> Entry a b) -> [a] -> [Entry a b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
shrinkVal a
v)
    Entry a b
Delete             -> []

{-------------------------------------------------------------------------------
  WithSerialised
-------------------------------------------------------------------------------}

-- | Cache serialised keys
--
-- Also useful for failing tests that have keys as inputs, because the printed
-- 'WithSerialised' values will show both keys and their serialised form.
data WithSerialised k = WithSerialised k SerialisedKey
  deriving stock Int -> WithSerialised k -> ShowS
[WithSerialised k] -> ShowS
WithSerialised k -> String
(Int -> WithSerialised k -> ShowS)
-> (WithSerialised k -> String)
-> ([WithSerialised k] -> ShowS)
-> Show (WithSerialised k)
forall k. Show k => Int -> WithSerialised k -> ShowS
forall k. Show k => [WithSerialised k] -> ShowS
forall k. Show k => WithSerialised k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall k. Show k => Int -> WithSerialised k -> ShowS
showsPrec :: Int -> WithSerialised k -> ShowS
$cshow :: forall k. Show k => WithSerialised k -> String
show :: WithSerialised k -> String
$cshowList :: forall k. Show k => [WithSerialised k] -> ShowS
showList :: [WithSerialised k] -> ShowS
Show

instance Eq k => Eq (WithSerialised k) where
  WithSerialised k
k1 SerialisedKey
_ == :: WithSerialised k -> WithSerialised k -> Bool
== WithSerialised k
k2 SerialisedKey
_ = k
k1 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k2

instance Ord k => Ord (WithSerialised k) where
  WithSerialised k
k1 SerialisedKey
_ compare :: WithSerialised k -> WithSerialised k -> Ordering
`compare` WithSerialised k
k2 SerialisedKey
_ = k
k1 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` k
k2

instance (Arbitrary k, SerialiseKey k) => Arbitrary (WithSerialised k) where
  arbitrary :: Gen (WithSerialised k)
arbitrary = do
    k
x <- Gen k
forall a. Arbitrary a => Gen a
arbitrary
    WithSerialised k -> Gen (WithSerialised k)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WithSerialised k -> Gen (WithSerialised k))
-> WithSerialised k -> Gen (WithSerialised k)
forall a b. (a -> b) -> a -> b
$ k -> SerialisedKey -> WithSerialised k
forall k. k -> SerialisedKey -> WithSerialised k
WithSerialised k
x (k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
serialiseKey k
x)
  shrink :: WithSerialised k -> [WithSerialised k]
shrink (WithSerialised k
k SerialisedKey
_) = [k -> SerialisedKey -> WithSerialised k
forall k. k -> SerialisedKey -> WithSerialised k
WithSerialised k
k' (k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
serialiseKey k
k') | k
k' <- k -> [k]
forall a. Arbitrary a => a -> [a]
shrink k
k]

instance SerialiseKey k => SerialiseKey (WithSerialised k) where
  serialiseKey :: WithSerialised k -> RawBytes
serialiseKey (WithSerialised k
_ (SerialisedKey RawBytes
bytes)) = RawBytes
bytes
  deserialiseKey :: RawBytes -> WithSerialised k
deserialiseKey RawBytes
bytes = k -> SerialisedKey -> WithSerialised k
forall k. k -> SerialisedKey -> WithSerialised k
WithSerialised (RawBytes -> k
forall k. SerialiseKey k => RawBytes -> k
S.Class.deserialiseKey RawBytes
bytes) (RawBytes -> SerialisedKey
SerialisedKey RawBytes
bytes)

{-------------------------------------------------------------------------------
  Other number newtypes
-------------------------------------------------------------------------------}

instance Arbitrary PageNo where
  arbitrary :: Gen PageNo
arbitrary = Gen (NonNegative Int) -> Gen PageNo
forall a b. Coercible a b => a -> b
coerce (forall a. Arbitrary a => Gen a
arbitrary @(QC.NonNegative Int))
  shrink :: PageNo -> [PageNo]
shrink = (NonNegative Int -> [NonNegative Int]) -> PageNo -> [PageNo]
forall a b. Coercible a b => a -> b
coerce (forall a. Arbitrary a => a -> [a]
shrink @(QC.NonNegative Int))

instance Arbitrary NumEntries where
  arbitrary :: Gen NumEntries
arbitrary = Gen (NonNegative Int) -> Gen NumEntries
forall a b. Coercible a b => a -> b
coerce (forall a. Arbitrary a => Gen a
arbitrary @(QC.NonNegative Int))
  shrink :: NumEntries -> [NumEntries]
shrink = (NonNegative Int -> [NonNegative Int])
-> NumEntries -> [NumEntries]
forall a b. Coercible a b => a -> b
coerce (forall a. Arbitrary a => a -> [a]
shrink @(QC.NonNegative Int))

{-------------------------------------------------------------------------------
  True page
-------------------------------------------------------------------------------}

-- | A summary of min/max information for keys on a /true/ page.
--
-- A true page corresponds directly to a disk page. See 'LogicalPageSummary' for
-- contrast.
data TruePageSummary k = TruePageSummary { forall k. TruePageSummary k -> k
tpsMinKey :: k, forall k. TruePageSummary k -> k
tpsMaxKey :: k }

flattenLogicalPageSummary :: LogicalPageSummary k -> [TruePageSummary k]
flattenLogicalPageSummary :: forall k. LogicalPageSummary k -> [TruePageSummary k]
flattenLogicalPageSummary = \case
    OnePageOneKey k
k       -> [k -> k -> TruePageSummary k
forall k. k -> k -> TruePageSummary k
TruePageSummary k
k k
k]
    OnePageManyKeys k
k1 k
k2 -> [k -> k -> TruePageSummary k
forall k. k -> k -> TruePageSummary k
TruePageSummary k
k1 k
k2]
    MultiPageOneKey k
k Word32
n   -> Int -> TruePageSummary k -> [TruePageSummary k]
forall a. Int -> a -> [a]
replicate (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (k -> k -> TruePageSummary k
forall k. k -> k -> TruePageSummary k
TruePageSummary k
k k
k)

{-------------------------------------------------------------------------------
  Logical page
-------------------------------------------------------------------------------}

-- | A summary of min/max information for keys on a /logical/ page.
--
-- A key\/operation pair can fit onto a single page, or the operation is so
-- large that its bytes flow over into subsequent pages. A logical page makes
-- this overflow explicit. Making these cases explicit in the representation
-- makes generating and shrinking test cases easier.
data LogicalPageSummary k =
    OnePageOneKey   k
  | OnePageManyKeys k k
  | MultiPageOneKey k Word32 -- ^ number of overflow pages
  deriving stock (Int -> LogicalPageSummary k -> ShowS
[LogicalPageSummary k] -> ShowS
LogicalPageSummary k -> String
(Int -> LogicalPageSummary k -> ShowS)
-> (LogicalPageSummary k -> String)
-> ([LogicalPageSummary k] -> ShowS)
-> Show (LogicalPageSummary k)
forall k. Show k => Int -> LogicalPageSummary k -> ShowS
forall k. Show k => [LogicalPageSummary k] -> ShowS
forall k. Show k => LogicalPageSummary k -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall k. Show k => Int -> LogicalPageSummary k -> ShowS
showsPrec :: Int -> LogicalPageSummary k -> ShowS
$cshow :: forall k. Show k => LogicalPageSummary k -> String
show :: LogicalPageSummary k -> String
$cshowList :: forall k. Show k => [LogicalPageSummary k] -> ShowS
showList :: [LogicalPageSummary k] -> ShowS
Show, (forall x. LogicalPageSummary k -> Rep (LogicalPageSummary k) x)
-> (forall x. Rep (LogicalPageSummary k) x -> LogicalPageSummary k)
-> Generic (LogicalPageSummary k)
forall x. Rep (LogicalPageSummary k) x -> LogicalPageSummary k
forall x. LogicalPageSummary k -> Rep (LogicalPageSummary k) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k x. Rep (LogicalPageSummary k) x -> LogicalPageSummary k
forall k x. LogicalPageSummary k -> Rep (LogicalPageSummary k) x
$cfrom :: forall k x. LogicalPageSummary k -> Rep (LogicalPageSummary k) x
from :: forall x. LogicalPageSummary k -> Rep (LogicalPageSummary k) x
$cto :: forall k x. Rep (LogicalPageSummary k) x -> LogicalPageSummary k
to :: forall x. Rep (LogicalPageSummary k) x -> LogicalPageSummary k
Generic, (forall a b.
 (a -> b) -> LogicalPageSummary a -> LogicalPageSummary b)
-> (forall a b. a -> LogicalPageSummary b -> LogicalPageSummary a)
-> Functor LogicalPageSummary
forall a b. a -> LogicalPageSummary b -> LogicalPageSummary a
forall a b.
(a -> b) -> LogicalPageSummary a -> LogicalPageSummary b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> LogicalPageSummary a -> LogicalPageSummary b
fmap :: forall a b.
(a -> b) -> LogicalPageSummary a -> LogicalPageSummary b
$c<$ :: forall a b. a -> LogicalPageSummary b -> LogicalPageSummary a
<$ :: forall a b. a -> LogicalPageSummary b -> LogicalPageSummary a
Functor)
  deriving anyclass LogicalPageSummary k -> ()
(LogicalPageSummary k -> ()) -> NFData (LogicalPageSummary k)
forall k. NFData k => LogicalPageSummary k -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall k. NFData k => LogicalPageSummary k -> ()
rnf :: LogicalPageSummary k -> ()
NFData

toAppend :: LogicalPageSummary SerialisedKey -> Append
toAppend :: LogicalPageSummary SerialisedKey -> Append
toAppend (OnePageOneKey SerialisedKey
k)       = SerialisedKey -> SerialisedKey -> Append
AppendSinglePage SerialisedKey
k SerialisedKey
k
toAppend (OnePageManyKeys SerialisedKey
k1 SerialisedKey
k2) = SerialisedKey -> SerialisedKey -> Append
AppendSinglePage SerialisedKey
k1 SerialisedKey
k2
toAppend (MultiPageOneKey SerialisedKey
k Word32
n)   = SerialisedKey -> Word32 -> Append
AppendMultiPage SerialisedKey
k Word32
n

shrinkLogicalPageSummary :: Arbitrary k => LogicalPageSummary k -> [LogicalPageSummary k]
shrinkLogicalPageSummary :: forall k.
Arbitrary k =>
LogicalPageSummary k -> [LogicalPageSummary k]
shrinkLogicalPageSummary = \case
    OnePageOneKey k
k       -> k -> LogicalPageSummary k
forall k. k -> LogicalPageSummary k
OnePageOneKey (k -> LogicalPageSummary k) -> [k] -> [LogicalPageSummary k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> [k]
forall a. Arbitrary a => a -> [a]
shrink k
k
    OnePageManyKeys k
k1 k
k2 -> [
        k -> k -> LogicalPageSummary k
forall k. k -> k -> LogicalPageSummary k
OnePageManyKeys k
k1' k
k2'
      | (k
k1', k
k2') <- (k, k) -> [(k, k)]
forall a. Arbitrary a => a -> [a]
shrink (k
k1, k
k2)
      ]
    MultiPageOneKey k
k Word32
n   -> [
        k -> Word32 -> LogicalPageSummary k
forall k. k -> Word32 -> LogicalPageSummary k
MultiPageOneKey k
k' Word32
n'
      | (k
k', Word32
n') <- (k, Word32) -> [(k, Word32)]
forall a. Arbitrary a => a -> [a]
shrink (k
k, Word32
n)
      ]

{-------------------------------------------------------------------------------
  Sequences of (logical\/true) pages
-------------------------------------------------------------------------------}

-- | Sequences of (logical\/true) pages
--
-- INVARIANT: The sequence consists of multiple pages in sorted order (keys are
-- sorted within a page and across pages).
newtype Pages fp k = Pages { forall {k} (fp :: k -> *) (k :: k). Pages fp k -> [fp k]
getPages :: [fp k] }
  deriving stock (Int -> Pages fp k -> ShowS
[Pages fp k] -> ShowS
Pages fp k -> String
(Int -> Pages fp k -> ShowS)
-> (Pages fp k -> String)
-> ([Pages fp k] -> ShowS)
-> Show (Pages fp k)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (fp :: k -> *) (k :: k).
Show (fp k) =>
Int -> Pages fp k -> ShowS
forall k (fp :: k -> *) (k :: k).
Show (fp k) =>
[Pages fp k] -> ShowS
forall k (fp :: k -> *) (k :: k).
Show (fp k) =>
Pages fp k -> String
$cshowsPrec :: forall k (fp :: k -> *) (k :: k).
Show (fp k) =>
Int -> Pages fp k -> ShowS
showsPrec :: Int -> Pages fp k -> ShowS
$cshow :: forall k (fp :: k -> *) (k :: k).
Show (fp k) =>
Pages fp k -> String
show :: Pages fp k -> String
$cshowList :: forall k (fp :: k -> *) (k :: k).
Show (fp k) =>
[Pages fp k] -> ShowS
showList :: [Pages fp k] -> ShowS
Show, (forall x. Pages fp k -> Rep (Pages fp k) x)
-> (forall x. Rep (Pages fp k) x -> Pages fp k)
-> Generic (Pages fp k)
forall x. Rep (Pages fp k) x -> Pages fp k
forall x. Pages fp k -> Rep (Pages fp k) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (fp :: k -> *) (k :: k) x.
Rep (Pages fp k) x -> Pages fp k
forall k (fp :: k -> *) (k :: k) x.
Pages fp k -> Rep (Pages fp k) x
$cfrom :: forall k (fp :: k -> *) (k :: k) x.
Pages fp k -> Rep (Pages fp k) x
from :: forall x. Pages fp k -> Rep (Pages fp k) x
$cto :: forall k (fp :: k -> *) (k :: k) x.
Rep (Pages fp k) x -> Pages fp k
to :: forall x. Rep (Pages fp k) x -> Pages fp k
Generic, (forall a b. (a -> b) -> Pages fp a -> Pages fp b)
-> (forall a b. a -> Pages fp b -> Pages fp a)
-> Functor (Pages fp)
forall a b. a -> Pages fp b -> Pages fp a
forall a b. (a -> b) -> Pages fp a -> Pages fp b
forall (fp :: * -> *) a b.
Functor fp =>
a -> Pages fp b -> Pages fp a
forall (fp :: * -> *) a b.
Functor fp =>
(a -> b) -> Pages fp a -> Pages fp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (fp :: * -> *) a b.
Functor fp =>
(a -> b) -> Pages fp a -> Pages fp b
fmap :: forall a b. (a -> b) -> Pages fp a -> Pages fp b
$c<$ :: forall (fp :: * -> *) a b.
Functor fp =>
a -> Pages fp b -> Pages fp a
<$ :: forall a b. a -> Pages fp b -> Pages fp a
Functor)
  deriving anyclass Pages fp k -> ()
(Pages fp k -> ()) -> NFData (Pages fp k)
forall a. (a -> ()) -> NFData a
forall k (fp :: k -> *) (k :: k). NFData (fp k) => Pages fp k -> ()
$crnf :: forall k (fp :: k -> *) (k :: k). NFData (fp k) => Pages fp k -> ()
rnf :: Pages fp k -> ()
NFData

class TrueNumberOfPages fp where
  trueNumberOfPages :: Pages fp k -> Int

instance TrueNumberOfPages LogicalPageSummary where
  trueNumberOfPages :: LogicalPageSummaries k -> Int
  trueNumberOfPages :: forall k. Pages LogicalPageSummary k -> Int
trueNumberOfPages = [TruePageSummary k] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TruePageSummary k] -> Int)
-> (LogicalPageSummaries k -> [TruePageSummary k])
-> LogicalPageSummaries k
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pages TruePageSummary k -> [TruePageSummary k]
forall {k} (fp :: k -> *) (k :: k). Pages fp k -> [fp k]
getPages (Pages TruePageSummary k -> [TruePageSummary k])
-> (LogicalPageSummaries k -> Pages TruePageSummary k)
-> LogicalPageSummaries k
-> [TruePageSummary k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogicalPageSummaries k -> Pages TruePageSummary k
forall k. LogicalPageSummaries k -> TruePageSummaries k
flattenLogicalPageSummaries

instance TrueNumberOfPages TruePageSummary where
  trueNumberOfPages :: TruePageSummaries k -> Int
  trueNumberOfPages :: forall k. Pages TruePageSummary k -> Int
trueNumberOfPages = [TruePageSummary k] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TruePageSummary k] -> Int)
-> (TruePageSummaries k -> [TruePageSummary k])
-> TruePageSummaries k
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TruePageSummaries k -> [TruePageSummary k]
forall {k} (fp :: k -> *) (k :: k). Pages fp k -> [fp k]
getPages

{-------------------------------------------------------------------------------
  Sequences of true pages
-------------------------------------------------------------------------------}

type TruePageSummaries    k = Pages TruePageSummary k

flattenLogicalPageSummaries :: LogicalPageSummaries k -> TruePageSummaries k
flattenLogicalPageSummaries :: forall k. LogicalPageSummaries k -> TruePageSummaries k
flattenLogicalPageSummaries (Pages [LogicalPageSummary k]
ps) = [TruePageSummary k] -> Pages TruePageSummary k
forall {k} (fp :: k -> *) (k :: k). [fp k] -> Pages fp k
Pages ((LogicalPageSummary k -> [TruePageSummary k])
-> [LogicalPageSummary k] -> [TruePageSummary k]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap LogicalPageSummary k -> [TruePageSummary k]
forall k. LogicalPageSummary k -> [TruePageSummary k]
flattenLogicalPageSummary [LogicalPageSummary k]
ps)

{-------------------------------------------------------------------------------
  Sequences of logical pages
-------------------------------------------------------------------------------}

type LogicalPageSummaries k = Pages LogicalPageSummary k

toAppends :: SerialiseKey k => LogicalPageSummaries k -> [Append]
toAppends :: forall k. SerialiseKey k => LogicalPageSummaries k -> [Append]
toAppends (Pages [LogicalPageSummary k]
ps) = (LogicalPageSummary k -> Append)
-> [LogicalPageSummary k] -> [Append]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LogicalPageSummary SerialisedKey -> Append
toAppend (LogicalPageSummary SerialisedKey -> Append)
-> (LogicalPageSummary k -> LogicalPageSummary SerialisedKey)
-> LogicalPageSummary k
-> Append
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> SerialisedKey)
-> LogicalPageSummary k -> LogicalPageSummary SerialisedKey
forall a b.
(a -> b) -> LogicalPageSummary a -> LogicalPageSummary b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
serialiseKey) [LogicalPageSummary k]
ps

--
-- Labelling
--

labelPages :: LogicalPageSummaries k -> (Property -> Property)
labelPages :: forall k. LogicalPageSummaries k -> Property -> Property
labelPages LogicalPageSummaries k
ps =
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
QC.tabulate String
"# True pages" [Int -> String
showPowersOf10 Int
nTruePages]
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
QC.tabulate String
"# Logical pages" [Int -> String
showPowersOf10 Int
nLogicalPages]
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
QC.tabulate String
"# OnePageOneKey logical pages" [Int -> String
showPowersOf10 Int
n1]
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
QC.tabulate String
"# OnePageManyKeys logical pages" [Int -> String
showPowersOf10 Int
n2]
    (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
QC.tabulate String
"# MultiPageOneKey logical pages" [Int -> String
showPowersOf10 Int
n3]
  where
    nLogicalPages :: Int
nLogicalPages = [LogicalPageSummary k] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([LogicalPageSummary k] -> Int) -> [LogicalPageSummary k] -> Int
forall a b. (a -> b) -> a -> b
$ LogicalPageSummaries k -> [LogicalPageSummary k]
forall {k} (fp :: k -> *) (k :: k). Pages fp k -> [fp k]
getPages LogicalPageSummaries k
ps
    nTruePages :: Int
nTruePages = LogicalPageSummaries k -> Int
forall k. Pages LogicalPageSummary k -> Int
forall {k} (fp :: k -> *) (k :: k).
TrueNumberOfPages fp =>
Pages fp k -> Int
trueNumberOfPages LogicalPageSummaries k
ps

    (Int
n1,Int
n2,Int
n3) = [LogicalPageSummary k] -> (Int, Int, Int)
forall k. [LogicalPageSummary k] -> (Int, Int, Int)
counts (LogicalPageSummaries k -> [LogicalPageSummary k]
forall {k} (fp :: k -> *) (k :: k). Pages fp k -> [fp k]
getPages LogicalPageSummaries k
ps)

    counts :: [LogicalPageSummary k] -> (Int, Int, Int)
    counts :: forall k. [LogicalPageSummary k] -> (Int, Int, Int)
counts []       = (Int
0, Int
0, Int
0)
    counts (LogicalPageSummary k
lp:[LogicalPageSummary k]
lps) = let (Int
x, Int
y, Int
z) = [LogicalPageSummary k] -> (Int, Int, Int)
forall k. [LogicalPageSummary k] -> (Int, Int, Int)
counts [LogicalPageSummary k]
lps
                      in case LogicalPageSummary k
lp of
                        OnePageOneKey{}   -> (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
y, Int
z)
                        OnePageManyKeys{} -> (Int
x, Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
z)
                        MultiPageOneKey{} -> (Int
x, Int
y, Int
zInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

--
-- Generation and shrinking
--

instance (Arbitrary k, Ord k)
      => Arbitrary (LogicalPageSummaries k) where
  arbitrary :: Gen (LogicalPageSummaries k)
arbitrary = Double -> Gen Word32 -> Double -> Gen (LogicalPageSummaries k)
forall k.
(Arbitrary k, Ord k) =>
Double -> Gen Word32 -> Double -> Gen (LogicalPageSummaries k)
genPages Double
0.03 ((Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
QC.choose (Word32
0, Word32
16)) Double
0.01
  shrink :: LogicalPageSummaries k -> [LogicalPageSummaries k]
shrink = LogicalPageSummaries k -> [LogicalPageSummaries k]
forall k.
(Arbitrary k, Ord k) =>
LogicalPageSummaries k -> [LogicalPageSummaries k]
shrinkPages

shrinkPages ::
     (Arbitrary k, Ord k)
  => LogicalPageSummaries k
  -> [LogicalPageSummaries k]
shrinkPages :: forall k.
(Arbitrary k, Ord k) =>
LogicalPageSummaries k -> [LogicalPageSummaries k]
shrinkPages (Pages [LogicalPageSummary k]
ps) = [
      [LogicalPageSummary k] -> Pages LogicalPageSummary k
forall {k} (fp :: k -> *) (k :: k). [fp k] -> Pages fp k
Pages [LogicalPageSummary k]
ps'
    | [LogicalPageSummary k]
ps' <- (LogicalPageSummary k -> [LogicalPageSummary k])
-> [LogicalPageSummary k] -> [[LogicalPageSummary k]]
forall a. (a -> [a]) -> [a] -> [[a]]
QC.shrinkList LogicalPageSummary k -> [LogicalPageSummary k]
forall k.
Arbitrary k =>
LogicalPageSummary k -> [LogicalPageSummary k]
shrinkLogicalPageSummary [LogicalPageSummary k]
ps, Pages LogicalPageSummary k -> Bool
forall k. Ord k => LogicalPageSummaries k -> Bool
pagesInvariant ([LogicalPageSummary k] -> Pages LogicalPageSummary k
forall {k} (fp :: k -> *) (k :: k). [fp k] -> Pages fp k
Pages [LogicalPageSummary k]
ps')
    ]

genPages ::
     (Arbitrary k, Ord k)
  => Double -- ^ Probability of a value being larger-than-page
  -> Gen Word32 -- ^ Number of overflow pages for a larger-than-page value
  -> Double -- ^ Probability of generating a page with only one key and value,
            --   which does /not/ span multiple pages.
  -> Gen (LogicalPageSummaries k)
genPages :: forall k.
(Arbitrary k, Ord k) =>
Double -> Gen Word32 -> Double -> Gen (LogicalPageSummaries k)
genPages Double
p Gen Word32
genN Double
p' = do
    [k]
ks <- Gen [k]
forall a. Arbitrary a => Gen a
arbitrary
    Double
-> Gen Word32 -> Double -> [k] -> Gen (LogicalPageSummaries k)
forall k.
Ord k =>
Double
-> Gen Word32 -> Double -> [k] -> Gen (LogicalPageSummaries k)
mkPages Double
p Gen Word32
genN Double
p' [k]
ks

mkPages ::
     forall k. Ord k
  => Double -- ^ Probability of a value being larger-than-page
  -> Gen Word32 -- ^ Number of overflow pages for a larger-than-page value
  -> Double -- ^ Probability of generating a page with only one key and value,
            --   which does /not/ span multiple pages.
  -> [k]
  -> Gen (LogicalPageSummaries k)
mkPages :: forall k.
Ord k =>
Double
-> Gen Word32 -> Double -> [k] -> Gen (LogicalPageSummaries k)
mkPages Double
p Gen Word32
genN Double
p' =
    ([LogicalPageSummary k] -> LogicalPageSummaries k)
-> Gen [LogicalPageSummary k] -> Gen (LogicalPageSummaries k)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [LogicalPageSummary k] -> LogicalPageSummaries k
forall {k} (fp :: k -> *) (k :: k). [fp k] -> Pages fp k
Pages (Gen [LogicalPageSummary k] -> Gen (LogicalPageSummaries k))
-> ([k] -> Gen [LogicalPageSummary k])
-> [k]
-> Gen (LogicalPageSummaries k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> Gen [LogicalPageSummary k]
go ([k] -> Gen [LogicalPageSummary k])
-> ([k] -> [k]) -> [k] -> Gen [LogicalPageSummary k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> [k]
forall a. Ord a => [a] -> [a]
nubOrd ([k] -> [k]) -> ([k] -> [k]) -> [k] -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [k] -> [k]
forall a. Ord a => [a] -> [a]
sort
  where
    go :: [k] -> Gen [LogicalPageSummary k]
    go :: [k] -> Gen [LogicalPageSummary k]
go []          = [LogicalPageSummary k] -> Gen [LogicalPageSummary k]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    go [k
k]         = do
      Bool
b <- Gen Bool
largerThanPage
      if Bool
b then LogicalPageSummary k -> [LogicalPageSummary k]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LogicalPageSummary k -> [LogicalPageSummary k])
-> (Word32 -> LogicalPageSummary k)
-> Word32
-> [LogicalPageSummary k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> Word32 -> LogicalPageSummary k
forall k. k -> Word32 -> LogicalPageSummary k
MultiPageOneKey k
k (Word32 -> [LogicalPageSummary k])
-> Gen Word32 -> Gen [LogicalPageSummary k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
genN
           else [LogicalPageSummary k] -> Gen [LogicalPageSummary k]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [k -> LogicalPageSummary k
forall k. k -> LogicalPageSummary k
OnePageOneKey k
k]
      -- the min and max key are allowed to be the same
    go  (k
k1:k
k2:[k]
ks) = do
      Bool
b <- Gen Bool
largerThanPage
      Bool
b' <- Gen Bool
onePageOneKey
      if Bool
b then (:) (LogicalPageSummary k
 -> [LogicalPageSummary k] -> [LogicalPageSummary k])
-> Gen (LogicalPageSummary k)
-> Gen ([LogicalPageSummary k] -> [LogicalPageSummary k])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (k -> Word32 -> LogicalPageSummary k
forall k. k -> Word32 -> LogicalPageSummary k
MultiPageOneKey k
k1 (Word32 -> LogicalPageSummary k)
-> Gen Word32 -> Gen (LogicalPageSummary k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
genN) Gen ([LogicalPageSummary k] -> [LogicalPageSummary k])
-> Gen [LogicalPageSummary k] -> Gen [LogicalPageSummary k]
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [k] -> Gen [LogicalPageSummary k]
go (k
k2 k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k]
ks)
           else if Bool
b' then (k -> LogicalPageSummary k
forall k. k -> LogicalPageSummary k
OnePageOneKey   k
k1 :)    ([LogicalPageSummary k] -> [LogicalPageSummary k])
-> Gen [LogicalPageSummary k] -> Gen [LogicalPageSummary k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [k] -> Gen [LogicalPageSummary k]
go (k
k2 k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k]
ks)
                      else (k -> k -> LogicalPageSummary k
forall k. k -> k -> LogicalPageSummary k
OnePageManyKeys k
k1 k
k2 :) ([LogicalPageSummary k] -> [LogicalPageSummary k])
-> Gen [LogicalPageSummary k] -> Gen [LogicalPageSummary k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [k] -> Gen [LogicalPageSummary k]
go [k]
ks

    largerThanPage :: Gen Bool
    largerThanPage :: Gen Bool
largerThanPage = Gen Double
genDouble Gen Double -> (Double -> Gen Bool) -> Gen Bool
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x -> Bool -> Gen Bool
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
p)

    onePageOneKey :: Gen Bool
    onePageOneKey :: Gen Bool
onePageOneKey = Gen Double
genDouble Gen Double -> (Double -> Gen Bool) -> Gen Bool
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Double
x -> Bool -> Gen Bool
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
p')

pagesInvariant :: Ord k => LogicalPageSummaries k -> Bool
pagesInvariant :: forall k. Ord k => LogicalPageSummaries k -> Bool
pagesInvariant (Pages [LogicalPageSummary k]
ps0) =
       [k] -> [k]
forall a. Ord a => [a] -> [a]
sort [k]
ks   [k] -> [k] -> Bool
forall a. Eq a => a -> a -> Bool
== [k]
ks
    Bool -> Bool -> Bool
&& [k] -> [k]
forall a. Ord a => [a] -> [a]
nubOrd [k]
ks [k] -> [k] -> Bool
forall a. Eq a => a -> a -> Bool
== [k]
ks
  where
    ks :: [k]
ks = [LogicalPageSummary k] -> [k]
forall k. Eq k => [LogicalPageSummary k] -> [k]
flatten [LogicalPageSummary k]
ps0

    flatten :: Eq k => [LogicalPageSummary k] -> [k]
    flatten :: forall k. Eq k => [LogicalPageSummary k] -> [k]
flatten []            = []
                          -- the min and max key are allowed to be the same
    flatten (LogicalPageSummary k
p:[LogicalPageSummary k]
ps) = case LogicalPageSummary k
p of
      OnePageOneKey k
k       -> k
k k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [LogicalPageSummary k] -> [k]
forall k. Eq k => [LogicalPageSummary k] -> [k]
flatten [LogicalPageSummary k]
ps
      OnePageManyKeys k
k1 k
k2 -> k
k1 k -> [k] -> [k]
forall a. a -> [a] -> [a]
: k
k2 k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [LogicalPageSummary k] -> [k]
forall k. Eq k => [LogicalPageSummary k] -> [k]
flatten [LogicalPageSummary k]
ps
      MultiPageOneKey k
k Word32
_   -> k
k k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [LogicalPageSummary k] -> [k]
forall k. Eq k => [LogicalPageSummary k] -> [k]
flatten [LogicalPageSummary k]
ps

{-------------------------------------------------------------------------------
  Chunking size
-------------------------------------------------------------------------------}

newtype ChunkSize = ChunkSize Int
  deriving stock Int -> ChunkSize -> ShowS
[ChunkSize] -> ShowS
ChunkSize -> String
(Int -> ChunkSize -> ShowS)
-> (ChunkSize -> String)
-> ([ChunkSize] -> ShowS)
-> Show ChunkSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChunkSize -> ShowS
showsPrec :: Int -> ChunkSize -> ShowS
$cshow :: ChunkSize -> String
show :: ChunkSize -> String
$cshowList :: [ChunkSize] -> ShowS
showList :: [ChunkSize] -> ShowS
Show
  deriving newtype Integer -> ChunkSize
ChunkSize -> ChunkSize
ChunkSize -> ChunkSize -> ChunkSize
(ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (ChunkSize -> ChunkSize)
-> (Integer -> ChunkSize)
-> Num ChunkSize
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: ChunkSize -> ChunkSize -> ChunkSize
+ :: ChunkSize -> ChunkSize -> ChunkSize
$c- :: ChunkSize -> ChunkSize -> ChunkSize
- :: ChunkSize -> ChunkSize -> ChunkSize
$c* :: ChunkSize -> ChunkSize -> ChunkSize
* :: ChunkSize -> ChunkSize -> ChunkSize
$cnegate :: ChunkSize -> ChunkSize
negate :: ChunkSize -> ChunkSize
$cabs :: ChunkSize -> ChunkSize
abs :: ChunkSize -> ChunkSize
$csignum :: ChunkSize -> ChunkSize
signum :: ChunkSize -> ChunkSize
$cfromInteger :: Integer -> ChunkSize
fromInteger :: Integer -> ChunkSize
Num

instance Arbitrary ChunkSize where
  arbitrary :: Gen ChunkSize
arbitrary = Int -> ChunkSize
ChunkSize (Int -> ChunkSize) -> Gen Int -> Gen ChunkSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
QC.chooseInt (Int
chunkSizeLB, Int
chunkSizeUB)
  shrink :: ChunkSize -> [ChunkSize]
shrink (ChunkSize Int
csize) = [
        Int -> ChunkSize
ChunkSize Int
csize'
      | Int
csize' <- Int -> [Int]
forall a. Arbitrary a => a -> [a]
shrink Int
csize
      , ChunkSize -> Bool
chunkSizeInvariant (Int -> ChunkSize
ChunkSize Int
csize')
      ]

chunkSizeLB, chunkSizeUB :: Int
chunkSizeLB :: Int
chunkSizeLB = Int
1
chunkSizeUB :: Int
chunkSizeUB = Int
20

chunkSizeInvariant :: ChunkSize -> Bool
chunkSizeInvariant :: ChunkSize -> Bool
chunkSizeInvariant (ChunkSize Int
csize) = Int
chunkSizeLB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
csize Bool -> Bool -> Bool
&& Int
csize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
chunkSizeUB

{-------------------------------------------------------------------------------
  Serialised keys/values/blobs
-------------------------------------------------------------------------------}

instance Arbitrary RawBytes where
  arbitrary :: Gen RawBytes
arbitrary = do
    QC.NonNegative (QC.Small Int
prefixLength)  <- Gen (NonNegative (Small Int))
forall a. Arbitrary a => Gen a
arbitrary
    QC.NonNegative (QC.Small Int
payloadLength) <- Gen (NonNegative (Small Int))
forall a. Arbitrary a => Gen a
arbitrary
    QC.NonNegative (QC.Small Int
suffixLength)  <- Gen (NonNegative (Small Int))
forall a. Arbitrary a => Gen a
arbitrary
    RawBytes
base <- Int -> Gen RawBytes
genRawBytesN (Int
prefixLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
payloadLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
suffixLength)
    RawBytes -> Gen RawBytes
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (RawBytes
base RawBytes -> (RawBytes -> RawBytes) -> RawBytes
forall a b. a -> (a -> b) -> b
& Int -> RawBytes -> RawBytes
RB.drop Int
prefixLength RawBytes -> (RawBytes -> RawBytes) -> RawBytes
forall a b. a -> (a -> b) -> b
& Int -> RawBytes -> RawBytes
RB.take Int
payloadLength)
  shrink :: RawBytes -> [RawBytes]
shrink RawBytes
rb = RawBytes -> [RawBytes]
shrinkSlice RawBytes
rb [RawBytes] -> [RawBytes] -> [RawBytes]
forall a. [a] -> [a] -> [a]
++ RawBytes -> [RawBytes]
shrinkRawBytes RawBytes
rb

genRawBytesN :: Int -> Gen RawBytes
genRawBytesN :: Int -> Gen RawBytes
genRawBytesN Int
n =
    Bool -> [Word8] -> RawBytes
packRawBytesPinnedOrUnpinned (Bool -> [Word8] -> RawBytes)
-> Gen Bool -> Gen ([Word8] -> RawBytes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary Gen ([Word8] -> RawBytes) -> Gen [Word8] -> Gen RawBytes
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
QC.vectorOf Int
n Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

genRawBytes :: Gen RawBytes
genRawBytes :: Gen RawBytes
genRawBytes =
    Bool -> [Word8] -> RawBytes
packRawBytesPinnedOrUnpinned (Bool -> [Word8] -> RawBytes)
-> Gen Bool -> Gen ([Word8] -> RawBytes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary Gen ([Word8] -> RawBytes) -> Gen [Word8] -> Gen RawBytes
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
QC.listOf Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

genRawBytesSized :: Int -> Gen RawBytes
genRawBytesSized :: Int -> Gen RawBytes
genRawBytesSized Int
n = Int -> Gen RawBytes -> Gen RawBytes
forall a. HasCallStack => Int -> Gen a -> Gen a
QC.resize Int
n Gen RawBytes
genRawBytes

packRawBytesPinnedOrUnpinned :: Bool -> [Word8] -> RawBytes
packRawBytesPinnedOrUnpinned :: Bool -> [Word8] -> RawBytes
packRawBytesPinnedOrUnpinned Bool
False = [Word8] -> RawBytes
RB.pack
packRawBytesPinnedOrUnpinned Bool
True  = \[Word8]
ws ->
    let len :: Int
len = [Word8] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
ws in
    Vector Word8 -> RawBytes
RB.RawBytes (Vector Word8 -> RawBytes) -> Vector Word8 -> RawBytes
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteArray -> Vector Word8
forall a. Prim a => Int -> Int -> ByteArray -> Vector a
mkPrimVector Int
0 Int
len (ByteArray -> Vector Word8) -> ByteArray -> Vector Word8
forall a b. (a -> b) -> a -> b
$ (forall s. ST s (MutableByteArray s)) -> ByteArray
BA.runByteArray ((forall s. ST s (MutableByteArray s)) -> ByteArray)
-> (forall s. ST s (MutableByteArray s)) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
      MutableByteArray s
mba <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
BA.newPinnedByteArray Int
len
      [ST s ()] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
BA.writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
mba Int
i Word8
w | (Int
i, Word8
w) <- [Int] -> [Word8] -> [(Int, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Word8]
ws ]
      MutableByteArray s -> ST s (MutableByteArray s)
forall a. a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray s
mba

shrinkRawBytes :: RawBytes -> [RawBytes]
shrinkRawBytes :: RawBytes -> [RawBytes]
shrinkRawBytes (RawBytes Vector Word8
pvec) =
    [ Vector Word8 -> RawBytes
RawBytes Vector Word8
pvec'
    | Vector Word8
pvec' <- (Word8 -> [Word8]) -> Vector Word8 -> [Vector Word8]
forall a. Prim a => (a -> [a]) -> Vector a -> [Vector a]
shrinkVec Word8 -> [Word8]
forall {a}. Integral a => a -> [a]
shrinkByte Vector Word8
pvec
    ]
  where
    -- no need to try harder shrinking individual bytes
    shrinkByte :: a -> [a]
shrinkByte a
b = [a] -> [a]
forall a. Eq a => [a] -> [a]
nub ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b) [a
0, a
b a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2])

-- | Based on QuickCheck's 'shrinkList' (behaves identically, see tests).
shrinkVec :: VP.Prim a => (a -> [a]) -> VP.Vector a -> [VP.Vector a]
shrinkVec :: forall a. Prim a => (a -> [a]) -> Vector a -> [Vector a]
shrinkVec a -> [a]
shr Vector a
vec =
    [[Vector a]] -> [Vector a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Int -> [Vector a]
removeBlockOf Int
k | Int
k <- (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Int
len) ]
    [Vector a] -> [Vector a] -> [Vector a]
forall a. [a] -> [a] -> [a]
++ [Vector a]
shrinkOne
  where
    len :: Int
len = Vector a -> Int
forall a. Prim a => Vector a -> Int
VP.length Vector a
vec

    shrinkOne :: [Vector a]
shrinkOne =
        [ Vector a
vec Vector a -> [(Int, a)] -> Vector a
forall a. Prim a => Vector a -> [(Int, a)] -> Vector a
VP.// [(Int
i, a
x')]
        | Int
i <- [Int
0 .. Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
        , let x :: a
x = Vector a
vec Vector a -> Int -> a
forall a. Prim a => Vector a -> Int -> a
VP.! Int
i
        , a
x' <- a -> [a]
shr a
x
        ]

    removeBlockOf :: Int -> [Vector a]
removeBlockOf Int
k =
        [ Int -> Vector a -> Vector a
forall a. Prim a => Int -> Vector a -> Vector a
VP.take Int
i Vector a
vec Vector a -> Vector a -> Vector a
forall a. Prim a => Vector a -> Vector a -> Vector a
VP.++ Int -> Vector a -> Vector a
forall a. Prim a => Int -> Vector a -> Vector a
VP.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) Vector a
vec
        | Int
i <- [Int
0, Int
k .. Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k]
        ]

genSlice :: RawBytes -> Gen RawBytes
genSlice :: RawBytes -> Gen RawBytes
genSlice (RawBytes Vector Word8
pvec) = do
    Int
n <- (Int, Int) -> Gen Int
QC.chooseInt (Int
0, Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
VP.length Vector Word8
pvec)
    Int
m <- (Int, Int) -> Gen Int
QC.chooseInt (Int
0, Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
VP.length Vector Word8
pvec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
    RawBytes -> Gen RawBytes
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawBytes -> Gen RawBytes) -> RawBytes -> Gen RawBytes
forall a b. (a -> b) -> a -> b
$ Vector Word8 -> RawBytes
RawBytes (Int -> Int -> Vector Word8 -> Vector Word8
forall a. Prim a => Int -> Int -> Vector a -> Vector a
VP.slice Int
m Int
n Vector Word8
pvec)

shrinkSlice :: RawBytes -> [RawBytes]
shrinkSlice :: RawBytes -> [RawBytes]
shrinkSlice (RawBytes Vector Word8
pvec) =
    [ Vector Word8 -> RawBytes
RawBytes (Int -> Vector Word8 -> Vector Word8
forall a. Prim a => Int -> Vector a -> Vector a
VP.take Int
len' Vector Word8
pvec)
    | Int
len' <- Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink Int
len
    ] [RawBytes] -> [RawBytes] -> [RawBytes]
forall a. [a] -> [a] -> [a]
++
    [ Vector Word8 -> RawBytes
RawBytes (Int -> Vector Word8 -> Vector Word8
forall a. Prim a => Int -> Vector a -> Vector a
VP.drop (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len') Vector Word8
pvec)
    | Int
len' <- Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink Int
len
    ]
  where
    len :: Int
len = Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
VP.length Vector Word8
pvec

deriving newtype instance Arbitrary SerialisedKey

instance Arbitrary SerialisedValue where
  -- good mix of sizes, including larger than two pages, also some slices
  arbitrary :: Gen SerialisedValue
arbitrary = RawBytes -> SerialisedValue
SerialisedValue (RawBytes -> SerialisedValue)
-> Gen RawBytes -> Gen SerialisedValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen RawBytes)] -> Gen RawBytes
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
16, Gen RawBytes
forall a. Arbitrary a => Gen a
arbitrary)
      , ( Int
4, Int -> Gen RawBytes
genRawBytesN (Int -> Gen RawBytes) -> Gen Int -> Gen RawBytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> Gen Int
QC.chooseInt ( Int
100,  Int
1000))
      , ( Int
2, Int -> Gen RawBytes
genRawBytesN (Int -> Gen RawBytes) -> Gen Int -> Gen RawBytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> Gen Int
QC.chooseInt (Int
1000,  Int
4000))
      , ( Int
1, Int -> Gen RawBytes
genRawBytesN (Int -> Gen RawBytes) -> Gen Int -> Gen RawBytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> Gen Int
QC.chooseInt (Int
4000, Int
10000))
      , ( Int
1, RawBytes -> Gen RawBytes
genSlice (RawBytes -> Gen RawBytes) -> Gen RawBytes -> Gen RawBytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Gen RawBytes
genRawBytesN (Int -> Gen RawBytes) -> Gen Int -> Gen RawBytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> Gen Int
QC.chooseInt (Int
0, Int
10000))
      ]
  shrink :: SerialisedValue -> [SerialisedValue]
shrink (SerialisedValue RawBytes
rb)
      | RawBytes -> Int
RB.size RawBytes
rb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 = [LargeRawBytes] -> [SerialisedValue]
forall a b. Coercible a b => a -> b
coerce (LargeRawBytes -> [LargeRawBytes]
forall a. Arbitrary a => a -> [a]
shrink (RawBytes -> LargeRawBytes
LargeRawBytes RawBytes
rb))
      | Bool
otherwise       = [RawBytes] -> [SerialisedValue]
forall a b. Coercible a b => a -> b
coerce (RawBytes -> [RawBytes]
forall a. Arbitrary a => a -> [a]
shrink RawBytes
rb)

deriving newtype instance Arbitrary SerialisedBlob

newtype LargeRawBytes = LargeRawBytes RawBytes
  deriving stock Int -> LargeRawBytes -> ShowS
[LargeRawBytes] -> ShowS
LargeRawBytes -> String
(Int -> LargeRawBytes -> ShowS)
-> (LargeRawBytes -> String)
-> ([LargeRawBytes] -> ShowS)
-> Show LargeRawBytes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LargeRawBytes -> ShowS
showsPrec :: Int -> LargeRawBytes -> ShowS
$cshow :: LargeRawBytes -> String
show :: LargeRawBytes -> String
$cshowList :: [LargeRawBytes] -> ShowS
showList :: [LargeRawBytes] -> ShowS
Show
  deriving newtype LargeRawBytes -> ()
(LargeRawBytes -> ()) -> NFData LargeRawBytes
forall a. (a -> ()) -> NFData a
$crnf :: LargeRawBytes -> ()
rnf :: LargeRawBytes -> ()
NFData

instance Arbitrary LargeRawBytes where
  arbitrary :: Gen LargeRawBytes
arbitrary = Int -> Gen RawBytes
genRawBytesSized (Int
4096Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
3) Gen RawBytes
-> (RawBytes -> Gen LargeRawBytes) -> Gen LargeRawBytes
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (RawBytes -> LargeRawBytes) -> Gen RawBytes -> Gen LargeRawBytes
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RawBytes -> LargeRawBytes
LargeRawBytes (Gen RawBytes -> Gen LargeRawBytes)
-> (RawBytes -> Gen RawBytes) -> RawBytes -> Gen LargeRawBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawBytes -> Gen RawBytes
genSlice
  shrink :: LargeRawBytes -> [LargeRawBytes]
shrink (LargeRawBytes RawBytes
rb) =
      (RawBytes -> LargeRawBytes) -> [RawBytes] -> [LargeRawBytes]
forall a b. (a -> b) -> [a] -> [b]
map RawBytes -> LargeRawBytes
LargeRawBytes (RawBytes -> [RawBytes]
shrinkSlice RawBytes
rb)
      -- After shrinking length, don't shrink content using normal list shrink
      -- as that's too slow. We try zeroing out long suffixes of the bytes
      -- (since for large raw bytes in page format, the interesting information
      -- is at the start and the suffix is just the value.
   [LargeRawBytes] -> [LargeRawBytes] -> [LargeRawBytes]
forall a. [a] -> [a] -> [a]
++ [ RawBytes -> LargeRawBytes
LargeRawBytes (Vector Word8 -> RawBytes
RawBytes Vector Word8
pvec')
      | let (RawBytes Vector Word8
pvec) = RawBytes
rb
      , Int
n <- Int -> [Int]
forall a. Arbitrary a => a -> [a]
QC.shrink (Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
VP.length Vector Word8
pvec)
      , Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) Bool
True  -- negative values would make pvec' longer
      , let pvec' :: Vector Word8
pvec' = Int -> Vector Word8 -> Vector Word8
forall a. Prim a => Int -> Vector a -> Vector a
VP.take Int
n Vector Word8
pvec Vector Word8 -> Vector Word8 -> Vector Word8
forall a. Prim a => Vector a -> Vector a -> Vector a
VP.++ Int -> Word8 -> Vector Word8
forall a. Prim a => Int -> a -> Vector a
VP.replicate (Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
VP.length Vector Word8
pvec Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Word8
0
      , Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert (Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
VP.length Vector Word8
pvec' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Vector Word8 -> Int
forall a. Prim a => Vector a -> Int
VP.length Vector Word8
pvec) (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
        Vector Word8
pvec' Vector Word8 -> Vector Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector Word8
pvec
      ]

deriving newtype instance SerialiseValue LargeRawBytes

-- Serialised keys for the compact index must be at least 8 bytes long.

genKeyForIndexCompact :: Gen RawBytes
genKeyForIndexCompact :: Gen RawBytes
genKeyForIndexCompact =
    Int -> Gen RawBytes
genRawBytesN (Int -> Gen RawBytes) -> Gen Int -> Gen RawBytes
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> Gen Int) -> Gen Int
forall a. (Int -> Gen a) -> Gen a
QC.sized (\Int
s -> (Int, Int) -> Gen Int
QC.chooseInt (Int
8, Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8))

isKeyForIndexCompact :: RawBytes -> Bool
isKeyForIndexCompact :: RawBytes -> Bool
isKeyForIndexCompact RawBytes
rb = RawBytes -> Int
RB.size RawBytes
rb Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8

newtype KeyForIndexCompact =
    KeyForIndexCompact { KeyForIndexCompact -> RawBytes
getKeyForIndexCompact :: RawBytes }
  deriving stock (KeyForIndexCompact -> KeyForIndexCompact -> Bool
(KeyForIndexCompact -> KeyForIndexCompact -> Bool)
-> (KeyForIndexCompact -> KeyForIndexCompact -> Bool)
-> Eq KeyForIndexCompact
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
== :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
$c/= :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
/= :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
Eq, Eq KeyForIndexCompact
Eq KeyForIndexCompact =>
(KeyForIndexCompact -> KeyForIndexCompact -> Ordering)
-> (KeyForIndexCompact -> KeyForIndexCompact -> Bool)
-> (KeyForIndexCompact -> KeyForIndexCompact -> Bool)
-> (KeyForIndexCompact -> KeyForIndexCompact -> Bool)
-> (KeyForIndexCompact -> KeyForIndexCompact -> Bool)
-> (KeyForIndexCompact -> KeyForIndexCompact -> KeyForIndexCompact)
-> (KeyForIndexCompact -> KeyForIndexCompact -> KeyForIndexCompact)
-> Ord KeyForIndexCompact
KeyForIndexCompact -> KeyForIndexCompact -> Bool
KeyForIndexCompact -> KeyForIndexCompact -> Ordering
KeyForIndexCompact -> KeyForIndexCompact -> KeyForIndexCompact
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 :: KeyForIndexCompact -> KeyForIndexCompact -> Ordering
compare :: KeyForIndexCompact -> KeyForIndexCompact -> Ordering
$c< :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
< :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
$c<= :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
<= :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
$c> :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
> :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
$c>= :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
>= :: KeyForIndexCompact -> KeyForIndexCompact -> Bool
$cmax :: KeyForIndexCompact -> KeyForIndexCompact -> KeyForIndexCompact
max :: KeyForIndexCompact -> KeyForIndexCompact -> KeyForIndexCompact
$cmin :: KeyForIndexCompact -> KeyForIndexCompact -> KeyForIndexCompact
min :: KeyForIndexCompact -> KeyForIndexCompact -> KeyForIndexCompact
Ord, Int -> KeyForIndexCompact -> ShowS
[KeyForIndexCompact] -> ShowS
KeyForIndexCompact -> String
(Int -> KeyForIndexCompact -> ShowS)
-> (KeyForIndexCompact -> String)
-> ([KeyForIndexCompact] -> ShowS)
-> Show KeyForIndexCompact
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyForIndexCompact -> ShowS
showsPrec :: Int -> KeyForIndexCompact -> ShowS
$cshow :: KeyForIndexCompact -> String
show :: KeyForIndexCompact -> String
$cshowList :: [KeyForIndexCompact] -> ShowS
showList :: [KeyForIndexCompact] -> ShowS
Show)

instance Arbitrary KeyForIndexCompact where
  arbitrary :: Gen KeyForIndexCompact
arbitrary =
      RawBytes -> KeyForIndexCompact
KeyForIndexCompact (RawBytes -> KeyForIndexCompact)
-> Gen RawBytes -> Gen KeyForIndexCompact
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen RawBytes
genKeyForIndexCompact
  shrink :: KeyForIndexCompact -> [KeyForIndexCompact]
shrink (KeyForIndexCompact RawBytes
rawBytes) =
      [RawBytes -> KeyForIndexCompact
KeyForIndexCompact RawBytes
rawBytes' | RawBytes
rawBytes' <- RawBytes -> [RawBytes]
forall a. Arbitrary a => a -> [a]
shrink RawBytes
rawBytes,
                                      RawBytes -> Bool
isKeyForIndexCompact RawBytes
rawBytes']

deriving newtype instance SerialiseKey KeyForIndexCompact

-- we try to make collisions and close keys more likely (very crudely)
arbitraryBiasedKey :: (RawBytes -> k) -> Gen RawBytes -> Gen k
arbitraryBiasedKey :: forall k. (RawBytes -> k) -> Gen RawBytes -> Gen k
arbitraryBiasedKey RawBytes -> k
fromRB Gen RawBytes
genUnbiased = RawBytes -> k
fromRB (RawBytes -> k) -> Gen RawBytes -> Gen k
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen RawBytes)] -> Gen RawBytes
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
6, Gen RawBytes
genUnbiased)
    , (Int
1, do
        Word8
lastByte <- (Int -> Gen Word8) -> Gen Word8
forall a. (Int -> Gen a) -> Gen a
QC.sized ((Int -> Gen Word8) -> Gen Word8)
-> (Int -> Gen Word8) -> Gen Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Gen Word8
forall {b}. (Bounded b, Integral b) => b -> Gen b
skewedWithMax (Word8 -> Gen Word8) -> (Int -> Word8) -> Int -> Gen Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
        RawBytes -> Gen RawBytes
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word8] -> RawBytes
RB.pack ([Word8
1,Word8
3,Word8
3,Word8
7,Word8
0,Word8
1,Word8
7] [Word8] -> [Word8] -> [Word8]
forall a. Semigroup a => a -> a -> a
<> [Word8
lastByte]))
      )
    ]
    where
      -- generates a value in range from 0 to ub, but skewed towards low end
      skewedWithMax :: b -> Gen b
skewedWithMax b
ub0 = do
        b
ub1 <- (b, b) -> Gen b
forall a. (Bounded a, Integral a) => (a, a) -> Gen a
QC.chooseBoundedIntegral (b
0, b
ub0)
        b
ub2 <- (b, b) -> Gen b
forall a. (Bounded a, Integral a) => (a, a) -> Gen a
QC.chooseBoundedIntegral (b
0, b
ub1)
        (b, b) -> Gen b
forall a. (Bounded a, Integral a) => (a, a) -> Gen a
QC.chooseBoundedIntegral (b
0, b
ub2)

newtype BiasedKey = BiasedKey { BiasedKey -> RawBytes
getBiasedKey :: RawBytes }
  deriving stock (BiasedKey -> BiasedKey -> Bool
(BiasedKey -> BiasedKey -> Bool)
-> (BiasedKey -> BiasedKey -> Bool) -> Eq BiasedKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BiasedKey -> BiasedKey -> Bool
== :: BiasedKey -> BiasedKey -> Bool
$c/= :: BiasedKey -> BiasedKey -> Bool
/= :: BiasedKey -> BiasedKey -> Bool
Eq, Eq BiasedKey
Eq BiasedKey =>
(BiasedKey -> BiasedKey -> Ordering)
-> (BiasedKey -> BiasedKey -> Bool)
-> (BiasedKey -> BiasedKey -> Bool)
-> (BiasedKey -> BiasedKey -> Bool)
-> (BiasedKey -> BiasedKey -> Bool)
-> (BiasedKey -> BiasedKey -> BiasedKey)
-> (BiasedKey -> BiasedKey -> BiasedKey)
-> Ord BiasedKey
BiasedKey -> BiasedKey -> Bool
BiasedKey -> BiasedKey -> Ordering
BiasedKey -> BiasedKey -> BiasedKey
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 :: BiasedKey -> BiasedKey -> Ordering
compare :: BiasedKey -> BiasedKey -> Ordering
$c< :: BiasedKey -> BiasedKey -> Bool
< :: BiasedKey -> BiasedKey -> Bool
$c<= :: BiasedKey -> BiasedKey -> Bool
<= :: BiasedKey -> BiasedKey -> Bool
$c> :: BiasedKey -> BiasedKey -> Bool
> :: BiasedKey -> BiasedKey -> Bool
$c>= :: BiasedKey -> BiasedKey -> Bool
>= :: BiasedKey -> BiasedKey -> Bool
$cmax :: BiasedKey -> BiasedKey -> BiasedKey
max :: BiasedKey -> BiasedKey -> BiasedKey
$cmin :: BiasedKey -> BiasedKey -> BiasedKey
min :: BiasedKey -> BiasedKey -> BiasedKey
Ord, Int -> BiasedKey -> ShowS
[BiasedKey] -> ShowS
BiasedKey -> String
(Int -> BiasedKey -> ShowS)
-> (BiasedKey -> String)
-> ([BiasedKey] -> ShowS)
-> Show BiasedKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BiasedKey -> ShowS
showsPrec :: Int -> BiasedKey -> ShowS
$cshow :: BiasedKey -> String
show :: BiasedKey -> String
$cshowList :: [BiasedKey] -> ShowS
showList :: [BiasedKey] -> ShowS
Show)
  deriving newtype BiasedKey -> ()
(BiasedKey -> ()) -> NFData BiasedKey
forall a. (a -> ()) -> NFData a
$crnf :: BiasedKey -> ()
rnf :: BiasedKey -> ()
NFData

instance Arbitrary BiasedKey where
  arbitrary :: Gen BiasedKey
arbitrary = (RawBytes -> BiasedKey) -> Gen RawBytes -> Gen BiasedKey
forall k. (RawBytes -> k) -> Gen RawBytes -> Gen k
arbitraryBiasedKey RawBytes -> BiasedKey
BiasedKey Gen RawBytes
forall a. Arbitrary a => Gen a
arbitrary

  shrink :: BiasedKey -> [BiasedKey]
shrink (BiasedKey RawBytes
rb) = [RawBytes -> BiasedKey
BiasedKey RawBytes
rb' | RawBytes
rb' <- RawBytes -> [RawBytes]
forall a. Arbitrary a => a -> [a]
shrink RawBytes
rb]

deriving newtype instance SerialiseKey BiasedKey

{-------------------------------------------------------------------------------
  Unsliced
-------------------------------------------------------------------------------}

instance Arbitrary (Unsliced SerialisedKey) where
  arbitrary :: Gen (Unsliced SerialisedKey)
arbitrary = SerialisedKey -> Unsliced SerialisedKey
makeUnslicedKey (SerialisedKey -> Unsliced SerialisedKey)
-> Gen SerialisedKey -> Gen (Unsliced SerialisedKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SerialisedKey
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Unsliced SerialisedKey -> [Unsliced SerialisedKey]
shrink = (SerialisedKey -> Unsliced SerialisedKey)
-> [SerialisedKey] -> [Unsliced SerialisedKey]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SerialisedKey -> Unsliced SerialisedKey
makeUnslicedKey ([SerialisedKey] -> [Unsliced SerialisedKey])
-> (Unsliced SerialisedKey -> [SerialisedKey])
-> Unsliced SerialisedKey
-> [Unsliced SerialisedKey]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  SerialisedKey -> [SerialisedKey]
forall a. Arbitrary a => a -> [a]
shrink (SerialisedKey -> [SerialisedKey])
-> (Unsliced SerialisedKey -> SerialisedKey)
-> Unsliced SerialisedKey
-> [SerialisedKey]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Unsliced SerialisedKey -> SerialisedKey
fromUnslicedKey

{-------------------------------------------------------------------------------
  BlobRef
-------------------------------------------------------------------------------}

instance Arbitrary BlobSpan where
  arbitrary :: Gen BlobSpan
arbitrary = Word64 -> Word32 -> BlobSpan
BlobSpan (Word64 -> Word32 -> BlobSpan)
-> Gen Word64 -> Gen (Word32 -> BlobSpan)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen (Word32 -> BlobSpan) -> Gen Word32 -> Gen BlobSpan
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 :: BlobSpan -> [BlobSpan]
shrink (BlobSpan Word64
x Word32
y) = [ Word64 -> Word32 -> BlobSpan
BlobSpan Word64
x' Word32
y' | (Word64
x', Word32
y') <- (Word64, Word32) -> [(Word64, Word32)]
forall a. Arbitrary a => a -> [a]
shrink (Word64
x, Word32
y) ]

{-------------------------------------------------------------------------------
  Merge
-------------------------------------------------------------------------------}

instance Arbitrary Merge.MergeType where
  arbitrary :: Gen MergeType
arbitrary = [MergeType] -> Gen MergeType
forall a. HasCallStack => [a] -> Gen a
QC.elements
      [MergeType
Merge.MergeTypeMidLevel, MergeType
Merge.MergeTypeLastLevel, MergeType
Merge.MergeTypeUnion]
  shrink :: MergeType -> [MergeType]
shrink MergeType
Merge.MergeTypeMidLevel  = []
  shrink MergeType
Merge.MergeTypeLastLevel = [MergeType
Merge.MergeTypeMidLevel]
  shrink MergeType
Merge.MergeTypeUnion     = [MergeType
Merge.MergeTypeLastLevel]

instance Arbitrary Merge.LevelMergeType where
  arbitrary :: Gen LevelMergeType
arbitrary = [LevelMergeType] -> Gen LevelMergeType
forall a. HasCallStack => [a] -> Gen a
QC.elements [LevelMergeType
Merge.MergeMidLevel, LevelMergeType
Merge.MergeLastLevel]
  shrink :: LevelMergeType -> [LevelMergeType]
shrink LevelMergeType
Merge.MergeMidLevel  = []
  shrink LevelMergeType
Merge.MergeLastLevel = [LevelMergeType
Merge.MergeMidLevel]

instance Arbitrary Merge.TreeMergeType where
  arbitrary :: Gen TreeMergeType
arbitrary = [TreeMergeType] -> Gen TreeMergeType
forall a. HasCallStack => [a] -> Gen a
QC.elements [TreeMergeType
Merge.MergeLevel, TreeMergeType
Merge.MergeUnion]
  shrink :: TreeMergeType -> [TreeMergeType]
shrink TreeMergeType
Merge.MergeLevel = []
  shrink TreeMergeType
Merge.MergeUnion = [TreeMergeType
Merge.MergeLevel]