redis-io 0.3 → 0.3.1
raw patch · 2 files changed
+38/−52 lines, 2 filesdep −pipesdep −pipes-attoparsecdep −pipes-parsedep ~attoparsecdep ~bytestringdep ~containers
Dependencies removed: pipes, pipes-attoparsec, pipes-parse
Dependency ranges changed: attoparsec, bytestring, containers, criterion, exceptions, hedis, mtl, network, tasty, tasty-hunit, time
Files
- redis-io.cabal +17/−20
- src/Database/Redis/IO/Connection.hs +21/−32
redis-io.cabal view
@@ -1,5 +1,5 @@ name: redis-io-version: 0.3+version: 0.3.1 synopsis: Yet another redis client. license: OtherLicense license-file: LICENSE@@ -37,22 +37,19 @@ Database.Redis.IO.Types build-depends:- attoparsec >= 0.11 && < 0.13- , auto-update >= 0.1 && < 0.2- , base >= 4.5 && < 5.0- , bytestring >= 0.9 && < 0.11- , containers == 0.5.*- , exceptions == 0.6.*- , mtl == 2.1.*- , network >= 2.5 && < 2.6+ attoparsec >= 0.12.1.2 && < 1.0+ , auto-update >= 0.1 && < 0.2+ , base >= 4.5 && < 5.0+ , bytestring >= 0.9 && < 1.0+ , containers >= 0.5 && < 1.0+ , exceptions >= 0.6 && < 1.0+ , mtl >= 2.1 && < 3.0+ , network >= 2.5 && < 3.0 , operational == 0.2.*- , pipes == 4.1.*- , pipes-attoparsec == 0.5.*- , pipes-parse == 3.0.*- , redis-resp >= 0.2 && < 0.4- , resource-pool >= 0.2 && < 0.3- , time == 1.4.*- , transformers >= 0.3 && < 0.5+ , redis-resp >= 0.2 && < 0.4+ , resource-pool >= 0.2 && < 0.3+ , time >= 1.4 && < 2.0+ , transformers >= 0.3 && < 0.5 , tinylog == 0.10.* test-suite redis-io-tests@@ -73,8 +70,8 @@ , containers , redis-io , redis-resp- , tasty == 0.8.*- , tasty-hunit == 0.8.*+ , tasty >= 0.10+ , tasty-hunit >= 0.9 , tinylog , transformers @@ -87,8 +84,8 @@ build-depends: base , bytestring- , criterion >= 1.0.0.2 && < 1.1- , hedis >= 0.6+ , criterion >= 1.0.0.2 && < 2.0+ , hedis >= 0.6 && < 1.0 , redis-io , redis-resp , tinylog
src/Database/Redis/IO/Connection.hs view
@@ -20,6 +20,7 @@ import Control.Applicative import Control.Exception import Control.Monad+import Data.Attoparsec.ByteString hiding (Result) import Data.ByteString (ByteString) import Data.ByteString.Lazy (toChunks) import Data.Foldable hiding (concatMap)@@ -34,22 +35,18 @@ import Network import Network.Socket hiding (connect, close, send, recv) import Network.Socket.ByteString (recv, sendMany)-import Pipes-import Pipes.Attoparsec-import Pipes.Parse import System.Logger hiding (Settings, settings, close) import System.Timeout -import qualified Data.ByteString as B-import qualified Data.Sequence as Seq-import qualified Network.Socket as S+import qualified Data.Sequence as Seq+import qualified Network.Socket as S data Connection = Connection { settings :: !Settings , logger :: !Logger , timeouts :: !TimeoutManager , sock :: !Socket- , producer :: IORef (Producer ByteString IO ())+ , leftover :: IORef ByteString , buffer :: IORef (Seq (Resp, IORef Resp)) } @@ -67,18 +64,10 @@ ok <- timeout (ms (sConnectTimeout t) * 1000) (S.connect s (addrAddress a)) unless (isJust ok) $ throwIO ConnectTimeout- Connection t g m s <$> newIORef (fromSock s) <*> newIORef Seq.empty+ Connection t g m s <$> newIORef "" <*> newIORef Seq.empty where mkSock = socket (addrFamily a) (addrSocketType a) (addrProtocol a) - fromSock :: Socket -> Producer ByteString IO ()- fromSock s = do- x <- lift $ recv s 4096- when (B.null x) $- lift $ throwIO ConnectionClosed- yield x- fromSock s- close :: Connection -> IO () close = S.close . sock @@ -96,37 +85,37 @@ where go a = do send c (toList $ fmap fst a)- prod <- readIORef (producer c)- foldlM fetchResult prod (fmap snd a) >>= writeIORef (producer c)+ bb <- readIORef (leftover c)+ foldlM fetchResult bb (fmap snd a) >>= writeIORef (leftover c) abort = do err (logger c) $ "connection.timeout" .= show c close c throwIO $ Timeout (show c) - fetchResult :: Producer ByteString IO () -> IORef Resp -> IO (Producer ByteString IO ())- fetchResult p r = do- (p', x) <- receiveWith p+ fetchResult :: ByteString -> IORef Resp -> IO ByteString+ fetchResult b r = do+ (b', x) <- receiveWith c b writeIORef r x- return p'+ return b' send :: Connection -> [Resp] -> IO () send c = sendMany (sock c) . concatMap (toChunks . encode) receive :: Connection -> IO Resp receive c = do- prod <- readIORef (producer c)- (p, x) <- receiveWith prod- writeIORef (producer c) p+ bstr <- readIORef (leftover c)+ (b, x) <- receiveWith c bstr+ writeIORef (leftover c) b return x -receiveWith :: Producer ByteString IO () -> IO (Producer ByteString IO (), Resp)-receiveWith p = do- (x, p') <- runStateT (parse resp) p- case x of- Nothing -> throwIO ConnectionClosed- Just (Left e) -> throwIO $ InternalError (peMessage e)- Just (Right y) -> (p',) <$> errorCheck y+receiveWith :: Connection -> ByteString -> IO (ByteString, Resp)+receiveWith c b = do+ res <- parseWith (recv (sock c) 4096) resp b+ case res of+ Fail _ _ m -> throwIO $ InternalError m+ Partial _ -> throwIO $ InternalError "partial result"+ Done b' x -> (b',) <$> errorCheck x errorCheck :: Resp -> IO Resp errorCheck (Err e) = throwIO $ RedisError e