redis 0.12 → 0.12.1
raw patch · 6 files changed
+48/−75 lines, 6 filesdep +concurrent-extraPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: concurrent-extra
API changes (from Hackage documentation)
- Database.Redis.Monad: r_lock_cnt :: Redis -> MVar (Maybe (ThreadId, Int))
+ Database.Redis.Monad: fromRMultiBulk' :: (Monad m, BS s) => Reply s -> m [s]
- Database.Redis.Monad: Redis :: MVar (Maybe (ThreadId, Int)) -> MVar () -> IORef RedisState -> Redis
+ Database.Redis.Monad: Redis :: RLock -> IORef RedisState -> Redis
- Database.Redis.Monad: r_lock :: Redis -> MVar ()
+ Database.Redis.Monad: r_lock :: Redis -> RLock
Files
- Benchmark.hs +17/−3
- Database/Redis/Internal.hs +12/−47
- Database/Redis/Monad.hs +2/−1
- Database/Redis/Redis.hs +5/−1
- redis-2.0.conf +0/−18
- redis.cabal +12/−5
Benchmark.hs view
@@ -2,8 +2,13 @@ Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com> License: MIT -}+{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ < 702 import System (getArgs)+#else+import System.Environment (getArgs)+#endif import System.Exit (exitFailure, exitSuccess) import System.Console.GetOpt import Data.Time.Clock@@ -14,7 +19,7 @@ makeConnections :: Int -> String -> String -> Int -> IO [Redis] makeConnections count host port db = mapM mkConn [0 .. (count - 1)]- where mkConn n = do r <- connect host port+ where mkConn _ = do r <- connect host port select r db return r @@ -84,10 +89,17 @@ optDatabase :: Int, optClients :: Int, optRequests :: Int,+ optWorkers :: Int, optHelp :: Bool} deriving Show -defaultOpts = Opt localhost defaultPort 6 50 100000 False+defaultOpts = Opt { optHost = localhost,+ optPort = defaultPort,+ optDatabase = 6,+ optClients = 50,+ optRequests = 100000,+ optWorkers = 50,+ optHelp = False } options :: [OptDescr (Opt -> Opt)] options = [Option ['h'] ["host"] (OptArg (maybe id (\h o -> o{optHost = h})) "HOSTNAME") ("Server hostname (default " ++ localhost ++ ")"),@@ -95,6 +107,7 @@ Option ['d'] ["database"] (OptArg (maybe id (\d o -> o{optDatabase = read d})) "DATABASE") "Database number (default 6)", Option ['c'] ["clients"] (OptArg (maybe id (\c o -> o{optClients = read c})) "CLIENTS") "Number of parallel connections (default 50)", Option ['n'] ["requests"] (OptArg (maybe id (\n o -> o{optRequests = read n})) "REQUESTS") "Total number of requests (default 100000)",+ Option ['w'] ["workers"] (OptArg (maybe id (\n o -> o{optWorkers = read n})) "WORKERS") "Number of worker threads (default 50)", Option [] ["help"] (NoArg (\o -> o{optHelp = True})) "Show this usage info"] main :: IO ()@@ -116,7 +129,8 @@ select r $ optDatabase opts flushDb r - rs <- makeConnections (optClients opts) (optHost opts) (optPort opts) (optDatabase opts)+ rs' <- makeConnections (optClients opts) (optHost opts) (optPort opts) (optDatabase opts)+ let rs = take (optWorkers opts) $ concat $ repeat rs' t <- runWorkers rs (optRequests opts) worker_set printResult "set" (optRequests opts) t
Database/Redis/Internal.hs view
@@ -8,7 +8,7 @@ import Prelude hiding (putStrLn, putStr, catch) import Control.Concurrent (ThreadId, myThreadId)-import Control.Concurrent.MVar+import qualified Control.Concurrent.RLock as RLock import Data.IORef import qualified System.IO as IO import System.IO.UTF8 (putStrLn, putStr)@@ -43,16 +43,14 @@ } -- | Redis connection descriptor-data Redis = Redis {r_lock_cnt :: MVar (Maybe (ThreadId, Int)),- r_lock :: MVar (),+data Redis = Redis {r_lock :: RLock.RLock, r_st :: IORef RedisState} deriving Eq newRedis :: (String, String) -> IO.Handle -> IO Redis-newRedis server h = do lcnt <- newMVar Nothing- l <- newMVar ()+newRedis server h = do l <- RLock.new st <- newIORef $ RedisState server 0 h 0 Map.empty- return $ Redis lcnt l st+ return $ Redis l st -- | Redis command variants data Command = CInline ByteString@@ -111,52 +109,19 @@ {-# INLINE hPutRn #-} takeState :: Redis -> IO RedisState-takeState r = block $ do lcnt <- takeMVar $ r_lock_cnt r- mytid <- myThreadId- case lcnt of- Nothing -> do l <- tryTakeMVar $ r_lock r- when (isNothing l)- $ error "takeState: r_lock_cnt is Nothing BUT r_lock is locked"- take_n_put mytid 1- Just (tid, cnt) -> if tid == mytid- then let !cnt' = cnt + 1- in take_n_put tid cnt'- else do putMVar (r_lock_cnt r) lcnt- l <- takeMVar $ r_lock r- lcnt <- takeMVar $ r_lock_cnt r- when (isJust lcnt)- $ error "takeState: r_lock is locked by me BUT r_lock_cnt is not Nothing"- take_n_put mytid 1- where take_n_put tid cnt = do st <- readIORef $ r_st r- putMVar (r_lock_cnt r) $ Just (tid, cnt)- return st+takeState r = block $ do RLock.acquire $ r_lock r+ readIORef $ r_st r putState :: Redis -> RedisState -> IO ()-putState r s = block $ do lcnt <- takeMVar $ r_lock_cnt r+putState r s = block $ do lstate <- RLock.state $ r_lock r mytid <- myThreadId- case lcnt of- Nothing -> error "putState: trying put state that was not took"- Just (tid, cnt) -> if tid /= mytid- then error "putState: trying put state that was not took by me"- else do writeIORef (r_st r) s- if cnt > 1- then let !cnt' = cnt - 1- in putMVar (r_lock_cnt r) $ Just (tid, cnt')- else do putMVar (r_lock r) ()- putMVar (r_lock_cnt r) Nothing+ case lstate of+ Just (mytid, _) -> do writeIORef (r_st r) s+ RLock.release $ r_lock r+ otherwise -> error "putState: trying put state that was not took" putStateUnmodified :: Redis -> IO ()-putStateUnmodified r = block $ do lcnt <- takeMVar $ r_lock_cnt r- mytid <- myThreadId- case lcnt of- Nothing -> error "putState: trying put state that was not took"- Just (tid, cnt) -> if tid /= mytid- then error "putState: trying put state that was not took by me"- else if cnt > 1- then let !cnt' = cnt - 1- in putMVar (r_lock_cnt r) $ Just (tid, cnt')- else do putMVar (r_lock r) ()- putMVar (r_lock_cnt r) Nothing+putStateUnmodified r = RLock.release $ r_lock r inState :: Redis -> (RedisState -> IO (RedisState, a)) -> IO a inState r action = bracketOnError (takeState r) (\_ -> putStateUnmodified r)
Database/Redis/Monad.hs view
@@ -22,7 +22,8 @@ R.sortDefaults, R.fromRInline, R.fromRBulk, R.fromRMulti, R.fromRMultiBulk,- R.fromRInt, R.fromROk, R.noError, R.parseMessage, R.takeAll,+ R.fromRMultiBulk', R.fromRInt, R.fromROk, R.noError, R.parseMessage,+ R.takeAll, -- * Database connection R.localhost, R.defaultPort,
Database/Redis/Redis.hs view
@@ -3,7 +3,7 @@ License: MIT -} -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies,+{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts, OverloadedStrings, BangPatterns #-} -- | Main Redis API and protocol implementation@@ -229,10 +229,14 @@ socket_unix :: String -> IO S.Socket socket_unix path =+#if CABAL_OS_WINDOWS+ error "UNIX Sockets is unsupported on Windows platform"+#else do s <- S.socket S.AF_UNIX S.Stream S.defaultProtocol S.setSocketOption s S.KeepAlive 0 S.connect s (S.SockAddrUnix path) return s+#endif -- | Close connection disconnect :: Redis -> IO ()
− redis-2.0.conf
@@ -1,18 +0,0 @@-daemonize yes-timeout 300-loglevel warning-logfile stdout-databases 2--# No snapshots-# save 900 1-# save 300 10-# save 60 10000--dir ./--# requirepass foobared-appendonly no-hash-max-zipmap-entries 64-hash-max-zipmap-value 512-activerehashing yes
redis.cabal view
@@ -1,5 +1,5 @@ Name: redis-Version: 0.12+Version: 0.12.1 License: MIT Maintainer: Alexander Bogdanov <andorn@gmail.com> Author: Alexander Bogdanov <andorn@gmail.com>@@ -14,7 +14,7 @@ . This library is a Haskell driver for Redis. It's tested with current git version and with v2.4.6 of redis server. It also- tested with v2.2 and v2.0 and basic functions are works correctly+ tested with v2.2 and basic functions are works correctly but not all of them. . You can use Test module from the source package to run unit@@ -40,6 +40,12 @@ - Fixed compilation with GHC 7.2 (and hopefully with more recent versions too), thanks Ben Gamari and Sean Hess for reporting. .+ - Using RLock from concurrent-extra fixes multithreading issues,+ thanks Dmitry Dzhus for reporting+ .+ - Hopefully, fix building on Windows (untested), thanks Piotr+ Staszewski and Alexander Dorofeev+ . Stability: beta Build-Type: Simple@@ -55,12 +61,13 @@ Test/ZSetCommands.hs, Test/HashCommands.hs, Test/MultiCommands.hs, Test/SortCommands.hs, Test/Monad/CASCommands.hs, Test/Monad/MultiCommands.hs,- redis-2.0.conf, redis-2.2.conf,- Benchmark.hs+ redis-2.2.conf,+ Benchmark.hs Library Build-Depends: base < 5, containers, bytestring, utf8-string,- network, mtl, old-time, MonadCatchIO-mtl+ network, mtl, old-time, MonadCatchIO-mtl,+ concurrent-extra Exposed-modules: Database.Redis.Redis Database.Redis.Monad Database.Redis.ByteStringClass