git.iko.soy/typeable/attoparsec
on master help sign in
swap
287a62d70 ahead, 0 behind
32 files changed+663−144
since splitsnapshots
unifiedsplit
.gitignore+1 .hgtags+1 .travis.yml+161 Data/Attoparsec/ByteString/Buffer.hs+10−8 Data/Attoparsec/ByteString/Char8.hs+2−3 Data/Attoparsec/ByteString/Internal.hs+16−9 Data/Attoparsec/Internal.hs+10 Data/Attoparsec/Internal/Types.hs+37−27 Data/Attoparsec/Text.hs+1 Data/Attoparsec/Text/Buffer.hs+12−8 Data/Attoparsec/Text/FastSet.hs+3−1 Data/Attoparsec/Text/Internal.hs+32−25 Data/Attoparsec/Zepto.hs+17−8 README.markdown−6 attoparsec.cabal+53−13 benchmarks/Benchmarks.hs+6 benchmarks/HeadersByteString.hs+10−1 benchmarks/HeadersByteString/Atto.hs+9−1 benchmarks/Sets.hs+21 benchmarks/TextFastSet.hs+121 benchmarks/attoparsec-benchmarks.cabal+4 benchmarks/http-request.txt+3−8 benchmarks/http-response.txt+2−4 changelog.md+26 tests/QC.hs+2−2 tests/QC/Buffer.hs+3−3 tests/QC/ByteString.hs+7−5 tests/QC/Combinator.hs+3−3 tests/QC/Simple.hs+3−3 tests/QC/Text.hs+18−6 tests/QC/Text/FastSet.hs+15 tests/QC/Text/Regressions.hs+54
.gitignore+1
@@ -3,3 +3,4 @@
33/dist/
44.cabal-sandbox
55cabal.sandbox.config
6+*.sw[op]
.hgtags+1
@@ -60,3 +60,4 @@ ef875ad3bebef2b6fb1bd7063de6a46a06d0d4b4 0.12.1.4
6060dc1fcff28d13a508f677c7b06af6420877842493 0.12.1.5
6161013e04e4526bfd5e9e4a611b42e6f03c413bea91 0.12.1.6
62620ddbce995b77b8db391b4d6519f13feddf4b5bf3 0.13.0.0
63+46c16463ec20ad46c9cd0bfb1050c4268f34b749 0.13.0.1
.travis.ymlnew file+161
@@ -0,0 +1,161 @@
1+# This Travis job script has been generated by a script via
2+#
3+# haskell-ci '--tests-jobs=>=7.4' '--no-benchmarks' 'attoparsec.cabal'
4+#
5+# For more information, see https://github.com/haskell-CI/haskell-ci
6+#
7+# version: 0.3.20190815
8+#
9+language: c
10+dist: xenial
11+git:
12+ # whether to recursively clone submodules
13+ submodules: false
14+cache:
15+ directories:
16+ - $HOME/.cabal/packages
17+ - $HOME/.cabal/store
18+before_cache:
19+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
20+ # remove files that are regenerated by 'cabal update'
21+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
22+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
23+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
24+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
25+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
26+ - rm -rfv $CABALHOME/packages/head.hackage
27+matrix:
28+ include:
29+ - compiler: ghc-8.8.1
30+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}
31+ - compiler: ghc-8.6.5
32+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}
33+ - compiler: ghc-8.4.4
34+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}
35+ - compiler: ghc-8.2.2
36+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}
37+ - compiler: ghc-8.0.2
38+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}}
39+ - compiler: ghc-7.10.3
40+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}}
41+ - compiler: ghc-7.8.4
42+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}}
43+ - compiler: ghc-7.6.3
44+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.6.3","cabal-install-2.4"]}}
45+ - compiler: ghc-7.4.2
46+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.4.2","cabal-install-2.4"]}}
47+ - compiler: ghc-7.2.2
48+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.2.2","cabal-install-2.4"]}}
49+ - compiler: ghc-7.0.4
50+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.0.4","cabal-install-2.4"]}}
51+before_install:
52+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
53+ - WITHCOMPILER="-w $HC"
54+ - HCPKG="$HC-pkg"
55+ - unset CC
56+ - CABAL=/opt/ghc/bin/cabal
57+ - CABALHOME=$HOME/.cabal
58+ - export PATH="$CABALHOME/bin:$PATH"
59+ - TOP=$(pwd)
60+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
61+ - echo $HCNUMVER
62+ - CABAL="$CABAL -vnormal+nowrap+markoutput"
63+ - set -o pipefail
64+ - |
65+ echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk
66+ echo 'BEGIN { state = "output"; }' >> .colorful.awk
67+ echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk
68+ echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk
69+ echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk
70+ echo ' if (state == "cabal") {' >> .colorful.awk
71+ echo ' print blue($0)' >> .colorful.awk
72+ echo ' } else {' >> .colorful.awk
73+ echo ' print $0' >> .colorful.awk
74+ echo ' }' >> .colorful.awk
75+ echo '}' >> .colorful.awk
76+ - cat .colorful.awk
77+ - |
78+ color_cabal_output () {
79+ awk -f $TOP/.colorful.awk
80+ }
81+ - echo text | color_cabal_output
82+install:
83+ - ${CABAL} --version
84+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
85+ - TEST=--enable-tests
86+ - if [ $HCNUMVER -lt 70400 ] ; then TEST=--disable-tests ; fi
87+ - BENCH=--enable-benchmarks
88+ - BENCH=--disable-benchmarks
89+ - HEADHACKAGE=false
90+ - rm -f $CABALHOME/config
91+ - |
92+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
93+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config
94+ echo "write-ghc-environment-files: always" >> $CABALHOME/config
95+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
96+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
97+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config
98+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
99+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
100+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
101+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
102+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
103+ echo "install-dirs user" >> $CABALHOME/config
104+ echo " prefix: $CABALHOME" >> $CABALHOME/config
105+ echo "repository hackage.haskell.org" >> $CABALHOME/config
106+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
107+ - cat $CABALHOME/config
108+ - rm -fv cabal.project cabal.project.local cabal.project.freeze
109+ - travis_retry ${CABAL} v2-update -v
110+ # Generate cabal.project
111+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
112+ - touch cabal.project
113+ - |
114+ echo "packages: ." >> cabal.project
115+ - |
116+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(attoparsec)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
117+ - cat cabal.project || true
118+ - cat cabal.project.local || true
119+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
120+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output
121+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
122+ - rm cabal.project.freeze
123+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output
124+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output
125+script:
126+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
127+ # Packaging...
128+ - ${CABAL} v2-sdist all | color_cabal_output
129+ # Unpacking...
130+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
131+ - cd ${DISTDIR} || false
132+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
133+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
134+ - PKGDIR_attoparsec="$(find . -maxdepth 1 -type d -regex '.*/attoparsec-[0-9.]*')"
135+ # Generate cabal.project
136+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
137+ - touch cabal.project
138+ - |
139+ echo "packages: ${PKGDIR_attoparsec}" >> cabal.project
140+ - |
141+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(attoparsec)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
142+ - cat cabal.project || true
143+ - cat cabal.project.local || true
144+ # Building...
145+ # this builds all libraries and executables (without tests/benchmarks)
146+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
147+ # Building with tests and benchmarks...
148+ # build & run tests, build benchmarks
149+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
150+ # Testing...
151+ - if [ $HCNUMVER -ge 70400 ] ; then ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output ; fi
152+ # cabal check...
153+ - (cd ${PKGDIR_attoparsec} && ${CABAL} -vnormal check)
154+ # haddock...
155+ - ${CABAL} v2-haddock $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
156+ # Building without installed constraints for packages in global-db...
157+ - rm -f cabal.project.local
158+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
159+
160+# REGENDATA ["--tests-jobs=>=7.4","--no-benchmarks","attoparsec.cabal"]
161+# EOF
Data/Attoparsec/ByteString/Buffer.hs+10−8
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP #-}
1+{-# LANGUAGE BangPatterns #-}
22-- |
33-- Module : Data.Attoparsec.ByteString.Buffer
44-- Copyright : Bryan O'Sullivan 2007-2015
@@ -57,9 +57,8 @@ import Control.Exception (assert)
5757import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
5858import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
5959import Data.List (foldl1')
60−#if !MIN_VERSION_base(4,8,0)
61−import Data.Monoid (Monoid(..))
62−#endif
60+import Data.Monoid as Mon (Monoid(..))
61+import Data.Semigroup (Semigroup(..))
6362import Data.Word (Word8)
6463import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
6564import Foreign.Ptr (castPtr, plusPtr)
@@ -88,14 +87,17 @@ buffer (PS fp off len) = Buf fp off len len 0
8887unbuffer :: Buffer -> ByteString
8988unbuffer (Buf fp off len _ _) = PS fp off len
9089
90+instance Semigroup Buffer where
91+ (Buf _ _ _ 0 _) <> b = b
92+ a <> (Buf _ _ _ 0 _) = a
93+ buf <> (Buf fp off len _ _) = append buf fp off len
94+
9195instance Monoid Buffer where
9296 mempty = Buf nullForeignPtr 0 0 0 0
9397
94− mappend (Buf _ _ _ 0 _) b = b
95− mappend a (Buf _ _ _ 0 _) = a
96− mappend buf (Buf fp off len _ _) = append buf fp off len
98+ mappend = (<>)
9799
98− mconcat [] = mempty
100+ mconcat [] = Mon.mempty
99101 mconcat xs = foldl1' mappend xs
100102
101103pappend :: Buffer -> ByteString -> Buffer
Data/Attoparsec/ByteString/Char8.hs+2−3
@@ -444,9 +444,8 @@ hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit
444444
445445-- | Parse and decode an unsigned decimal number.
446446decimal :: Integral a => Parser a
447−decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig
448− where isDig w = w >= 48 && w <= 57
449− step a w = a * 10 + fromIntegral (w - 48)
447+decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDigit_w8
448+ where step a w = a * 10 + fromIntegral (w - 48)
450449{-# SPECIALISE decimal :: Parser Int #-}
451450{-# SPECIALISE decimal :: Parser Int8 #-}
452451{-# SPECIALISE decimal :: Parser Int16 #-}
Data/Attoparsec/ByteString/Internal.hs+16−9
@@ -257,15 +257,24 @@ takeTill p = takeWhile (not . p)
257257-- parsers loop until a failure occurs. Careless use will thus result
258258-- in an infinite loop.
259259takeWhile :: (Word8 -> Bool) -> Parser ByteString
260−takeWhile p = (B.concat . reverse) `fmap` go []
260+takeWhile p = do
261+ s <- B8.takeWhile p <$> get
262+ continue <- inputSpansChunks (B.length s)
263+ if continue
264+ then takeWhileAcc p [s]
265+ else return s
266+{-# INLINE takeWhile #-}
267+
268+takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
269+takeWhileAcc p = go
261270 where
262271 go acc = do
263272 s <- B8.takeWhile p <$> get
264273 continue <- inputSpansChunks (B.length s)
265274 if continue
266275 then go (s:acc)
267− else return (s:acc)
268−{-# INLINE takeWhile #-}
276+ else return $ concatReverse (s:acc)
277+{-# INLINE takeWhileAcc #-}
269278
270279takeRest :: Parser [ByteString]
271280takeRest = go []
@@ -329,16 +338,13 @@ scan_ f s0 p = go [] s0
329338-- parsers loop until a failure occurs. Careless use will thus result
330339-- in an infinite loop.
331340scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
332−scan = scan_ $ \_ chunks ->
333− case chunks of
334− [x] -> return x
335− xs -> return $! B.concat $ reverse xs
341+scan = scan_ $ \_ chunks -> return $! concatReverse chunks
336342{-# INLINE scan #-}
337343
338344-- | Like 'scan', but generalized to return the final state of the
339345-- scanner.
340346runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
341−runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
347+runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
342348{-# INLINE runScanner #-}
343349
344350-- | Consume input as long as the predicate returns 'True', and return
@@ -358,8 +364,9 @@ takeWhile1 p = do
358364 advance len
359365 eoc <- endOfChunk
360366 if eoc
361− then (s<>) `fmap` takeWhile p
367+ then takeWhileAcc p [s]
362368 else return s
369+{-# INLINE takeWhile1 #-}
363370
364371-- | Match any byte in a set.
365372--
Data/Attoparsec/Internal.hs+10
@@ -20,10 +20,12 @@ module Data.Attoparsec.Internal
2020 , endOfInput
2121 , atEnd
2222 , satisfyElem
23+ , concatReverse
2324 ) where
2425
2526#if !MIN_VERSION_base(4,8,0)
2627import Control.Applicative ((<$>))
28+import Data.Monoid (Monoid, mconcat)
2729#endif
2830import Data.Attoparsec.Internal.Types
2931import Data.ByteString (ByteString)
@@ -159,3 +161,11 @@ satisfyElem p = Parser $ \t pos more lose succ ->
159161 | otherwise -> lose t pos more [] "satisfyElem"
160162 Nothing -> satisfySuspended p t pos more lose succ
161163{-# INLINE satisfyElem #-}
164+
165+-- | Concatenate a monoid after reversing its elements. Used to
166+-- glue together a series of textual chunks that have been accumulated
167+-- \"backwards\".
168+concatReverse :: Monoid m => [m] -> m
169+concatReverse [x] = x
170+concatReverse xs = mconcat (reverse xs)
171+{-# INLINE concatReverse #-}
Data/Attoparsec/Internal/Types.hs+37−27
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, OverloadedStrings,
1+{-# LANGUAGE CPP, BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,
22 Rank2Types, RecordWildCards, TypeFamilies #-}
33-- |
44-- Module : Data.Attoparsec.Internal.Types
@@ -25,13 +25,13 @@ module Data.Attoparsec.Internal.Types
2525 , Chunk(..)
2626 ) where
2727
28−#if !MIN_VERSION_base(4,8,0)
29−import Control.Applicative (Applicative(..), (<$>))
30−import Data.Monoid (Monoid(..))
31−#endif
28+import Control.Applicative as App (Applicative(..), (<$>))
3229import Control.Applicative (Alternative(..))
3330import Control.DeepSeq (NFData(rnf))
3431import Control.Monad (MonadPlus(..))
32+import qualified Control.Monad.Fail as Fail (MonadFail(..))
33+import Data.Monoid as Mon (Monoid(..))
34+import Data.Semigroup (Semigroup(..))
3535import Data.Word (Word8)
3636import Data.ByteString (ByteString)
3737import qualified Data.ByteString as BS
@@ -39,7 +39,7 @@ import Data.ByteString.Internal (w2c)
3939import Data.Text (Text)
4040import qualified Data.Text as Text
4141import Data.Text.Unsafe (Iter(..))
42−import Prelude hiding (getChar, succ)
42+import Prelude hiding (succ)
4343import qualified Data.Attoparsec.ByteString.Buffer as B
4444import qualified Data.Attoparsec.Text.Buffer as T
4545
@@ -127,17 +127,21 @@ type Success i t a r = t -> Pos -> More -> a -> IResult i r
127127data More = Complete | Incomplete
128128 deriving (Eq, Show)
129129
130−instance Monoid More where
131− mappend c@Complete _ = c
132− mappend _ m = m
133− mempty = Incomplete
130+instance Semigroup More where
131+ c@Complete <> _ = c
132+ _ <> m = m
133+
134+instance Mon.Monoid More where
135+ mappend = (<>)
136+ mempty = Incomplete
134137
135138instance Monad (Parser i) where
136− fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg
137− where msg = "Failed reading: " ++ err
139+#if !(MIN_VERSION_base(4,13,0))
140+ fail = Fail.fail
138141 {-# INLINE fail #-}
142+#endif
139143
140− return v = Parser $ \t pos more _lose succ -> succ t pos more v
144+ return = App.pure
141145 {-# INLINE return #-}
142146
143147 m >>= k = Parser $ \t !pos more lose succ ->
@@ -145,6 +149,15 @@ instance Monad (Parser i) where
145149 in runParser m t pos more lose succ'
146150 {-# INLINE (>>=) #-}
147151
152+ (>>) = (*>)
153+ {-# INLINE (>>) #-}
154+
155+
156+instance Fail.MonadFail (Parser i) where
157+ fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg
158+ where msg = "Failed reading: " ++ err
159+ {-# INLINE fail #-}
160+
148161plus :: Parser i a -> Parser i a -> Parser i a
149162plus f g = Parser $ \t pos more lose succ ->
150163 let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ
@@ -169,23 +182,23 @@ apP d e = do
169182{-# INLINE apP #-}
170183
171184instance Applicative (Parser i) where
172− pure = return
185+ pure v = Parser $ \t !pos more _lose succ -> succ t pos more v
173186 {-# INLINE pure #-}
174187 (<*>) = apP
175188 {-# INLINE (<*>) #-}
176−
177− -- These definitions are equal to the defaults, but this
178− -- way the optimizer doesn't have to work so hard to figure
179− -- that out.
180− (*>) = (>>)
189+ m *> k = m >>= \_ -> k
181190 {-# INLINE (*>) #-}
182− x <* y = x >>= \a -> y >> return a
191+ x <* y = x >>= \a -> y >> pure a
183192 {-# INLINE (<*) #-}
184193
194+instance Semigroup (Parser i a) where
195+ (<>) = plus
196+ {-# INLINE (<>) #-}
197+
185198instance Monoid (Parser i a) where
186199 mempty = fail "mempty"
187200 {-# INLINE mempty #-}
188− mappend = plus
201+ mappend = (<>)
189202 {-# INLINE mappend #-}
190203
191204instance Alternative (Parser i) where
@@ -196,8 +209,9 @@ instance Alternative (Parser i) where
196209 {-# INLINE (<|>) #-}
197210
198211 many v = many_v
199− where many_v = some_v <|> pure []
200− some_v = (:) <$> v <*> many_v
212+ where
213+ many_v = some_v <|> pure []
214+ some_v = (:) <$> v <*> many_v
201215 {-# INLINE many #-}
202216
203217 some v = some_v
@@ -206,10 +220,6 @@ instance Alternative (Parser i) where
206220 some_v = (:) <$> v <*> many_v
207221 {-# INLINE some #-}
208222
209−(<>) :: (Monoid m) => m -> m -> m
210−(<>) = mappend
211−{-# INLINE (<>) #-}
212−
213223-- | A common interface for input chunks.
214224class Monoid c => Chunk c where
215225 type ChunkElem c
Data/Attoparsec/Text.hs+1
@@ -72,6 +72,7 @@ module Data.Attoparsec.Text
7272 , skipSpace
7373 , I.skipWhile
7474 , I.scan
75+ , I.runScanner
7576 , I.take
7677 , I.takeWhile
7778 , I.takeWhile1
Data/Attoparsec/Text/Buffer.hs+12−8
@@ -40,9 +40,8 @@ module Data.Attoparsec.Text.Buffer
4040import Control.Exception (assert)
4141import Data.Bits (shiftR)
4242import Data.List (foldl1')
43−#if !MIN_VERSION_base(4,8,0)
44−import Data.Monoid (Monoid(..))
45−#endif
43+import Data.Monoid as Mon (Monoid(..))
44+import Data.Semigroup (Semigroup(..))
4645import Data.Text ()
4746import Data.Text.Internal (Text(..))
4847import Data.Text.Internal.Encoding.Utf16 (chr2)
@@ -80,15 +79,20 @@ unbufferAt s (Buf arr off len _ _) =
8079 assert (s >= 0 && s <= len) $
8180 Text arr (off+s) (len-s)
8281
82+instance Semigroup Buffer where
83+ (Buf _ _ _ 0 _) <> b = b
84+ a <> (Buf _ _ _ 0 _) = a
85+ buf <> (Buf arr off len _ _) = append buf arr off len
86+ {-# INLINE (<>) #-}
87+
8388instance Monoid Buffer where
8489 mempty = Buf A.empty 0 0 0 0
90+ {-# INLINE mempty #-}
8591
86− mappend (Buf _ _ _ 0 _) b = b
87− mappend a (Buf _ _ _ 0 _) = a
88− mappend buf (Buf arr off len _ _) = append buf arr off len
92+ mappend = (<>)
8993
90− mconcat [] = mempty
91− mconcat xs = foldl1' mappend xs
94+ mconcat [] = Mon.mempty
95+ mconcat xs = foldl1' (<>) xs
9296
9397pappend :: Buffer -> Text -> Buffer
9498pappend (Buf _ _ _ 0 _) t = buffer t
Data/Attoparsec/Text/FastSet.hs+3−1
@@ -62,7 +62,9 @@ resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries)
6262
6363pad :: Int -> [Entry] -> [Entry]
6464pad = go 0
65− where go !_ !m [] = replicate (max 1 m) empty
65+ where -- ensure that we pad enough so that lookups beyond the
66+ -- last hash in the table fall within the array
67+ go !_ !m [] = replicate (max 1 m + 1) empty
6668 go k m (e:entries) = map (const empty) [k..i - 1] ++ e :
6769 go (i + 1) (m + i - k - 1) entries
6870 where i = index e
Data/Attoparsec/Text/Internal.hs+32−25
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, GADTs, OverloadedStrings,
1+{-# LANGUAGE BangPatterns, FlexibleInstances, GADTs, OverloadedStrings,
22 Rank2Types, RecordWildCards, TypeFamilies, TypeSynonymInstances #-}
33{-# OPTIONS_GHC -fno-warn-orphans #-}
44-- |
@@ -65,17 +65,14 @@ module Data.Attoparsec.Text.Internal
6565 , atEnd
6666 ) where
6767
68−#if !MIN_VERSION_base(4,8,0)
69−import Control.Applicative ((<$>))
70−#endif
71−import Control.Applicative ((<|>))
68+import Control.Applicative ((<|>), (<$>), pure, (*>))
7269import Control.Monad (when)
7370import Data.Attoparsec.Combinator ((<?>))
7471import Data.Attoparsec.Internal
7572import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
7673import qualified Data.Attoparsec.Text.Buffer as Buf
7774import Data.Attoparsec.Text.Buffer (Buffer, buffer)
78−import Data.Char (chr, ord)
75+import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)
7976import Data.List (intercalate)
8077import Data.String (IsString(..))
8178import Data.Text.Internal (Text(..))
@@ -225,15 +222,16 @@ stringCI s = go 0
225222
226223-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
227224asciiCI :: Text -> Parser Text
228−asciiCI s = string_ (stringSuspended asciiToLower) asciiToLower s
229− where
230− asciiToLower = T.map f
231− where
232− offset = ord 'a' - ord 'A'
233− f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)
234− | otherwise = c
225+asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s
235226{-# INLINE asciiCI #-}
236227
228+asciiCharCI :: Char -> Parser Char
229+asciiCharCI c
230+ | isAsciiUpper c = char c <|> char (toLower c)
231+ | isAsciiLower c = char c <|> char (toUpper c)
232+ | otherwise = char c
233+{-# INLINE asciiCharCI #-}
234+
237235-- | Skip past input for as long as the predicate returns 'True'.
238236skipWhile :: (Char -> Bool) -> Parser ()
239237skipWhile p = go
@@ -269,14 +267,25 @@ takeTill p = takeWhile (not . p)
269267-- parsers loop until a failure occurs. Careless use will thus result
270268-- in an infinite loop.
271269takeWhile :: (Char -> Bool) -> Parser Text
272−takeWhile p = (T.concat . reverse) `fmap` go []
270+takeWhile p = do
271+ h <- T.takeWhile p <$> get
272+ continue <- inputSpansChunks (size h)
273+ -- only use slow concat path if necessary
274+ if continue
275+ then takeWhileAcc p [h]
276+ else return h
277+{-# INLINE takeWhile #-}
278+
279+takeWhileAcc :: (Char -> Bool) -> [Text] -> Parser Text
280+takeWhileAcc p = go
273281 where
274282 go acc = do
275283 h <- T.takeWhile p <$> get
276284 continue <- inputSpansChunks (size h)
277285 if continue
278286 then go (h:acc)
279− else return (h:acc)
287+ else return $ concatReverse (h:acc)
288+{-# INLINE takeWhileAcc #-}
280289
281290takeRest :: Parser [Text]
282291takeRest = go []
@@ -299,7 +308,7 @@ takeLazyText :: Parser L.Text
299308takeLazyText = L.fromChunks `fmap` takeRest
300309
301310data Scan s = Continue s
302− | Finished {-# UNPACK #-} !Int Text
311+ | Finished s {-# UNPACK #-} !Int Text
303312
304313scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
305314scan_ f s0 p = go [] s0
@@ -308,7 +317,7 @@ scan_ f s0 p = go [] s0
308317 case T.uncons t of
309318 Just (c,t') -> case p s c of
310319 Just s' -> scanner s' (n+1) t'
311− Nothing -> Finished n t
320+ Nothing -> Finished s n t
312321 Nothing -> Continue s
313322 go acc s = do
314323 input <- get
@@ -317,8 +326,8 @@ scan_ f s0 p = go [] s0
317326 if continue
318327 then go (input : acc) s'
319328 else f s' (input : acc)
320− Finished n t -> do advance (size input - size t)
321− f s (T.take n input : acc)
329+ Finished s' n t -> do advance (size input - size t)
330+ f s' (T.take n input : acc)
322331{-# INLINE scan_ #-}
323332
324333-- | A stateful scanner. The predicate consumes and transforms a
@@ -334,16 +343,13 @@ scan_ f s0 p = go [] s0
334343-- parsers loop until a failure occurs. Careless use will thus result
335344-- in an infinite loop.
336345scan :: s -> (s -> Char -> Maybe s) -> Parser Text
337−scan = scan_ $ \_ chunks ->
338− case chunks of
339− [x] -> return x
340− xs -> return . T.concat . reverse $ xs
346+scan = scan_ $ \_ chunks -> return $! concatReverse chunks
341347{-# INLINE scan #-}
342348
343349-- | Like 'scan', but generalized to return the final state of the
344350-- scanner.
345351runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
346−runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)
352+runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
347353{-# INLINE runScanner #-}
348354
349355-- | Consume input as long as the predicate returns 'True', and return
@@ -361,8 +367,9 @@ takeWhile1 p = do
361367 advance size'
362368 eoc <- endOfChunk
363369 if eoc
364− then (h<>) `fmap` takeWhile p
370+ then takeWhileAcc p [h]
365371 else return h
372+{-# INLINE takeWhile1 #-}
366373
367374-- | Match any character in a set.
368375--
Data/Attoparsec/Zepto.hs+17−8
@@ -38,18 +38,17 @@ module Data.Attoparsec.Zepto
3838
3939import Control.Applicative
4040import Control.Monad (MonadPlus(..), ap)
41+import qualified Control.Monad.Fail as Fail
4142import Control.Monad.IO.Class (MonadIO(..))
4243import Data.ByteString (ByteString)
4344import Data.Functor.Identity (Identity(runIdentity))
45+import Data.Monoid as Mon (Monoid(..))
46+import Data.Semigroup (Semigroup(..))
4447import Data.Word (Word8)
4548import Prelude hiding (take, takeWhile)
4649import qualified Data.ByteString as B
4750import qualified Data.ByteString.Unsafe as B
4851
49−#if !MIN_VERSION_base(4,8,0)
50−import Data.Monoid (Monoid(..))
51−#endif
52−
5352newtype S = S {
5453 input :: ByteString
5554 }
@@ -83,7 +82,7 @@ instance MonadIO m => MonadIO (ZeptoT m) where
8382 {-# INLINE liftIO #-}
8483
8584instance Monad m => Monad (ZeptoT m) where
86− return a = Parser $ \s -> return (OK a s)
85+ return = pure
8786 {-# INLINE return #-}
8887
8988 m >>= k = Parser $ \s -> do
@@ -93,6 +92,12 @@ instance Monad m => Monad (ZeptoT m) where
9392 Fail err -> return (Fail err)
9493 {-# INLINE (>>=) #-}
9594
95+#if !(MIN_VERSION_base(4,13,0))
96+ fail = Fail.fail
97+ {-# INLINE fail #-}
98+#endif
99+
100+instance Monad m => Fail.MonadFail (ZeptoT m) where
96101 fail msg = Parser $ \_ -> return (Fail msg)
97102 {-# INLINE fail #-}
98103
@@ -108,7 +113,7 @@ instance Monad m => MonadPlus (ZeptoT m) where
108113 {-# INLINE mplus #-}
109114
110115instance (Monad m) => Applicative (ZeptoT m) where
111− pure = return
116+ pure a = Parser $ \s -> return (OK a s)
112117 {-# INLINE pure #-}
113118 (<*>) = ap
114119 {-# INLINE (<*>) #-}
@@ -137,10 +142,14 @@ parseT p bs = do
137142 Fail err -> return (Left err)
138143{-# INLINE parseT #-}
139144
140−instance Monad m => Monoid (ZeptoT m a) where
145+instance Monad m => Semigroup (ZeptoT m a) where
146+ (<>) = mplus
147+ {-# INLINE (<>) #-}
148+
149+instance Monad m => Mon.Monoid (ZeptoT m a) where
141150 mempty = fail "mempty"
142151 {-# INLINE mempty #-}
143− mappend = mplus
152+ mappend = (<>)
144153 {-# INLINE mappend #-}
145154
146155instance Monad m => Alternative (ZeptoT m) where
README.markdown−6
@@ -16,12 +16,6 @@ Master [git repository](https://github.com/bos/attoparsec):
1616
1717* `git clone git://github.com/bos/attoparsec.git`
1818
19−There's also a [Mercurial mirror](https://bitbucket.org/bos/attoparsec):
20−
21−* `hg clone https://bitbucket.org/bos/attoparsec`
22−
23−(You can create and contribute changes using either Mercurial or git.)
24−
2519Authors
2620-------
2721
attoparsec.cabal+53−13
@@ -1,12 +1,13 @@
11name: attoparsec
2−version: 0.13.0.0
2+version: 0.13.2.2
3+x-revision: 3
34license: BSD3
45license-file: LICENSE
56category: Text, Parsing
67author: Bryan O'Sullivan <bos@serpentine.com>
7−maintainer: Bryan O'Sullivan <bos@serpentine.com>
8+maintainer: Bryan O'Sullivan <bos@serpentine.com>, Ben Gamari <ben@smart-cactus.org>
89stability: experimental
9−tested-with: GHC == 7.0, GHC == 7.2, GHC == 7.4, GHC == 7.6, GHC == 7.8, GHC == 7.10
10+tested-with: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.2, GHC ==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
1011synopsis: Fast combinator parsing for bytestrings and text
1112cabal-version: >= 1.8
1213homepage: https://github.com/bos/attoparsec
@@ -21,6 +22,7 @@ extra-source-files:
2122 benchmarks/*.cabal
2223 benchmarks/*.hs
2324 benchmarks/*.txt
25+ benchmarks/json-data/*.json
2426 benchmarks/Makefile
2527 benchmarks/med.txt.bz2
2628 changelog.md
@@ -38,17 +40,22 @@ Flag developer
3840
3941library
4042 build-depends: array,
41− base >= 4.2 && < 5,
43+ base >= 4.3 && < 5,
4244 bytestring,
4345 containers,
4446 deepseq,
4547 scientific >= 0.3.1 && < 0.4,
46− transformers,
48+ transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,
4749 text >= 1.1.1.3
4850 if impl(ghc < 7.4)
4951 build-depends:
5052 bytestring < 0.10.4.0
5153
54+ if !impl(ghc >= 8.0)
55+ -- Data.Semigroup && Control.Monad.Fail are available in base-4.9+
56+ build-depends: fail == 4.9.*,
57+ semigroups >=0.16.1 && <0.20
58+
5259 exposed-modules: Data.Attoparsec
5360 Data.Attoparsec.ByteString
5461 Data.Attoparsec.ByteString.Char8
@@ -89,6 +96,26 @@ test-suite tests
8996 QC.Rechunked
9097 QC.Simple
9198 QC.Text
99+ QC.Text.FastSet
100+ QC.Text.Regressions
101+
102+ other-modules: Data.Attoparsec.ByteString
103+ Data.Attoparsec.ByteString.Buffer
104+ Data.Attoparsec.ByteString.Char8
105+ Data.Attoparsec.ByteString.FastSet
106+ Data.Attoparsec.ByteString.Internal
107+ Data.Attoparsec.ByteString.Lazy
108+ Data.Attoparsec.Combinator
109+ Data.Attoparsec.Internal
110+ Data.Attoparsec.Internal.Fhthagn
111+ Data.Attoparsec.Internal.Types
112+ Data.Attoparsec.Number
113+ Data.Attoparsec.Text
114+ Data.Attoparsec.Text.Buffer
115+ Data.Attoparsec.Text.FastSet
116+ Data.Attoparsec.Text.Internal
117+ Data.Attoparsec.Text.Lazy
118+ Data.Attoparsec.Zepto
92119
93120 ghc-options:
94121 -Wall -threaded -rtsopts
@@ -98,18 +125,23 @@ test-suite tests
98125
99126 build-depends:
100127 array,
101− base >= 4 && < 5,
128+ base,
102129 bytestring,
103130 deepseq >= 1.1,
104− QuickCheck >= 2.7,
131+ QuickCheck >= 2.13.2 && < 2.14,
105132 quickcheck-unicode,
106133 scientific,
107− test-framework >= 0.8.0.2,
108− test-framework-quickcheck2 >= 0.3.0.3,
134+ tasty >= 0.11,
135+ tasty-quickcheck >= 0.8,
109136 text,
110− transformers,
137+ transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,
111138 vector
112139
140+ if !impl(ghc >= 8.0)
141+ -- Data.Semigroup && Control.Monad.Fail are available in base-4.9+
142+ build-depends: fail == 4.9.*,
143+ semigroups >=0.16.1 && <0.20
144+
113145benchmark benchmarks
114146 type: exitcode-stdio-1.0
115147 hs-source-dirs: benchmarks benchmarks/warp-3.0.1.1 .
@@ -121,7 +153,11 @@ benchmark benchmarks
121153 HeadersByteString.Atto
122154 HeadersText
123155 Links
156+ Network.Wai.Handler.Warp.ReadInt
157+ Network.Wai.Handler.Warp.RequestHeader
124158 Numbers
159+ Sets
160+ TextFastSet
125161 Warp
126162 ghc-options: -O2 -Wall
127163
@@ -133,6 +169,7 @@ benchmark benchmarks
133169 base == 4.*,
134170 bytestring >= 0.10.4.0,
135171 case-insensitive,
172+ containers,
136173 criterion >= 1.0,
137174 deepseq >= 1.1,
138175 directory,
@@ -142,13 +179,16 @@ benchmark benchmarks
142179 parsec >= 3.1.2,
143180 scientific,
144181 text >= 1.1.1.0,
182+ transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,
145183 unordered-containers,
146184 vector
147185
186+ if !impl(ghc >= 8.0)
187+ -- Data.Semigroup && Control.Monad.Fail are available in base-4.9+
188+ build-depends: fail == 4.9.*,
189+ semigroups >=0.16.1 && <0.19
190+
148191source-repository head
149192 type: git
150193 location: https://github.com/bos/attoparsec
151194
152−source-repository head
153− type: mercurial
154− location: https://bitbucket.org/bos/attoparsec
benchmarks/Benchmarks.hs+6
@@ -28,6 +28,7 @@ import qualified HeadersByteString
2828import qualified HeadersText
2929import qualified Links
3030import qualified Text.Parsec as P
31+import qualified Sets
3132
3233main :: IO ()
3334main = do
@@ -70,10 +71,14 @@ main = do
7071 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl
7172 , bench "isAlpha_iso8859_15" $
7273 nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl
74+ , bench "T isAlpha" $ nf (AT.parse (AT.takeWhile isAlpha)) t
75+ , bench "TL isAlpha" $ nf (ATL.parse (AT.takeWhile isAlpha)) tl
7376 ]
7477 , bgroup "takeWhile1" [
7578 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl
7679 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile1 AC.isAlpha_ascii)) bl
80+ , bench "T isAlpha" $ nf (AT.parse (AT.takeWhile1 isAlpha)) t
81+ , bench "TL isAlpha" $ nf (ATL.parse (AT.takeWhile1 isAlpha)) tl
7782 ]
7883 , bench "word32LE" $ nf (AB.parse word32LE) b
7984 , bgroup "scan" [
@@ -86,6 +91,7 @@ main = do
8691 , headersT
8792 , Links.links
8893 , numbers
94+ , Sets.benchmarks
8995 , Warp.benchmarks
9096 ]
9197
benchmarks/HeadersByteString.hs+10−1
@@ -9,6 +9,15 @@ import qualified Data.Attoparsec.ByteString.Char8 as B
99import qualified Data.Attoparsec.ByteString.Lazy as BL
1010import qualified Data.ByteString.Char8 as B
1111
12+-- Note: In the benchmarks for parsing an http request
13+-- from a strict bytestring, we consider warp's implementation,
14+-- which has highly optimized code for handling the first
15+-- line in particular. It's treatment of the headers
16+-- is more relaxed from the treatment they are given by the
17+-- attoparsec parser benchmarked here. Consequently, it
18+-- is should not be possible to match its performance since
19+-- it accepts header names with disallowed characters.
20+
1221headers :: IO Benchmark
1322headers = do
1423 req <- B.readFile =<< pathTo "http-request.txt"
@@ -18,7 +27,7 @@ headers = do
1827 return $ bgroup "headers" [
1928 bgroup "B" [
2029 bench "request" $ nf (B.parseOnly request) req
21− , bench "warp" $ nfIO (parseHeaderLines [req])
30+ , bench "warp" $ nfIO (parseHeaderLines (B.split '\n' req))
2231 , bench "response" $ nf (B.parseOnly response) resp
2332 ]
2433 , bgroup "BL" [
benchmarks/HeadersByteString/Atto.hs+9−1
@@ -15,8 +15,16 @@ import qualified Data.ByteString.Char8 as B
1515instance NFData HttpVersion where
1616 rnf !_ = ()
1717
18+isHeaderChar :: Char -> Bool
19+isHeaderChar c =
20+ (c >= 'a' && c <= 'z') ||
21+ (c >= 'A' && c <= 'Z') ||
22+ (c >= '0' && c <= '9') ||
23+ (c == '_') ||
24+ (c == '-')
25+
1826header = do
19− name <- B.takeWhile1 (B.inClass "a-zA-Z0-9_-") <* B.char ':' <* B.skipSpace
27+ name <- B.takeWhile1 isHeaderChar <* B.char ':' <* B.skipSpace
2028 body <- bodyLine
2129 return (name, body)
2230
benchmarks/Sets.hsnew file+21
@@ -0,0 +1,21 @@
1+module Sets (benchmarks) where
2+
3+import Criterion
4+import Data.Char (ord)
5+import qualified Data.Attoparsec.Text.FastSet as FastSet
6+import qualified TextFastSet
7+import qualified Data.HashSet as HashSet
8+import qualified Data.IntSet as IntSet
9+
10+smallSet :: String
11+smallSet = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']
12+
13+benchmarks :: Benchmark
14+benchmarks = bgroup "sets" [
15+ bench "Fast" $ whnf (FastSet.member '*') (FastSet.fromList smallSet)
16+ , bench "Hash" $ whnf (HashSet.member '*') (HashSet.fromList smallSet)
17+ , bench "Int" $ whnf (IntSet.member (ord '*'))
18+ (IntSet.fromList (map ord smallSet))
19+ , bench "TextFast" $ whnf (TextFastSet.member '*')
20+ (TextFastSet.fromList smallSet)
21+ ]
benchmarks/TextFastSet.hsnew file+121
@@ -0,0 +1,121 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+------------------------------------------------------------------------------
4+-- |
5+-- Module : Data.Attoparsec.FastSet
6+-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015
7+-- License : BSD3
8+--
9+-- Maintainer : felipe.lessa@gmail.com
10+-- Stability : experimental
11+-- Portability : unknown
12+--
13+-- Fast set membership tests for 'Char' values. We test for
14+-- membership using a hashtable implemented with Robin Hood
15+-- collision resolution. The set representation is unboxed,
16+-- and the characters and hashes interleaved, for efficiency.
17+--
18+--
19+-----------------------------------------------------------------------------
20+module TextFastSet
21+ (
22+ -- * Data type
23+ FastSet
24+ -- * Construction
25+ , fromList
26+ , set
27+ -- * Lookup
28+ , member
29+ -- * Handy interface
30+ , charClass
31+ ) where
32+
33+import Data.Bits ((.|.), (.&.), shiftR)
34+import Data.Function (on)
35+import Data.List (sort, sortBy)
36+import qualified Data.Array.Base as AB
37+import qualified Data.Array.Unboxed as A
38+import qualified Data.Text as T
39+
40+data FastSet = FastSet {
41+ table :: {-# UNPACK #-} !(A.UArray Int Int)
42+ , mask :: {-# UNPACK #-} !Int
43+ }
44+
45+data Entry = Entry {
46+ key :: {-# UNPACK #-} !Char
47+ , initialIndex :: {-# UNPACK #-} !Int
48+ , index :: {-# UNPACK #-} !Int
49+ }
50+
51+offset :: Entry -> Int
52+offset e = index e - initialIndex e
53+
54+resolveCollisions :: [Entry] -> [Entry]
55+resolveCollisions [] = []
56+resolveCollisions [e] = [e]
57+resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries)
58+ where (a', b')
59+ | index a < index b = (a, b)
60+ | offset a < offset b = (b { index=index a }, a { index=index a + 1 })
61+ | otherwise = (a, b { index=index a + 1 })
62+
63+pad :: Int -> [Entry] -> [Entry]
64+pad = go 0
65+ where -- ensure that we pad enough so that lookups beyond the
66+ -- last hash in the table fall within the array
67+ go !_ !m [] = replicate (max 1 m + 1) empty
68+ go k m (e:entries) = map (const empty) [k..i - 1] ++ e :
69+ go (i + 1) (m + i - k - 1) entries
70+ where i = index e
71+ empty = Entry '\0' maxBound 0
72+
73+nextPowerOf2 :: Int -> Int
74+nextPowerOf2 0 = 1
75+nextPowerOf2 x = go (x - 1) 1
76+ where go y 32 = y + 1
77+ go y k = go (y .|. (y `shiftR` k)) $ k * 2
78+
79+fastHash :: Char -> Int
80+fastHash = fromEnum
81+
82+fromList :: String -> FastSet
83+fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved)
84+ mask'
85+ where s' = ordNub (sort s)
86+ l = length s'
87+ mask' = nextPowerOf2 ((5 * l) `div` 4) - 1
88+ entries = pad mask' .
89+ resolveCollisions .
90+ sortBy (compare `on` initialIndex) .
91+ zipWith (\c i -> Entry c i i) s' .
92+ map ((.&. mask') . fastHash) $ s'
93+ interleaved = concatMap (\e -> [fromEnum $ key e, initialIndex e])
94+ entries
95+
96+ordNub :: Eq a => [a] -> [a]
97+ordNub [] = []
98+ordNub (y:ys) = go y ys
99+ where go x (z:zs)
100+ | x == z = go x zs
101+ | otherwise = x : go z zs
102+ go x [] = [x]
103+
104+set :: T.Text -> FastSet
105+set = fromList . T.unpack
106+
107+-- | Check the set for membership.
108+member :: Char -> FastSet -> Bool
109+member c a = go (2 * i)
110+ where i = fastHash c .&. mask a
111+ lookupAt j b = (i' <= i) && (c == c' || b)
112+ where c' = toEnum $ AB.unsafeAt (table a) j
113+ i' = AB.unsafeAt (table a) $ j + 1
114+ go j = lookupAt j . lookupAt (j + 2) . lookupAt (j + 4) .
115+ lookupAt (j + 6) . go $ j + 8
116+
117+charClass :: String -> FastSet
118+charClass = fromList . go
119+ where go (a:'-':b:xs) = [a..b] ++ go xs
120+ go (x:xs) = x : go xs
121+ go _ = ""
benchmarks/attoparsec-benchmarks.cabal+4
@@ -16,6 +16,8 @@ executable attoparsec-benchmarks
1616 Links
1717 Numbers
1818 Network.Wai.Handler.Warp.ReadInt
19+ Sets
20+ TextFastSet
1921 Warp
2022 hs-source-dirs: .. . warp-3.0.1.1
2123 ghc-options: -O2 -Wall -rtsopts
@@ -24,6 +26,7 @@ executable attoparsec-benchmarks
2426 base == 4.*,
2527 bytestring >= 0.10.4.0,
2628 case-insensitive,
29+ containers,
2730 criterion >= 1.0,
2831 deepseq >= 1.1,
2932 directory,
@@ -33,5 +36,6 @@ executable attoparsec-benchmarks
3336 parsec >= 3.1.2,
3437 scientific >= 0.3.1,
3538 text >= 1.1.1.0,
39+ transformers,
3640 unordered-containers,
3741 vector
benchmarks/http-request.txt+3−8
@@ -1,14 +1,9 @@
11GET / HTTP/1.1
22Host: twitter.com
3−Accept: text/html, application/xhtml+xml, application/xml; q=0.9,
4− image/webp, */*; q=0.8
3+Accept: text/html, application/xhtml+xml, application/xml; q=0.9, image/webp, */*; q=0.8
54Accept-Encoding: gzip,deflate,sdch
65Accept-Language: en-GB,en-US;q=0.8,en;q=0.6
76Cache-Control: max-age=0
8−Cookie: guest_id=v1%3A139; _twitter_sess=BAh7CSIKZmxhc2hJQz-e1e1;
9− __utma=43838368.452555194.1399611824.1; __utmb=43838368;
10− __utmc=43838368; __utmz=1399611824.1.1.utmcsr=(direct)|utmcmd=(none)
11−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10_8_5)
12− AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.86
13− Safari/537.36
7+Cookie: guest_id=v1%3A139; _twitter_sess=BAh7CSIKZmxhc2hJQz-e1e1; __utma=43838368.452555194.1399611824.1; __utmb=43838368; __utmc=43838368; __utmz=1399611824.1.1.utmcsr=(direct)|utmcmd=(none)
8+User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10_8_5) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.86 Safari/537.36
149
benchmarks/http-response.txt+2−4
@@ -3,10 +3,8 @@ Date: Fri, 09 May 2014 04:24:57 GMT
33Expires: -1
44Cache-Control: private, max-age=0
55Content-Type: text/html; charset=ISO-8859-1
6−Set-Cookie: PREF=ID=1a871afc4240db5e:FF:LM=1399609497:S=e5MZ0itEekjVwNcU;
7− expires=Sun, 08-May-2016 04:24:57 GMT; path=/; domain=.google.com
8−Set-Cookie: NID=67=-WlfaDG6VSEPk7abAjrK98HBSoCD2ID6JKkUR95tEumzDmg7Fc8pSQ8;
9− expires=Sat, 08-Nov-2014 04:24:57 GMT; path=/; domain=.google.com; HttpOnly
6+Set-Cookie: PREF=ID=1a871afc4240db5e:FF:LM=1399609497:S=e5MZ0itEekjVwNcU; expires=Sun, 08-May-2016 04:24:57 GMT; path=/; domain=.google.com
7+Set-Cookie: NID=67=-WlfaDG6VSEPk7abAjrK98HBSoCD2ID6JKkUR95tEumzDmg7Fc8pSQ8; expires=Sat, 08-Nov-2014 04:24:57 GMT; path=/; domain=.google.com; HttpOnly
108P3P: CP="This is not a P3P policy! See http://www.google.com/support/accounts/bin/answer.py?hl=en&answer=151657 for more info."
119Server: gws
1210X-XSS-Protection: 1; mode=block
changelog.md+26
@@ -1,3 +1,29 @@
1+0.13.2.1
2+
3+* Improved performance of `Data.Attoparsec.Text.asciiCI`
4+
5+0.13.2.0
6+
7+* `pure` is now strict in `Position`
8+
9+0.13.1.0
10+
11+* `runScanner` now correctly returns the final state
12+ (https://github.com/bos/attoparsec/issues/105).
13+* `Parser`, `ZeptoT`, `Buffer`, and `More` now expose `Semigroup` instances.
14+* `Parser`, and `ZeptoT` now expose `MonadFail` instances.
15+
16+0.13.0.2
17+
18+* Restore the fast specialised character set implementation for Text
19+* Move testsuite from test-framework to tasty
20+* Performance optimization of takeWhile and takeWhile1
21+
22+0.13.0.1
23+
24+* Fixed a bug in the implementations of inClass and notInClass for
25+ Text (https://github.com/bos/attoparsec/issues/103)
26+
1270.13.0.0
228
329* Made the parser type in the Zepto module a monad transformer
tests/QC.hs+2−2
@@ -6,11 +6,11 @@ import qualified QC.ByteString as ByteString
66import qualified QC.Combinator as Combinator
77import qualified QC.Simple as Simple
88import qualified QC.Text as Text
9−import Test.Framework (defaultMain, testGroup)
9+import Test.Tasty (defaultMain, testGroup)
1010
1111main = defaultMain tests
1212
13−tests = [
13+tests = testGroup "tests" [
1414 testGroup "bs" ByteString.tests
1515 , testGroup "buf" Buffer.tests
1616 , testGroup "combinator" Combinator.tests
tests/QC/Buffer.hs+3−3
@@ -8,8 +8,8 @@ import Control.Applicative ((<$>))
88import Data.Monoid (Monoid(mconcat))
99#endif
1010import QC.Common ()
11−import Test.Framework (Test)
12−import Test.Framework.Providers.QuickCheck2 (testProperty)
11+import Test.Tasty (TestTree)
12+import Test.Tasty.QuickCheck (testProperty)
1313import Test.QuickCheck
1414import qualified Data.Attoparsec.ByteString.Buffer as BB
1515import qualified Data.Attoparsec.Text.Buffer as BT
@@ -82,7 +82,7 @@ t_dropWord16 (BP _ts t buf) = do
8282 i <- choose (0, T.lengthWord16 t)
8383 return $ T.dropWord16 i t === BT.dropWord16 i buf
8484
85−tests :: [Test]
85+tests :: [TestTree]
8686tests = [
8787 testProperty "b_unbuffer" b_unbuffer
8888 , testProperty "t_unbuffer" t_unbuffer
tests/QC/ByteString.hs+7−5
@@ -9,8 +9,8 @@ import Data.Int (Int64)
99import Data.Word (Word8)
1010import Prelude hiding (take, takeWhile)
1111import QC.Common (ASCII(..), liftOp, parseBS, toStrictBS)
12−import Test.Framework (Test)
13−import Test.Framework.Providers.QuickCheck2 (testProperty)
12+import Test.Tasty (TestTree)
13+import Test.Tasty.QuickCheck (testProperty)
1414import Test.QuickCheck
1515import qualified Data.Attoparsec.ByteString as P
1616import qualified Data.Attoparsec.ByteString.Char8 as P8
@@ -26,9 +26,11 @@ import qualified Data.ByteString.Lazy.Char8 as L8
2626satisfy :: Word8 -> L.ByteString -> Property
2727satisfy w s = parseBS (P.satisfy (<=w)) (L.cons w s) === Just w
2828
29−satisfyWith :: Char -> L.ByteString -> Property
30−satisfyWith c s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))
29+satisfyWith :: Word8 -> L.ByteString -> Property
30+satisfyWith w s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))
3131 (L.cons (fromIntegral (ord c)) s) === Just c
32+ where
33+ c = chr (fromIntegral w)
3234
3335word8 :: Word8 -> L.ByteString -> Property
3436word8 w s = parseBS (P.word8 w) (L.cons w s) === Just w
@@ -155,7 +157,7 @@ nonmembers :: [Word8] -> [Word8] -> Property
155157nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s'
156158 where set = S.fromList s
157159
158−tests :: [Test]
160+tests :: [TestTree]
159161tests = [
160162 testProperty "anyWord8" anyWord8
161163 , testProperty "endOfInput" endOfInput
tests/QC/Combinator.hs+3−3
@@ -8,8 +8,8 @@ import Control.Applicative ((<*>), (<$>), (<*), (*>))
88import Data.Maybe (fromJust, isJust)
99import Data.Word (Word8)
1010import QC.Common (Repack, parseBS, repackBS, toLazyBS)
11−import Test.Framework (Test)
12−import Test.Framework.Providers.QuickCheck2 (testProperty)
11+import Test.Tasty (TestTree)
12+import Test.Tasty.QuickCheck (testProperty)
1313import Test.QuickCheck
1414import qualified Data.Attoparsec.ByteString.Char8 as P
1515import qualified Data.Attoparsec.Combinator as C
@@ -43,7 +43,7 @@ match n (NonNegative x) (NonNegative y) rs =
4343 B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'
4444 ]
4545
46−tests :: [Test]
46+tests :: [TestTree]
4747tests = [
4848 testProperty "choice" choice
4949 , testProperty "count" count
tests/QC/Simple.hs+3−3
@@ -10,8 +10,8 @@ import Data.ByteString (ByteString)
1010import Data.List (foldl')
1111import Data.Maybe (fromMaybe)
1212import QC.Rechunked (rechunkBS)
13−import Test.Framework (Test)
14−import Test.Framework.Providers.QuickCheck2 (testProperty)
13+import Test.Tasty (TestTree)
14+import Test.Tasty.QuickCheck (testProperty)
1515import Test.QuickCheck (Property, counterexample, forAll)
1616import qualified Data.Attoparsec.ByteString.Char8 as A
1717
@@ -31,7 +31,7 @@ parse :: A.Parser r -> [ByteString] -> A.Result r
3131parse p (x:xs) = foldl' A.feed (A.parse p x) xs
3232parse p [] = A.parse p ""
3333
34−tests :: [Test]
34+tests :: [TestTree]
3535tests = [
3636 testProperty "issue75" t_issue75
3737 ]
tests/QC/Text.hs+18−6
@@ -6,16 +6,21 @@ module QC.Text (tests) where
66import Control.Applicative ((<*>), (<$>))
77#endif
88import Data.Int (Int64)
9+import Data.Word (Word8)
910import Prelude hiding (take, takeWhile)
1011import QC.Common (liftOp, parseT)
11−import Test.Framework (Test)
12−import Test.Framework.Providers.QuickCheck2 (testProperty)
12+import qualified QC.Text.FastSet as FastSet
13+import qualified QC.Text.Regressions as Regressions
14+import Test.Tasty (TestTree, testGroup)
15+import Test.Tasty.QuickCheck (testProperty)
1316import Test.QuickCheck
1417import qualified Data.Attoparsec.Text as P
1518import qualified Data.Attoparsec.Text.Lazy as PL
1619import qualified Data.Attoparsec.Text.FastSet as S
20+import qualified Data.ByteString as BS
1721import qualified Data.Char as Char
1822import qualified Data.Text as T
23+import qualified Data.Text.Encoding as TE
1924import qualified Data.Text.Lazy as L
2025
2126-- Basic byte-level combinators.
@@ -68,9 +73,12 @@ strings s t u =
6873 === Just t'
6974 where t' = toStrict t
7075
71−stringCI :: T.Text -> Property
72−stringCI s = P.parseOnly (P.stringCI fs) s === Right s
76+-- | Note: "simple, and efficient" works for well formed input...
77+-- i.e. e.g. Latin1 texts
78+stringCI :: [Word8] -> Property
79+stringCI ws = P.parseOnly (P.stringCI fs) s === Right s
7380 where fs = T.toCaseFold s
81+ s = TE.decodeLatin1 (BS.pack ws)
7482
7583asciiCI :: T.Text -> Gen Bool
7684asciiCI x =
@@ -148,7 +156,9 @@ endOfLine s =
148156 (c, fst <$> L.uncons s') === ('\r', Just '\n')
149157
150158scan :: L.Text -> Positive Int64 -> Property
151−scan s (Positive k) = parseT p s === Just (toStrict $ L.take k s)
159+-- for some reason, if counterexample is removed, this test fails?
160+scan s (Positive k) = counterexample (show s)
161+ $ parseT p s === Just (toStrict $ L.take k s)
152162 where p = P.scan k $ \ n _ ->
153163 if n > 0 then let !n' = n - 1 in Just n' else Nothing
154164
@@ -160,7 +170,7 @@ nonmembers :: String -> String -> Property
160170nonmembers s s' = property . not . any (`S.member` set) $ filter (not . (`elem` s)) s'
161171 where set = S.fromList s
162172
163−tests :: [Test]
173+tests :: [TestTree]
164174tests = [
165175 testProperty "anyChar" anyChar
166176 , testProperty "asciiCI" asciiCI
@@ -188,4 +198,6 @@ tests = [
188198 , testProperty "takeWhile1_empty" takeWhile1_empty
189199 , testProperty "members" members
190200 , testProperty "nonmembers" nonmembers
201+ , testGroup "FastSet" FastSet.tests
202+ , testGroup "Regressions" Regressions.tests
191203 ]
tests/QC/Text/FastSet.hsnew file+15
@@ -0,0 +1,15 @@
1+module QC.Text.FastSet where
2+
3+import Test.Tasty (TestTree)
4+import Test.Tasty.QuickCheck (testProperty)
5+import Test.QuickCheck
6+import qualified Data.Attoparsec.Text.FastSet as FastSet
7+
8+membershipCorrect :: String -> String -> Property
9+membershipCorrect members others =
10+ let fs = FastSet.fromList members
11+ correct c = (c `FastSet.member` fs) == (c `elem` members)
12+ in property $ all correct (members ++ others)
13+
14+tests :: [TestTree]
15+tests = [ testProperty "membership is correct" membershipCorrect ]
tests/QC/Text/Regressions.hsnew file+54
@@ -0,0 +1,54 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module QC.Text.Regressions (
4+ tests
5+ ) where
6+
7+import Data.Text (Text)
8+import qualified Data.Text as T
9+import Data.List (foldl')
10+import Data.Maybe (fromMaybe)
11+import Data.Char (isLower)
12+import Data.Monoid ((<>))
13+import QC.Rechunked (rechunkT)
14+import Test.Tasty (TestTree)
15+import Test.Tasty.QuickCheck (testProperty)
16+import Test.QuickCheck (Property, counterexample, forAll)
17+import qualified Data.Attoparsec.Text as A
18+
19+
20+--------------------------------------------------------------------------------
21+-- 105 was about runScanner not always returning the final state. The result
22+-- did depend on how the data was fed to the parser.
23+
24+t_issue105 :: Property
25+t_issue105 = expect issue105 "lowER" (A.Done "ER" "low")
26+
27+issue105 :: A.Parser Text
28+issue105 = do
29+ (_, firstFourLowercaseLetters) <- A.runScanner "" f
30+ return $ firstFourLowercaseLetters
31+
32+ where
33+ f :: Text -> Char -> Maybe Text
34+ f acc c = if T.length acc < 4 && isLower c
35+ then Just $ acc <> T.singleton c
36+ else Nothing
37+
38+
39+expect :: (Show r, Eq r) => A.Parser r -> Text -> A.Result r -> Property
40+expect p input wanted =
41+ forAll (rechunkT input) $ \in' ->
42+ let result = parse p in'
43+ in counterexample (show result ++ " /= " ++ show wanted) $
44+ fromMaybe False (A.compareResults result wanted)
45+
46+parse :: A.Parser r -> [Text] -> A.Result r
47+parse p (x:xs) = foldl' A.feed (A.parse p x) xs
48+parse p [] = A.parse p ""
49+
50+
51+tests :: [TestTree]
52+tests = [
53+ testProperty "issue105" t_issue105
54+ ]