lmdb

Minimal LMDB bindings for Haskell.
git clone git://git.ppad.tech/lmdb.git
Log | Files | Refs | README | LICENSE

Main.hs (2636B)

      1 {-# LANGUAGE BangPatterns      #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 
      4 module Main where
      5 
      6 import Control.Monad (forM_)
      7 import Criterion.Main
      8 import qualified Data.ByteString as BS
      9 import qualified Data.ByteString.Builder as BB
     10 import qualified Data.ByteString.Lazy as BSL
     11 import qualified Database.LMDB as L
     12 import System.Directory
     13   ( createDirectory
     14   , doesDirectoryExist
     15   , getTemporaryDirectory
     16   , removeDirectoryRecursive
     17   )
     18 import System.FilePath ((</>))
     19 
     20 main :: IO ()
     21 main = do
     22   tmpRoot <- getTemporaryDirectory
     23   let dir = tmpRoot </> "ppad-lmdb-bench"
     24   exists <- doesDirectoryExist dir
     25   if exists then removeDirectoryRecursive dir else pure ()
     26   createDirectory dir
     27   let flags = L.defaultEnvFlags
     28                 { L.envMapSize = 128 * 1024 * 1024
     29                 , L.envMaxDbs  = 4
     30                 }
     31   L.withEnv dir flags $ \env -> do
     32     -- pre-populate
     33     L.withWriteTxn env $ \txn -> do
     34       dbi <- L.openDbi txn Nothing True
     35       forM_ (kvs 10000) $ \(k, v) -> L.put txn dbi k v
     36     defaultMain
     37       [ bgroup "put"
     38           [ bench "1k inserts (one txn)"  $ whnfIO (insert env 1000)
     39           , bench "10k inserts (one txn)" $ whnfIO (insert env 10000)
     40           ]
     41       , bgroup "get"
     42           [ bench "1k random hits"        $ whnfIO (readN env 1000)
     43           , bench "10k random hits"       $ whnfIO (readN env 10000)
     44           ]
     45       , bgroup "cursor"
     46           [ bench "scan 10k entries"      $ whnfIO (scanAll env)
     47           ]
     48       ]
     49   removeDirectoryRecursive dir
     50 
     51 -- key/value helpers ----------------------------------------------------------
     52 
     53 kvs :: Int -> [(BS.ByteString, BS.ByteString)]
     54 kvs n = [ (mkKey i, mkVal i) | i <- [0 .. n - 1] ]
     55 
     56 mkKey :: Int -> BS.ByteString
     57 mkKey i = BSL.toStrict (BB.toLazyByteString (BB.string7 "k" <> BB.intDec i))
     58 
     59 mkVal :: Int -> BS.ByteString
     60 mkVal i = BSL.toStrict (BB.toLazyByteString (BB.string7 "v" <> BB.intDec i))
     61 
     62 -- workloads ------------------------------------------------------------------
     63 
     64 insert :: L.Env -> Int -> IO ()
     65 insert env n = L.withWriteTxn env $ \txn -> do
     66   dbi <- L.openDbi txn Nothing False
     67   forM_ (kvs n) $ \(k, v) -> L.put txn dbi k v
     68 
     69 readN :: L.Env -> Int -> IO ()
     70 readN env n = L.withReadTxn env $ \txn -> do
     71   dbi <- L.openDbi txn Nothing False
     72   forM_ [0 .. n - 1] $ \i -> do
     73     _ <- L.get txn dbi (mkKey i)
     74     pure ()
     75 
     76 scanAll :: L.Env -> IO Int
     77 scanAll env = L.withReadTxn env $ \txn -> do
     78   dbi <- L.openDbi txn Nothing False
     79   L.withCursor txn dbi $ \cur -> do
     80     let go !acc Nothing  = pure acc
     81         go !acc (Just _) = L.cursorNext cur >>= go (acc + 1)
     82     mfirst <- L.cursorFirst cur
     83     go (0 :: Int) mfirst
     84