-- | Utilities for generating collections of key\/value pairs, and creating runs
-- from them. Tests and benchmarks should preferably use these utilities instead
-- of (re-)defining their own.
module Database.LSMTree.Extras.RunData (
    -- * Create runs
    withRun
  , withRunAt
  , withRuns
  , unsafeCreateRun
  , unsafeCreateRunAt
  , simplePath
  , simplePaths
    -- * Serialise write buffers
  , withRunDataAsWriteBuffer
  , withSerialisedWriteBuffer
    -- * RunData
  , RunData (..)
  , mapRunData
  , SerialisedRunData
  , serialiseRunData
    -- * NonEmptyRunData
  , NonEmptyRunData (..)
  , nonEmptyRunData
  , toRunData
  , mapNonEmptyRunData
  , SerialisedNonEmptyRunData
    -- * QuickCheck
  , labelRunData
  , labelNonEmptyRunData
  , genRunData
  , shrinkRunData
  , genNonEmptyRunData
  , shrinkNonEmptyRunData
  , liftArbitrary2Map
  , liftShrink2Map
  ) where

import           Control.Exception (bracket, bracket_)
import           Control.RefCount
import           Data.Bifoldable (Bifoldable (bifoldMap))
import           Data.Bifunctor
import           Data.Foldable (for_)
import           Data.Map.NonEmpty (NEMap)
import qualified Data.Map.NonEmpty as NEMap
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Vector as V
import           Database.LSMTree.Extras (showPowersOf10)
import           Database.LSMTree.Extras.Generators ()
import           Database.LSMTree.Internal.Entry
import           Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
import           Database.LSMTree.Internal.MergeSchedule (addWriteBufferEntries)
import           Database.LSMTree.Internal.Paths
import qualified Database.LSMTree.Internal.Paths as Paths
import           Database.LSMTree.Internal.Run (Run, RunParams (..))
import qualified Database.LSMTree.Internal.Run as Run
import           Database.LSMTree.Internal.RunAcc (entryWouldFitInPage)
import           Database.LSMTree.Internal.RunNumber
import           Database.LSMTree.Internal.Serialise
import           Database.LSMTree.Internal.UniqCounter
import qualified Database.LSMTree.Internal.WriteBuffer as WB
import qualified Database.LSMTree.Internal.WriteBufferBlobs as WBB
import           Database.LSMTree.Internal.WriteBufferWriter (writeWriteBuffer)
import qualified System.FS.API as FS
import           System.FS.API (HasFS)
import qualified System.FS.BlockIO.API as FS
import           System.FS.BlockIO.API (HasBlockIO)
import           Test.QuickCheck


{-------------------------------------------------------------------------------
  Create runs
-------------------------------------------------------------------------------}

-- | Create a temporary 'Run' using 'unsafeCreateRun'.
withRun ::
     HasFS IO h
  -> HasBlockIO IO h
  -> RunParams
  -> FS.FsPath
  -> UniqCounter IO
  -> SerialisedRunData
  -> (Ref (Run IO h) -> IO a)
  -> IO a
withRun :: forall h a.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedRunData
-> (Ref (Run IO h) -> IO a)
-> IO a
withRun HasFS IO h
hfs HasBlockIO IO h
hbio RunParams
runParams FsPath
path UniqCounter IO
counter SerialisedRunData
rd = do
    IO (Ref (Run IO h))
