hedis 0.1 → 0.2

raw patch · 10 files changed

+200/−164 lines, 10 filesdep +resource-poolPVP ok

version bump matches the API change (PVP)

Dependencies added: resource-pool

API changes (from Hackage documentation)

Files

• benchmark/Benchmark.hs +4/−5
• hedis.cabal +17/−18
• src/Database/Redis.hs +8/−16
• src/Database/Redis/Commands.hs +14/−15
• src/Database/Redis/Connection.hs +76/−0
• src/Database/Redis/Core.hs +69/−0
• src/Database/Redis/Internal.hs +0/−99
• src/Database/Redis/ManualCommands.hs +1/−1
• src/Database/Redis/PubSub.hs +6/−8
• src/Database/Redis/Types.hs +5/−2

@@ -19,13 +19,13 @@     ----------------------------------------------------------------------     -- Preparation     ---    conn <- connect "localhost" (PortNumber 6379)+    conn <- connect defaultConnectInfo     runRedis conn $ do+        _ <- flushall         Right _ <- mset [ ("k1","v1"), ("k2","v2"), ("k3","v3")                         , ("k4","v4"), ("k5","v5") ]-        return ()     -    disconnect conn+        return ()          ----------------------------------------------------------------------     -- Spawn clients@@ -33,7 +33,7 @@     start <- newEmptyMVar     done  <- newEmptyMVar     replicateM_ nClients $ forkIO $ do-        c <- connect "localhost" (PortNumber 6379)+        c <- connect defaultConnectInfo         runRedis c $ forever $ do             action <- liftIO $ takeMVar start             replicateM_ (nRequests `div` nClients) $ action@@ -64,4 +64,3 @@         let expected = map Just ["v1","v2","v3","v4","v5"]         True <- return $ vs == expected         return ()-        

