cli parser

bench/macro/lsm-tree-bench-wp8.hs

@@ -40,12 +40,12 @@ module Main (main) where
 import           Control.Applicative ((<**>))
 import           Control.DeepSeq (force)
 import           Control.Exception (bracket, evaluate)
-import           Control.Monad (forM_, unless, void, when)
+import           Control.Monad (forM_, void, when)
 import qualified Crypto.Hash.SHA256 as SHA256
 import qualified Data.Binary as B
 import qualified Data.ByteString as BS
 import qualified Data.IntSet as IS
-import           Data.IORef (newIORef, readIORef, writeIORef)
+import           Data.IORef (modifyIORef', newIORef, readIORef, writeIORef)
 import           Data.Traversable (mapAccumL)
 import           Data.Tuple (swap)
 import           Data.Void (Void)
@@ -124,7 +124,7 @@ data Cmd
 globalOptsP :: O.Parser GlobalOpts
 globalOptsP = pure GlobalOpts
     <*> pure "_bench_session"
-    <*> pure 100_000 -- _000
+    <*> O.option O.auto (O.long "initial-size" <> O.value 100_000_000 <> O.showDefault <> O.help "Initial LSM tree size")
 
 cmdP :: O.Parser Cmd
 cmdP = O.subparser $ mconcat
@@ -142,10 +142,10 @@ setupOptsP = pure SetupOpts
 
 runOptsP :: O.Parser RunOpts
 runOptsP = pure RunOpts
-    <*> pure 100
-    <*> pure 16 -- TODO: 256
-    <*> pure True
-    <*> pure 50
+    <*> O.option O.auto (O.long "batch-count" <> O.value 200 <> O.showDefault <> O.help "Batch count")
+    <*> O.option O.auto (O.long "batch-size" <> O.value 256 <> O.showDefault <> O.help "Batch size")
+    <*> O.switch (O.long "check" <> O.help "Check generated key distribution")
+    <*> O.option O.auto (O.long "seed" <> O.value 1337 <> O.showDefault <> O.help "Random seed")
 
 -------------------------------------------------------------------------------
 -- clock
@@ -206,7 +206,13 @@ doSetup gopts _opts = do
 
 doDryRun :: GlobalOpts -> RunOpts -> IO ()
 doDryRun gopts opts = do
-    when opts.check $ do
+    time <- timed_ $ doDryRun' gopts opts
+    printf "Batch generation: %.03f sec\n" time
+
+doDryRun' :: GlobalOpts -> RunOpts -> IO ()
+doDryRun' gopts opts = do
+    -- calculated some expected statistics for generated batches
+    id $ do
         -- we generate n random numbers in range of [ 1 .. d ]
         -- what is the chance they are all distinct
         let n = fromIntegral (opts.batchCount * opts.batchSize) :: Double
@@ -219,7 +225,7 @@ doDryRun gopts opts = do
         let q = n * (1 - ((d - 1) / d) ** (n - 1))
 
         printf "Probability of a duplicate: %5f\n" p
-        printf "Expected number of duplicate: %5f out of %f\n" q n
+        printf "Expected number of duplicates: %5f out of %f\n" q n
 
     -- TODO: open session to measure that as well.
     let initGen = SM.mkSMGen opts.seed
@@ -228,6 +234,7 @@ doDryRun gopts opts = do
         if opts.check
         then IS.fromList [ 0 .. gopts.initialSize - 1 ]
         else IS.empty
+    duplicateRef <- newIORef (0 :: Int)
 
     void $ forFoldM_ initGen [ 0 .. opts.batchCount - 1 ] $ \b g -> do
         let lookups :: [Word64]
@@ -238,8 +245,8 @@ doDryRun gopts opts = do
             keys <- readIORef keysRef
             let new  = IS.fromList $ map fromIntegral lookups
             let diff = IS.difference new keys
-            unless (IS.null diff) $ printf "missing in batch %d %s\n" b (show diff)
-
+            -- when (IS.notNull diff) $ printf "missing in batch %d %s\n" b (show diff)
+            modifyIORef' duplicateRef $ \n -> n + IS.size diff
             writeIORef keysRef $! IS.union
                 (IS.difference keys new)
                 (IS.fromList $ map fromIntegral inserts)
@@ -261,6 +268,9 @@ doDryRun gopts opts = do
 
         return nextG
 
+    when opts.check $ do
+        duplicates <- readIORef duplicateRef
+        printf "True duplicates: %d\n" duplicates
 
 {- | Implement generation of unbounded sequence of insert/delete operations
 
@@ -308,7 +318,7 @@ main = do
         CmdRun opts    -> doRun gopts opts
   where
     cliP = O.info ((,) <$> globalOptsP <*> cmdP <**> O.helper) O.fullDesc
-    prefs = O.prefs O.showHelpOnEmpty
+    prefs = O.prefs $ O.showHelpOnEmpty <> O.helpShowGlobals <> O.subparserInline
 
 -------------------------------------------------------------------------------
 -- utils: should this be in main lib?

src/Database/LSMTree/Internal/Normal.hs

@@ -4,7 +4,7 @@ module Database.LSMTree.Internal.Normal (
     Update (..),
 ) where
 
-import Control.DeepSeq (NFData (..))
+import           Control.DeepSeq (NFData (..))
 
 -- | Result of a single point lookup.
 data LookupResult k v blobref =
@@ -29,5 +29,5 @@ data Update v blob =
   deriving (Show, Eq)
 
 instance (NFData v, NFData blob) => NFData (Update v blob) where
-  rnf Delete = ()
+  rnf Delete       = ()
   rnf (Insert v b) = rnf v `seq` rnf b