lmdb

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

Weight.hs (2221B)

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