-> (Ref (Run IO h) -> IO ()) -> (Ref (Run IO h) -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      (HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedRunData
-> IO (Ref (Run IO h))
forall h.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedRunData
-> IO (Ref (Run IO h))
unsafeCreateRun HasFS IO h
hfs HasBlockIO IO h
hbio RunParams
runParams FsPath
path UniqCounter IO
counter SerialisedRunData
rd)
      Ref (Run IO h) -> IO ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef

-- | Create a temporary 'Run' using 'unsafeCreateRunAt'.
withRunAt ::
     HasFS IO h
  -> HasBlockIO IO h
  -> RunParams
  -> RunFsPaths
  -> SerialisedRunData
  -> (Ref (Run IO h) -> IO a)
  -> IO a
withRunAt :: forall h a.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> RunFsPaths
-> SerialisedRunData
-> (Ref (Run IO h) -> IO a)
-> IO a
withRunAt HasFS IO h
hfs HasBlockIO IO h
hbio RunParams
runParams RunFsPaths
path SerialisedRunData
rd = do
    IO (Ref (Run IO h))
-> (Ref (Run IO h) -> IO ()) -> (Ref (Run IO h) -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      (HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> RunFsPaths
-> SerialisedRunData
-> IO (Ref (Run IO h))
forall h.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> RunFsPaths
-> SerialisedRunData
-> IO (Ref (Run IO h))
unsafeCreateRunAt HasFS IO h
hfs HasBlockIO IO h
hbio RunParams
runParams RunFsPaths
path SerialisedRunData
rd)
      Ref (Run IO h) -> IO ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef

{-# INLINABLE withRuns #-}
-- | Create temporary 'Run's using 'unsafeCreateRun'.
withRuns ::
     HasFS IO h
  -> HasBlockIO IO h
  -> RunParams
  -> FS.FsPath
  -> UniqCounter IO
  -> [SerialisedRunData]
  -> ([Ref (Run IO h)] -> IO a)
  -> IO a
withRuns :: forall h a.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> [SerialisedRunData]
-> ([Ref (Run IO h)] -> IO a)
-> IO a
withRuns HasFS IO h
hfs HasBlockIO IO h
hbio RunParams
runParams FsPath
path UniqCounter IO
counter = [SerialisedRunData] -> ([Ref (Run IO h)] -> IO a) -> IO a
go
  where
    go :: [SerialisedRunData] -> ([Ref (Run IO h)] -> IO a) -> IO a
go []       [Ref (Run IO h)] -> IO a
act = [Ref (Run IO h)] -> IO a
act []
    go (SerialisedRunData
rd:[SerialisedRunData]
rds) [Ref (Run IO h)] -> IO a
act =
      HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedRunData
-> (Ref (Run IO h) -> IO a)
-> IO a
forall h a.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedRunData
-> (Ref (Run IO h) -> IO a)
-> IO a
withRun HasFS IO h
hfs HasBlockIO IO h
hbio RunParams
runParams FsPath
path UniqCounter IO
counter SerialisedRunData
rd ((Ref (Run IO h) -> IO a) -> IO a)
-> (Ref (Run IO h) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ref (Run IO h)
r ->
        [SerialisedRunData] -> ([Ref (Run IO h)] -> IO a) -> IO a
go [SerialisedRunData]
rds (([Ref (Run IO h)] -> IO a) -> IO a)
-> ([Ref (Run IO h)] -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \[Ref (Run IO h)]
rs ->
          [Ref (Run IO h)] -> IO a
act (Ref (Run IO h)
rRef (Run IO h) -> [Ref (Run IO h)] -> [Ref (Run IO h)]
forall a. a -> [a] -> [a]
:[Ref (Run IO h)]
rs)

-- | Like 'unsafeCreateRunAt', but uses a 'UniqCounter' to determine
-- the 'RunFsPaths', at a base file path.
unsafeCreateRun ::
     HasFS IO h
  -> HasBlockIO IO h
  -> RunParams
  -> FS.FsPath
  -> UniqCounter IO
  -> SerialisedRunData
  -> IO (Ref (Run IO h))
unsafeCreateRun :: forall h.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> FsPath
-> UniqCounter IO
-> SerialisedRunData
-> IO (Ref (Run IO h))
unsafeCreateRun HasFS IO h
fs HasBlockIO IO h
hbio RunParams
runParams FsPath
path UniqCounter IO
counter SerialisedRunData
rd = do
    Unique
n <- UniqCounter IO -> IO Unique
forall (m :: * -> *). PrimMonad m => UniqCounter m -> m Unique
incrUniqCounter UniqCounter IO
counter
    let fsPaths :: RunFsPaths
fsPaths = FsPath -> RunNumber -> RunFsPaths
RunFsPaths FsPath
path (Unique -> RunNumber
uniqueToRunNumber Unique
n)
    HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> RunFsPaths
-> SerialisedRunData
-> IO (Ref (Run IO h))
forall h.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> RunFsPaths
-> SerialisedRunData
-> IO (Ref (Run IO h))
unsafeCreateRunAt HasFS IO h
fs HasBlockIO IO h
hbio RunParams
runParams RunFsPaths
fsPaths SerialisedRunData
rd

-- | Flush serialised run data to disk as if it were a write buffer.
--
-- This might leak resources if not run with asynchronous exceptions masked.
-- Use helper functions like 'withRun' or 'withRuns' instead.
--
-- Use of this function should be paired with a 'releaseRef'.
unsafeCreateRunAt ::
     HasFS IO h
  -> HasBlockIO IO h
  -> RunParams
  -> RunFsPaths
  -> SerialisedRunData
  -> IO (Ref (Run IO h))
unsafeCreateRunAt :: forall h.
HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> RunFsPaths
-> SerialisedRunData
-> IO (Ref (Run IO h))
unsafeCreateRunAt HasFS IO h
fs HasBlockIO IO h
hbio RunParams
runParams RunFsPaths
fsPaths (RunData Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
m) = do
    -- the WBB file path doesn't have to be at a specific place relative to
    -- the run we want to create, but fsPaths should already point to a unique
    -- location, so we just append something to not conflict with that.
    let blobpath :: FsPath
blobpath = FsPath -> String -> FsPath
FS.addExtension (RunFsPaths -> FsPath
runBlobPath RunFsPaths
fsPaths) String
".wb"
    IO (Ref (WriteBufferBlobs IO h))
-> (Ref (WriteBufferBlobs IO h) -> IO ())
-> (Ref (WriteBufferBlobs IO h) -> IO (Ref (Run IO h)))
-> IO (Ref (Run IO h))
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (HasFS IO h -> FsPath -> IO (Ref (WriteBufferBlobs IO h))
forall (m :: * -> *) h.
(PrimMonad m, MonadMask m) =>
HasFS m h -> FsPath -> m (Ref (WriteBufferBlobs m h))
WBB.new HasFS IO h
fs FsPath
blobpath) Ref (WriteBufferBlobs IO h) -> IO ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef ((Ref (WriteBufferBlobs IO h) -> IO (Ref (Run IO h)))
 -> IO (Ref (Run IO h)))
-> (Ref (WriteBufferBlobs IO h) -> IO (Ref (Run IO h)))
-> IO (Ref (Run IO h))
forall a b. (a -> b) -> a -> b
$ \Ref (WriteBufferBlobs IO h)
wbblobs -> do
      WriteBuffer
wb <- Map SerialisedKey (Entry SerialisedValue BlobSpan) -> WriteBuffer
WB.fromMap (Map SerialisedKey (Entry SerialisedValue BlobSpan) -> WriteBuffer)
-> IO (Map SerialisedKey (Entry SerialisedValue BlobSpan))
-> IO WriteBuffer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Entry SerialisedValue SerialisedBlob
 -> IO (Entry SerialisedValue BlobSpan))
-> Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
-> IO (Map SerialisedKey (Entry SerialisedValue BlobSpan))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map SerialisedKey a -> f (Map SerialisedKey b)
traverse ((SerialisedBlob -> IO BlobSpan)
-> Entry SerialisedValue SerialisedBlob
-> IO (Entry SerialisedValue BlobSpan)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Entry SerialisedValue a -> f (Entry SerialisedValue b)
traverse (HasFS IO h
-> Ref (WriteBufferBlobs IO h) -> SerialisedBlob -> IO BlobSpan
forall (m :: * -> *) h.
(PrimMonad m, MonadThrow m) =>
HasFS m h
-> Ref (WriteBufferBlobs m h) -> SerialisedBlob -> m BlobSpan
WBB.addBlob HasFS IO h
fs Ref (WriteBufferBlobs IO h)
wbblobs)) Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
m
      HasFS IO h
-> HasBlockIO IO h
-> RunParams
-> RunFsPaths
-> WriteBuffer
-> Ref (WriteBufferBlobs IO h)
-> IO (Ref (Run IO h))
forall (m :: * -> *) h.
(MonadST m, MonadSTM m, MonadMask m) =>
HasFS m h
-> HasBlockIO m h
-> RunParams
-> RunFsPaths
-> WriteBuffer
-> Ref (WriteBufferBlobs m h)
-> m (Ref (Run m h))
Run.fromWriteBuffer HasFS IO h
fs HasBlockIO IO h
hbio RunParams
runParams RunFsPaths
fsPaths WriteBuffer
wb Ref (WriteBufferBlobs IO h)
wbblobs

-- | Create a 'RunFsPaths' using an empty 'FsPath'. The empty path corresponds
-- to the "root" or "mount point" of a 'HasFS' instance.
simplePath :: Int -> RunFsPaths
simplePath :: Int -> RunFsPaths
simplePath Int
n = FsPath -> RunNumber -> RunFsPaths
RunFsPaths ([String] -> FsPath
FS.mkFsPath []) (Int -> RunNumber
RunNumber Int
n)

-- | Like 'simplePath', but for a list.
simplePaths :: [Int] -> [RunFsPaths]
simplePaths :: [Int] -> [RunFsPaths]
simplePaths [Int]
ns = (Int -> RunFsPaths) -> [Int] -> [RunFsPaths]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> RunFsPaths
simplePath [Int]
ns

{-------------------------------------------------------------------------------
  Serialise write buffers
-------------------------------------------------------------------------------}

-- | Use 'SerialisedRunData' to 'WriteBuffer' and 'WriteBufferBlobs'.
withRunDataAsWriteBuffer ::
     FS.HasFS IO h
  -> ResolveSerialisedValue
  -> WriteBufferFsPaths
  -> SerialisedRunData
  -> (WB.WriteBuffer -> Ref (WBB.WriteBufferBlobs IO h) -> IO a)
  -> IO a
withRunDataAsWriteBuffer :: forall h a.
HasFS IO h
-> ResolveSerialisedValue
-> WriteBufferFsPaths
-> SerialisedRunData
-> (WriteBuffer -> Ref (WriteBufferBlobs IO h) -> IO a)
-> IO a
withRunDataAsWriteBuffer HasFS IO h
hfs ResolveSerialisedValue
f WriteBufferFsPaths
fsPaths SerialisedRunData
rd WriteBuffer -> Ref (WriteBufferBlobs IO h) -> IO a
action = do
  let es :: Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
es = [(SerialisedKey, Entry SerialisedValue SerialisedBlob)]
-> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
forall a. [a] -> Vector a
V.fromList ([(SerialisedKey, Entry SerialisedValue SerialisedBlob)]
 -> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob))
-> (Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
    -> [(SerialisedKey, Entry SerialisedValue SerialisedBlob)])
-> Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
-> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
-> [(SerialisedKey, Entry SerialisedValue SerialisedBlob)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
 -> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob))
-> Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
-> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
forall a b. (a -> b) -> a -> b
$ SerialisedRunData
-> Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
forall k v b. RunData k v b -> Map k (Entry v b)
unRunData SerialisedRunData
rd
  let maxn :: NumEntries
maxn = Int -> NumEntries
NumEntries (Int -> NumEntries) -> Int -> NumEntries
forall a b. (a -> b) -> a -> b
$ Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob) -> Int
forall a. Vector a -> Int
V.length Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
es
  let wbbPath :: FsPath
wbbPath = WriteBufferFsPaths -> FsPath
Paths.writeBufferBlobPath WriteBufferFsPaths
fsPaths
  IO (Ref (WriteBufferBlobs IO h))
-> (Ref (WriteBufferBlobs IO h) -> IO ())
-> (Ref (WriteBufferBlobs IO h) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (HasFS IO h -> FsPath -> IO (Ref (WriteBufferBlobs IO h))
forall (m :: * -> *) h.
(PrimMonad m, MonadMask m) =>
HasFS m h -> FsPath -> m (Ref (WriteBufferBlobs m h))
WBB.new HasFS IO h
hfs FsPath
wbbPath) Ref (WriteBufferBlobs IO h) -> IO ()
forall (m :: * -> *) obj.
(RefCounted m obj, PrimMonad m, MonadMask m, HasCallStack) =>
Ref obj -> m ()
releaseRef ((Ref (WriteBufferBlobs IO h) -> IO a) -> IO a)
-> (Ref (WriteBufferBlobs IO h) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ref (WriteBufferBlobs IO h)
wbb -> do
    (WriteBuffer
wb, Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
_) <- HasFS IO h
-> ResolveSerialisedValue
-> Ref (WriteBufferBlobs IO h)
-> NumEntries
-> WriteBuffer
-> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
-> IO
     (WriteBuffer,
      Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob))
forall (m :: * -> *) h.
(MonadSTM m, MonadThrow m, PrimMonad m) =>
HasFS m h
-> ResolveSerialisedValue
-> Ref (WriteBufferBlobs m h)
-> NumEntries
-> WriteBuffer
-> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
-> m (WriteBuffer,
      Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob))
addWriteBufferEntries HasFS IO h
hfs ResolveSerialisedValue
f Ref (WriteBufferBlobs IO h)
wbb NumEntries
maxn WriteBuffer
WB.empty Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
es
    WriteBuffer -> Ref (WriteBufferBlobs IO h) -> IO a
action WriteBuffer
wb Ref (WriteBufferBlobs IO h)
wbb

-- | Serialise a 'WriteBuffer' and 'WriteBufferBlobs' to disk and perform an
-- 'IO' action.
withSerialisedWriteBuffer ::
     FS.HasFS IO h
  -> FS.HasBlockIO IO h
  -> WriteBufferFsPaths
  -> WB.WriteBuffer
  -> Ref (WBB.WriteBufferBlobs IO h)
  -> IO a
  -> IO a
withSerialisedWriteBuffer :: forall h a.
HasFS IO h
-> HasBlockIO IO h
-> WriteBufferFsPaths
-> WriteBuffer
-> Ref (WriteBufferBlobs IO h)
-> IO a
-> IO a
withSerialisedWriteBuffer HasFS IO h
hfs HasBlockIO IO h
hbio WriteBufferFsPaths
wbPaths WriteBuffer
wb Ref (WriteBufferBlobs IO h)
wbb =
  IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (HasFS IO h
-> HasBlockIO IO h
-> WriteBufferFsPaths
-> WriteBuffer
-> Ref (WriteBufferBlobs IO h)
-> IO ()
forall (m :: * -> *) h.
(MonadSTM m, MonadST m, MonadThrow m) =>
HasFS m h
-> HasBlockIO m h
-> WriteBufferFsPaths
-> WriteBuffer
-> Ref (WriteBufferBlobs m h)
-> m ()
writeWriteBuffer HasFS IO h
hfs HasBlockIO IO h
hbio WriteBufferFsPaths
wbPaths WriteBuffer
wb Ref (WriteBufferBlobs IO h)
wbb) (IO () -> IO a -> IO a) -> IO () -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    [FsPath] -> (FsPath -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ WriteBufferFsPaths -> FsPath
Paths.writeBufferKOpsPath WriteBufferFsPaths
wbPaths
         , WriteBufferFsPaths -> FsPath
Paths.writeBufferBlobPath WriteBufferFsPaths
wbPaths
         , WriteBufferFsPaths -> FsPath
Paths.writeBufferChecksumsPath WriteBufferFsPaths
wbPaths
         ] ((FsPath -> IO ()) -> IO ()) -> (FsPath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ HasFS IO h -> HasCallStack => FsPath -> IO ()
forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
FS.removeFile HasFS IO h
hfs

{-------------------------------------------------------------------------------
  RunData
-------------------------------------------------------------------------------}

-- | A collection of arbitrary key\/value pairs that are suitable for creating
-- 'Run's.
--
-- Note: 'b ~ Void' should rule out blobs.
newtype RunData k v b = RunData {
    forall k v b. RunData k v b -> Map k (Entry v b)
unRunData :: Map k (Entry v b)
  }
  deriving stock (RunData k v b -> RunData k v b -> Bool
(RunData k v b -> RunData k v b -> Bool)
-> (RunData k v b -> RunData k v b -> Bool) -> Eq (RunData k v b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v b.
(Eq k, Eq b, Eq v) =>
RunData k v b -> RunData k v b -> Bool
$c== :: forall k v b.
(Eq k, Eq b, Eq v) =>
RunData k v b -> RunData k v b -> Bool
== :: RunData k v b -> RunData k v b -> Bool
$c/= :: forall k v b.
(Eq k, Eq b, Eq v) =>
RunData k v b -> RunData k v b -> Bool
/= :: RunData k v b -> RunData k v b -> Bool
Eq, Int -> RunData k v b -> ShowS
[RunData k v b] -> ShowS
RunData k v b -> String
(Int -> RunData k v b -> ShowS)
-> (RunData k v b -> String)
-> ([RunData k v b] -> ShowS)
-> Show (RunData k v b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v b.
(Show k, Show b, Show v) =>
Int -> RunData k v b -> ShowS
forall k v b. (Show k, Show b, Show v) => [RunData k v b] -> ShowS
forall k v b. (Show k, Show b, Show v) => RunData k v b -> String
$cshowsPrec :: forall k v b.
(Show k, Show b, Show v) =>
Int -> RunData k v b -> ShowS
showsPrec :: Int -> RunData k v b -> ShowS
$cshow :: forall k v b. (Show k, Show b, Show v) => RunData k v b -> String
show :: RunData k v b -> String
$cshowList :: forall k v b. (Show k, Show b, Show v) => [RunData k v b] -> ShowS
showList :: [RunData k v b] -> ShowS
Show)

mapRunData ::
     Ord k'
  => (k -> k') -> (v -> v') -> (b -> b')
  -> RunData k v b -> RunData k' v' b'
mapRunData :: forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v') -> (b -> b') -> RunData k v b -> RunData k' v' b'
mapRunData k -> k'
f v -> v'
g b -> b'
h = Map k' (Entry v' b') -> RunData k' v' b'
forall k v b. Map k (Entry v b) -> RunData k v b
RunData (Map k' (Entry v' b') -> RunData k' v' b')
-> (RunData k v b -> Map k' (Entry v' b'))
-> RunData k v b
-> RunData k' v' b'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> k') -> Map k (Entry v' b') -> Map k' (Entry v' b')
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys k -> k'
f (Map k (Entry v' b') -> Map k' (Entry v' b'))
-> (RunData k v b -> Map k (Entry v' b'))
-> RunData k v b
-> Map k' (Entry v' b')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry v b -> Entry v' b')
-> Map k (Entry v b) -> Map k (Entry v' b')
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((v -> v') -> (b -> b') -> Entry v b -> Entry v' b'
forall a b c d. (a -> b) -> (c -> d) -> Entry a c -> Entry b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap v -> v'
g b -> b'
h) (Map k (Entry v b) -> Map k (Entry v' b'))
-> (RunData k v b -> Map k (Entry v b))
-> RunData k v b
-> Map k (Entry v' b')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunData k v b -> Map k (Entry v b)
forall k v b. RunData k v b -> Map k (Entry v b)
unRunData

type SerialisedRunData = RunData SerialisedKey SerialisedValue SerialisedBlob

serialiseRunData ::
     (SerialiseKey k, SerialiseValue v, SerialiseValue b)
  => RunData k v b -> SerialisedRunData
serialiseRunData :: forall k v b.
(SerialiseKey k, SerialiseValue v, SerialiseValue b) =>
RunData k v b -> SerialisedRunData
serialiseRunData = (k -> SerialisedKey)
-> (v -> SerialisedValue)
-> (b -> SerialisedBlob)
-> RunData k v b
-> SerialisedRunData
forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v') -> (b -> b') -> RunData k v b -> RunData k' v' b'
mapRunData k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
serialiseKey v -> SerialisedValue
forall v. SerialiseValue v => v -> SerialisedValue
serialiseValue b -> SerialisedBlob
forall v. SerialiseValue v => v -> SerialisedBlob
serialiseBlob

{-------------------------------------------------------------------------------
  NonEmptyRunData
-------------------------------------------------------------------------------}

-- | A collection of arbitrary key\/value pairs that are suitable for creating
-- 'Run's.
--
-- Note: 'b ~ Void' should rule out blobs.
newtype NonEmptyRunData k v b =
    NonEmptyRunData { forall k v b. NonEmptyRunData k v b -> NEMap k (Entry v b)
unNonEmptyRunData :: NEMap k (Entry v b) }
  deriving stock (NonEmptyRunData k v b -> NonEmptyRunData k v b -> Bool
(NonEmptyRunData k v b -> NonEmptyRunData k v b -> Bool)
-> (NonEmptyRunData k v b -> NonEmptyRunData k v b -> Bool)
-> Eq (NonEmptyRunData k v b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v b.
(Eq k, Eq b, Eq v) =>
NonEmptyRunData k v b -> NonEmptyRunData k v b -> Bool
$c== :: forall k v b.
(Eq k, Eq b, Eq v) =>
NonEmptyRunData k v b -> NonEmptyRunData k v b -> Bool
== :: NonEmptyRunData k v b -> NonEmptyRunData k v b -> Bool
$c/= :: forall k v b.
(Eq k, Eq b, Eq v) =>
NonEmptyRunData k v b -> NonEmptyRunData k v b -> Bool
/= :: NonEmptyRunData k v b -> NonEmptyRunData k v b -> Bool
Eq, Int -> NonEmptyRunData k v b -> ShowS
[NonEmptyRunData k v b] -> ShowS
NonEmptyRunData k v b -> String
(Int -> NonEmptyRunData k v b -> ShowS)
-> (NonEmptyRunData k v b -> String)
-> ([NonEmptyRunData k v b] -> ShowS)
-> Show (NonEmptyRunData k v b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v b.
(Show k, Show b, Show v) =>
Int -> NonEmptyRunData k v b -> ShowS
forall k v b.
(Show k, Show b, Show v) =>
[NonEmptyRunData k v b] -> ShowS
forall k v b.
(Show k, Show b, Show v) =>
NonEmptyRunData k v b -> String
$cshowsPrec :: forall k v b.
(Show k, Show b, Show v) =>
Int -> NonEmptyRunData k v b -> ShowS
showsPrec :: Int -> NonEmptyRunData k v b -> ShowS
$cshow :: forall k v b.
(Show k, Show b, Show v) =>
NonEmptyRunData k v b -> String
show :: NonEmptyRunData k v b -> String
$cshowList :: forall k v b.
(Show k, Show b, Show v) =>
[NonEmptyRunData k v b] -> ShowS
showList :: [NonEmptyRunData k v b] -> ShowS
Show)

nonEmptyRunData :: RunData k v b -> Maybe (NonEmptyRunData k v b)
nonEmptyRunData :: forall k v b. RunData k v b -> Maybe (NonEmptyRunData k v b)
nonEmptyRunData (RunData Map k (Entry v b)
m) = NEMap k (Entry v b) -> NonEmptyRunData k v b
forall k v b. NEMap k (Entry v b) -> NonEmptyRunData k v b
NonEmptyRunData (NEMap k (Entry v b) -> NonEmptyRunData k v b)
-> Maybe (NEMap k (Entry v b)) -> Maybe (NonEmptyRunData k v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map k (Entry v b) -> Maybe (NEMap k (Entry v b))
forall k a. Map k a -> Maybe (NEMap k a)
NEMap.nonEmptyMap Map k (Entry v b)
m

toRunData :: NonEmptyRunData k v b -> RunData k v b
toRunData :: forall k v b. NonEmptyRunData k v b -> RunData k v b
toRunData (NonEmptyRunData NEMap k (Entry v b)
m) = Map k (Entry v b) -> RunData k v b
forall k v b. Map k (Entry v b) -> RunData k v b
RunData (NEMap k (Entry v b) -> Map k (Entry v b)
forall k a. NEMap k a -> Map k a
NEMap.toMap NEMap k (Entry v b)
m)

mapNonEmptyRunData ::
     Ord k'
  => (k -> k') -> (v -> v') -> (b -> b')
  -> NonEmptyRunData k v b -> NonEmptyRunData k' v' b'
mapNonEmptyRunData :: forall k' k v v' b b'.
Ord k' =>
(k -> k')
-> (v -> v')
-> (b -> b')
-> NonEmptyRunData k v b
-> NonEmptyRunData k' v' b'
mapNonEmptyRunData k -> k'
f v -> v'
g b -> b'
h =
    NEMap k' (Entry v' b') -> NonEmptyRunData k' v' b'
forall k v b. NEMap k (Entry v b) -> NonEmptyRunData k v b
NonEmptyRunData (NEMap k' (Entry v' b') -> NonEmptyRunData k' v' b')
-> (NonEmptyRunData k v b -> NEMap k' (Entry v' b'))
-> NonEmptyRunData k v b
-> NonEmptyRunData k' v' b'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> k') -> NEMap k (Entry v' b') -> NEMap k' (Entry v' b')
forall k2 k1 a. Ord k2 => (k1 -> k2) -> NEMap k1 a -> NEMap k2 a
NEMap.mapKeys k -> k'
f (NEMap k (Entry v' b') -> NEMap k' (Entry v' b'))
-> (NonEmptyRunData k v b -> NEMap k (Entry v' b'))
-> NonEmptyRunData k v b
-> NEMap k' (Entry v' b')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry v b -> Entry v' b')
-> NEMap k (Entry v b) -> NEMap k (Entry v' b')
forall a b k. (a -> b) -> NEMap k a -> NEMap k b
NEMap.map ((v -> v') -> (b -> b') -> Entry v b -> Entry v' b'
forall a b c d. (a -> b) -> (c -> d) -> Entry a c -> Entry b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap v -> v'
g b -> b'
h) (NEMap k (Entry v b) -> NEMap k (Entry v' b'))
-> (NonEmptyRunData k v b -> NEMap k (Entry v b))
-> NonEmptyRunData k v b
-> NEMap k (Entry v' b')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyRunData k v b -> NEMap k (Entry v b)
forall k v b. NonEmptyRunData k v b -> NEMap k (Entry v b)
unNonEmptyRunData

type SerialisedNonEmptyRunData =
    NonEmptyRunData SerialisedKey SerialisedValue SerialisedBlob

{-------------------------------------------------------------------------------
  QuickCheck
-------------------------------------------------------------------------------}

{- HLINT ignore "Hoist not" -}
labelRunData :: SerialisedRunData -> Property -> Property
labelRunData :: SerialisedRunData -> Property -> Property
labelRunData (RunData Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
m) =
      String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"value size" [String]
valSizes
    (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
tabulate String
"run length" [String
runLength]
      -- We use tabulate here, not label. Otherwise, if multiple RunDatas get
      -- labelled in a test case, each leads to a separate entry in the
      -- displayed statistics, which isn't that useful.
    (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
tabulate String
"run has large k/ops" [String
note]
  where
    kops :: [(SerialisedKey, Entry SerialisedValue SerialisedBlob)]
kops = Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
-> [(SerialisedKey, Entry SerialisedValue SerialisedBlob)]
forall k a. Map k a -> [(k, a)]
Map.toList Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
m
    valSizes :: [String]
valSizes = (SerialisedValue -> String) -> [SerialisedValue] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String
showPowersOf10 (Int -> String)
-> (SerialisedValue -> Int) -> SerialisedValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedValue -> Int
sizeofValue) [SerialisedValue]
vals
    runLength :: String
runLength = Int -> String
showPowersOf10 (Map SerialisedKey (Entry SerialisedValue SerialisedBlob) -> Int
forall k a. Map k a -> Int
Map.size Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
m)
    vals :: [SerialisedValue]
vals = ((SerialisedKey, Entry SerialisedValue SerialisedBlob)
 -> [SerialisedValue])
-> [(SerialisedKey, Entry SerialisedValue SerialisedBlob)]
-> [SerialisedValue]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SerialisedValue -> [SerialisedValue])
-> (SerialisedBlob -> [SerialisedValue])
-> Entry SerialisedValue SerialisedBlob
-> [SerialisedValue]
forall m a b. Monoid m => (a -> m) -> (b -> m) -> Entry a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap SerialisedValue -> [SerialisedValue]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure SerialisedBlob -> [SerialisedValue]
forall a. Monoid a => a
mempty (Entry SerialisedValue SerialisedBlob -> [SerialisedValue])
-> ((SerialisedKey, Entry SerialisedValue SerialisedBlob)
    -> Entry SerialisedValue SerialisedBlob)
-> (SerialisedKey, Entry SerialisedValue SerialisedBlob)
-> [SerialisedValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SerialisedKey, Entry SerialisedValue SerialisedBlob)
-> Entry SerialisedValue SerialisedBlob
forall a b. (a, b) -> b
snd) [(SerialisedKey, Entry SerialisedValue SerialisedBlob)]
kops
    note :: String
note
      | ((SerialisedKey, Entry SerialisedValue SerialisedBlob) -> Bool)
-> [(SerialisedKey, Entry SerialisedValue SerialisedBlob)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool)
-> ((SerialisedKey, Entry SerialisedValue SerialisedBlob) -> Bool)
-> (SerialisedKey, Entry SerialisedValue SerialisedBlob)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SerialisedKey -> Entry SerialisedValue SerialisedBlob -> Bool)
-> (SerialisedKey, Entry SerialisedValue SerialisedBlob) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SerialisedKey -> Entry SerialisedValue SerialisedBlob -> Bool
forall b. SerialisedKey -> Entry SerialisedValue b -> Bool
entryWouldFitInPage) [(SerialisedKey, Entry SerialisedValue SerialisedBlob)]
kops = String
"has large k/op"
      | Bool
otherwise = String
"no large k/op"

labelNonEmptyRunData :: SerialisedNonEmptyRunData -> Property -> Property
labelNonEmptyRunData :: SerialisedNonEmptyRunData -> Property -> Property
labelNonEmptyRunData = SerialisedRunData -> Property -> Property
labelRunData (SerialisedRunData -> Property -> Property)
-> (SerialisedNonEmptyRunData -> SerialisedRunData)
-> SerialisedNonEmptyRunData
-> Property
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialisedNonEmptyRunData -> SerialisedRunData
forall k v b. NonEmptyRunData k v b -> RunData k v b
toRunData

instance ( Ord k, Arbitrary k, Arbitrary v, Arbitrary b
         ) => Arbitrary (RunData k v b) where
  arbitrary :: Gen (RunData k v b)
arbitrary = Gen k -> Gen v -> Gen b -> Gen (RunData k v b)
forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Gen (RunData k v b)
genRunData Gen k
forall a. Arbitrary a => Gen a
arbitrary Gen v
forall a. Arbitrary a => Gen a
arbitrary Gen b
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: RunData k v b -> [RunData k v b]
shrink = (k -> [k])
-> (v -> [v]) -> (b -> [b]) -> RunData k v b -> [RunData k v b]
forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v]) -> (b -> [b]) -> RunData k v b -> [RunData k v b]
shrinkRunData k -> [k]
forall a. Arbitrary a => a -> [a]
shrink v -> [v]
forall a. Arbitrary a => a -> [a]
shrink b -> [b]
forall a. Arbitrary a => a -> [a]
shrink

instance ( Ord k, Arbitrary k, Arbitrary v, Arbitrary b
         ) => Arbitrary (NonEmptyRunData k v b) where
  arbitrary :: Gen (NonEmptyRunData k v b)
arbitrary = Gen k -> Gen v -> Gen b -> Gen (NonEmptyRunData k v b)
forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Gen (NonEmptyRunData k v b)
genNonEmptyRunData Gen k
forall a. Arbitrary a => Gen a
arbitrary Gen v
forall a. Arbitrary a => Gen a
arbitrary Gen b
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: NonEmptyRunData k v b -> [NonEmptyRunData k v b]
shrink = (k -> [k])
-> (v -> [v])
-> (b -> [b])
-> NonEmptyRunData k v b
-> [NonEmptyRunData k v b]
forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> NonEmptyRunData k v b
-> [NonEmptyRunData k v b]
shrinkNonEmptyRunData k -> [k]
forall a. Arbitrary a => a -> [a]
shrink v -> [v]
forall a. Arbitrary a => a -> [a]
shrink b -> [b]
forall a. Arbitrary a => a -> [a]
shrink

genRunData :: Ord k => Gen k -> Gen v -> Gen b -> Gen (RunData k v b)
genRunData :: forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Gen (RunData k v b)
genRunData Gen k
genKey Gen v
genVal Gen b
genBlob =
    Map k (Entry v b) -> RunData k v b
forall k v b. Map k (Entry v b) -> RunData k v b
RunData (Map k (Entry v b) -> RunData k v b)
-> Gen (Map k (Entry v b)) -> Gen (RunData k v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen k -> Gen (Entry v b) -> Gen (Map k (Entry v b))
forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
liftArbitrary2Map Gen k
genKey (Gen v -> Gen b -> Gen (Entry v b)
forall a b. Gen a -> Gen b -> Gen (Entry a b)
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
Gen a -> Gen b -> Gen (f a b)
liftArbitrary2 Gen v
genVal Gen b
genBlob)

shrinkRunData ::
     Ord k
  => (k -> [k])
  -> (v -> [v])
  -> (b -> [b])
  -> RunData k v b
  -> [RunData k v b]
shrinkRunData :: forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v]) -> (b -> [b]) -> RunData k v b -> [RunData k v b]
shrinkRunData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob =
      (Map k (Entry v b) -> RunData k v b)
-> [Map k (Entry v b)] -> [RunData k v b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map k (Entry v b) -> RunData k v b
forall k v b. Map k (Entry v b) -> RunData k v b
RunData
    ([Map k (Entry v b)] -> [RunData k v b])
-> (RunData k v b -> [Map k (Entry v b)])
-> RunData k v b
-> [RunData k v b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> [k])
-> (Entry v b -> [Entry v b])
-> Map k (Entry v b)
-> [Map k (Entry v b)]
forall k v.
Ord k =>
(k -> [k]) -> (v -> [v]) -> Map k v -> [Map k v]
liftShrink2Map k -> [k]
shrinkKey ((v -> [v]) -> (b -> [b]) -> Entry v b -> [Entry v b]
forall a b. (a -> [a]) -> (b -> [b]) -> Entry a b -> [Entry a b]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2 v -> [v]
shrinkVal b -> [b]
shrinkBlob)
    (Map k (Entry v b) -> [Map k (Entry v b)])
-> (RunData k v b -> Map k (Entry v b))
-> RunData k v b
-> [Map k (Entry v b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunData k v b -> Map k (Entry v b)
forall k v b. RunData k v b -> Map k (Entry v b)
unRunData

-- | We cannot implement 'Arbitrary2' since we have constraints on @k@.
liftArbitrary2Map :: Ord k => Gen k -> Gen v -> Gen (Map k v)
liftArbitrary2Map :: forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
liftArbitrary2Map Gen k
genk Gen v
genv = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> Gen [(k, v)] -> Gen (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Gen (k, v) -> Gen [(k, v)]
forall a. Gen a -> Gen [a]
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (Gen k -> Gen v -> Gen (k, v)
forall a b. Gen a -> Gen b -> Gen (a, b)
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
Gen a -> Gen b -> Gen (f a b)
liftArbitrary2 Gen k
genk Gen v
genv)

-- | We cannot implement 'Arbitrary2' since we have constraints @k@.
liftShrink2Map :: Ord k => (k -> [k]) -> (v -> [v]) -> Map k v -> [Map k v]
liftShrink2Map :: forall k v.
Ord k =>
(k -> [k]) -> (v -> [v]) -> Map k v -> [Map k v]
liftShrink2Map k -> [k]
shrinkk v -> [v]
shrinkv Map k v
m = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> [[(k, v)]] -> [Map k v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ((k, v) -> [(k, v)]) -> [(k, v)] -> [[(k, v)]]
forall a. (a -> [a]) -> [a] -> [[a]]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink ((k -> [k]) -> (v -> [v]) -> (k, v) -> [(k, v)]
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 k -> [k]
shrinkk v -> [v]
shrinkv) (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m)

genNonEmptyRunData ::
     Ord k => Gen k -> Gen v -> Gen b -> Gen (NonEmptyRunData k v b)
genNonEmptyRunData :: forall k v b.
Ord k =>
Gen k -> Gen v -> Gen b -> Gen (NonEmptyRunData k v b)
genNonEmptyRunData Gen k
genKey Gen v
genVal Gen b
genBlob = NEMap k (Entry v b) -> NonEmptyRunData k v b
forall k v b. NEMap k (Entry v b) -> NonEmptyRunData k v b
NonEmptyRunData (NEMap k (Entry v b) -> NonEmptyRunData k v b)
-> Gen (NEMap k (Entry v b)) -> Gen (NonEmptyRunData k v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Gen k -> Gen (Entry v b) -> Gen (NEMap k (Entry v b))
forall k v. Ord k => Gen k -> Gen v -> Gen (NEMap k v)
liftArbitrary2NEMap Gen k
genKey (Gen v -> Gen b -> Gen (Entry v b)
forall a b. Gen a -> Gen b -> Gen (Entry a b)
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
Gen a -> Gen b -> Gen (f a b)
liftArbitrary2 Gen v
genVal Gen b
genBlob)

shrinkNonEmptyRunData ::
     Ord k
  => (k -> [k])
  -> (v -> [v])
  -> (b -> [b])
  -> NonEmptyRunData k v b
  -> [NonEmptyRunData k v b]
shrinkNonEmptyRunData :: forall k v b.
Ord k =>
(k -> [k])
-> (v -> [v])
-> (b -> [b])
-> NonEmptyRunData k v b
-> [NonEmptyRunData k v b]
shrinkNonEmptyRunData k -> [k]
shrinkKey v -> [v]
shrinkVal b -> [b]
shrinkBlob =
      (NEMap k (Entry v b) -> NonEmptyRunData k v b)
-> [NEMap k (Entry v b)] -> [NonEmptyRunData k v b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NEMap k (Entry v b) -> NonEmptyRunData k v b
forall k v b. NEMap k (Entry v b) -> NonEmptyRunData k v b
NonEmptyRunData
    ([NEMap k (Entry v b)] -> [NonEmptyRunData k v b])
-> (NonEmptyRunData k v b -> [NEMap k (Entry v b)])
-> NonEmptyRunData k v b
-> [NonEmptyRunData k v b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> [k])
-> (Entry v b -> [Entry v b])
-> NEMap k (Entry v b)
-> [NEMap k (Entry v b)]
forall k v.
Ord k =>
(k -> [k]) -> (v -> [v]) -> NEMap k v -> [NEMap k v]
liftShrink2NEMap k -> [k]
shrinkKey ((v -> [v]) -> (b -> [b]) -> Entry v b -> [Entry v b]
forall a b. (a -> [a]) -> (b -> [b]) -> Entry a b -> [Entry a b]
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
(a -> [a]) -> (b -> [b]) -> f a b -> [f a b]
liftShrink2 v -> [v]
shrinkVal b -> [b]
shrinkBlob)
    (NEMap k (Entry v b) -> [NEMap k (Entry v b)])
-> (NonEmptyRunData k v b -> NEMap k (Entry v b))
-> NonEmptyRunData k v b
-> [NEMap k (Entry v b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyRunData k v b -> NEMap k (Entry v b)
forall k v b. NonEmptyRunData k v b -> NEMap k (Entry v b)
unNonEmptyRunData

-- | We cannot implement 'Arbitrary2' since we have constraints on @k@.
liftArbitrary2NEMap :: Ord k => Gen k -> Gen v -> Gen (NEMap k v)
liftArbitrary2NEMap :: forall k v. Ord k => Gen k -> Gen v -> Gen (NEMap k v)
liftArbitrary2NEMap Gen k
genk Gen v
genv = NonEmpty (k, v) -> NEMap k v
forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
NEMap.fromList (NonEmpty (k, v) -> NEMap k v)
-> Gen (NonEmpty (k, v)) -> Gen (NEMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Gen (k, v) -> Gen (NonEmpty (k, v))
forall a. Gen a -> Gen (NonEmpty a)
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (Gen k -> Gen v -> Gen (k, v)
forall a b. Gen a -> Gen b -> Gen (a, b)
forall (f :: * -> * -> *) a b.
Arbitrary2 f =>
Gen a -> Gen b -> Gen (f a b)
liftArbitrary2 Gen k
genk Gen v
genv)

-- | We cannot implement 'Arbitrary2' since we have constraints @k@.
liftShrink2NEMap :: Ord k => (k -> [k]) -> (v -> [v]) -> NEMap k v -> [NEMap k v]
liftShrink2NEMap :: forall k v.
Ord k =>
(k -> [k]) -> (v -> [v]) -> NEMap k v -> [NEMap k v]
liftShrink2NEMap k -> [k]
shrinkk v -> [v]
shrinkv NEMap k v
m = NonEmpty (k, v) -> NEMap k v
forall k a. Ord k => NonEmpty (k, a) -> NEMap k a
NEMap.fromList (NonEmpty (k, v) -> NEMap k v) -> [NonEmpty (k, v)] -> [NEMap k v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ((k, v) -> [(k, v)]) -> NonEmpty (k, v) -> [NonEmpty (k, v)]
forall a. (a -> [a]) -> NonEmpty a -> [NonEmpty a]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink ((k -> [k]) -> (v -> [v]) -> (k, v) -> [(k, v)]
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 k -> [k]
shrinkk v -> [v]
shrinkv) (NEMap k v -> NonEmpty (k, v)
forall k a. NEMap k a -> NonEmpty (k, a)
NEMap.toList NEMap k v
m)