hedis 0.6.10 → 0.7.0

raw patch · 5 files changed

+51/−21 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

CHANGELOG +9/−0
hedis.cabal +3/−3
src/Database/Redis.hs +3/−2
src/Database/Redis/Core.hs +27/−10
src/Database/Redis/ProtocolPipelining.hs +9/−6

CHANGELOG view

@@ -1,5 +1,14 @@ # Changelog for Hedis +## 0.7.0++* Enforce all replies being recieved in runRedis. Pipelining between runRedis +  calls doesn't work now.++## 0.6.10++* Add HyperLogLog support+ ## 0.6.4  * New connection option to automatically SELECT a database.

hedis.cabal view

@@ -1,5 +1,5 @@ name:               hedis-version:            0.6.10+version:            0.7.0 synopsis:     Client library for the Redis datastore: supports full command set,       pipelining.@@ -36,8 +36,8 @@     . license:            BSD3 license-file:       LICENSE-author:             Falko Peters-maintainer:         falko.peters@gmail.com+author:             Falko Peters <falko.peters@gmail.com>+maintainer:         Kostiantyn Rybnikov <k-bx@k-bx.com> copyright:          Copyright (c) 2011 Falko Peters category:           Database build-type:         Simple

src/Database/Redis.hs view

@@ -101,8 +101,9 @@     --  Automatic pipelining makes use of Haskell's laziness. As long as a     --  previous reply is not evaluated, subsequent commands can be pipelined.     ---    --  Automatic pipelining also works across several calls to 'runRedis', as-    --  long as replies are only evaluated /outside/ the 'runRedis' block.+    --  Automatic pipelining is limited to the scope of 'runRedis' call and+    --  it is guaranteed that every reply expected as a part of 'runRedis'+    --  execution gets received after 'runRedis` invocation.     --     --  To keep memory usage low, the number of requests \"in the pipeline\" is     --  limited (per connection) to 1000. After that number, the next command is

src/Database/Redis/Core.hs view

@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, RecordWildCards,-    MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}+    MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP #-}  module Database.Redis.Core (     Connection, connect,@@ -12,11 +12,15 @@  import Prelude import Control.Applicative-import Control.Monad.Reader+import Control.Exception (evaluate)+import Control.Monad.State import qualified Data.ByteString as B import Data.Pool import Data.Time import Network+#if __GLASGOW_HASKELL__ < 710+import Data.Traversable (traverse)+#endif  import Database.Redis.Protocol import qualified Database.Redis.ProtocolPipelining as PP@@ -32,7 +36,7 @@ -- --  In this context, each result is wrapped in an 'Either' to account for the --  possibility of Redis returning an 'Error' reply.-newtype Redis a = Redis (ReaderT (PP.Connection Reply) IO a)+newtype Redis a = Redis (StateT (PP.Connection Reply, Maybe Reply) IO a)     deriving (Monad, MonadIO, Functor, Applicative)  -- |This class captures the following behaviour: In a context @m@, a command@@ -64,15 +68,26 @@ -- |Internal version of 'runRedis' that does not depend on the 'Connection' --  abstraction. Used to run the AUTH command when connecting.  runRedisInternal :: PP.Connection Reply -> Redis a -> IO a-runRedisInternal env (Redis redis) = runReaderT redis env+runRedisInternal env (Redis redis) = do+  (r, (_, lastReply)) <- runStateT redis (env, Nothing)+  void $ traverse evaluate lastReply+  return r  +getConn :: StateT (PP.Connection Reply, Maybe Reply) IO (PP.Connection Reply)+getConn = fst <$> get+++putReply :: Reply -> StateT (PP.Connection Reply, Maybe Reply) IO ()+putReply r = modify $ \(c, _) -> (c, Just r)++ recv :: (MonadRedis m) => m Reply-recv = liftRedis $ Redis $ ask >>= liftIO . PP.recv+recv = liftRedis $ Redis getConn >>= liftIO . PP.recv  send :: (MonadRedis m) => [B.ByteString] -> m () send req = liftRedis $ Redis $ do-    conn <- ask+    conn <- getConn     liftIO $ PP.send conn (renderRequest req)  -- |'sendRequest' can be used to implement commands from experimental@@ -88,10 +103,12 @@ sendRequest :: (RedisCtx m f, RedisResult a)     => [B.ByteString] -> m (f a) sendRequest req = do-    r <- liftRedis $ Redis $ do-        conn <- ask-        liftIO $ PP.request conn (renderRequest req)-    returnDecode r+    r' <- liftRedis $ Redis $ do+        conn <- getConn+        r <- liftIO $ PP.request conn (renderRequest req)+        putReply r+        return r+    returnDecode r'   --------------------------------------------------------------------------------

src/Database/Redis/ProtocolPipelining.hs view

@@ -42,6 +42,7 @@ import           Data.Typeable import           Network import           System.IO+import           System.IO.Error import           System.IO.Unsafe  @@ -81,7 +82,7 @@ -- --  The 'Handle' is 'hFlush'ed when reading replies. send :: Connection a -> S.ByteString -> IO ()-send Conn{..} = S.hPut connHandle+send Conn{..} = ioErrorToConnLost . S.hPut connHandle  -- |Take a reply from the list of future replies. --@@ -121,12 +122,14 @@                 rs <- go rest'                 return (r:rs) -    readMore = do+    readMore = ioErrorToConnLost $ do         hFlush h -- send any pending requests-        S.hGetSome h maxRead `catchIOError` const errConnClosed+        S.hGetSome h maxRead      maxRead       = 4*1024-    errConnClosed = throwIO ConnectionLost -    catchIOError :: IO a -> (IOError -> IO a) -> IO a-    catchIOError = catch+ioErrorToConnLost :: IO a -> IO a+ioErrorToConnLost a = a `catchIOError` const errConnClosed++errConnClosed :: IO a+errConnClosed = throwIO ConnectionLost