Add benchmark for inserts
This commit is contained in:
parent
6d3f617dd2
commit
79b88ddeb5
2 changed files with 50 additions and 0 deletions
26
Benchmark.hs
Normal file
26
Benchmark.hs
Normal file
|
@ -0,0 +1,26 @@
|
||||||
|
import Criterion.Main
|
||||||
|
|
||||||
|
import Control.Monad (forM_, void)
|
||||||
|
import qualified Database.MongoDB as M
|
||||||
|
import Data.Bson (Document, Field(..), Label, Val, Value(String, Doc, Bool),
|
||||||
|
Javascript, at, valueAt, lookup, look, genObjectId, (=:),
|
||||||
|
(=?))
|
||||||
|
|
||||||
|
import Database.MongoDB.Query
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
main = defaultMain [
|
||||||
|
bgroup "insert" [ bench "100" $ nfIO doInserts ]
|
||||||
|
]
|
||||||
|
|
||||||
|
doInserts = do
|
||||||
|
let docs = (flip map) [0..100] $ \i ->
|
||||||
|
["name" M.=: (T.pack $ "name " ++ (show i))]
|
||||||
|
|
||||||
|
pipe <- M.connect (M.host "127.0.0.1")
|
||||||
|
|
||||||
|
forM_ docs $ \doc -> do
|
||||||
|
void $ M.access pipe M.master "mongodb-haskell-test" $ M.insert "bigCollection" doc
|
||||||
|
|
||||||
|
M.close pipe
|
|
@ -73,3 +73,27 @@ test-suite test
|
||||||
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions: OverloadedStrings
|
default-extensions: OverloadedStrings
|
||||||
|
|
||||||
|
Benchmark bench
|
||||||
|
main-is: Benchmark.hs
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
Build-depends: array -any
|
||||||
|
, base < 5
|
||||||
|
, binary -any
|
||||||
|
, bson >= 0.3 && < 0.4
|
||||||
|
, text
|
||||||
|
, bytestring -any
|
||||||
|
, containers -any
|
||||||
|
, mtl >= 2
|
||||||
|
, cryptohash -any
|
||||||
|
, network -any
|
||||||
|
, parsec -any
|
||||||
|
, random -any
|
||||||
|
, random-shuffle -any
|
||||||
|
, monad-control >= 0.3.1
|
||||||
|
, lifted-base >= 0.1.0.3
|
||||||
|
, transformers-base >= 0.4.1
|
||||||
|
, hashtables >= 1.1.2.0
|
||||||
|
, criterion
|
||||||
|
default-language: Haskell2010
|
||||||
|
default-extensions: OverloadedStrings
|
||||||
|
|
Loading…
Reference in a new issue