scanner-0.3/0000755000000000000000000000000013334255311011173 5ustar0000000000000000scanner-0.3/changelog.md0000644000000000000000000000033413334255311013444 0ustar00000000000000000.3 * add foldWhile, foldWhile1, satisfy, satisfyMaybe 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 scanner-0.3/Setup.hs0000644000000000000000000000005613334255311012630 0ustar0000000000000000import Distribution.Simple main = defaultMain scanner-0.3/LICENSE0000644000000000000000000000277013334255311012206 0ustar0000000000000000Copyright (c) 2016, Yuras Shumovich All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Yuras Shumovich nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. scanner-0.3/README.md0000644000000000000000000000227313334255311012456 0ustar0000000000000000# scanner Fast non-backtracking incremental combinator parsing for bytestrings [![Build Status](https://travis-ci.org/Yuras/scanner.svg?branch=master)](https://travis-ci.org/Yuras/scanner) 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. 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 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 repo, both using attoparsec and scanner libraries: https://github.com/Yuras/scanner/tree/master/examples/Redis 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 scanner-0.3/scanner.cabal0000644000000000000000000000370413334255311013614 0ustar0000000000000000name: scanner version: 0.3 synopsis: Fast non-backtracking incremental combinator parsing for bytestrings homepage: https://github.com/Yuras/scanner license: BSD3 license-file: LICENSE author: Yuras Shumovich maintainer: shumovichy@gmail.com copyright: (c) Yuras Shumovich 2016 category: Parsing build-type: Simple cabal-version: >=1.10 extra-source-files: README.md changelog.md bench/bench.png description: Parser combinator library designed to be fast. It doesn't support backtracking. source-repository head type: git location: git@github.com:Yuras/scanner.git library exposed-modules: Scanner Scanner.Internal other-modules: Prelude Data.Either Scanner.OctetPredicates build-depends: base <5 , bytestring hs-source-dirs: lib, compat ghc-options: -O2 default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: spec, compat main-is: spec.hs build-depends: base , bytestring , hspec , scanner other-modules: Prelude Data.Either default-language: Haskell2010 benchmark bench type: exitcode-stdio-1.0 hs-source-dirs: bench, examples, compat main-is: bench.hs other-modules: Redis.Reply Redis.Atto Redis.Zepto Redis.Scanner default-language: Haskell2010 build-depends: base , bytestring , text , attoparsec , cereal , criterion , scanner scanner-0.3/examples/0000755000000000000000000000000013334255311013011 5ustar0000000000000000scanner-0.3/examples/Redis/0000755000000000000000000000000013334255311014057 5ustar0000000000000000scanner-0.3/examples/Redis/Zepto.hs0000644000000000000000000000274513334255311015524 0ustar0000000000000000{-# 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" scanner-0.3/examples/Redis/Scanner.hs0000644000000000000000000000276513334255311016016 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Redis.Scanner ( reply ) where import Scanner (Scanner) import qualified Scanner import Redis.Reply import Prelude hiding (error) import Data.ByteString (ByteString) import qualified Data.Text.Encoding as Text import qualified Data.Text.Read as Text import Control.Monad {-# INLINE reply #-} reply :: Scanner Reply reply = do c <- Scanner.anyChar8 case c of '+' -> string '-' -> error ':' -> integer '$' -> bulk '*' -> multi _ -> fail "Unknown reply type" {-# INLINE string #-} string :: Scanner Reply string = String <$> line {-# INLINE error #-} error :: Scanner Reply error = Error <$> line {-# INLINE integer #-} integer :: Scanner Reply integer = Integer <$> integral {-# INLINE bulk #-} bulk :: Scanner Reply bulk = Bulk <$> do len <- integral if len < 0 then return Nothing else Just <$> Scanner.take len <* eol -- don't inline it to break the circle between reply and multi {-# NOINLINE multi #-} multi :: Scanner Reply multi = Multi <$> 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' scanner-0.3/examples/Redis/Reply.hs0000644000000000000000000000036313334255311015510 0ustar0000000000000000 module Redis.Reply ( Reply (..) ) where import Data.Int import Data.ByteString (ByteString) data Reply = String ByteString | Error ByteString | Integer Int64 | Bulk (Maybe ByteString) | Multi (Maybe [Reply]) deriving (Show, Eq) scanner-0.3/examples/Redis/Atto.hs0000644000000000000000000000261413334255311015325 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Redis.Atto ( reply ) where import Redis.Reply import Prelude hiding (error) import Data.ByteString (ByteString) import Data.Attoparsec.ByteString (Parser) import qualified Data.Attoparsec.ByteString as Atto (takeTill) import qualified Data.Attoparsec.ByteString.Char8 as Atto hiding (takeTill) import Control.Monad {-# INLINE reply #-} reply :: Parser Reply reply = do c <- Atto.anyChar 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 bulk #-} bulk :: Parser Reply bulk = Bulk <$> do len <- integral if len < 0 then return Nothing else Just <$> Atto.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 <$> Atto.count len reply {-# INLINE integral #-} integral :: Integral i => Parser i integral = Atto.signed Atto.decimal <* eol {-# INLINE line #-} line :: Parser ByteString line = Atto.takeTill (== 13) <* eol {-# INLINE eol #-} eol :: Parser () eol = void $ Atto.string "\r\n" scanner-0.3/spec/0000755000000000000000000000000013334255311012125 5ustar0000000000000000scanner-0.3/spec/spec.hs0000644000000000000000000000776213334255311013427 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import Scanner import Prelude hiding (take, takeWhile) import Data.Either import qualified Data.ByteString as ByteString import qualified Data.ByteString.Lazy as Lazy.ByteString import Test.Hspec main :: IO () main = hspec $ do anyWord8Spec stringSpec takeSpec takeWhileSpec lookAheadSpec scanWithSpec anyWord8Spec :: Spec anyWord8Spec = describe "anyWord8" $ do it "should return the current byte" $ do let bs = ByteString.pack [42, 43] scanOnly anyWord8 bs `shouldBe` Right 42 it "should consume the current byte" $ do let bs = ByteString.pack [42, 43] scanOnly (anyWord8 *> anyWord8) bs `shouldBe` Right 43 let bs' = Lazy.ByteString.fromChunks [ ByteString.pack [42] , ByteString.pack [43] , ByteString.pack [44] ] scanLazy (anyWord8 *> anyWord8 *> anyWord8) bs' `shouldBe` Right 44 it "should ask for more input" $ do let bs = Lazy.ByteString.fromChunks [ ByteString.pack [42] , ByteString.pack [43] ] scanLazy (anyWord8 *> anyWord8) bs `shouldBe` Right 43 it "should fail on end of input" $ do let bs = ByteString.empty scanOnly anyWord8 bs `shouldSatisfy` isLeft stringSpec :: Spec stringSpec = describe "string" $ do it "should consume the string" $ do let bs = "hello world" scanOnly (string "hello" *> anyWord8) bs `shouldBe` Right 32 it "should ask for more input" $ do let bs = Lazy.ByteString.fromChunks [ "hel" , "lo" ] scanLazy (string "hello") bs `shouldBe` Right () it "should fail on wrong input" $ do let bs = "helo world" scanOnly (string "hello") bs `shouldSatisfy` isLeft takeSpec :: Spec takeSpec = describe "take" $ do it "should return the first n bytes" $ do let bs = "hello world" scanOnly (take 5) bs `shouldBe` Right "hello" it "should ask for more input" $ do let bs = Lazy.ByteString.fromChunks [ "he" , "l" , "lo world" ] scanLazy (take 5) bs `shouldBe` Right "hello" it "should fail on end of input" $ do let bs = "hell" scanOnly (take 5) bs `shouldSatisfy` isLeft let bs' = Lazy.ByteString.fromChunks [ "he" , "l" , "l" ] scanLazy (take 5) bs' `shouldSatisfy` isLeft takeWhileSpec :: Spec takeWhileSpec = describe "takeWhile" $ do it "should return bytes according to the predicate" $ do let bs = "hello world" scanOnly (takeWhile (/= 32)) bs `shouldBe` Right "hello" it "should ask for more input" $ do let bs = Lazy.ByteString.fromChunks [ "he" , "l" , "lo world" ] scanLazy (takeWhile (/= 32)) bs `shouldBe` Right "hello" it "should return everything is predicate where becomes False" $ do let bs = "hello" scanOnly (takeWhile (/= 32)) bs `shouldBe` Right "hello" lookAheadSpec :: Spec lookAheadSpec = describe "lookAhead" $ do it "should return the next byte" $ do let bs = ByteString.pack [42, 43] scanOnly lookAhead bs `shouldBe` Right (Just 42) it "should return Nothing on end of input" $ do let bs = ByteString.empty scanOnly lookAhead bs `shouldBe` Right Nothing it "should not consume input" $ do let bs = ByteString.pack [42, 43] scanOnly (lookAhead *> anyWord8) bs `shouldBe` Right 42 it "should ask for more input" $ do let bs = Lazy.ByteString.fromChunks [ ByteString.pack [42] , 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' scanner-0.3/bench/0000755000000000000000000000000013334255311012252 5ustar0000000000000000scanner-0.3/bench/bench.hs0000644000000000000000000001462113334255311013671 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import qualified Scanner 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 import Criterion.Main main :: IO () main = do let smallStringInput = "+OK\r\n" longStringInput = "+11111111111111111111111111122222222222222222222233333333333333333333333444444444444444444445555555555555555555555666666666666666666677777777777777777777888888888888888888888999999999999999999000000000000000000\r\n" intInput = ":123\r\n" bulkInput = "$10\r\n0123456789\r\n" multiInput = "*3\r\n+A\r\n+B\r\n+C\r\n" 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" [ bench "Atto" $ whnf stringAtto smallStringInput , bench "Scanner" $ whnf stringScanner smallStringInput , bench "WordScanner" $ whnf stringWordScanner smallStringInput ] ] , 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 ] ] , 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 Atto.Done _ r -> Right r 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 Scanner.Done _ r -> Right r Scanner.Fail _ err -> Left err Scanner.More _ -> Left "Not enought input" {-# NOINLINE redisByteStringReply #-} redisByteStringReply :: ByteString -> Either String Redis.Reply redisByteStringReply bs = case ByteString.uncons bs of Just (c, bs') -> case c of 43 -> let (l, r) = ByteString.span (/= 13) bs' in case ByteString.uncons r of Just (c', bs'') -> case c' of 13 -> case ByteString.uncons bs'' of Just (c'', _) -> case c'' of 10 -> Right (Redis.String l) _ -> Left "Unexpected input" Nothing -> Left "Not enough input" _ -> Left "Unexpected input" 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 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 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.getBytes n scanner-0.3/bench/bench.png0000644000000000000000000010547013334255311014046 0ustar0000000000000000PNG  IHDRsBIT|dtEXtSoftwaregnome-screenshot> IDATx{\Tu?0#h^PPTK9؀a_ku ^(jn. i,iZmcfe*^@*f~Ќ3܀ 8|>uӶ;g>#RjdDDDDDDTy$""""""<El"6DDDDDDdG""""""#Y摈,bHDDDDDDI^Xx#Y;䰪_Qe k- Y80Xg`m:O#Y摈,bHDDDDDDy$""""""<QѥK{Gh<ErXW~wGD w """"jcHޙAK$y#]VVM hעv=`!(ˡ{ Ќ%aH?H}:O]3Wcw8og;rf_^qO\B'>s9uݸKũ/USDDDDTS3f@~~> v܉EAV=vժU2e ||| .F F1ݺupuu*1v`*H$Rlr;Ju G"iQ*E:igo!=G/ĖP|Hu9x)36;ϟ!==J;PPTPT8tMsjϹw^ƚ<* f\]]QPP(Fzz:JKK{w(6 rÊ98_tLJ_Ⱦ]"cw;m#s8:&aL,! ot.mB]9b*Ex9 7#]oa &xevk;pm -,+}=,+}=pF w,Zpz _DEE'Nķ~ zjL0.\Ei},cjTTN>hlڴI{N㫬2d,XPU:tfffbҤIPlW|lOq#R1fEsXj;c=!v]ERDFg1\\{iy^-ʫ{qliY ze̗|kM'A^^^?K`Z uNCuXX5o蝿`mԨQڟM-8a#l{ޓxL:u1~xY~}еkWl$KHç஘L6|yzo>'J~<}զ9Ʀ*;Vmc ށJgf\%ȿ|qb/,{+l>TQۣJĹHo>Z^„~i9HL4$6*+vÅfCDDDXʲe'Oƚ5kp]t SLw$m7ƻ/L OҎr\7M3=F o=.S-}uj: ԿY]MglߒĢ5146:i`آtl n;+ʿ 9m’-GѣC BDDDDeee; AHHcXE6yVؗ} e%!!2][cKH:Ok8?f<' U_"h{ǩ !`Z uk- R*Uoŋ[=w51;fm'p^[?օlDDDDDd;lFn@"""""QDDDDDDd>3g`ʕXt`ٌeFDD 5n\0k 88X4ª#;DDDDDdqGFzz:v̸qk7n6n܈qΝ;غu+^}U1B{Τ$=zD^Us9"""0m4 4dL=&;k,@$a0`q̘1Xvx[G"""""1MdTd2bԨQHMMn իQVVft. 6`޼y]PPX wwǎY|<:t _)66ׯGBB>j\\Ak~/..ʕ+1yd_^_S5k@"VxVr r""" رcoڴ) 77ӧOGƍ!JM1HIIСCedd_~Fٰax???bܻwŸsvvv6֮]˗/CR0ư^HJJnR)))5oGrX? t&6DDDD[zD"g''DΘ1P(رcqA̚51;wĢE4wtVmV”)SX\qQX]5m|-c\ڽT_DDDDd/ӡT*w^Rڵfn8< RaPPTPT8tPZʪꊂDEEh~Cuܽ{M6W~#芊ӧM6!&&F=33'NDEE94ߣ "22*Ǽ&3y„ Xz5&L .b:!C` 5;|qҤIPFsقH{ϓ1Z=ϽfZ0Xg`Sj@l>]Z#hR9s`ԩ["""}ZyVy$""""j`FvwwYl#'Oƚ5kp]t SLsyhQyyҠn|9 g|$.CթMEDDDDedC!!! \lUg[l"PRaOebM-m|ܔzg!֮9ƿPyNJ9p0Şxw{,)EҖpB1mؑ}ЮEzbB}7J`/|#Wonwkp8p̯d~ԚjGYm5e)sl_-G9ܦG "[BG5Mƭ{J|9}f e)RPDDBfJǟ|nL^fb~8>g$YΛ!8f{;7\u_zԛ;^nX=}|cjXoHNTοvb=L,& .1>|i#7'ft1|duc8)?[#иX=G0Էncgq*~=0,^Ԛ죮*HXkaa: #4Xy{y5,ҏòPxc=!vis",o+u{ 0{`*H$l,4=Zߣ5Fu}^/jMQ%w0Xg`SjmrQl P!U@y~ι U -j@ݯ5Y'00F_pԆ- 3q{a3q~8?nMx>޾U;rpa9^{}7KJ֣8~&jϧq(PcvFwśyủE{Ìf; ebH"<_0Şڶy.cs{Z ]eu0Xg`Sj@dR?9l)"" -kcUG3/^1y&/Wv KHCBduD?W'6ªG(Xkaa: >Ժ6@e}ᇈ8̙3Xr%.]jt{JSY۪t ܹWxgDu#)4T@ppij=bnDDDD4=xr9nݺ˗#//]tik׮aҥx"x si) rD"DFFB*`ܹFܼy+V:u*Zl{֬YHIIH$1`5f]V/.\ƍ??""ӦMàAL:m6ԛs40^^^HNNnOMML&Cjj*FT ^eeeFذa͛Xpw7~?zjx{{kϫ+Wɓ~zAAAXf $Ķmлwoڽ4\]]QPP(id la{I/""""B1piDGGcӦMnĉQQQath$&&b…4ʪᘨ(`ҤI8qℶ3uq4ij5bkk2 ,@hhXRlH:YCW>Q`Z uN}u]Gk)J̙3SN珈@||<|||o>cu-sȢg~jdٲe6ɓfܽ{ݺuÔ)Sj\Uell,{GBBBbF;G""""žR֭ Ha""""#9,uZ>aHI׷QarɆ#QRƏ6\l0YB@1?IHH#‚G~o$"""rV'pwXIɿ=FTYc7kIKMYBVl;ݷxS%SMW nA#,䜿UsYbi-;s f͚U14M+Y5Ol ͥɶѴq#ŞwpCI̵6 }:C,)} osY#>>1@pppPUխg~OD"&J{ ķ#>(m'p86¸A^xOG,d~5÷7+I${I[~ ֶ9bGAM^M @Y˶,|ס+KHÜ~t09c^)Ee9 ̵o(Bgοʿa^O@3Fq!l9Sݱb_C.&3k2\(*o݇ڶ9%N _'7/ه.ѣ@.֭[X|9ХKL6 nnnv.]/70:掤B\.H$Bdd$R)qܹFh~5kRRR 0~x 0@oDDMAYu̘1Xv\ƘG}V;)Nc@$m9 XA6-'>ǿ7?ڮ=%>3}W)rR`gl|w("x"Yߌywl 3\ Xf&C3V1?Rf3lX,EmHDzc nWSL=~sGq#1Bݱb{va=᫽(WQpGc(-3Bw";\%x?ͬ,A'm Rܻ=-B高^Lz}xyy;BZ uk- Y8ucǎ!##CiӦ\L>7T*6]"%%Cņ ׯYB~ι U -j@}nEzz:J%݋X7QZZ]vCÇ(,,JGQQQVgݽ{U爪~Nds$qqqxcwqp \Тm!`Z uN}uVV1}9ETbΜ9:u*<==9gDD}i43/^1 dkbw N}%ڷ;#و>{{Ge˖ zɓ'c͚5{.u)Sz4uAX;,{GwBBBbv摈TUk""""""jXxV7T*6"%%C~=v / 6L{ױ:rssd > <#ժuUoHh''6͘1P(رcqAb9%PQQX Һ6}Arr2|||i8GЈ"==J{վ(--Ů]ΡyqyBRc'"==zj P*AAA⁲YR-btk#]&R|ƅL 6:n̳X'"=,|h 큯~iܾƌ4^U{Y:k/to'Us9d i3R&exNJ9p0Şxw{9 [#E J%wzrnq!l9Sݱb_C.ժQCeTO9{5͊wǖ0SݾJ;cC9Ɋ?je*si:#(ېEpkfM7#_Z k{OlnmpA\]+ᕾpu8Rpsxyy;BZ uk- Y80rјsePb~86"ϕ٘W1EaT>9@12vD":p o? 0rԄb'캵Szc ku܀,! iR|aZg k- Y80Xg°sy O\B_>P!U`{9shw7:+ E;Pl1UR_O_XKY5\%ȿ|.Q Qyv<,És70m#6/ ~iٜt ܹWxgDQ]X>Ȉ!3mRDD@.-G]0}C%.IoýuS{G""""zXZw̚5VshJ]dsDlΉx́,@}dsD|ljLsnHOOǃ q-,_yyyҥ M777\v K.ŋoKs'PP@.C$!22R@e8w\1ƍƍ1n8ܹs[nū#F<6T5#""0m4 4A?k*Sq-"""2B.#""^^^1b׿RSS!Ǐ#55sEjj*㧟~2:Ɔ pBރT*EAAb1t ,E_Fؼ&FGV""""xtgرcoڴr\L>7T*Ejj9Cj@~;bC`` b1ܹck< twwL֭[WWWm"H?,f̘|( ر8xr$c?~:H$BEEb1JeU_b׀P*ػw/bccHOOGii)vevcÇQXXJ*iժT*?Z< G"""""1etEEEӈƦMݞ'HLL… itUc7q㐜hy`Ȑ!X`BCC^gC R%rqqqŋ9IÐ///{hXkaa: >:++ g5~LT*1gL:vQUofVuڭ%|!3F-[f GrXgnV弝ј""":*++⟸7 zk*PDDDDUbMcH˭| Bo!&""""V"6DDDDDDdQxlUPsfYab9|dT/GpmS1H 2;b|(ּ`ٌe,!Ӛknz BJ=1JDDD`>.ZIl#"" ı ⁲YR-btk#]&R|ƅL 6:ٚyA$aB|;=c<=կ ؘQqƫj< Y_Gv1d`.,! sFAdL=&;o?VlρH/ o^lGxݼ]6 d~  ˷khy>R6KMa6DDDD0rmIGs4{wl 39x)36;jQN wm'.!-,>~Ρkx+n=UTj .v$yyy =Ba: ,P묬,:4sOбcG >G?FΝ1|p:t[lARRʏ0lM?i$Ġ{ARRXcsi/^l?ZhlڴI]`Gl:~„ Xz5z-\p%j$w;9͛#66-[ļyn.ッ R ggg5\d[lwFw<ú_&yDDD䐲)6nV;Qbl"ky$բ}V<7VaHkpgg{G """"rQDDDDD bHDDDDDDy$""""""GrX?UO4!}#y$U>>bH˫X)+lI""""rLla5i$.:xˑ!""""""me i% yJfY&hض8bLJ6"if3Ui8vkHj-JDŽ?c+6W nA#,䜿Uyցjd_O^@H#,kZ5R,!M?P@5&[l"PRaOebn[ցjGGzbBb2ވ_3ScïgpǮE:Qc}=J_g;sqT}˔Npi7LvM7#+?z5*-@sX>k?8K8wNN"tm-cuvql2N_bۭd^^^``Z uk- ~lsepu֟R$٘Ww[3"9,ꏽ'`hHN".fGkD5ZM\pT~I]vjװFHwtjpWIc "t51" fgvM37:+ E;Pl1UR_O[^y*Y5\%ȿ|.Q Qyvc52TZVmGΡO| <0Us.eȽp 669ծ*7芑Bd'/ %뉌GTF| }usډ_r/cK>cK.^ׄAv"vbĽg:QVؗ} {G;YB"ߵ5v$jaY&'ʿ .v*1U]qqq a*E!]==`Z uk- 643/^1usX#3}s_ -Έ>^#YB\$bL UGtvտ pG ka:Ql""""""r\l">J AWʯDDDD<úv_腄DDDDD5V6Yl*6䰞n.V`Y摈,c*JJAP?xZ ,RkO"MDVvd#4Ѐ`SjV6DD GrXN.. j_Z uN]ZZ͏a""`HӤI \zm۶w,^WCT;Qs"6DDDDDDdGd i%}"""""ͣ maN],Ƥ_La/UibNkCcǰb{dNDDDDdl !21O Xs2r)O\BiYCDDDDDˡW[ܱz}'6,e9qI[~ ֶ9bGAMp>} E%mt.ĭg~OD"&J{ ķ#`+X3FܸKũ/USFc8DbOл=hsQ7{zYt˥_9# `6YlE J%wzrn3UG"""""=}Qxwl 39x)36;~Ib|ߝI'};P."%~ǚ$XdO\J#yᘬIɊOJV~QqWͷ M^Aơkcdffkе1<^9< '[URVui5퍒alkΗkux/{*i/8 ]ڸ':m)يTUsپ=ؠ\~; V*[>Μ/UځѕC{Bՙ+Vfwj}Uf5@4G3 45*;]zaIY՚LծBMV; 5ڧc8Veųج1{ٍ,VsW)X_B.+Ҕ_Tq\tU:H˔5Ҷ׶&%+i ҺJޞ7IJ֔}(I9bFo tm z6Nso||8W,33Aύ;9s꽏GTޙ&[{zByEN_Pd9f`\ek>0*6Lb˪Ys6ǣh l+4;W(--U~f tm z6Ns^ZjvhVJ1;(1;kcгq X}^^!''Gݻw7;Wkcгq}͎#nE*sWHSJ ln/vG۵թF ޡ^=U7gGukUn_`KםoפZh˸=Cn ђq*-pûk7i򝒤}y'kQxpky2]Oũ_X{-W[ Z ڽU^̵tHX+㹶 ߵnj{5j~znMkqNWY'];3F#OwV>AZW].\u4VFʡ u1v%a热J;x\;Pw@? s͛#t,w0tmH#x 6=A1պ,{֪@,ӿ;8.Fٶ}z@|6c띡!|%I>]\J9Ǣ ńi̐W&Ҍ(&7q>;9@RPPPc6Fff&Aơkcгyřǚb{-*)+׺ÚFIRZ5[K˵rǁ:p 1o#*vEtjrZ{薧d+GPVe`r9)+&[Uc֗l&%*)+WIi2rO}$I{uԲ'k[$Iv{埯o~bfwj}Uf5@4G3 45*;]zaIY՚LծBMV; 5ڧc8Ve3hج1{ٍ,欏C"&]h\%f_I-ްOO]<Oo$ysetρn4ubʂu@Evik[4ibzi]a%oяs%\ek>̖(I9bARF_"I璸Htm z6]w9s{y3;~dkOO?Hө V3 lc5lM5cSQue,9kGay#ldMJ](7G/vkxTF9ޡ#Ҥ!*Іۖ2eXX\opC7o4ϱ5oN=Tnm5hoP͕X}t[.T3zhDZQ-KUr9ַ&%뙱ъe75_f"ĄWo~YOWϐ6#ktѡ^=hr٪n lsPw}4M׽z/+ݣ|%@)Uϐ6j*eWø]8H<{AOmH=`j0Gg6='22^CƠg4{=kUX,w&q\2m9"^0mړ;CCJ|},eUgÕdsG@ _ {N4jy&Lξ1A Ҙ!=44:qm6='33_ @ơkcгyn=ɖlk]aM{{$X{-ۚZUSѩ};h֋[A[5ۃ 溺0oUY_էrH=.$ڧ:b ޡskw=&%*)+WIi2rO}\X=xexzY*#Z~w $MMzm+Np|}"^Xg}Gz;D>Ӭ}+PBMUsu+5s9DŽj?6kuv.K}Ú{_]yqgҾCzuԝz]5&M4qjMFkw*q\i=hZ5vߔ5Ҷ׶&%+i ҺJޞ7IJv%}/- 7诿E4Okq>ߣDI#LH}8tm z,_RI^zZs18tm znߙ̙S}A;~dkOO?Hө V3 lc5l Ú?_==<ٵ7=4QaH7|ilZX=}Z[6;Wkcsm~m\0{05;#~_۵Tv-/Ҵ/n#مzz@ip=4h4#x 6Fdd]CƠg0<6eZ_V$Q"}-G_?M{X$Xdov{UJhǪ'y{9^R4е1233 tm z6]e(g>ْrK;ioo$ke[u\+ws `5>rZ NnWD6W-OYy'5aުzg}{^ϙϜ/UځѲNmv?eNgۢ;h֋\AW @՛T5Wu,ͼ>ڜYIQyO KR̢oH\oWI l֘=ծg1ݽ>gǫ{U/*藿ЅK4k+69]eߕSjgvZ@Ӳ؝]fcʂu@EvikIJ4D1=.G~u]Ubb$iĔq)q})ы]ߡ8tm z6]w9s{̽3ozByEN_Pd9fctnMՌ Ө0chfx#-G[\ eIj%Kp&^/;z: Xޣ^IᱞɳfG yyyܹ'um2;^' |J4\LEYKFk`&npce2;W-Εq;TvkƪfG{ M>dv |}BiiZha^8gM;>`xǚgBAABBBL;~j^ƴx ߨhn1<`MJ5)Ь0<`Pk)n{HSo>U5VC)%.ޢ{^imzJ?x”\zH4s6-QOsP5ޡv냧t MN9Ȼ:K>ْsdgJ4wړ[^!m4k@ujREz_;[xFrgrxC,뭑I6otǿ'FoLŢu5)YόV\nF*I:}TY#jB;^|/}]ۿ?^nԀ]=~%@3A"[;?=r[]?}& B[ƥvcLSiYӵ]W:)ԳcQ1Z`Kw͑zseFdž%վdՕQ n^W1azse}jQ3w܀ѯvjwzoh\o SJQ=9|5g&%*)+WIi2rO}$I{uԲ^~XS I+|]UuPSC^cT5Wu,ͼk$i6ghkkT^aw}’==%uUcB55fpzg:wN{Фa-G[ kRIɦQsxNm=T) ׻\J]uatw62cxI}=y%i>nqIRӗiURZnxWq&["ɖlP&?S˿՞" iYcSۖ/*ڡ3zldӵg?ۖ2eXX\oMiO~{j&QhV zOV͵})=FI^wCѷѺÊ ZIzflwu|*RTuwڷ3ęG8n lsPw}4ڮ?|UiKv!=QU9ssd\gs\_jU9ǯu)ԯJDumTny܌QKunRzuԩsڗwۙ]qCqCÕg 1;נkcгq"##͎8tm z6c3YldCdX*wg k)ԳHxp'ã,+쒤'q}q5vpL֤d'%++4#x 6='33^CƠg0<6#=ɖlk]aM{{ײ:_Z;Թ=o#*vEtjS빶o|imAw$ TJkEzwonSnZ=sTiFWϏҎ U\RVVNj¼U.Ewв+<%[=cx4A՛T5Wu,ͼk$i6ghkk* \zaIYUs+45ڲYH?߭OMh\Wl?t≳%ֆZ?w5/t6"MEwiI l֘=\nf]9<vfjn3ezͺ{"JRbb$c{#f6ƵcJsWq%33.CƠyΜ9އpLW@U[ ltA>jWq]q|[#<ϛKkcе1g:Fm ^qܶ+H4 ~Ǻ6fG . tm z9$-G[ x#ڮ'( hIC>g<ـ4wݴt8tCfk3h~aK=%Blֹ eN3%[-R65v:mb-!m#GPYC%Iϕ/+ҔuD[[#u_hT:÷ݨ;T=1zse|,=~G֯KwշÙG'HTvzz\t9>~vMK34-Ҳ k9v~?y~3q.)IڗwR~ -~ _mWtYC?EtT5~znMkqNW{;3F#OwV>AZW]w-zwz?oWM3u,򰒺6dU>:$iwN@? [5o ֛+5:6L>/%P؛ХWbWN>JWsvܸ]5_) 6ѸzrT?jxTNR:TxVv>*6T~zC~m~U5?0GHHFdd=AơkcгyhٳVWb83byHmχiӞ|=?>seT^aE%eʼh>͸kK1AK[Irz\_bƒ1Czh{_itlr>|f5@1A8koVqg}y)((`4Hff&iz6]CƠgpj '[URVui5!^˶f|iV8Pj=}RݮNmj=A/-ײ-?T0MR\+R+PM~tr :=5)Y_VIYJJ˕{B[]'IܫmקԷ6H*?__g<ـ4V3GqIRӗiURZnt<Wq["ɖlP&?S˿՞" iYcSۖ/*ڡ3zldӵg?ۖ2eXX\oMiO~{j<[K6fѸ:Y|AoޯnA~ֺܳ55Yht9$iCѷѺÊ ךU;}^CEVVVvy4cNOܾ;uO߮I#Жqi{%TZVt-w'o&;%INע j9ܤN5灛Nu54|6;Aq:ݧfIZz@ctJޞS5nt^<~aX3,@6dU>:$iwN@? s892XoL0}\$חQ>:sT7,_Ζ4뫩fQKunRڵԟHӾB==f4nh;:Y2]CƠgе1< &[Uտ ߝIEl[H=>L񱵞SǕT^aE%eW~Ě9ЎUNMsUMEhb|Pql6=AU '[URVui5퍒alkΗkuSGNk)UԦy*%Jʵ")+&[U뱚9Μ/UځѲNmv?5kne[/wtyJ{5hGTKUӬ}{\[̻.j͙W؝D|_$E,Fvzɪ;qJR|Lfc Q95sJEp}^b{rMgۦYjWN&_مjStbkŔ5ks$&&JC ?7е18tm z6]/n$I?{l[uθ]<n֌mxFw[3tOd܅2f']WH;PڶT~Q^c#8ٶ-ސ)ŢzknM{WѸZ1K x~=p 㞵֭oWɚgF+WTqy i#?I>F*I:}TY#jB;^|-/}]ۿ?^nԀex2]>nץ^ @̣.SQqu5ix2.mаCdzJ*ڽA|$i_IZܺ>A4灛u)<

