scanner 0.2 → 0.3
raw patch · 8 files changed
+220/−8 lines, 8 files
Files
- README.md +2/−0
- bench/bench.hs +51/−6
- changelog.md +3/−0
- examples/Redis/Zepto.hs +73/−0
- lib/Scanner.hs +5/−0
- lib/Scanner/Internal.hs +72/−1
- lib/Scanner/OctetPredicates.hs +9/−0
- scanner.cabal +5/−1
README.md view
@@ -5,6 +5,8 @@ On hackage: http://hackage.haskell.org/package/scanner +On stackage: https://www.stackage.org/package/scanner+ It is often convinient to use backtracking to parse some sophisticated input. Unfortunately it kills performance, so usually you should avoid backtracking.
bench/bench.hs view
@@ -9,11 +9,13 @@ import qualified Redis.Reply as Redis import qualified Redis.Atto+import qualified Redis.Zepto import qualified Redis.Scanner import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.Attoparsec.ByteString as Atto+import qualified Data.Attoparsec.Zepto as Zepto import qualified Data.Serialize.Get as Cereal import Criterion@@ -26,19 +28,27 @@ intInput = ":123\r\n" bulkInput = "$10\r\n0123456789\r\n" multiInput = "*3\r\n+A\r\n+B\r\n+C\r\n"- binaryInput = ByteString.pack [5, 65, 66, 67, 68, 69]+ binaryInput =+ let str = ByteString.pack [5, 65, 66, 67, 68, 69]+ in ByteString.concat (replicate 10 str) print (stringAtto smallStringInput) print (stringScanner smallStringInput) print (stringWordScanner smallStringInput) print (redisByteStringReply smallStringInput) print (redisAttoReply smallStringInput)+ print (redisZeptoReply smallStringInput) print (redisScannerReply smallStringInput) print (redisAttoReply intInput)+ print (redisZeptoReply intInput) print (redisScannerReply intInput) print (redisAttoReply bulkInput)+ print (redisZeptoReply bulkInput) print (redisScannerReply bulkInput) print (redisAttoReply multiInput)+ print (redisZeptoReply multiInput) print (redisScannerReply multiInput)+ print (binaryScanner binaryInput)+ print (binaryCereal binaryInput) defaultMain [ bgroup "scanner" [ bgroup "string"@@ -51,27 +61,32 @@ , bgroup "redis" [ bgroup "small string" [ bench "Atto" $ whnf redisAttoReply smallStringInput+ , bench "Zepto" $ whnf redisZeptoReply smallStringInput , bench "Scanner" $ whnf redisScannerReply smallStringInput , bench "ByteString" $ whnf redisByteStringReply smallStringInput ] , bgroup "long string" [ bench "Atto" $ whnf redisAttoReply longStringInput+ , bench "Zepto" $ whnf redisZeptoReply longStringInput , bench "Scanner" $ whnf redisScannerReply longStringInput , bench "ByteString" $ whnf redisByteStringReply longStringInput ] , bgroup "integer" [ bench "Atto" $ whnf redisAttoReply intInput+ , bench "Zepto" $ whnf redisZeptoReply intInput , bench "Scanner" $ whnf redisScannerReply intInput ] , bgroup "bulk" [ bench "Atto" $ whnf redisAttoReply bulkInput+ , bench "Zepto" $ whnf redisZeptoReply bulkInput , bench "Scanner" $ whnf redisScannerReply bulkInput ] , bgroup "multi" [ bench "Atto" $ whnf redisAttoReply multiInput+ , bench "Zepto" $ whnf redisZeptoReply multiInput , bench "Scanner" $ whnf redisScannerReply multiInput ] ]@@ -117,6 +132,10 @@ Atto.Fail _ _ err -> Left err Atto.Partial _ -> Left "Not enough input" +{-# NOINLINE redisZeptoReply #-}+redisZeptoReply :: ByteString -> Either String Redis.Reply+redisZeptoReply = Zepto.parse Redis.Zepto.reply+ {-# NOINLINE redisScannerReply #-} redisScannerReply :: ByteString -> Either String Redis.Reply redisScannerReply bs = case Scanner.scan Redis.Scanner.reply bs of@@ -141,19 +160,45 @@ _ -> Left "Unknown type" Nothing -> Left "Not enought input" -binaryScanner :: ByteString -> Either String ByteString-binaryScanner bs = case Scanner.scan p bs of+binaryScanner :: ByteString -> Either String [ByteString]+binaryScanner bs = case Scanner.scan p' bs of Scanner.Done _ r -> Right r Scanner.Fail _ err -> Left err Scanner.More _ -> Left "Not enought input" where+ p' = do+ a0 <- p+ a1 <- p+ a2 <- p+ a3 <- p+ a4 <- p+ a5 <- p+ a6 <- p+ a7 <- p+ a8 <- p+ a9 <- p+ return [a0, a1, a2, a3, a4, a5, a6, a7, a8, a9]+ {-# INLINE p #-} p = do n <- fromIntegral <$> Scanner.anyWord8 Scanner.take n -binaryCereal :: ByteString -> Either String ByteString-binaryCereal bs = Cereal.runGet g bs+binaryCereal :: ByteString -> Either String [ByteString]+binaryCereal bs = Cereal.runGet g' bs where+ g' = do+ a0 <- g+ a1 <- g+ a2 <- g+ a3 <- g+ a4 <- g+ a5 <- g+ a6 <- g+ a7 <- g+ a8 <- g+ a9 <- g+ return [a0, a1, a2, a3, a4, a5, a6, a7, a8, a9]+ {-# INLINE g #-} g = do n <- fromIntegral <$> Cereal.getWord8- Cereal.getByteString n+ Cereal.getBytes n
changelog.md view
@@ -1,3 +1,6 @@+0.3++* add foldWhile, foldWhile1, satisfy, satisfyMaybe 0.2
+ examples/Redis/Zepto.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedStrings #-}++module Redis.Zepto+( reply+)+where++import Redis.Reply++import Prelude hiding (error)+import Data.ByteString (ByteString)+import Data.Attoparsec.Zepto (Parser)+import qualified Data.Attoparsec.Zepto as Zepto+import qualified Data.Text.Encoding as Text+import qualified Data.Text.Read as Text+import Control.Monad++{-# INLINE reply #-}+reply :: Parser Reply+reply = do+ c <- Zepto.take 1+ case c of+ "+" -> string+ "-" -> error+ ":" -> integer+ "$" -> bulk+ "*" -> multi+ _ -> fail "Unknown reply type"++{-# INLINE string #-}+string :: Parser Reply+string = String <$> line++{-# INLINE error #-}+error :: Parser Reply+error = Error <$> line++{-# INLINE integer #-}+integer :: Parser Reply+integer = Integer <$> integral++{-# INLINE integral #-}+integral :: Integral i => Parser i+integral = do+ str <- line+ case Text.signed Text.decimal (Text.decodeUtf8 str) of+ Left err -> fail (show err)+ Right (l, _) -> return l++{-# INLINE bulk #-}+bulk :: Parser Reply+bulk = Bulk <$> do+ len <- integral+ if len < 0+ then return Nothing+ else Just <$> Zepto.take len <* eol++-- don't inline it to break the circle between reply and multi+{-# NOINLINE multi #-}+multi :: Parser Reply+multi = Multi <$> do+ len <- integral+ if len < 0+ then return Nothing+ else Just <$> replicateM len reply++{-# INLINE line #-}+line :: Parser ByteString+line = Zepto.takeWhile (/= 13) <* eol++{-# INLINE eol #-}+eol :: Parser ()+eol = Zepto.string "\r\n"
lib/Scanner.hs view
@@ -27,6 +27,11 @@ , skipSpace , lookAhead , lookAheadChar8+, foldlWhile+, foldlWhile1+, satisfy+, satisfyMaybe+, decimal ) where
lib/Scanner/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RankNTypes, BangPatterns #-} {-# OPTIONS_HADDOCK not-home #-} -- | Scanner implementation@@ -11,6 +11,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.ByteString.Unsafe as ByteString (unsafeDrop)+import qualified Scanner.OctetPredicates as OctetPredicates import Control.Monad -- | CPS scanner without backtracking@@ -169,3 +170,73 @@ case ByteString.uncons bs of Just (c, _) -> next bs (Just c) _ -> next ByteString.empty Nothing++{-| Fold over the octets, which satisfy the predicate -}+{-# INLINE foldlWhile #-}+foldlWhile :: (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a+foldlWhile p step init = Scanner $ \ bs next -> let+ (l, r) = ByteString.span p bs+ state = ByteString.foldl' step init l+ in if ByteString.null r+ then More $ \ bs -> if ByteString.null bs+ then next ByteString.empty state+ else run (loop state) bs next+ else next r state+ where+ loop state = do+ chunk <- takeChunk state+ if ByteString.null chunk+ then return state+ else do+ done <- endOfInput+ if done+ then return state+ else loop (ByteString.foldl' step state chunk)+ takeChunk state = Scanner $ \ bs next ->+ let (l, r) = ByteString.span p bs+ in next r l++{-| Fold over the octets, which satisfy the predicate, ensuring that there's at least one -}+{-# INLINE foldlWhile1 #-}+foldlWhile1 :: (Word8 -> Bool) -> (a -> Word8 -> a) -> a -> Scanner a+foldlWhile1 predicate step init = do+ head <- satisfy predicate+ foldlWhile predicate step (step init head)++{-| Consume a single octet which satisfies the predicate and fail if it does not -}+{-# INLINE satisfy #-}+satisfy :: (Word8 -> Bool) -> Scanner Word8+satisfy predicate = Scanner $ \ chunk next -> case ByteString.uncons chunk of+ Just (word8, remainder) -> handleHeadAndTail word8 remainder next chunk+ Nothing -> More $ \ chunk -> case ByteString.uncons chunk of+ Just (word8, remainder) -> handleHeadAndTail word8 remainder next chunk+ Nothing -> Fail chunk "No more input"+ where+ handleHeadAndTail :: Word8 -> ByteString -> (ByteString -> Word8 -> Result r) -> ByteString -> Result r+ handleHeadAndTail word8 remainder next chunk = if predicate word8+ then if ByteString.null remainder+ then More $ \ chunk -> next chunk word8+ else next remainder word8+ else Fail chunk "Octet doesn't satisfy the predicate"++{-| Consume a single octet in case it satisfies the predicate -}+{-# INLINE satisfyMaybe #-}+satisfyMaybe :: (Word8 -> Bool) -> Scanner (Maybe Word8)+satisfyMaybe predicate = Scanner $ \ chunk next -> case ByteString.uncons chunk of+ Just (word8, remainder) -> handleHeadAndTail word8 remainder next chunk+ Nothing -> More $ \ chunk -> case ByteString.uncons chunk of+ Just (word8, remainder) -> handleHeadAndTail word8 remainder next chunk+ Nothing -> next ByteString.empty Nothing+ where+ handleHeadAndTail :: Word8 -> ByteString -> (ByteString -> Maybe Word8 -> Result r) -> ByteString -> Result r+ handleHeadAndTail word8 remainder next chunk = if predicate word8+ then if ByteString.null remainder+ then More $ \ chunk -> next chunk (Just word8)+ else next remainder (Just word8)+ else next chunk Nothing++{-| Parse a non-negative decimal number in ASCII -}+{-# INLINE decimal #-}+decimal :: Integral n => Scanner n+decimal = foldlWhile1 OctetPredicates.isDigit step 0 where+ step a w = a * 10 + fromIntegral (w - 48)
+ lib/Scanner/OctetPredicates.hs view
@@ -0,0 +1,9 @@+module Scanner.OctetPredicates+where++import Prelude+import Data.Word+++isDigit :: Word8 -> Bool+isDigit w = w - 48 <= 9
scanner.cabal view
@@ -1,5 +1,5 @@ name: scanner-version: 0.2+version: 0.3 synopsis: Fast non-backtracking incremental combinator parsing for bytestrings homepage: https://github.com/Yuras/scanner license: BSD3@@ -23,6 +23,7 @@ Scanner.Internal other-modules: Prelude Data.Either+ Scanner.OctetPredicates build-depends: base <5 , bytestring hs-source-dirs: lib, compat@@ -37,6 +38,8 @@ , bytestring , hspec , scanner+ other-modules: Prelude+ Data.Either default-language: Haskell2010 benchmark bench@@ -45,6 +48,7 @@ main-is: bench.hs other-modules: Redis.Reply Redis.Atto+ Redis.Zepto Redis.Scanner default-language: Haskell2010 build-depends: base