hedis 0.7.10 → 0.8.0

raw patch · 5 files changed

+74/−38 lines, 5 filesdep +scannerdep +textdep −attoparsecPVP ok

version bump matches the API change (PVP)

Dependencies added: scanner, text

Dependencies removed: attoparsec

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• hedis.cabal +3/−2
• src/Database/Redis/Protocol.hs +51/−23
• src/Database/Redis/ProtocolPipelining.hs +6/−6
• test/Test.hs +10/−7

@@ -1,5 +1,9 @@ # Changelog for Hedis +## 0.8.0++* Major speed improvement by using non-backtracking parser (PR #69)+ ## 0.7.10  * Improved performance (PR #64)

@@ -1,5 +1,5 @@ name:               hedis-version:            0.7.10+version:            0.8.0 synopsis:     Client library for the Redis datastore: supports full command set,     pipelining.@@ -63,10 +63,11 @@   if flag(dev)     ghc-prof-options: -auto-all   exposed-modules:  Database.Redis-  build-depends:    attoparsec >= 0.12,+  build-depends:    scanner >= 0.2,                     base >= 4.6 && < 5,                     bytestring >= 0.9,                     bytestring-lexing >= 0.5,+                    text,                     deepseq,                     mtl >= 2,                     network >= 2,

@@ -9,11 +9,14 @@ import Control.Applicative #endif import Control.DeepSeq-import Data.Attoparsec.ByteString (takeTill)-import Data.Attoparsec.ByteString.Char8 hiding (takeTill)+import Scanner (Scanner)+import qualified Scanner import Data.ByteString.Char8 (ByteString) import GHC.Generics import qualified Data.ByteString.Char8 as B+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Read as Text+import Control.Monad (replicateM)  -- |Low-level representation of replies from the Redis server. data Reply = SingleLine ByteString@@ -48,36 +51,61 @@ ------------------------------------------------------------------------------ -- Reply parsers ---reply :: Parser Reply+{-# INLINE reply #-}+reply :: Scanner Reply reply = do-  c <- anyChar+  c <- Scanner.anyChar8   case c of-    '+' -> singleLine+    '+' -> string     '-' -> error     ':' -> integer     '$' -> bulk-    '*' -> multiBulk+    '*' -> multi     _ -> fail "Unknown reply type" -singleLine :: Parser Reply-singleLine = SingleLine <$> (takeTill isEndOfLine <* endOfLine)+{-# INLINE string #-}+string :: Scanner Reply+string = SingleLine <$> line -error :: Parser Reply-error = Error <$> (takeTill isEndOfLine <* endOfLine)+{-# INLINE error #-}+error :: Scanner Reply+error = Error <$> line -integer :: Parser Reply-integer = Integer <$> (signed decimal <* endOfLine)+{-# INLINE integer #-}+integer :: Scanner Reply+integer = Integer <$> integral -bulk :: Parser Reply+{-# INLINE bulk #-}+bulk :: Scanner Reply bulk = Bulk <$> do-    len <- signed decimal <* endOfLine-    if len < 0-        then return Nothing-        else Just <$> take len <* endOfLine+  len <- integral+  if len < 0+    then return Nothing+    else Just <$> Scanner.take len <* eol -multiBulk :: Parser Reply-multiBulk = MultiBulk <$> do-    len <- signed decimal <* endOfLine-    if len < 0-        then return Nothing-        else Just <$> count len reply+-- don't inline it to break the circle between reply and multi+{-# NOINLINE multi #-}+multi :: Scanner Reply+multi = MultiBulk <$> do+  len <- integral+  if len < 0+    then return Nothing+    else Just <$> replicateM len reply++{-# INLINE integral #-}+integral :: Integral i => Scanner i+integral = do+  str <- line+  case Text.signed Text.decimal (Text.decodeUtf8 str) of+    Left err -> fail (show err)+    Right (l, _) -> return l++{-# INLINE line #-}+line :: Scanner ByteString+line = Scanner.takeWhileChar8 (/= '\r') <* eol++{-# INLINE eol #-}+eol :: Scanner ()+eol = do+  Scanner.char8 '\r'+  Scanner.char8 '\n'

@@ -23,7 +23,7 @@ import           Prelude import           Control.Exception import           Control.Monad-import           Data.Attoparsec.ByteString+import qualified Scanner import qualified Data.ByteString as S import           Data.IORef import           Data.Typeable@@ -116,11 +116,11 @@       ~(r, rest') <- unsafeInterleaveIO $ do         -- Force previous reply for correct order.         previous `seq` return ()-        parseResult <- parseWith readMore reply rest-        case parseResult of-          Fail{}       -> errConnClosed-          Partial{}    -> error "Hedis: parseWith returned Partial"-          Done rest' r -> do+        scanResult <- Scanner.scanWith readMore reply rest+        case scanResult of+          Scanner.Fail{}       -> errConnClosed+          Scanner.More{}    -> error "Hedis: parseWith returned Partial"+          Scanner.Done rest' r -> do             -- r is the same as 'head' of 'connPending'. Since we just             -- received r, we remove it from the pending list.             atomicModifyIORef' connPending $ \(_:rs) -> (rs, ())

@@ -437,14 +437,17 @@         scriptFlush                             >>=? Ok         -- start long running script from another client         configSet "lua-time-limit" "100"        >>=? Ok-        liftIO $ do-            _ <- fork $ runRedis conn $ do-                -- we must pattern match to block the thread-                Left _ <- eval "while true do end" [] []-                    :: Redis (Either Reply Integer)-                return ()-            threadDelay 500000 -- 0.5s+        evalFinished <- liftIO newEmptyMVar+        void $ liftIO $ fork $ runRedis conn $ do+            -- we must pattern match to block the thread+            Left _ <- eval "while true do end" [] []+                :: Redis (Either Reply Integer)+            liftIO (putMVar evalFinished ())+            return ()+        liftIO (threadDelay 500000) -- 0.5s         scriptKill                              >>=? Ok+        () <- liftIO (takeMVar evalFinished)+        return ()  ------------------------------------------------------------------------------ -- Connection