޼% >5s2[EZoܧպޱ>1RG~'x0vNE~_[]p汊.'iCF^[Hvٱ ӨP-\`2]cs\_:WGRtC|},*:[h9tՈ~]+P+ГۤGzktlRQQ*;J:VgPYUN3*6T~zC~m~U5_0g6='22^CƠg0^uH*Ǣ򆿘(&P8tm z6Nff&CƠgpjb{-*)+׺ÚFIRZ5[K˵rǁ:p So#*vEtjڜYIQyO KR̢oH\o:;?[[oPq%)>&T3Ycg9&ъ8w&_r8.}y'u߫kx>=u'ݚ8or3SC @ӱ.ި&1ezͺ{"%GILL$;pqxRUJuXq.=3=Aύ;9so&3;~jvI'kbxeXe͎%tm6=7R##<־o^3;8ރADU^Aύ:##<֭^eA8 sn1<bx{VzoC~!4Gx]?T.?n F'L1UfaxْsdG۵թF eM{K;=~{ m/I<~vM I/NOKҋiyb^{x^Ye}y'kQxŏ{HQՙgzrT?jxT+u1mȫ|^,InuToС³n?T%:1##ivAƠgе18tm z6c3faiٳV?ߥw PLx|},DJ IDATu޹tӞ|=?>7vi'4f BƠgе18tm z66c{uԲ*)+ÚIRl }ui5uv{埯wSѩM23P%e:qDe)4-fl} ]*g׽Vï4vYg\=~z#y&[gaMJvzj56ZNJ/ܠ#1dд,޸H`f=P]ښ^%I?I̱ng+䘡 hе18tm z6]w9s{ޙS#0bxeX'ΚMkfG<#x*N7ncJiJ:V-c`7?S˿՞" iYcSۖK>ْsdG۵թF eM{K>!m#GPYC]ٟ'FoLŢu @̣սck}0c~1^tg;uO߮I#Ж!Qqq|Izq -Ok+v̲/|- n-Ie|?=x߸Oy'x'^Т_LNw @̣RQQ*Ǵ!#y[TohD$}~JQ:C Ϫn3KKV%)n@WEr =Mz4Fdž]㍊ Us[oh'0Gdd]CƠgе1< @Y-qҌ(&:﮺iO[mE1A Ҙ!=44:6e/ϷrmgxC;233qе18tm z6]eܫmVIY֧Է6Hb{-K;ioosWϯ+|]RݮNm*Yea\'ԾuuDC;t 6WNWh}z3ryWYyiL^3zd|?[V3Nװ&%׺dU&ъ8w&_r8.=ޕ|mh'nw8x) k٥Q]bb$ǟ5V$Fɸt8tm z6]CƠyΜ9އ7yw!\ p#-qui#؞fG<#<ր#bxp#-G[|TFwiڶmVn[zo8W=K|7[jɒ%:zzG}T={tcgƔK*77W8(~NOOt:bUr`aLْ/trri ByteString -> Either String a scanOnly s bs = go (scan s bs) where go res = case res of Done _ r -> Right r Fail _ err -> Left err More more -> go (more ByteString.empty) -- | Scan lazy bytestring by resupplying scanner with chunks scanLazy :: Scanner a -> Lazy.ByteString -> Either String a scanLazy s lbs = go (scan s) (Lazy.ByteString.toChunks lbs) where go more chunks = let (chunk, chunks') = case chunks of [] -> (ByteString.empty, []) (c:cs) -> (c, cs) in case more chunk of 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 -- -- It fails if end of input {-# INLINE anyChar8 #-} anyChar8 :: Scanner Char anyChar8 = w2c <$> anyWord8 -- | Consume the specified word or fail {-# INLINE word8 #-} word8 :: Word8 -> Scanner () word8 w = do w' <- anyWord8 unless (w' == w) $ fail "unexpected word" -- | Consume the specified 8-bit char or fail {-# INLINE char8 #-} char8 :: Char -> Scanner () char8 = word8 . c2w -- | Take input while the predicate is `True` {-# INLINE takeWhileChar8 #-} takeWhileChar8 :: (Char -> Bool) -> Scanner ByteString takeWhileChar8 p = takeWhile (p . w2c) -- | Return the next byte, if any, without consuming it {-# INLINE lookAheadChar8 #-} lookAheadChar8 :: Scanner (Maybe Char) lookAheadChar8 = fmap w2c <$> lookAhead -- | Skip any input while the preducate is `True` {-# INLINE skipWhile #-} skipWhile :: (Word8 -> Bool) -> Scanner () skipWhile = void . takeWhile -- | Skip space {-# INLINE skipSpace #-} skipSpace :: Scanner () skipSpace = skipWhile isSpaceWord8 {-# INLINE isSpaceWord8 #-} isSpaceWord8 :: Word8 -> Bool isSpaceWord8 w = w == 32 || w <= 13 {-# INLINE w2c #-} w2c :: Word8 -> Char w2c = unsafeChr . fromIntegral {-# INLINE c2w #-} c2w :: Char -> Word8 c2w = fromIntegral . Char.ord scanner-0.3/lib/Scanner/0000755000000000000000000000000013334255311013332 5ustar0000000000000000scanner-0.3/lib/Scanner/Internal.hs0000644000000000000000000001711613334255311015450 0ustar0000000000000000{-# LANGUAGE RankNTypes, BangPatterns #-} {-# OPTIONS_HADDOCK not-home #-} -- | Scanner implementation module Scanner.Internal where 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 qualified Scanner.OctetPredicates as OctetPredicates import Control.Monad -- | CPS scanner without backtracking newtype Scanner a = Scanner { run :: forall r. ByteString -> Next a r -> Result r } -- | Scanner continuation type Next a r = ByteString -> a -> Result r -- | Scanner result data Result r -- | Successful result with the rest of input = Done ByteString r -- | Scanner failed with rest of input and error message | Fail ByteString String -- | Need more input | More (ByteString -> Result r) -- | Run scanner with the input scan :: Scanner r -> ByteString -> Result r scan s bs = run s bs Done instance Functor Scanner where {-# INLINE fmap #-} fmap f (Scanner s) = Scanner $ \bs next -> s bs $ \bs' a -> next bs' (f a) instance Applicative Scanner where {-# INLINE pure #-} pure = return {-# INLINE (<*>) #-} (<*>) = ap {-# INLINE (*>) #-} (*>) = (>>) {-# INLINE (<*) #-} s1 <* s2 = s1 >>= \a -> s2 >> return a instance Monad Scanner where {-# INLINE return #-} return a = Scanner $ \bs next -> next bs a {-# INLINE (>>=) #-} s1 >>= s2 = Scanner $ \bs next -> run s1 bs $ \bs' a -> run (s2 a) bs' next {-# INLINE fail #-} fail err = Scanner $ \bs _ -> Fail bs err -- | Consume the next word -- -- It fails if end of input {-# INLINE anyWord8 #-} anyWord8 :: Scanner Word8 anyWord8 = Scanner $ \bs next -> case ByteString.uncons bs of Just (c, bs') -> next bs' c _ -> More $ \bs' -> slowPath bs' next where slowPath bs next = case ByteString.uncons bs of Just (c, bs') -> next bs' c _ -> Fail ByteString.empty "No more input" -- | Take input while the predicate is `True` {-# INLINE takeWhile #-} takeWhile :: (Word8 -> Bool) -> Scanner ByteString takeWhile p = Scanner $ \bs next -> let (l, r) = ByteString.span p bs in if ByteString.null r then More $ \bs' -> if ByteString.null bs' then next ByteString.empty l else run (slowPath l) bs' next else next r l where slowPath l = go [l] go res = do chunk <- takeChunk done <- endOfInput if done || ByteString.null chunk then return . ByteString.concat . reverse $ (chunk : res) else go (chunk : res) takeChunk = Scanner $ \bs next -> let (l, r) = ByteString.span p bs in next r l -- | Take the specified number of bytes {-# INLINE take #-} take :: Int -> Scanner ByteString take n = Scanner $ \bs next -> let len = ByteString.length bs in if len >= n then let (l, r) = ByteString.splitAt n bs in next r l else More $ \bs' -> if ByteString.null bs' then Fail ByteString.empty "No more input" else run (slowPath bs len) bs' next where slowPath bs len = go [bs] (n - len) go res 0 = return . ByteString.concat . reverse $ res go res i = Scanner $ \bs next -> let len = ByteString.length bs in if len >= i then let (l, r) = ByteString.splitAt i bs in next r (ByteString.concat . reverse $ (l : res)) else More $ \bs' -> if ByteString.null bs' then Fail ByteString.empty "No more input" else run (go (bs : res) (i - len)) bs' next -- | Returns `True` when there is no more input {-# INLINE endOfInput #-} endOfInput :: Scanner Bool endOfInput = Scanner $ \bs next -> if ByteString.null bs then More $ \bs' -> next bs' (ByteString.null bs') else next bs False -- | Consume the specified string -- -- Warning: it is not optimized yet, so for for small string it is better -- to consume it byte-by-byte using `Scanner.word8` {-# INLINE string #-} string :: ByteString -> Scanner () string str = Scanner $ \bs next -> let strL = ByteString.length str in if ByteString.isPrefixOf str bs 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 #-} lookAhead :: Scanner (Maybe Word8) lookAhead = Scanner $ \bs next -> case ByteString.uncons bs of Just (c, _) -> next bs (Just c) _ -> More $ \bs' -> slowPath bs' next where slowPath bs next = 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) scanner-0.3/lib/Scanner/OctetPredicates.hs0000644000000000000000000000017113334255311016747 0ustar0000000000000000module Scanner.OctetPredicates where import Prelude import Data.Word isDigit :: Word8 -> Bool isDigit w = w - 48 <= 9 scanner-0.3/compat/0000755000000000000000000000000013334255311012456 5ustar0000000000000000scanner-0.3/compat/Prelude.hs0000644000000000000000000000065613334255311014421 0ustar0000000000000000{-# LANGUAGE PackageImports #-} {-# LANGUAGE CPP #-} module Prelude ( module P, #if MIN_VERSION_base(4,8,0) #else (<$>), Monoid(..), Applicative(..), #endif ) where #if MIN_VERSION_base(4,6,0) import "base" Prelude as P #else import "base" Prelude as P hiding (catch) #endif #if MIN_VERSION_base(4,8,0) #else import Data.Functor((<$>)) import Data.Monoid(Monoid(..)) import Control.Applicative(Applicative(..)) #endif scanner-0.3/compat/Data/0000755000000000000000000000000013334255311013327 5ustar0000000000000000scanner-0.3/compat/Data/Either.hs0000644000000000000000000000055713334255311015112 0ustar0000000000000000{-# LANGUAGE PackageImports #-} {-# LANGUAGE CPP #-} module Data.Either ( module Export, #if MIN_VERSION_base(4,7,0) #else isRight, isLeft, #endif ) where import "base" Data.Either as Export #if MIN_VERSION_base(4,7,0) #else isRight :: Either a b -> Bool isRight (Right _) = True isRight _ = False isLeft :: Either a b -> Bool isLeft = not . isRight #endif