diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,14 +3,16 @@ [![Build Status](https://travis-ci.org/Yuras/scanner.svg?branch=master)](https://travis-ci.org/Yuras/scanner) -It is often convinient to use backtracking to parse some sofisticated +On hackage: http://hackage.haskell.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. Often (actually always, but it could be too hard sometimes) you can implement your parser without any backtracking. It that case all the bookkeeping usuall parser combinators do becomes unnecessary. The -scanner libarary is designed for such cases. It is often 2 times faster +scanner library is designed for such cases. It is often 2 times faster then attoparsec. As an example, please checkout redis protocol parser included into the @@ -20,3 +22,6 @@ Benchmark results: ![Bechmark results](https://raw.githubusercontent.com/Yuras/scanner/master/bench/bench.png) + +But if you really really really need backtracking, then you can just +inject attoparsec parser into a scanner: http://hackage.haskell.org/package/scanner-attoparsec diff --git a/bench/bench.hs b/bench/bench.hs --- a/bench/bench.hs +++ b/bench/bench.hs @@ -14,6 +14,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import qualified Data.Attoparsec.ByteString as Atto +import qualified Data.Serialize.Get as Cereal import Criterion import Criterion.Main @@ -25,6 +26,10 @@ 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] + print (stringAtto smallStringInput) + print (stringScanner smallStringInput) + print (stringWordScanner smallStringInput) print (redisByteStringReply smallStringInput) print (redisAttoReply smallStringInput) print (redisScannerReply smallStringInput) @@ -35,34 +40,76 @@ print (redisAttoReply multiInput) print (redisScannerReply multiInput) defaultMain - [ bgroup "small string" - [ bench "Atto" $ whnf redisAttoReply smallStringInput - , bench "Scanner" $ whnf redisScannerReply smallStringInput - , bench "ByteString" $ whnf redisByteStringReply smallStringInput + [ bgroup "scanner" + [ bgroup "string" + [ bench "Atto" $ whnf stringAtto smallStringInput + , bench "Scanner" $ whnf stringScanner smallStringInput + , bench "WordScanner" $ whnf stringWordScanner smallStringInput + ] ] - , bgroup "long string" - [ bench "Atto" $ whnf redisAttoReply longStringInput - , bench "Scanner" $ whnf redisScannerReply longStringInput - , bench "ByteString" $ whnf redisByteStringReply longStringInput - ] + , bgroup "redis" + [ bgroup "small string" + [ bench "Atto" $ whnf redisAttoReply smallStringInput + , bench "Scanner" $ whnf redisScannerReply smallStringInput + , bench "ByteString" $ whnf redisByteStringReply smallStringInput + ] + , bgroup "long string" + [ bench "Atto" $ whnf redisAttoReply longStringInput + , bench "Scanner" $ whnf redisScannerReply longStringInput + , bench "ByteString" $ whnf redisByteStringReply longStringInput + ] - , bgroup "integer" - [ bench "Atto" $ whnf redisAttoReply intInput - , bench "Scanner" $ whnf redisScannerReply intInput - ] + , bgroup "integer" + [ bench "Atto" $ whnf redisAttoReply intInput + , bench "Scanner" $ whnf redisScannerReply intInput + ] - , bgroup "bulk" - [ bench "Atto" $ whnf redisAttoReply bulkInput - , bench "Scanner" $ whnf redisScannerReply bulkInput + , bgroup "bulk" + [ bench "Atto" $ whnf redisAttoReply bulkInput + , bench "Scanner" $ whnf redisScannerReply bulkInput + ] + + , bgroup "multi" + [ bench "Atto" $ whnf redisAttoReply multiInput + , bench "Scanner" $ whnf redisScannerReply multiInput + ] ] - , bgroup "multi" - [ bench "Atto" $ whnf redisAttoReply multiInput - , bench "Scanner" $ whnf redisScannerReply multiInput + , bgroup "cereal" + [ bench "Cereal" $ whnf binaryCereal binaryInput + , bench "Scanner" $ whnf binaryScanner binaryInput ] ] +{-# NOINLINE stringAtto #-} +stringAtto :: ByteString -> Either String () +stringAtto bs = case Atto.parse (Atto.string "+OK\r\n") bs of + Atto.Done _ _ -> Right () + Atto.Fail _ _ err -> Left err + Atto.Partial _ -> Left "Not enough input" + +{-# NOINLINE stringScanner #-} +stringScanner :: ByteString -> Either String () +stringScanner bs = case Scanner.scan (Scanner.string "+OK\r\n") bs of + Scanner.Done _ _ -> Right () + Scanner.Fail _ err -> Left err + Scanner.More _ -> Left "Not enought input" + +{-# NOINLINE stringWordScanner #-} +stringWordScanner :: ByteString -> Either String () +stringWordScanner bs = case Scanner.scan s bs of + Scanner.Done _ _ -> Right () + Scanner.Fail _ err -> Left err + Scanner.More _ -> Left "Not enought input" + where + s = do + Scanner.char8 '+' + Scanner.char8 'O' + Scanner.char8 'K' + Scanner.char8 '\r' + Scanner.char8 '\n' + {-# NOINLINE redisAttoReply #-} redisAttoReply :: ByteString -> Either String Redis.Reply redisAttoReply bs = case Atto.parse Redis.Atto.reply bs of @@ -93,3 +140,20 @@ Nothing -> Left "Not enought input" _ -> Left "Unknown type" Nothing -> Left "Not enought input" + +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 + n <- fromIntegral <$> Scanner.anyWord8 + Scanner.take n + +binaryCereal :: ByteString -> Either String ByteString +binaryCereal bs = Cereal.runGet g bs + where + g = do + n <- fromIntegral <$> Cereal.getWord8 + Cereal.getByteString n diff --git a/bench/bench.png b/bench/bench.png Binary files a/bench/bench.png and b/bench/bench.png differ diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,10 @@ + +0.2 + +* make Scanner a newtype instead of data, see https://github.com/Yuras/scanner/pull/3 +* improve `string` performance +* add `scanWith` + +0.1 + +* initial release diff --git a/lib/Scanner.hs b/lib/Scanner.hs --- a/lib/Scanner.hs +++ b/lib/Scanner.hs @@ -14,6 +14,7 @@ , scan , scanOnly , scanLazy +, scanWith , anyWord8 , anyChar8 , word8 @@ -62,6 +63,16 @@ Done _ r -> Right r Fail _ err -> Left err More more' -> go more' chunks' + +-- | Scan with the provided resupply action +scanWith :: Monad m => m ByteString -> Scanner a -> ByteString -> m (Result a) +scanWith more s input = go input (scan s) + where + go bs next = case next bs of + More next' -> do + bs' <- more + go bs' next' + res -> return res -- | Consume the next 8-bit char -- diff --git a/lib/Scanner/Internal.hs b/lib/Scanner/Internal.hs --- a/lib/Scanner/Internal.hs +++ b/lib/Scanner/Internal.hs @@ -6,14 +6,15 @@ module Scanner.Internal where -import Prelude hiding (takeWhile) +import Prelude hiding (take, takeWhile) import Data.Word import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Unsafe as ByteString (unsafeDrop) import Control.Monad -- | CPS scanner without backtracking -data Scanner a = Scanner +newtype Scanner a = Scanner { run :: forall r. ByteString -> Next a r -> Result r } @@ -145,13 +146,16 @@ {-# INLINE string #-} string :: ByteString -> Scanner () string str = Scanner $ \bs next -> - let bsL = ByteString.length bs - strL = ByteString.length str + let strL = ByteString.length str in if ByteString.isPrefixOf str bs - then next (ByteString.drop strL bs) () - else if ByteString.isPrefixOf bs str - then More $ \bs' -> run (string (ByteString.drop bsL str)) bs' next - else Fail bs "unexpected input" + then next (ByteString.unsafeDrop strL bs) () + else run slowPath bs next + where + slowPath = do + bs <- take (ByteString.length str) + if bs == str + then return () + else fail "Unexpected input" -- | Return the next byte, if any, without consuming it {-# INLINE lookAhead #-} diff --git a/scanner.cabal b/scanner.cabal --- a/scanner.cabal +++ b/scanner.cabal @@ -1,5 +1,5 @@ name: scanner -version: 0.1 +version: 0.2 synopsis: Fast non-backtracking incremental combinator parsing for bytestrings homepage: https://github.com/Yuras/scanner license: BSD3 @@ -10,7 +10,7 @@ category: Parsing build-type: Simple cabal-version: >=1.10 -extra-source-files: README.md bench/bench.png +extra-source-files: README.md changelog.md bench/bench.png description: Parser combinator library designed to be fast. It doesn't support backtracking. @@ -51,5 +51,6 @@ , bytestring , text , attoparsec + , cereal , criterion , scanner diff --git a/spec/spec.hs b/spec/spec.hs --- a/spec/spec.hs +++ b/spec/spec.hs @@ -20,6 +20,7 @@ takeSpec takeWhileSpec lookAheadSpec + scanWithSpec anyWord8Spec :: Spec anyWord8Spec = describe "anyWord8" $ do @@ -129,3 +130,17 @@ , ByteString.pack [43] ] scanLazy (anyWord8 *> lookAhead) bs `shouldBe` Right (Just 43) + +scanWithSpec :: Spec +scanWithSpec = describe "scanWith" $ do + it "should apply the scanner" $ do + let bs = ByteString.pack [42, 43] + let Just (Scanner.Done _ r) = scanWith (Just ByteString.empty) anyWord8 bs + r `shouldBe` 42 + + it "should resupply scanner when necessary" $ do + let bs = "a" + p = Scanner.anyChar8 *> Scanner.anyChar8 + + let Just (Scanner.Done _ r) = scanWith (Just "b") p bs + r `shouldBe` 'b'