WIP

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

@@ -1,23 +1,48 @@
+{-# LANGUAGE BangPatterns        #-}
 {-# LANGUAGE NoFieldSelectors    #-}
 {-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings   #-}
 module Main (main) where
 
+import           Control.Applicative ((<**>))
 import qualified Crypto.Hash.SHA256 as SHA256
+import qualified Data.Binary as B
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Short as SBS
 import           Data.Void (Void)
+import           Data.Word (Word64)
 import qualified Options.Applicative as O
+import qualified System.Clock as Clock
 
 -- We should be able to write this benchmark
 -- using only use public lsm-tree interface
 import qualified Database.LSMTree.Normal as LSM
 
+-------------------------------------------------------------------------------
+-- Keys and values
+-------------------------------------------------------------------------------
+
 type K = BS.ByteString
 type V = BS.ByteString
 type B = Void
 
-main :: IO ()
-main = putStrLn "hello"
+-- We generate keys by hashing a word64 and adding two "random" bytes.
+-- This way we can ensure that keys are distinct.
+--
+-- I think this approach of generating keys should match UTxO quite well.
+-- This is purely CPU bound operation, and we should be able to push IO
+-- when doing these in between.
+makeKey :: Word64 -> K
+makeKey w64 = SHA256.hashlazy (B.encode w64) <> "=="
+
+theValue :: V
+theValue = BS.replicate 60 120 -- 'x'
+{-# NOINLINE theValue #-}
+
+
+-------------------------------------------------------------------------------
+-- Options and commands
+-------------------------------------------------------------------------------
 
 data GlobalOpts = GlobalOpts
     { rootDir :: FilePath  -- ^ session directory.
@@ -40,10 +65,62 @@ data Cmd
     | CmdRun
   deriving Show
 
+-------------------------------------------------------------------------------
+-- command line interface
+-------------------------------------------------------------------------------
+
 globalOptsP :: O.Parser GlobalOpts
 globalOptsP = pure GlobalOpts
     <*> pure "_bench_session"
 
+cmdP :: O.Parser Cmd
+cmdP = O.subparser $ mconcat
+    [ O.command "setup" $ O.info (CmdSetup <$> setupOptsP <**> O.helper) (O.progDesc "Setup benchmark")
+    ]
+
 setupOptsP :: O.Parser SetupOpts
 setupOptsP = pure SetupOpts
     <*> pure 1000 -- TODO: change to 100e6
+
+-------------------------------------------------------------------------------
+-- clock
+-------------------------------------------------------------------------------
+
+timed :: IO a -> IO (a, Double)
+timed action = do
+    t1 <- Clock.getTime Clock.Monotonic
+    x  <- action
+    t2 <- Clock.getTime Clock.Monotonic
+    let !t = fromIntegral (Clock.toNanoSecs (Clock.diffTimeSpec t2 t1)) * 1e-9
+    return (x, t)
+
+timed_ :: IO () -> IO Double
+timed_ action = do
+    t1 <- Clock.getTime Clock.Monotonic
+    action
+    t2 <- Clock.getTime Clock.Monotonic
+    return $! fromIntegral (Clock.toNanoSecs (Clock.diffTimeSpec t2 t1)) * 1e-9
+
+-------------------------------------------------------------------------------
+-- setup
+-------------------------------------------------------------------------------
+
+doSetup :: GlobalOpts -> SetupOpts -> IO ()
+doSetup _gopts _opts = return ()
+
+-------------------------------------------------------------------------------
+-- main
+-------------------------------------------------------------------------------
+
+main :: IO ()
+main = do
+    (gopts, cmd) <- O.customExecParser prefs cliP
+    print gopts
+    print cmd
+    case cmd of
+        CmdSetup opts -> doSetup gopts opts
+        CmdDryRun     -> return () -- TODO
+        CmdRun        -> return () -- TODO
+  where
+    cliP = O.info ((,) <$> globalOptsP <*> cmdP <**> O.helper) O.fullDesc
+    prefs = O.prefs O.showHelpOnEmpty

lsm-tree.cabal

@@ -347,6 +347,7 @@ benchmark lsm-tree-bench-wp8
   other-modules:    Database.LSMTree.Extras.Orphans
   build-depends:
     , base
+    , binary
     , bytestring
     , clock
     , cryptohash-sha256