monarch 0.8.0.0 → 0.8.1.1

raw patch · 5 files changed

+63/−19 lines, 5 filesdep +criterionPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion

API changes (from Hackage documentation)

Files

• Database/Monarch.hs +1/−1
• Database/Monarch/Binary.hs +16/−3
• monarch.cabal +3/−2
• test/benchmark.hs +31/−13
• test/specs.hs +12/−0

@@ -11,7 +11,7 @@     , runMonarchPool     , ExtOption(..), RestoreOption(..), MiscOption(..)     , Code(..)-    , put, putKeep, putCat, putShiftLeft+    , put, putKeep, putCat, putShiftLeft, multiplePut     , putNoResponse     , out     , get, multipleGet

@@ -1,8 +1,9 @@ {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-} -- | TokyoTyrant Original Binary Protocol(<http://fallabs.com/tokyotyrant/spex.html#protocol>). module Database.Monarch.Binary     (-      put, putKeep, putCat, putShiftLeft+      put, putKeep, putCat, putShiftLeft, multiplePut     , putNoResponse     , out     , get, multipleGet@@ -21,7 +22,7 @@ import Data.Maybe import qualified Data.Binary as B import Data.Binary.Put (putWord32be, putByteString)-import Data.ByteString hiding (length, copy)+import Data.ByteString.Char8 hiding (length, copy, init, last) import Control.Applicative import Control.Monad import Control.Monad.Error@@ -47,6 +48,16 @@       response Success = return ()       response code = throwError code +-- | Store records.+--   If a record with the same key exists in the database,+--   it is overwritten.+multiplePut :: ( MonadBaseControl IO m+               , MonadIO m ) =>+               [(ByteString,ByteString)] -- ^ key & value pairs+            -> MonarchT m ()+multiplePut [] = return ()+multiplePut kvs = void $ misc "putlist" [] (kvs >>= \(k,v)->[k,v])+ -- | Store a new record. --   If a record with the same key exists in the database, --   this function has no effect.@@ -408,7 +419,9 @@       putOptions opts       putWord32be . fromIntegral $ length args       putByteString func-      mapM_ putByteString args+      mapM_ (\arg -> do+               putWord32be $ lengthBS32 arg+               putByteString arg) args     response Success = do       siz <- fromIntegral <$> parseWord32       replicateM siz parseBS

@@ -1,5 +1,5 @@ name:                monarch-version:             0.8.0.0+version:             0.8.1.1 synopsis:            Monadic interface for TokyoTyrant. description:         This package provides simple monadic interface for TokyoTyrant. license:             BSD3@@ -66,7 +66,7 @@   build-depends:       base ==4.*                      , doctest ==0.8.* -test-suite benchmark+benchmark benchmark   if flag(develop)     buildable:         True   else@@ -86,3 +86,4 @@                      , tokyotyrant-haskell ==1.0.*                      , transformers ==0.3.*                      , transformers-base ==0.4.*+                     , criterion ==0.6.*

@@ -1,27 +1,45 @@ {-# LANGUAGE OverloadedStrings #-}-import Database.Monarch-+import Criterion.Main+import qualified Database.Monarch as Monarch import qualified Database.TokyoTyrant.FFI as FFI-import Control.Monad import Data.ByteString.Char8 ()  main :: IO ()-main = monarch+main = defaultMain+       [ bgroup "TokyoTyrant (multiple put)"+         [ bench "monarch" $ nfIO mmonarch+         , bench "tokyotyrant-haskell" $ nfIO mffi+         ]+       , bgroup "TokyoTyrant (put)"+         [ bench "monarch" $ nfIO monarch+         , bench "tokyotyrant-haskell" $ nfIO ffi+         ]+       ] +size :: Int+size = 10000+ ffi :: IO () ffi = do   Right conn <- FFI.open "localhost" 1978-  forM_ [1..1000::Int] $ \_ -> do-    FFI.put conn "foo" "bar"-    FFI.get conn "foo"-    return ()+  FFI.put conn "foo" "bar"   FFI.close conn +mffi :: IO ()+mffi = do+  Right conn <- FFI.open "localhost" 1978+  FFI.mput conn $ replicate size ("foo", "bar")+  FFI.close conn+ monarch :: IO () monarch = do-  withMonarchConn "localhost" 1978 $ runMonarchConn $ do-         forM_ [1..1000::Int] $ \_ -> do-            put "foo" "bar"-            get "foo"-            return ()+  Right () <- Monarch.withMonarchConn "localhost" 1978 $+              Monarch.runMonarchConn $+              Monarch.put "foo" "bar"+  return ()++mmonarch :: IO ()+mmonarch = do+  Right () <- Monarch.withMonarchConn "localhost" 1978 $ Monarch.runMonarchConn $+         Monarch.multiplePut $ replicate size ("foo", "bar")   return ()

@@ -13,6 +13,8 @@          describe "put" $ do            it "store a record" casePutRecord            it "overwrite a record if same key exists" casePutOverwriteRecord+         describe "mput" $ do+           it "store records" caseMputRecord          describe "putkeep" $ do            it "store a new record" casePutKeepNewRecord            it "has no effect if same key exists" casePutKeepNoEffect@@ -77,6 +79,16 @@         put "foo" "bar"         put "foo" "hoge"         get "foo"++caseMputRecord :: Assertion+caseMputRecord =+    action `returns` Right (Just "bob", Just "bar")+    where+      action = do+        multiplePut [("foo","bar"),("alice","bob")]+        bob <- get "alice"+        bar <- get "foo"+        return (bob, bar)  casePutKeepNewRecord :: Assertion casePutKeepNewRecord =