@@ -1,5 +1,5 @@ name:               hedis-version:            0.1+version:            0.2 synopsis:     Client library for the Redis datastore: supports full command set,       pipelining.@@ -12,10 +12,7 @@     .     [Complete Redis 2.4 command set:] All Redis commands          (<http://redis.io/commands>) are available as haskell functions. The -        exceptions to the rule are a handfull of internal and debugging-        commands: MONITOR, DEBUG OBJECT, DEBUG SEGFAULT, SYNC. If needed, these-        commands can easily be implemented by the library user with the-        'sendRequest' function.+        exceptions to the rule are the MONITOR and SYNC commands.     .     [Pipelining \"Just Works\":] Commands are pipelined          (<http://redis.io/topics/pipelining>) as much as possible without any@@ -35,8 +32,12 @@ category:           Database build-type:         Simple cabal-version:      >=1.8+homepage:           https://github.com/informatikr/hedis+bug-reports:        https://github.com/informatikr/hedis/issues -bug-reports: https://github.com/informatikr/hedis/issues+source-repository head+  type:     git+  location: https://github.com/informatikr/hedis  flag benchmark     description: Build the benchmark executable.@@ -52,9 +53,11 @@                     bytestring == 0.9.*,                     bytestring-lexing == 0.2.*,                     mtl == 2.*,-                    network == 2.*+                    network == 2.*,+                    resource-pool == 0.2.0.* -  other-modules:    Database.Redis.Internal,+  other-modules:    Database.Redis.Core,+                    Database.Redis.Connection                     Database.Redis.PubSub,                     Database.Redis.Reply,                     Database.Redis.Request,@@ -64,17 +67,13 @@  executable hedis-benchmark     main-is: benchmark/Benchmark.hs-    ghc-options: -Wall -rtsopts-    ghc-prof-options: -auto-all-    if ! flag(benchmark)-        buildable: False-    else+    if flag(benchmark)         build-depends:             base >= 4,             mtl == 2.0.*,             hedis,-            time >= 1.2--source-repository head-  type:     git-  location: https://github.com/informatikr/hedis+            time >= 1.2        +    else+        buildable: False+    ghc-options: -Wall -rtsopts+    ghc-prof-options: -auto-all

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, CPP #-}+{-# LANGUAGE OverloadedStrings #-}  module Database.Redis (     @@ -6,8 +6,9 @@     Redis(), runRedis,          -- * Connection-    RedisConn, connect, disconnect,-    HostName,PortID(..),defaultPort,+    Connection, connect,+    ConnectInfo(..),defaultConnectInfo,+    HostName,PortID(..),          -- * Commands 	module Database.Redis.Commands,@@ -15,22 +16,13 @@     -- * Pub\/Sub     module Database.Redis.PubSub, -    -- * Low-Level Requests and Replies-    sendRequest,-    -- |'sendRequest' can be used to implement one of the unimplemented -    --  commands, as shown below.-    ---    -- @-    -- -- |Redis DEBUG OBJECT command-    -- debugObject :: ByteString -> 'Redis' (Either 'Reply' ByteString)-    -- debugObject key = 'sendRequest' [\"DEBUG\", \"OBJECT\", 'encode' key]-    -- @-    ---    Reply(..),Status(..),RedisResult(..)+    -- * Redis Return Types+    Reply(..),Status(..)      ) where -import Database.Redis.Internal+import Database.Redis.Core+import Database.Redis.Connection import Database.Redis.PubSub import Database.Redis.Reply import Database.Redis.Types

@@ -74,6 +74,8 @@ configResetstat, -- |Reset the stats returned by INFO (<http://redis.io/commands/config-resetstat>). configSet, -- |Set a configuration parameter to the given value (<http://redis.io/commands/config-set>). dbsize, -- |Return the number of keys in the selected database (<http://redis.io/commands/dbsize>).+debugObject, -- |Get debugging information about a key (<http://redis.io/commands/debug-object>).+debugSegfault, -- |Make the server crash (<http://redis.io/commands/debug-segfault>). flushall, -- |Remove all keys from all databases (<http://redis.io/commands/flushall>). flushdb, -- |Remove all keys from the current database (<http://redis.io/commands/flushdb>). info, -- |Get information and statistics about the server (<http://redis.io/commands/info>).@@ -158,7 +160,7 @@ watch, -- |Watch the given keys to determine execution of the MULTI/EXEC block (<http://redis.io/commands/watch>).  -- * Unimplemented Commands--- |These commands are not implemented, as of now. Library users can implement them with the 'sendRequest' function.+-- |These commands are not implemented, as of now. -- -- * EVAL (<http://redis.io/commands/eval>) --@@ -166,12 +168,6 @@ -- * MONITOR (<http://redis.io/commands/monitor>) -- ----- * DEBUG OBJECT (<http://redis.io/commands/debug-object>)--------- * DEBUG SEGFAULT (<http://redis.io/commands/debug-segfault>)------ -- * SYNC (<http://redis.io/commands/sync>) -- ) where@@ -180,7 +176,7 @@ import Data.ByteString (ByteString) import Database.Redis.ManualCommands import Database.Redis.Types-import Database.Redis.Internal+import Database.Redis.Core import Database.Redis.Reply  flushall@@ -464,6 +460,11 @@     -> Redis (Either Reply Status) slaveof host port = sendRequest (["SLAVEOF"] ++ [encode host] ++ [encode port] ) +debugObject+    :: ByteString -- ^ key+    -> Redis (Either Reply ByteString)+debugObject key = sendRequest (["DEBUG","OBJECT"] ++ [encode key] )+ getset     :: ByteString -- ^ key     -> ByteString -- ^ value@@ -748,6 +749,10 @@     :: Redis (Either Reply Status) discard  = sendRequest (["DISCARD"] ) +debugSegfault+    :: Redis (Either Reply Status)+debugSegfault  = sendRequest (["DEBUG","SEGFAULT"] )+ srandmember     :: ByteString -- ^ key     -> Redis (Either Reply ByteString)@@ -760,18 +765,12 @@   -- * Unimplemented Commands--- |These commands are not implemented, as of now. Library users can implement them with the 'sendRequest' function.+-- |These commands are not implemented, as of now. -- -- * EVAL (<http://redis.io/commands/eval>) -- -- -- * MONITOR (<http://redis.io/commands/monitor>)--------- * DEBUG OBJECT (<http://redis.io/commands/debug-object>)--------- * DEBUG SEGFAULT (<http://redis.io/commands/debug-segfault>) -- -- -- * SYNC (<http://redis.io/commands/sync>)

@@ -0,0 +1,76 @@+{-# LANGUAGE RecordWildCards #-}++module Database.Redis.Connection (+    HostName,PortID(..),+    ConnectInfo(..),defaultConnectInfo,+    Connection(), connect+) where++import Control.Applicative+import Control.Monad.Reader+import Control.Concurrent+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy.Char8 as LB+import Data.IORef+import Data.Pool+import Network (HostName, PortID(..), connectTo)+import System.IO (hClose, hIsOpen, hSetBinaryMode)++import Database.Redis.Core+import Database.Redis.Commands (auth)+import Database.Redis.Reply++-- |Information for connnecting to a Redis server.+--+-- It is recommended to not use the 'ConnInfo' data constructor directly.+-- Instead use 'defaultConnectInfo' and update it with record syntax. For+-- example to connect to a password protected Redis server running on localhost+-- and listening to the default port:+-- +-- @+-- myConnectInfo :: ConnectInfo+-- myConnectInfo = defaultConnectInfo {connectAuth = Just \"secret\"}+-- @+--+data ConnectInfo = ConnInfo+    { connectHost :: HostName+    , connectPort :: PortID+    , connectAuth :: Maybe B.ByteString+    }++-- |Default information for connecting:+--+-- @+--  connectHost = \"localhost\"+--  connectPort = PortNumber 6379 -- Redis default port+--  connectAuth = Nothing         -- No password+-- @+--+defaultConnectInfo :: ConnectInfo+defaultConnectInfo = ConnInfo+    { connectHost = "localhost"+    , connectPort = PortNumber 6379+    , connectAuth = Nothing+    }++-- |Opens a connection to a Redis server designated by the given 'ConnectInfo'.+connect :: ConnectInfo -> IO Connection+connect ConnInfo{..} = do+    let maxIdleTime    = 10+        maxConnections = 50+    Conn <$> createPool create destroy 1 maxIdleTime maxConnections+  where+    create = do+        h   <- connectTo connectHost connectPort+        rs' <- parseReply <$> {-# SCC "LB.hgetContents" #-} LB.hGetContents h+        rs  <- newIORef rs'+        let conn = (h,rs)+        maybe (return ())+            (\pass -> runRedisInternal conn (auth pass) >> return ())+            connectAuth+        hSetBinaryMode h True+        newMVar conn++    destroy conn = withMVar conn $ \(h,_) -> do+        open <- hIsOpen h+        when open (hClose h)

@@ -0,0 +1,69 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Database.Redis.Core (+    Connection(..),+    Redis(),runRedis,runRedisInternal,+    send,+    recv,+    sendRequest+) where++import Control.Applicative+import Control.Arrow+import Control.Monad.Reader+import Control.Concurrent+import qualified Data.ByteString as B+import Data.IORef+import Data.Pool+import System.IO (Handle, hFlush)++import Database.Redis.Reply+import Database.Redis.Request+import Database.Redis.Types++-- |Connection to a Redis server. Use the 'connect' function to create one.+--+--  A 'Connection' is actually a pool of network connections.+newtype Connection = Conn (Pool (MVar (Handle, IORef [Reply])))++-- |All Redis commands run in the 'Redis' monad.+newtype Redis a = Redis (ReaderT RedisEnv IO a)+    deriving (Monad, MonadIO, Functor, Applicative)++type RedisEnv = (Handle, IORef [Reply])++askHandle :: ReaderT RedisEnv IO Handle+askHandle = asks fst++askReplies :: ReaderT RedisEnv IO (IORef [Reply])+askReplies = asks snd++-- |Interact with a Redis datastore specified by the given 'Connection'.+--+--  Each call of 'runRedis' takes a network connection from the 'Connection'+--  pool and runs the given 'Redis' action. Calls to 'runRedis' may thus block, --  while all connections from the pool are in use.+runRedis :: Connection -> Redis a -> IO a+runRedis (Conn pool) redis =+    withResource pool $ \conn ->+    withMVar conn $ \conn' -> runRedisInternal conn' redis++-- |Internal version of 'runRedis' that does not depend on the 'Connection'+--  abstraction. Used to run the AUTH command when connecting. +runRedisInternal :: RedisEnv -> Redis a -> IO a+runRedisInternal env (Redis redis) = runReaderT redis env++send :: [B.ByteString] -> Redis ()+send req = Redis $ do+    h <- askHandle+    liftIO $ do+        {-# SCC "send.hPut" #-} B.hPut h $ renderRequest req+        {-# SCC "send.hFlush" #-} hFlush h++recv :: Redis Reply+recv = Redis $ do+    -- head/tail avoids forcing the ':' constructor, enabling automatic+    -- pipelining.+    rs <- askReplies+    liftIO $ atomicModifyIORef rs (tail &&& head)++sendRequest :: (RedisResult a) => [B.ByteString] -> Redis (Either Reply a)+sendRequest req = decode <$> (send req >> recv)

@@ -1,99 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Database.Redis.Internal (-    HostName,PortID(..), defaultPort,-    RedisConn(), connect, disconnect,-    Redis(),runRedis,-    send,-    recv,-    sendRequest-) where--import Control.Applicative-import Control.Monad.RWS-import Control.Concurrent-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy.Char8 as LB-import Network (HostName, PortID(..), connectTo)-import System.IO (Handle, hFlush, hClose, hIsOpen)--import Database.Redis.Reply-import Database.Redis.Request-import Database.Redis.Types----------------------------------------------------------------------------------- Connection------- |Connection to a Redis server. Use the 'connect' function to create one.------  A 'RedisConn' can only be used by a single thread at a time. This means that---  calls to 'runRedis' or 'disconnet' may block when the 'RedisConn' is shared---  between multiple threads.-data RedisConn = Conn (MVar (Handle, [Reply]))--withConn :: RedisConn-         -> (Handle -> [Reply] -> IO ([Reply], a))-         -> IO a-withConn (Conn conn) f = do-    (h,rs)     <- takeMVar conn-    (rs',a) <- f h rs-    putMVar conn (h,rs')-    return a---- |Opens a connection to a Redis server at the given host and port.-connect :: HostName -> PortID -> IO RedisConn-connect host port = do-    h       <- connectTo host port-    replies <- parseReply <$> LB.hGetContents h-    Conn <$> newMVar (h, replies)---- |Close the given connection.------  May block when the given 'RedisConn' is shared between multiple threads. The--- 'RedisConn' can not be re-used.-disconnect :: RedisConn -> IO ()-disconnect conn = withConn conn $ \h rs -> do-    open <- hIsOpen h-    when open (hClose h)-    return (rs, ())---- | The Redis default port 6379. Equivalent to @'PortNumber' 6379@.-defaultPort :: PortID-defaultPort = PortNumber 6379----------------------------------------------------------------------------------- The Redis Monad----newtype Redis a = Redis (RWST Handle () [Reply] IO a)-    deriving (Monad, MonadIO, Functor, Applicative)---- |Interact with a Redis datastore specified by the given 'RedisConn'.------  May block when the given 'RedisConn' is shared between multiple threads.-runRedis :: RedisConn -> Redis a -> IO a-runRedis conn (Redis redis) = withConn conn $ \h rs -> do-    open <- hIsOpen h-    if open-        then do-            (a,rs',_) <- runRWST redis h rs-            return (rs',a)-        else error "Redis: disconnected"--send :: [B.ByteString] -> Redis ()-send req = Redis $ do-    h <- ask-    liftIO $ do-        B.hPut h $ renderRequest req-        hFlush h--recv :: Redis Reply-recv = Redis $ do-    -- head/tail avoids forcing the ':' constructor, enabling automatic-    -- pipelining.-    rs <- get-    put (tail rs)-    return (head rs)---- |Sends a request to the Redis server, returning the 'decode'd reply.-sendRequest :: (RedisResult a) => [B.ByteString] -> Redis (Either Reply a)-sendRequest req = decode <$> (send req >> recv)

@@ -4,7 +4,7 @@  import Prelude hiding (min,max) import Data.ByteString (ByteString)-import Database.Redis.Internal+import Database.Redis.Core import Database.Redis.Reply import Database.Redis.Types 

@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Database.Redis.PubSub (     publish,     pubSub,@@ -13,8 +12,7 @@ import Control.Monad.Writer import Data.ByteString.Char8 (ByteString) import Data.Maybe-import Database.Redis.Internal (Redis)-import qualified Database.Redis.Internal as Internal+import qualified Database.Redis.Core as Core import Database.Redis.Reply import Database.Redis.Types @@ -37,9 +35,9 @@ publish     :: ByteString -- ^ channel     -> ByteString -- ^ message-    -> Redis (Either Reply Integer)+    -> Core.Redis (Either Reply Integer) publish channel message =-    Internal.sendRequest ["PUBLISH", channel, message]+    Core.sendRequest ["PUBLISH", channel, message]  -- |Listen for messages published to the given channels --  (<http://redis.io/commands/subscribe>).@@ -94,15 +92,15 @@ pubSub     :: PubSub                 -- ^ Initial subscriptions.     -> (Message -> IO PubSub) -- ^ Callback function.-    -> Redis ()+    -> Core.Redis () pubSub p callback = send p 0   where     send (PubSub cmds) pending = do-        mapM_ Internal.send cmds+        mapM_ Core.send cmds         recv (pending + length cmds)      recv pending = do-        reply <- Internal.recv        +        reply <- Core.recv                 case decodeMsg reply of             Left cnt                 | cnt == 0 && pending == 0

@@ -1,5 +1,5 @@-{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances,-        TypeSynonymInstances, OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances, OverlappingInstances, TypeSynonymInstances,+    OverloadedStrings #-}  module Database.Redis.Types where @@ -8,8 +8,10 @@ import Data.ByteString.Char8 (ByteString, pack) import Data.ByteString.Lex.Double (readDouble) import Data.Maybe+ import Database.Redis.Reply + ------------------------------------------------------------------------------ -- Classes of types Redis understands --@@ -41,6 +43,7 @@     decode = Right  instance RedisResult ByteString where+    decode (SingleLine s)  = Right s     decode (Bulk (Just s)) = Right s     decode r               = Left r