master..05fc26c · typeable/attoparsec

git.iko.soy/typeable/attoparsec

67 files changed+889−3657

unifiedsplit

.gitignore−1 .hgignore+1−5 .hgtags−11 .travis.yml−161 Data/Attoparsec.hs+1−1 Data/Attoparsec/ByteString.hs+19−34 Data/Attoparsec/ByteString/Buffer.hs−156 Data/Attoparsec/ByteString/Char8.hs+54−40 Data/Attoparsec/ByteString/FastSet.hs+1−1 Data/Attoparsec/Internal/Fhthagn.hs → Data/Attoparsec/ByteString/Fhthagn.hs+1−1 Data/Attoparsec/ByteString/Internal.hs+140−148 Data/Attoparsec/ByteString/Lazy.hs+3−10 Data/Attoparsec/Char8.hs+1−1 Data/Attoparsec/Combinator.hs+42−59 Data/Attoparsec/Internal.hs+5−143 Data/Attoparsec/Internal/Types.hs+57−137 Data/Attoparsec/Lazy.hs+1−1 Data/Attoparsec/Number.hs+2−15 Data/Attoparsec/Text.hs+50−61 Data/Attoparsec/Text/Buffer.hs−172 Data/Attoparsec/Text/FastSet.hs+27−85 Data/Attoparsec/Text/Internal.hs+125−132 Data/Attoparsec/Text/Lazy.hs+10−13 Data/Attoparsec/Types.hs+2−3 Data/Attoparsec/Zepto.hs+46−88 README.markdown+6 attoparsec.cabal+27−83 benchmarks/Aeson.hs+3−8 benchmarks/Benchmarks.hs−10 benchmarks/Common.hs−10 benchmarks/Genome.hs−75 benchmarks/HeadersByteString.hs+34−15 benchmarks/HeadersByteString/Atto.hs−57 benchmarks/HeadersText.hs+3−3 benchmarks/Links.hs+2−2 benchmarks/Numbers.hs−1 benchmarks/Sets.hs−21 benchmarks/TextFastSet.hs−121 benchmarks/Warp.hs−17 benchmarks/attoparsec-benchmarks.cabal+3−13 benchmarks/http-request.txt+8−3 benchmarks/http-response.txt+4−2 benchmarks/warp-3.0.1.1/LICENSE−20 benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/ReadInt.hs−67 benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/RequestHeader.hs−172 changelog.md−71 examples/Makefile+2−6 examples/Parsec_RFC2616.hs+6−9 examples/RFC2616.hs+49−24 examples/Atto_RFC2616.hs → examples/TestRFC2616.hs+8−16 examples/attoparsec-examples.cabal−31 examples/http-requests.txt−494 examples/rfc2616.c+21−27 tests/Makefile+14 tests/QC.hs+2−6 tests/QC/Buffer.hs−96 tests/QC/ByteString.hs+9−39 tests/QC/Combinator.hs+5−18 tests/QC/Common.hs+4−34 tests/QC/IPv6/Internal.hs−316 tests/QC/IPv6/Types.hs−29 tests/QC/Rechunked.hs−56 tests/QC/Simple.hs−37 tests/QC/Text.hs+66−100 tests/QC/Text/FastSet.hs−15 tests/QC/Text/Regressions.hs−54 tests/TestFastSet.hs+25

.gitignore−1

@@ -3,4 +3,3 @@

33/dist/

44.cabal-sandbox

55cabal.sandbox.config

6−*.sw[op]

.hgignore+1−5

@@ -1,15 +1,11 @@

1+^(?:\.cabal-sandbox|benchmarks/\.cabal-sandbox|cabal-dev|dist)$

12\.(?:aux|eventlog|h[ip]|hs.html|log|[mt]ix|[oa]|orig|prof|ps|rej|swp)$

23~$

3−^(?:.+/|)\.cabal-sandbox/

4−^(?:.+/|)dist/

54benchmarks/Arse

65benchmarks/dist

76benchmarks/med.txt

87benchmarks/tiny

9−benchmarks/warp-[0-9]*

108cabal.sandbox.config

11−examples/c-http

12−examples/http_parser.[ch]

139hpc.*\.html$

1410

1511syntax: glob

.hgtags−11

@@ -50,14 +50,3 @@ ec23283e88c00af34c3144a8775ca4358daea3f7 0.10.4.0

5050a3c7a521fd58595d6a470ab890cc54a80dd45bd7 0.11.3.1

515138326ce07aca6c8c3a014b0d454d2a5bfdbd6a52 0.11.3.2

5252694039f4fc157a8ca5dce37959391615b6c3f535 0.11.3.3

53−1fe92d1838fb1b1afcee1ca18d4970cf7e01956e 0.11.3.4

54−68203a4cb847da905fa44b5aa1942b99d5867ab4 0.12.0.0

55−c9c2b05707b2fffcd749d5817e3e0d04e6ad6d0d 0.12.1.0

56−9157c2b4c35aa5f683b4ac51e6ff52c696bc22e2 0.12.1.1

57−682ba515f7ba62500ad79371b37b90932e0c0e3d 0.12.1.2

58−2066a72b79b478f59a9c7f1839c522fc59ba9af7 0.12.1.3

59−ef875ad3bebef2b6fb1bd7063de6a46a06d0d4b4 0.12.1.4

60−dc1fcff28d13a508f677c7b06af6420877842493 0.12.1.5

61−013e04e4526bfd5e9e4a611b42e6f03c413bea91 0.12.1.6

62−0ddbce995b77b8db391b4d6519f13feddf4b5bf3 0.13.0.0

63−46c16463ec20ad46c9cd0bfb1050c4268f34b749 0.13.0.1

.travis.ymldeleted−161

@@ -1,161 +0,0 @@

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.hs+1−1

@@ -1,6 +1,6 @@

11-- |

22-- Module : Data.Attoparsec

3−-- Copyright : Bryan O'Sullivan 2007-2015

3+-- Copyright : Bryan O'Sullivan 2007-2014

44-- License : BSD3

55--

66-- Maintainer : bos@serpentine.com

Data/Attoparsec/ByteString.hs+19−34

@@ -1,10 +1,6 @@

1−{-# LANGUAGE CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

51-- |

62-- Module : Data.Attoparsec.ByteString

7−-- Copyright : Bryan O'Sullivan 2007-2015

3+-- Copyright : Bryan O'Sullivan 2007-2014

84-- License : BSD3

95--

106-- Maintainer : bos@serpentine.com

@@ -63,7 +59,6 @@ module Data.Attoparsec.ByteString

6359 , I.skipWhile

6460 , I.take

6561 , I.scan

66− , I.runScanner

6762 , I.takeWhile

6863 , I.takeWhile1

6964 , I.takeTill

@@ -97,7 +92,6 @@ module Data.Attoparsec.ByteString

9792 ) where

9893

9994import Data.Attoparsec.Combinator

100−import Data.List (intercalate)

10195import qualified Data.Attoparsec.ByteString.Internal as I

10296import qualified Data.Attoparsec.Internal as I

10397import qualified Data.ByteString as B

@@ -106,51 +100,50 @@ import qualified Data.Attoparsec.Internal.Types as T

106100

107101-- $parsec

108102--

109−-- Compared to Parsec 3, attoparsec makes several tradeoffs. It is

103+-- Compared to Parsec 3, Attoparsec makes several tradeoffs. It is

110104-- not intended for, or ideal for, all possible uses.

111105--

112−-- * While attoparsec can consume input incrementally, Parsec cannot.

106+-- * While Attoparsec can consume input incrementally, Parsec cannot.

113107-- Incremental input is a huge deal for efficient and secure network

114108-- and system programming, since it gives much more control to users

115109-- of the library over matters such as resource usage and the I/O

116110-- model to use.

117111--

118−-- * Much of the performance advantage of attoparsec is gained via

112+-- * Much of the performance advantage of Attoparsec is gained via

119113-- high-performance parsers such as 'I.takeWhile' and 'I.string'.

120114-- If you use complicated combinators that return lists of bytes or

121115-- characters, there is less performance difference between the two

122116-- libraries.

123117--

124−-- * Unlike Parsec 3, attoparsec does not support being used as a

118+-- * Unlike Parsec 3, Attoparsec does not support being used as a

125119-- monad transformer.

126120--

127−-- * attoparsec is specialised to deal only with strict 'B.ByteString'

121+-- * Attoparsec is specialised to deal only with strict 'B.ByteString'

128122-- input. Efficiency concerns rule out both lists and lazy

129123-- bytestrings. The usual use for lazy bytestrings would be to

130124-- allow consumption of very large input without a large footprint.

131−-- For this need, attoparsec's incremental input provides an

125+-- For this need, Attoparsec's incremental input provides an

132126-- excellent substitute, with much more control over when input

133127-- takes place. If you must use lazy bytestrings, see the

134128-- "Data.Attoparsec.ByteString.Lazy" module, which feeds lazy chunks

135129-- to a regular parser.

136130--

137131-- * Parsec parsers can produce more helpful error messages than

138−-- attoparsec parsers. This is a matter of focus: attoparsec avoids

132+-- Attoparsec parsers. This is a matter of focus: Attoparsec avoids

139133-- the extra book-keeping in favour of higher performance.

140134

141135-- $incremental

142136--

143−-- attoparsec supports incremental input, meaning that you can feed it

137+-- Attoparsec supports incremental input, meaning that you can feed it

144138-- a bytestring that represents only part of the expected total amount

145139-- of data to parse. If your parser reaches the end of a fragment of

146140-- input and could consume more input, it will suspend parsing and

147141-- return a 'T.Partial' continuation.

148142--

149−-- Supplying the 'T.Partial' continuation with a bytestring will

150−-- resume parsing at the point where it was suspended, with the

151−-- bytestring you supplied used as new input at the end of the

152−-- existing input. You must be prepared for the result of the resumed

153−-- parse to be another 'T.Partial' continuation.

143+-- Supplying the 'T.Partial' continuation with another bytestring will

144+-- resume parsing at the point where it was suspended. You must be

145+-- prepared for the result of the resumed parse to be another

146+-- 'T.Partial' continuation.

154147--

155148-- To indicate that you have no more input, supply the 'T.Partial'

156149-- continuation with an empty bytestring.

@@ -162,19 +155,12 @@ import qualified Data.Attoparsec.Internal.Types as T

162155-- If you do not need support for incremental input, consider using

163156-- the 'I.parseOnly' function to run your parser. It will never

164157-- prompt for more input.

165−--

166−-- /Note/: incremental input does /not/ imply that attoparsec will

167−-- release portions of its internal state for garbage collection as it

168−-- proceeds. Its internal representation is equivalent to a single

169−-- 'ByteString': if you feed incremental input to a parser, it will

170−-- require memory proportional to the amount of input you supply.

171−-- (This is necessary to support arbitrary backtracking.)

172158

173159-- $performance

174160--

175−-- If you write an attoparsec-based parser carefully, it can be

176−-- realistic to expect it to perform similarly to a hand-rolled C

177−-- parser (measuring megabytes parsed per second).

161+-- If you write an Attoparsec-based parser carefully, it can be

162+-- realistic to expect it to perform within a factor of 2 of a

163+-- hand-rolled C parser (measuring megabytes parsed per second).

178164--

179165-- To actually achieve high performance, there are a few guidelines

180166-- that it is useful to follow.

@@ -224,7 +210,6 @@ maybeResult _ = Nothing

224210-- | Convert a 'Result' value to an 'Either' value. A 'T.Partial'

225211-- result is treated as failure.

226212eitherResult :: Result r -> Either String r

227−eitherResult (T.Done _ r) = Right r

228−eitherResult (T.Fail _ [] msg) = Left msg

229−eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)

230−eitherResult _ = Left "Result: incomplete input"

213+eitherResult (T.Done _ r) = Right r

214+eitherResult (T.Fail _ _ msg) = Left msg

215+eitherResult _ = Left "Result: incomplete input"

Data/Attoparsec/ByteString/Buffer.hsdeleted−156

@@ -1,156 +0,0 @@

1−{-# LANGUAGE BangPatterns #-}

2−-- |

3−-- Module : Data.Attoparsec.ByteString.Buffer

4−-- Copyright : Bryan O'Sullivan 2007-2015

5−-- License : BSD3

6−--

7−-- Maintainer : bos@serpentine.com

8−-- Stability : experimental

9−-- Portability : GHC

10−--

11−-- An "immutable" buffer that supports cheap appends.

12−--

13−-- A Buffer is divided into an immutable read-only zone, followed by a

14−-- mutable area that we've preallocated, but not yet written to.

15−--

16−-- We overallocate at the end of a Buffer so that we can cheaply

17−-- append. Since a user of an existing Buffer cannot see past the end

18−-- of its immutable zone into the data that will change during an

19−-- append, this is safe.

20−--

21−-- Once we run out of space at the end of a Buffer, we do the usual

22−-- doubling of the buffer size.

23−--

24−-- The fact of having a mutable buffer really helps with performance,

25−-- but it does have a consequence: if someone misuses the Partial API

26−-- that attoparsec uses by calling the same continuation repeatedly

27−-- (which never makes sense in practice), they could overwrite data.

28−--

29−-- Since the API *looks* pure, it should *act* pure, too, so we use

30−-- two generation counters (one mutable, one immutable) to track the

31−-- number of appends to a mutable buffer. If the counters ever get out

32−-- of sync, someone is appending twice to a mutable buffer, so we

33−-- duplicate the entire buffer in order to preserve the immutability

34−-- of its older self.

35−--

36−-- While we could go a step further and gain protection against API

37−-- abuse on a multicore system, by use of an atomic increment

38−-- instruction to bump the mutable generation counter, that would be

39−-- very expensive, and feels like it would also be in the realm of the

40−-- ridiculous. Clients should never call a continuation more than

41−-- once; we lack a linear type system that could enforce this; and

42−-- there's only so far we should go to accommodate broken uses.

43−

44−module Data.Attoparsec.ByteString.Buffer

45− (

46− Buffer

47− , buffer

48− , unbuffer

49− , pappend

50− , length

51− , unsafeIndex

52− , substring

53− , unsafeDrop

54− ) where

55−

56−import Control.Exception (assert)

57−import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)

58−import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)

59−import Data.List (foldl1')

60−import Data.Monoid as Mon (Monoid(..))

61−import Data.Semigroup (Semigroup(..))

62−import Data.Word (Word8)

63−import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)

64−import Foreign.Ptr (castPtr, plusPtr)

65−import Foreign.Storable (peek, peekByteOff, poke, sizeOf)

66−import GHC.ForeignPtr (mallocPlainForeignPtrBytes)

67−import Prelude hiding (length)

68−

69−-- If _cap is zero, this buffer is empty.

70−data Buffer = Buf {

71− _fp :: {-# UNPACK #-} !(ForeignPtr Word8)

72− , _off :: {-# UNPACK #-} !Int

73− , _len :: {-# UNPACK #-} !Int

74− , _cap :: {-# UNPACK #-} !Int

75− , _gen :: {-# UNPACK #-} !Int

76− }

77−

78−instance Show Buffer where

79− showsPrec p = showsPrec p . unbuffer

80−

81−-- | The initial 'Buffer' has no mutable zone, so we can avoid all

82−-- copies in the (hopefully) common case of no further input being fed

83−-- to us.

84−buffer :: ByteString -> Buffer

85−buffer (PS fp off len) = Buf fp off len len 0

86−

87−unbuffer :: Buffer -> ByteString

88−unbuffer (Buf fp off len _ _) = PS fp off len

89−

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−

95−instance Monoid Buffer where

96− mempty = Buf nullForeignPtr 0 0 0 0

97−

98− mappend = (<>)

99−

100− mconcat [] = Mon.mempty

101− mconcat xs = foldl1' mappend xs

102−

103−pappend :: Buffer -> ByteString -> Buffer

104−pappend (Buf _ _ _ 0 _) bs = buffer bs

105−pappend buf (PS fp off len) = append buf fp off len

106−

107−append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer

108−append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 =

109− inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->

110− withForeignPtr fp1 $ \ptr1 -> do

111− let genSize = sizeOf (0::Int)

112− newlen = len0 + len1

113− gen <- if gen0 == 0

114− then return 0

115− else peek (castPtr ptr0)

116− if gen == gen0 && newlen <= cap0

117− then do

118− let newgen = gen + 1

119− poke (castPtr ptr0) newgen

120− memcpy (ptr0 `plusPtr` (off0+len0))

121− (ptr1 `plusPtr` off1)

122− (fromIntegral len1)

123− return (Buf fp0 off0 newlen cap0 newgen)

124− else do

125− let newcap = newlen * 2

126− fp <- mallocPlainForeignPtrBytes (newcap + genSize)

127− withForeignPtr fp $ \ptr_ -> do

128− let ptr = ptr_ `plusPtr` genSize

129− newgen = 1

130− poke (castPtr ptr_) newgen

131− memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)

132− memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)

133− (fromIntegral len1)

134− return (Buf fp genSize newlen newcap newgen)

135−

136−length :: Buffer -> Int

137−length (Buf _ _ len _ _) = len

138−{-# INLINE length #-}

139−

140−unsafeIndex :: Buffer -> Int -> Word8

141−unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) .

142− inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)

143−{-# INLINE unsafeIndex #-}

144−

145−substring :: Int -> Int -> Buffer -> ByteString

146−substring s l (Buf fp off len _ _) =

147− assert (s >= 0 && s <= len) .

148− assert (l >= 0 && l <= len-s) $

149− PS fp (off+s) l

150−{-# INLINE substring #-}

151−

152−unsafeDrop :: Int -> Buffer -> ByteString

153−unsafeDrop s (Buf fp off len _ _) =

154− assert (s >= 0 && s <= len) $

155− PS fp (off+s) (len-s)

156−{-# INLINE unsafeDrop #-}

Data/Attoparsec/ByteString/Char8.hs+54−40

@@ -1,13 +1,10 @@

1−{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, TypeFamilies,

1+{-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies,

22 TypeSynonymInstances, GADTs #-}

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-} -- Imports internal modules

5−#endif

6−{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-}

3+{-# OPTIONS_GHC -fno-warn-orphans #-}

85-- |

96-- Module : Data.Attoparsec.ByteString.Char8

10−-- Copyright : Bryan O'Sullivan 2007-2015

7+-- Copyright : Bryan O'Sullivan 2007-2014

118-- License : BSD3

129--

1310-- Maintainer : bos@serpentine.com

@@ -30,10 +27,9 @@ module Data.Attoparsec.ByteString.Char8

3027

3128 -- * Running parsers

3229 , A.parse

33− , A.feed

3430 , A.parseOnly

35− , A.parseWith

3631 , A.parseTest

32+ , A.parseWith

3733

3834 -- ** Result conversion

3935 , A.maybeResult

@@ -70,7 +66,7 @@ module Data.Attoparsec.ByteString.Char8

7066

7167 -- * Efficient string handling

7268 , I.string

73− , I.stringCI

69+ , stringCI

7470 , skipSpace

7571 , skipWhile

7672 , I.take

@@ -127,11 +123,7 @@ module Data.Attoparsec.ByteString.Char8

127123 , I.atEnd

128124 ) where

129125

130−#if !MIN_VERSION_base(4,8,0)

131−import Control.Applicative (pure, (*>), (<*), (<$>))

132−import Data.Word (Word)

133−#endif

134−import Control.Applicative ((<|>))

126+import Control.Applicative (pure, (*>), (<*), (<$>), (<|>))

135127import Control.Monad (void, when)

136128import Data.Attoparsec.ByteString.FastSet (charClass, memberChar)

137129import Data.Attoparsec.ByteString.Internal (Parser)

@@ -143,7 +135,7 @@ import Data.Int (Int8, Int16, Int32, Int64)

143135import Data.String (IsString(..))

144136import Data.Scientific (Scientific)

145137import qualified Data.Scientific as Sci

146−import Data.Word (Word8, Word16, Word32, Word64)

138+import Data.Word (Word8, Word16, Word32, Word64, Word)

147139import Prelude hiding (takeWhile)

148140import qualified Data.Attoparsec.ByteString as A

149141import qualified Data.Attoparsec.ByteString.Internal as I

@@ -169,6 +161,16 @@ instance (a ~ B.ByteString) => IsString (Parser a) where

169161-- currency sign in ISO-8859-1). Haskell 'Char' values above U+00FF

170162-- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@.

171163

164+-- ASCII-specific but fast, oh yes.

165+toLower :: Word8 -> Word8

166+toLower w | w >= 65 && w <= 90 = w + 32

167+ | otherwise = w

168+

169+-- | Satisfy a literal string, ignoring case.

170+stringCI :: B.ByteString -> Parser B.ByteString

171+stringCI = I.stringTransform (B8.map toLower)

172+{-# INLINE stringCI #-}

173+

172174-- | Consume input as long as the predicate returns 'True', and return

173175-- the consumed input.

174176--

@@ -232,7 +234,7 @@ isDigit c = c >= '0' && c <= '9'

232234

233235-- | A fast digit predicate.

234236isDigit_w8 :: Word8 -> Bool

235−isDigit_w8 w = w - 48 <= 9

237+isDigit_w8 w = w >= 48 && w <= 57

236238{-# INLINE isDigit_w8 #-}

237239

238240-- | Match any character.

@@ -269,7 +271,7 @@ isSpace c = (c == ' ') || ('\t' <= c && c <= '\r')

269271

270272-- | Fast 'Word8' predicate for matching ASCII space characters.

271273isSpace_w8 :: Word8 -> Bool

272−isSpace_w8 w = w == 32 || w - 9 <= 4

274+isSpace_w8 w = (w == 32) || (9 <= w && w <= 13)

273275{-# INLINE isSpace_w8 #-}

274276

275277

@@ -444,8 +446,9 @@ hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit

444446

445447-- | Parse and decode an unsigned decimal number.

446448decimal :: Integral a => Parser a

447−decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDigit_w8

448− where step a w = a * 10 + fromIntegral (w - 48)

449+decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig

450+ where isDig w = w >= 48 && w <= 57

451+ step a w = a * 10 + fromIntegral (w - 48)

449452{-# SPECIALISE decimal :: Parser Int #-}

450453{-# SPECIALISE decimal :: Parser Int8 #-}

451454{-# SPECIALISE decimal :: Parser Int16 #-}

@@ -471,24 +474,6 @@ signed p = (negate <$> (char8 '-' *> p))

471474 <|> (char8 '+' *> p)

472475 <|> p

473476

474−-- | Parse a rational number.

475−--

476−-- The syntax accepted by this parser is the same as for 'double'.

477−--

478−-- /Note/: this parser is not safe for use with inputs from untrusted

479−-- sources. An input with a suitably large exponent such as

480−-- @"1e1000000000"@ will cause a huge 'Integer' to be allocated,

481−-- resulting in what is effectively a denial-of-service attack.

482−--

483−-- In most cases, it is better to use 'double' or 'scientific'

484−-- instead.

485−rational :: Fractional a => Parser a

486−{-# SPECIALIZE rational :: Parser Double #-}

487−{-# SPECIALIZE rational :: Parser Float #-}

488−{-# SPECIALIZE rational :: Parser Rational #-}

489−{-# SPECIALIZE rational :: Parser Scientific #-}

490−rational = scientifically realToFrac

491−

492477-- | Parse a rational number.

493478--

494479-- This parser accepts an optional leading sign character, followed by

@@ -516,12 +501,42 @@ rational = scientifically realToFrac

516501--

517502-- This function does not accept string representations of \"NaN\" or

518503-- \"Infinity\".

504+rational :: Fractional a => Parser a

505+{-# SPECIALIZE rational :: Parser Double #-}

506+{-# SPECIALIZE rational :: Parser Float #-}

507+{-# SPECIALIZE rational :: Parser Rational #-}

508+{-# SPECIALIZE rational :: Parser Scientific #-}

509+rational = scientifically realToFrac

510+

511+-- | Parse a rational number.

512+--

513+-- The syntax accepted by this parser is the same as for 'rational'.

514+--

515+-- /Note/: This function is almost ten times faster than 'rational',

516+-- but is slightly less accurate.

517+--

518+-- The 'Double' type supports about 16 decimal places of accuracy.

519+-- For 94.2% of numbers, this function and 'rational' give identical

520+-- results, but for the remaining 5.8%, this function loses precision

521+-- around the 15th decimal place. For 0.001% of numbers, this

522+-- function will lose precision at the 13th or 14th decimal place.

523+--

524+-- This function does not accept string representations of \"NaN\" or

525+-- \"Infinity\".

519526double :: Parser Double

520527double = scientifically Sci.toRealFloat

521528

522529-- | Parse a number, attempting to preserve both speed and precision.

523530--

524−-- The syntax accepted by this parser is the same as for 'double'.

531+-- The syntax accepted by this parser is the same as for 'rational'.

532+--

533+-- /Note/: This function is almost ten times faster than 'rational'.

534+-- On integral inputs, it gives perfectly accurate answers, and on

535+-- floating point inputs, it is slightly less accurate than

536+-- 'rational'.

537+--

538+-- This function does not accept string representations of \"NaN\" or

539+-- \"

525540number :: Parser Number

526541number = scientifically $ \s ->

527542 let e = Sci.base10Exponent s

@@ -529,11 +544,10 @@ number = scientifically $ \s ->

529544 in if e >= 0

530545 then I (c * 10 ^ e)

531546 else D (Sci.toRealFloat s)

532−{-# DEPRECATED number "Use 'scientific' instead." #-}

533547

534548-- | Parse a scientific number.

535549--

536−-- The syntax accepted by this parser is the same as for 'double'.

550+-- The syntax accepted by this parser is the same as for 'rational'.

537551scientific :: Parser Scientific

538552scientific = scientifically id

539553

Data/Attoparsec/ByteString/FastSet.hs+1−1

@@ -3,7 +3,7 @@

33-----------------------------------------------------------------------------

44-- |

55-- Module : Data.Attoparsec.ByteString.FastSet

6−-- Copyright : Bryan O'Sullivan 2007-2015

6+-- Copyright : Bryan O'Sullivan 2007-2014

77-- License : BSD3

88--

99-- Maintainer : bos@serpentine.com

Data/Attoparsec/Internal/Fhthagn.hs → Data/Attoparsec/ByteString/Fhthagn.hsrenamed+1−1

@@ -1,7 +1,7 @@

11{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings,

22 RecordWildCards, MagicHash, UnboxedTuples #-}

4−module Data.Attoparsec.Internal.Fhthagn

4+module Data.Attoparsec.ByteString.Fhthagn

55 (

66 inlinePerformIO

77 ) where

Data/Attoparsec/ByteString/Internal.hs+140−148

@@ -1,15 +1,14 @@

1−{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,

2− RecordWildCards #-}

1+{-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards #-}

32-- |

43-- Module : Data.Attoparsec.ByteString.Internal

5−-- Copyright : Bryan O'Sullivan 2007-2015

4+-- Copyright : Bryan O'Sullivan 2007-2014

65-- License : BSD3

76--

87-- Maintainer : bos@serpentine.com

98-- Stability : experimental

109-- Portability : unknown

1110--

12−-- Simple, efficient parser combinators for 'ByteString' strings,

11+-- Simple, efficient parser combinators for 'B.ByteString' strings,

1312-- loosely based on the Parsec library.

1413

1514module Data.Attoparsec.ByteString.Internal

@@ -47,7 +46,7 @@ module Data.Attoparsec.ByteString.Internal

4746 -- * Efficient string handling

4847 , skipWhile

4948 , string

50− , stringCI

49+ , stringTransform

5150 , take

5251 , scan

5352 , runScanner

@@ -66,25 +65,18 @@ module Data.Attoparsec.ByteString.Internal

6665 , atEnd

6766 ) where

6867

69−#if !MIN_VERSION_base(4,8,0)

70−import Control.Applicative ((<$>))

71−#endif

72−import Control.Applicative ((<|>))

68+import Control.Applicative ((<|>), (<$>))

7369import Control.Monad (when)

74−import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)

7570import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)

71+import Data.Attoparsec.ByteString.Fhthagn (inlinePerformIO)

7672import Data.Attoparsec.Combinator ((<?>))

77−import Data.Attoparsec.Internal

78−import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)

7973import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)

80−import Data.ByteString (ByteString)

81−import Data.List (intercalate)

8274import Data.Word (Word8)

8375import Foreign.ForeignPtr (withForeignPtr)

8476import Foreign.Ptr (castPtr, minusPtr, plusPtr)

8577import Foreign.Storable (Storable(peek, sizeOf))

8678import Prelude hiding (getChar, succ, take, takeWhile)

87−import qualified Data.Attoparsec.ByteString.Buffer as Buf

79+import Data.ByteString (ByteString)

8880import qualified Data.Attoparsec.Internal.Types as T

8981import qualified Data.ByteString as B8

9082import qualified Data.ByteString.Char8 as B

@@ -92,10 +84,10 @@ import qualified Data.ByteString.Internal as B

9284import qualified Data.ByteString.Lazy as L

9385import qualified Data.ByteString.Unsafe as B

9486

95−type Parser = T.Parser ByteString

96−type Result = IResult ByteString

97−type Failure r = T.Failure ByteString Buffer r

98−type Success a r = T.Success ByteString Buffer a r

87+type Parser = T.Parser B.ByteString B.ByteString

88+type Result = IResult B.ByteString B.ByteString

89+type Failure r = T.Failure B.ByteString B.ByteString r

90+type Success a r = T.Success B.ByteString B.ByteString a r

9991

10092-- | The parser @satisfy p@ succeeds for any byte for which the

10193-- predicate @p@ returns 'True'. Returns the byte that is actually

@@ -141,15 +133,22 @@ storable = hack undefined

141133 hack :: Storable b => b -> Parser b

142134 hack dummy = do

143135 (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)

144− return . inlinePerformIO . withForeignPtr fp $ \p ->

136+ return . B.inlinePerformIO . withForeignPtr fp $ \p ->

145137 peek (castPtr $ p `plusPtr` o)

146138

147−-- | Consume exactly @n@ bytes of input.

148−take :: Int -> Parser ByteString

149−take n0 = do

139+-- | Consume @n@ bytes of input, but succeed only if the predicate

140+-- returns 'True'.

141+takeWith :: Int -> (B.ByteString -> Bool) -> Parser B.ByteString

142+takeWith n0 p = do

150143 let n = max n0 0

151144 s <- ensure n

152− advance n >> return s

145+ if p s

146+ then advance n >> return s

147+ else fail "takeWith"

148+

149+-- | Consume exactly @n@ bytes of input.

150+take :: Int -> Parser B.ByteString

151+take n = takeWith n (const True)

153152{-# INLINE take #-}

154153

155154-- | @string s@ parses a sequence of bytes that identically match

@@ -165,62 +164,16 @@ take n0 = do

165164--

166165-- The reason for its failure is that the first branch is a

167166-- partial match, and will consume the letters @\'f\'@ and @\'o\'@

168−-- before failing. In attoparsec, the above parser will /succeed/ on

167+-- before failing. In Attoparsec, the above parser will /succeed/ on

169168-- that input, because the failed first branch will consume nothing.

170−string :: ByteString -> Parser ByteString

171−string s = string_ (stringSuspended id) id s

169+string :: B.ByteString -> Parser B.ByteString

170+string s = takeWith (B.length s) (==s)

172171{-# INLINE string #-}

173172

174−-- ASCII-specific but fast, oh yes.

175−toLower :: Word8 -> Word8

176−toLower w | w >= 65 && w <= 90 = w + 32

177− | otherwise = w

178−

179−-- | Satisfy a literal string, ignoring case.

180−stringCI :: ByteString -> Parser ByteString

181−stringCI s = string_ (stringSuspended lower) lower s

182− where lower = B8.map toLower

183−{-# INLINE stringCI #-}

184−

185−string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More

186− -> Failure r -> Success ByteString r -> Result r)

187− -> (ByteString -> ByteString)

188− -> ByteString -> Parser ByteString

189−string_ suspended f s0 = T.Parser $ \t pos more lose succ ->

190− let n = B.length s

191− s = f s0

192− in if lengthAtLeast pos n t

193− then let t' = substring pos (Pos n) t

194− in if s == f t'

195− then succ t (pos + Pos n) more t'

196− else lose t pos more [] "string"

197− else let t' = Buf.unsafeDrop (fromPos pos) t

198− in if f t' `B.isPrefixOf` s

199− then suspended s (B.drop (B.length t') s) t pos more lose succ

200− else lose t pos more [] "string"

201−{-# INLINE string_ #-}

202−

203−stringSuspended :: (ByteString -> ByteString)

204− -> ByteString -> ByteString -> Buffer -> Pos -> More

205− -> Failure r

206− -> Success ByteString r

207− -> Result r

208−stringSuspended f s0 s t pos more lose succ =

209− runParser (demandInput_ >>= go) t pos more lose succ

210− where go s'0 = T.Parser $ \t' pos' more' lose' succ' ->

211− let m = B.length s

212− s' = f s'0

213− n = B.length s'

214− in if n >= m

215− then if B.unsafeTake m s' == s

216− then let o = Pos (B.length s0)

217− in succ' t' (pos' + o) more'

218− (substring pos' o t')

219− else lose' t' pos' more' [] "string"

220− else if s' == B.unsafeTake n s

221− then stringSuspended f s0 (B.unsafeDrop n s)

222− t' pos' more' lose' succ'

223− else lose' t' pos' more' [] "string"

173+stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString

174+ -> Parser B.ByteString

175+stringTransform f s = takeWith (B.length s) ((==f s) . f)

176+{-# INLINE stringTransform #-}

224177

225178-- | Skip past input for as long as the predicate returns 'True'.

226179skipWhile :: (Word8 -> Bool) -> Parser ()

@@ -228,8 +181,11 @@ skipWhile p = go

228181 where

229182 go = do

230183 t <- B8.takeWhile p <$> get

231− continue <- inputSpansChunks (B.length t)

232− when continue go

184+ advance (B.length t)

185+ eoc <- endOfChunk

186+ when eoc $ do

187+ input <- wantInput

188+ when input go

233189{-# INLINE skipWhile #-}

234190

235191-- | Consume input as long as the predicate returns 'False'

@@ -242,7 +198,7 @@ skipWhile p = go

242198-- combinators such as 'Control.Applicative.many', because such

243199-- parsers loop until a failure occurs. Careless use will thus result

244200-- in an infinite loop.

245−takeTill :: (Word8 -> Bool) -> Parser ByteString

201+takeTill :: (Word8 -> Bool) -> Parser B.ByteString

246202takeTill p = takeWhile (not . p)

247203{-# INLINE takeTill #-}

248204

@@ -256,27 +212,23 @@ takeTill p = takeWhile (not . p)

256212-- combinators such as 'Control.Applicative.many', because such

257213-- parsers loop until a failure occurs. Careless use will thus result

258214-- in an infinite loop.

259−takeWhile :: (Word8 -> Bool) -> Parser ByteString

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

215+takeWhile :: (Word8 -> Bool) -> Parser B.ByteString

216+takeWhile p = (B.concat . reverse) `fmap` go []

270217 where

271218 go acc = do

272219 s <- B8.takeWhile p <$> get

273− continue <- inputSpansChunks (B.length s)

274− if continue

275− then go (s:acc)

276− else return $ concatReverse (s:acc)

277−{-# INLINE takeWhileAcc #-}

220+ advance (B.length s)

221+ eoc <- endOfChunk

222+ if eoc

223+ then do

224+ input <- wantInput

225+ if input

226+ then go (s:acc)

227+ else return (s:acc)

228+ else return (s:acc)

229+{-# INLINE takeWhile #-}

278230

279−takeRest :: Parser [ByteString]

231+takeRest :: Parser [B.ByteString]

280232takeRest = go []

281233 where

282234 go acc = do

@@ -289,7 +241,7 @@ takeRest = go []

289241 else return (reverse acc)

290242

291243-- | Consume all remaining input and return it as a single string.

292−takeByteString :: Parser ByteString

244+takeByteString :: Parser B.ByteString

293245takeByteString = B.concat `fmap` takeRest

294246

295247-- | Consume all remaining input and return it as a single string.

@@ -298,7 +250,7 @@ takeLazyByteString = L.fromChunks `fmap` takeRest

298250

299251data T s = T {-# UNPACK #-} !Int s

300252

301−scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)

253+scan_ :: (s -> [B.ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)

302254 -> Parser r

303255scan_ f s0 p = go [] s0

304256 where

@@ -319,9 +271,14 @@ scan_ f s0 p = go [] s0

319271 bs <- get

320272 let T i s' = inlinePerformIO $ scanner bs

321273 !h = B.unsafeTake i bs

322− continue <- inputSpansChunks i

323− if continue

324− then go (h:acc) s'

274+ advance i

275+ eoc <- endOfChunk

276+ if eoc

277+ then do

278+ input <- wantInput

279+ if input

280+ then go (h:acc) s'

281+ else f s' (h:acc)

325282 else f s' (h:acc)

326283{-# INLINE scan_ #-}

327284

@@ -337,14 +294,17 @@ scan_ f s0 p = go [] s0

337294-- combinators such as 'Control.Applicative.many', because such

338295-- parsers loop until a failure occurs. Careless use will thus result

339296-- in an infinite loop.

340−scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString

341−scan = scan_ $ \_ chunks -> return $! concatReverse chunks

297+scan :: s -> (s -> Word8 -> Maybe s) -> Parser B.ByteString

298+scan = scan_ $ \_ chunks ->

299+ case chunks of

300+ [x] -> return x

301+ xs -> return $! B.concat $ reverse xs

342302{-# INLINE scan #-}

343303

344304-- | Like 'scan', but generalized to return the final state of the

345305-- scanner.

346−runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)

347−runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)

306+runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (B.ByteString, s)

307+runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)

348308{-# INLINE runScanner #-}

349309

350310-- | Consume input as long as the predicate returns 'True', and return

@@ -353,7 +313,7 @@ runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)

353313-- This parser requires the predicate to succeed on at least one byte

354314-- of input: it will fail if the predicate never returns 'True' or if

355315-- there is no input left.

356−takeWhile1 :: (Word8 -> Bool) -> Parser ByteString

316+takeWhile1 :: (Word8 -> Bool) -> Parser B.ByteString

357317takeWhile1 p = do

358318 (`when` demandInput) =<< endOfChunk

359319 s <- B8.takeWhile p <$> get

@@ -364,9 +324,8 @@ takeWhile1 p = do

364324 advance len

365325 eoc <- endOfChunk

366326 if eoc

367− then takeWhileAcc p [s]

327+ then (s<>) `fmap` takeWhile p

368328 else return s

369−{-# INLINE takeWhile1 #-}

370329

371330-- | Match any byte in a set.

372331--

@@ -414,13 +373,13 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c

414373peekWord8 :: Parser (Maybe Word8)

415374peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->

416375 case () of

417− _| pos_ < Buf.length t ->

418− let !w = Buf.unsafeIndex t pos_

376+ _| pos_ < B.length t ->

377+ let !w = B.unsafeIndex t pos_

419378 in succ t pos more (Just w)

420379 | more == Complete ->

421380 succ t pos more Nothing

422381 | otherwise ->

423− let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_

382+ let succ' t' pos' more' = let !w = B.unsafeIndex t pos_

424383 in succ t' pos' more' (Just w)

425384 lose' t' pos' more' = succ t' pos' more' Nothing

426385 in prompt t pos more lose' succ'

@@ -431,7 +390,7 @@ peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->

431390peekWord8' :: Parser Word8

432391peekWord8' = T.Parser $ \t pos more lose succ ->

433392 if lengthAtLeast pos 1 t

434− then succ t pos more (Buf.unsafeIndex t (fromPos pos))

393+ then succ t pos more (B.unsafeIndex t (fromPos pos))

435394 else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs'

436395 in ensureSuspended 1 t pos more lose succ'

437396{-# INLINE peekWord8' #-}

@@ -443,62 +402,43 @@ endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ())

443402

444403-- | Terminal failure continuation.

445404failK :: Failure a

446−failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg

405+failK t (Pos pos) _more stack msg = Fail (B.unsafeDrop pos t) stack msg

447406{-# INLINE failK #-}

448407

449408-- | Terminal success continuation.

450409successK :: Success a a

451−successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a

410+successK t (Pos pos) _more a = Done (B.unsafeDrop pos t) a

452411{-# INLINE successK #-}

453412

454413-- | Run a parser.

455−parse :: Parser a -> ByteString -> Result a

456−parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK

414+parse :: Parser a -> B.ByteString -> Result a

415+parse m s = T.runParser m s (Pos 0) Incomplete failK successK

457416{-# INLINE parse #-}

458417

459418-- | Run a parser that cannot be resupplied via a 'Partial' result.

460−--

461−-- This function does not force a parser to consume all of its input.

462−-- Instead, any residual input will be discarded. To force a parser

463−-- to consume all of its input, use something like this:

464−--

465−-- @

466−--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')

467−-- @

468−parseOnly :: Parser a -> ByteString -> Either String a

469−parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of

470− Fail _ [] err -> Left err

471− Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)

472− Done _ a -> Right a

473− _ -> error "parseOnly: impossible error!"

419+parseOnly :: Parser a -> B.ByteString -> Either String a

420+parseOnly m s = case T.runParser m s (Pos 0) Complete failK successK of

421+ Fail _ _ err -> Left err

422+ Done _ a -> Right a

423+ _ -> error "parseOnly: impossible error!"

474424{-# INLINE parseOnly #-}

475425

476426get :: Parser ByteString

477427get = T.Parser $ \t pos more _lose succ ->

478− succ t pos more (Buf.unsafeDrop (fromPos pos) t)

428+ succ t pos more (B.unsafeDrop (fromPos pos) t)

479429{-# INLINE get #-}

480430

481431endOfChunk :: Parser Bool

482432endOfChunk = T.Parser $ \t pos more _lose succ ->

483− succ t pos more (fromPos pos == Buf.length t)

433+ succ t pos more (fromPos pos == B.length t)

484434{-# INLINE endOfChunk #-}

485435

486−inputSpansChunks :: Int -> Parser Bool

487−inputSpansChunks i = T.Parser $ \t pos_ more _lose succ ->

488− let pos = pos_ + Pos i

489− in if fromPos pos < Buf.length t || more == Complete

490− then succ t pos more False

491− else let lose' t' pos' more' = succ t' pos' more' False

492− succ' t' pos' more' = succ t' pos' more' True

493− in prompt t pos more lose' succ'

494−{-# INLINE inputSpansChunks #-}

495−

496436advance :: Int -> Parser ()

497437advance n = T.Parser $ \t pos more _lose succ ->

498438 succ t (pos + Pos n) more ()

499439{-# INLINE advance #-}

500440

501−ensureSuspended :: Int -> Buffer -> Pos -> More

441+ensureSuspended :: Int -> ByteString -> Pos -> More

502442 -> Failure r

503443 -> Success ByteString r

504444 -> Result r

@@ -517,8 +457,54 @@ ensure n = T.Parser $ \t pos more lose succ ->

517457 then succ t pos more (substring pos (Pos n) t)

518458 -- The uncommon case is kept out-of-line to reduce code size:

519459 else ensureSuspended n t pos more lose succ

460+-- Non-recursive so the bounds check can be inlined:

520461{-# INLINE ensure #-}

521462

463+-- | Ask for input. If we receive any, pass it to a success

464+-- continuation, otherwise to a failure continuation.

465+prompt :: ByteString -> Pos -> More

466+ -> (ByteString -> Pos -> More -> IResult ByteString ByteString r)

467+ -> (ByteString -> Pos -> More -> IResult ByteString ByteString r)

468+ -> IResult ByteString ByteString r

469+prompt t pos _more lose succ = Partial $ \s ->

470+ if B.null s

471+ then lose t pos Complete

472+ else succ (t <> s) pos Incomplete

473+

474+-- | Immediately demand more input via a 'Partial' continuation

475+-- result.

476+demandInput :: Parser ()

477+demandInput = T.Parser $ \t pos more lose succ ->

478+ case more of

479+ Complete -> lose t pos more [] "not enough input"

480+ _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"

481+ succ' t' pos' more' = succ t' pos' more' ()

482+ in prompt t pos more lose' succ'

483+

484+-- | This parser always succeeds. It returns 'True' if any input is

485+-- available either immediately or on demand, and 'False' if the end

486+-- of all input has been reached.

487+wantInput :: Parser Bool

488+wantInput = T.Parser $ \t pos more _lose succ ->

489+ case () of

490+ _ | lengthAtLeast pos 1 t -> succ t pos more True

491+ | more == Complete -> succ t pos more False

492+ | otherwise -> let lose' t' pos' more' = succ t' pos' more' False

493+ succ' t' pos' more' = succ t' pos' more' True

494+ in prompt t pos more lose' succ'

495+{-# INLINE wantInput #-}

496+

497+-- | Match only if all input has been consumed.

498+endOfInput :: Parser ()

499+endOfInput = T.Parser $ \t pos more lose succ ->

500+ case () of

501+ _| lengthAtLeast pos 1 t -> lose t pos more [] "endOfInput"

502+ | more == Complete -> succ t pos more ()

503+ | otherwise ->

504+ let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()

505+ succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput"

506+ in runParser demandInput t pos more lose' succ'

507+

522508-- | Return both the result of a parse and the portion of the input

523509-- that was consumed while it was being parsed.

524510match :: Parser a -> Parser (ByteString, a)

@@ -527,10 +513,16 @@ match p = T.Parser $ \t pos more lose succ ->

527513 succ t' pos' more' (substring pos (pos'-pos) t', a)

528514 in runParser p t pos more lose succ'

529515

530−lengthAtLeast :: Pos -> Int -> Buffer -> Bool

531−lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n

516+-- | Return an indication of whether the end of input has been

517+-- reached.

518+atEnd :: Parser Bool

519+atEnd = not <$> wantInput

520+{-# INLINE atEnd #-}

521+

522+lengthAtLeast :: Pos -> Int -> ByteString -> Bool

523+lengthAtLeast (Pos pos) n bs = B.length bs >= pos + n

532524{-# INLINE lengthAtLeast #-}

533525

534−substring :: Pos -> Pos -> Buffer -> ByteString

535−substring (Pos pos) (Pos n) = Buf.substring pos n

526+substring :: Pos -> Pos -> ByteString -> ByteString

527+substring (Pos pos) (Pos n) bs = B.unsafeTake n (B.unsafeDrop pos bs)

536528{-# INLINE substring #-}

Data/Attoparsec/ByteString/Lazy.hs+3−10

@@ -1,11 +1,6 @@

1−{-# LANGUAGE CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-} -- Imports internal modules

4−#endif

5−

61-- |

72-- Module : Data.Attoparsec.ByteString.Lazy

8−-- Copyright : Bryan O'Sullivan 2007-2015

3+-- Copyright : Bryan O'Sullivan 2007-2014

94-- License : BSD3

105--

116-- Maintainer : bos@serpentine.com

@@ -41,7 +36,6 @@ module Data.Attoparsec.ByteString.Lazy

4136

4237import Control.DeepSeq (NFData(rnf))

4338import Data.ByteString.Lazy.Internal (ByteString(..), chunk)

44−import Data.List (intercalate)

4539import qualified Data.ByteString as B

4640import qualified Data.Attoparsec.ByteString as A

4741import qualified Data.Attoparsec.Internal.Types as T

@@ -105,6 +99,5 @@ maybeResult _ = Nothing

10599

106100-- | Convert a 'Result' value to an 'Either' value.

107101eitherResult :: Result r -> Either String r

108−eitherResult (Done _ r) = Right r

109−eitherResult (Fail _ [] msg) = Left msg

110−eitherResult (Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)

102+eitherResult (Done _ r) = Right r

103+eitherResult (Fail _ _ msg) = Left msg

Data/Attoparsec/Char8.hs+1−1

@@ -1,6 +1,6 @@

11-- |

22-- Module : Data.Attoparsec.Char8

3−-- Copyright : Bryan O'Sullivan 2007-2015

3+-- Copyright : Bryan O'Sullivan 2007-2014

44-- License : BSD3

55--

66-- Maintainer : bos@serpentine.com

Data/Attoparsec/Combinator.hs+42−59

@@ -1,10 +1,7 @@

1−{-# LANGUAGE BangPatterns, CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-} -- Imports internal modules

4−#endif

1+{-# LANGUAGE BangPatterns #-}

52-- |

63-- Module : Data.Attoparsec.Combinator

7−-- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2015

4+-- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014

85-- License : BSD3

96--

107-- Maintainer : bos@serpentine.com

@@ -33,21 +30,14 @@ module Data.Attoparsec.Combinator

3330 , skipMany1

3431 , eitherP

3532 , feed

36− , satisfyElem

37− , endOfInput

38− , atEnd

39− , lookAhead

4033 ) where

4134

42−#if !MIN_VERSION_base(4,8,0)

43−import Control.Applicative (Applicative(..), (<$>))

44−import Data.Monoid (Monoid(mappend))

45−#endif

46−import Control.Applicative (Alternative(..), empty, liftA2, many, (<|>))

35+import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2,

36+ many, (<|>), (*>), (<$>))

4737import Control.Monad (MonadPlus(..))

4838import Data.Attoparsec.Internal.Types (Parser(..), IResult(..))

49−import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem)

5039import Data.ByteString (ByteString)

40+import Data.Monoid (Monoid(mappend))

5141import Data.Text (Text)

5242import qualified Data.Attoparsec.Zepto as Z

5343import Prelude hiding (succ)

@@ -56,15 +46,15 @@ import Prelude hiding (succ)

5646-- input appears to have been consumed.

5747--

5848-- This combinator is provided for compatibility with Parsec.

59−-- attoparsec parsers always backtrack on failure.

60−try :: Parser i a -> Parser i a

49+-- Attoparsec parsers always backtrack on failure.

50+try :: Parser i t a -> Parser i t a

6151try p = p

6252{-# INLINE try #-}

6353

6454-- | Name the parser, in case failure occurs.

65−(<?>) :: Parser i a

55+(<?>) :: Parser i t a

6656 -> String -- ^ the name to use if parsing fails

67− -> Parser i a

57+ -> Parser i t a

6858p <?> msg0 = Parser $ \t pos more lose succ ->

6959 let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg

7060 in runParser p t pos more lose' succ

@@ -76,9 +66,9 @@ infix 0 <?>

7666-- action.

7767choice :: Alternative f => [f a] -> f a

7868choice = foldr (<|>) empty

79−{-# SPECIALIZE choice :: [Parser ByteString a]

80− -> Parser ByteString a #-}

81−{-# SPECIALIZE choice :: [Parser Text a] -> Parser Text a #-}

69+{-# SPECIALIZE choice :: [Parser ByteString ByteString a]

70+ -> Parser ByteString ByteString a #-}

71+{-# SPECIALIZE choice :: [Parser Text Text a] -> Parser Text Text a #-}

8272{-# SPECIALIZE choice :: [Z.Parser a] -> Z.Parser a #-}

8373

8474-- | @option x p@ tries to apply action @p@. If @p@ fails without

@@ -88,8 +78,8 @@ choice = foldr (<|>) empty

8878-- > priority = option 0 (digitToInt <$> digit)

8979option :: Alternative f => a -> f a -> f a

9080option x p = p <|> pure x

91−{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-}

92−{-# SPECIALIZE option :: a -> Parser Text a -> Parser Text a #-}

81+{-# SPECIALIZE option :: a -> Parser ByteString ByteString a -> Parser ByteString ByteString a #-}

82+{-# SPECIALIZE option :: a -> Parser Text Text a -> Parser Text Text a #-}

9383{-# SPECIALIZE option :: a -> Z.Parser a -> Z.Parser a #-}

9484

9585-- | A version of 'liftM2' that is strict in the result of its first

@@ -132,50 +122,50 @@ many1' p = liftM2' (:) p (many' p)

132122-- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated

133123-- by @sep@. Returns a list of the values returned by @p@.

134124--

135−-- > commaSep p = p `sepBy` (char ',')

125+-- > commaSep p = p `sepBy` (symbol ",")

136126sepBy :: Alternative f => f a -> f s -> f [a]

137127sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure []

138−{-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s

139− -> Parser ByteString [a] #-}

140−{-# SPECIALIZE sepBy :: Parser Text a -> Parser Text s -> Parser Text [a] #-}

128+{-# SPECIALIZE sepBy :: Parser ByteString ByteString a -> Parser ByteString ByteString s

129+ -> Parser ByteString ByteString [a] #-}

130+{-# SPECIALIZE sepBy :: Parser Text Text a -> Parser Text Text s -> Parser Text Text [a] #-}

141131{-# SPECIALIZE sepBy :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}

142132

143133-- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated

144134-- by @sep@. Returns a list of the values returned by @p@. The value

145135-- returned by @p@ is forced to WHNF.

146136--

147−-- > commaSep p = p `sepBy'` (char ',')

137+-- > commaSep p = p `sepBy'` (symbol ",")

148138sepBy' :: (MonadPlus m) => m a -> m s -> m [a]

149139sepBy' p s = scan `mplus` return []

150140 where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return [])

151−{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s

152− -> Parser ByteString [a] #-}

153−{-# SPECIALIZE sepBy' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}

141+{-# SPECIALIZE sepBy' :: Parser ByteString ByteString a -> Parser ByteString ByteString s

142+ -> Parser ByteString ByteString [a] #-}

143+{-# SPECIALIZE sepBy' :: Parser Text Text a -> Parser Text Text s -> Parser Text Text [a] #-}

154144{-# SPECIALIZE sepBy' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}

155145

156146-- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated

157147-- by @sep@. Returns a list of the values returned by @p@.

158148--

159−-- > commaSep p = p `sepBy1` (char ',')

149+-- > commaSep p = p `sepBy1` (symbol ",")

160150sepBy1 :: Alternative f => f a -> f s -> f [a]

161151sepBy1 p s = scan

162152 where scan = liftA2 (:) p ((s *> scan) <|> pure [])

163−{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s

164− -> Parser ByteString [a] #-}

165−{-# SPECIALIZE sepBy1 :: Parser Text a -> Parser Text s -> Parser Text [a] #-}

153+{-# SPECIALIZE sepBy1 :: Parser ByteString ByteString a -> Parser ByteString ByteString s

154+ -> Parser ByteString ByteString [a] #-}

155+{-# SPECIALIZE sepBy1 :: Parser Text Text a -> Parser Text Text s -> Parser Text Text [a] #-}

166156{-# SPECIALIZE sepBy1 :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}

167157

168158-- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated

169159-- by @sep@. Returns a list of the values returned by @p@. The value

170160-- returned by @p@ is forced to WHNF.

171161--

172−-- > commaSep p = p `sepBy1'` (char ',')

162+-- > commaSep p = p `sepBy1'` (symbol ",")

173163sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]

174164sepBy1' p s = scan

175165 where scan = liftM2' (:) p ((s >> scan) `mplus` return [])

176−{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s

177− -> Parser ByteString [a] #-}

178−{-# SPECIALIZE sepBy1' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}

166+{-# SPECIALIZE sepBy1' :: Parser ByteString ByteString a -> Parser ByteString ByteString s

167+ -> Parser ByteString ByteString [a] #-}

168+{-# SPECIALIZE sepBy1' :: Parser Text Text a -> Parser Text Text s -> Parser Text Text [a] #-}

179169{-# SPECIALIZE sepBy1' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}

180170

181171-- | @manyTill p end@ applies action @p@ /zero/ or more times until

@@ -190,9 +180,9 @@ sepBy1' p s = scan

190180manyTill :: Alternative f => f a -> f b -> f [a]

191181manyTill p end = scan

192182 where scan = (end *> pure []) <|> liftA2 (:) p scan

193−{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b

194− -> Parser ByteString [a] #-}

195−{-# SPECIALIZE manyTill :: Parser Text a -> Parser Text b -> Parser Text [a] #-}

183+{-# SPECIALIZE manyTill :: Parser ByteString ByteString a -> Parser ByteString ByteString b

184+ -> Parser ByteString ByteString [a] #-}

185+{-# SPECIALIZE manyTill :: Parser Text Text a -> Parser Text Text b -> Parser Text Text [a] #-}

196186{-# SPECIALIZE manyTill :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-}

197187

198188-- | @manyTill' p end@ applies action @p@ /zero/ or more times until

@@ -209,24 +199,24 @@ manyTill p end = scan

209199manyTill' :: (MonadPlus m) => m a -> m b -> m [a]

210200manyTill' p end = scan

211201 where scan = (end >> return []) `mplus` liftM2' (:) p scan

212−{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b

213− -> Parser ByteString [a] #-}

214−{-# SPECIALIZE manyTill' :: Parser Text a -> Parser Text b -> Parser Text [a] #-}

202+{-# SPECIALIZE manyTill' :: Parser ByteString ByteString a -> Parser ByteString ByteString b

203+ -> Parser ByteString ByteString [a] #-}

204+{-# SPECIALIZE manyTill' :: Parser Text Text a -> Parser Text Text b -> Parser Text Text [a] #-}

215205{-# SPECIALIZE manyTill' :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-}

216206

217207-- | Skip zero or more instances of an action.

218208skipMany :: Alternative f => f a -> f ()

219209skipMany p = scan

220210 where scan = (p *> scan) <|> pure ()

221−{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-}

222−{-# SPECIALIZE skipMany :: Parser Text a -> Parser Text () #-}

211+{-# SPECIALIZE skipMany :: Parser ByteString ByteString a -> Parser ByteString ByteString () #-}

212+{-# SPECIALIZE skipMany :: Parser Text Text a -> Parser Text Text () #-}

223213{-# SPECIALIZE skipMany :: Z.Parser a -> Z.Parser () #-}

224214

225215-- | Skip one or more instances of an action.

226216skipMany1 :: Alternative f => f a -> f ()

227217skipMany1 p = p *> skipMany p

228−{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-}

229−{-# SPECIALIZE skipMany1 :: Parser Text a -> Parser Text () #-}

218+{-# SPECIALIZE skipMany1 :: Parser ByteString ByteString a -> Parser ByteString ByteString () #-}

219+{-# SPECIALIZE skipMany1 :: Parser Text Text a -> Parser Text Text () #-}

230220{-# SPECIALIZE skipMany1 :: Z.Parser a -> Z.Parser () #-}

231221

232222-- | Apply the given action repeatedly, returning every result.

@@ -241,15 +231,8 @@ eitherP a b = (Left <$> a) <|> (Right <$> b)

241231

242232-- | If a parser has returned a 'T.Partial' result, supply it with more

243233-- input.

244−feed :: Monoid i => IResult i r -> i -> IResult i r

245−feed (Fail t ctxs msg) d = Fail (mappend t d) ctxs msg

234+feed :: Monoid t => IResult t t r -> t -> IResult t t r

235+feed f@(Fail _ _ _) _ = f

246236feed (Partial k) d = k d

247237feed (Done t r) d = Done (mappend t d) r

248238{-# INLINE feed #-}

249−

250−-- | Apply a parser without consuming any input.

251−lookAhead :: Parser i a -> Parser i a

252−lookAhead p = Parser $ \t pos more lose succ ->

253− let succ' t' _pos' more' = succ t' pos more'

254− in runParser p t pos more lose succ'

255−{-# INLINE lookAhead #-}

Data/Attoparsec/Internal.hs+5−143

@@ -1,7 +1,7 @@

1−{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}

1+{-# LANGUAGE BangPatterns #-}

22-- |

33-- Module : Data.Attoparsec.Internal

4−-- Copyright : Bryan O'Sullivan 2007-2015

4+-- Copyright : Bryan O'Sullivan 2007-2014

55-- License : BSD3

66--

77-- Maintainer : bos@serpentine.com

@@ -12,24 +12,11 @@

1212-- library.

1313

1414module Data.Attoparsec.Internal

15− ( compareResults

16− , prompt

17− , demandInput

18− , demandInput_

19− , wantInput

20− , endOfInput

21− , atEnd

22− , satisfyElem

23− , concatReverse

15+ (

16+ compareResults

2417 ) where

2518

26−#if !MIN_VERSION_base(4,8,0)

27−import Control.Applicative ((<$>))

28−import Data.Monoid (Monoid, mconcat)

29−#endif

3019import Data.Attoparsec.Internal.Types

31−import Data.ByteString (ByteString)

32−import Data.Text (Text)

3320import Prelude hiding (succ)

3421

3522-- | Compare two 'IResult' values for equality.

@@ -37,135 +24,10 @@ import Prelude hiding (succ)

3724-- If both 'IResult's are 'Partial', the result will be 'Nothing', as

3825-- they are incomplete and hence their equality cannot be known.

3926-- (This is why there is no 'Eq' instance for 'IResult'.)

40−compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool

27+compareResults :: (Eq i, Eq r) => IResult i t r -> IResult i t r -> Maybe Bool

4128compareResults (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) =

4229 Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1)

4330compareResults (Done t0 r0) (Done t1 r1) =

4431 Just (t0 == t1 && r0 == r1)

4532compareResults (Partial _) (Partial _) = Nothing

4633compareResults _ _ = Just False

47−

48−-- | Ask for input. If we receive any, pass the augmented input to a

49−-- success continuation, otherwise to a failure continuation.

50−prompt :: Chunk t

51− => State t -> Pos -> More

52− -> (State t -> Pos -> More -> IResult t r)

53− -> (State t -> Pos -> More -> IResult t r)

54− -> IResult t r

55−prompt t pos _more lose succ = Partial $ \s ->

56− if nullChunk s

57− then lose t pos Complete

58− else succ (pappendChunk t s) pos Incomplete

59−{-# SPECIALIZE prompt :: State ByteString -> Pos -> More

60− -> (State ByteString -> Pos -> More

61− -> IResult ByteString r)

62− -> (State ByteString -> Pos -> More

63− -> IResult ByteString r)

64− -> IResult ByteString r #-}

65−{-# SPECIALIZE prompt :: State Text -> Pos -> More

66− -> (State Text -> Pos -> More -> IResult Text r)

67− -> (State Text -> Pos -> More -> IResult Text r)

68− -> IResult Text r #-}

69−

70−-- | Immediately demand more input via a 'Partial' continuation

71−-- result.

72−demandInput :: Chunk t => Parser t ()

73−demandInput = Parser $ \t pos more lose succ ->

74− case more of

75− Complete -> lose t pos more [] "not enough input"

76− _ -> let lose' _ pos' more' = lose t pos' more' [] "not enough input"

77− succ' t' pos' more' = succ t' pos' more' ()

78− in prompt t pos more lose' succ'

79−{-# SPECIALIZE demandInput :: Parser ByteString () #-}

80−{-# SPECIALIZE demandInput :: Parser Text () #-}

81−

82−-- | Immediately demand more input via a 'Partial' continuation

83−-- result. Return the new input.

84−demandInput_ :: Chunk t => Parser t t

85−demandInput_ = Parser $ \t pos more lose succ ->

86− case more of

87− Complete -> lose t pos more [] "not enough input"

88− _ -> Partial $ \s ->

89− if nullChunk s

90− then lose t pos Complete [] "not enough input"

91− else succ (pappendChunk t s) pos more s

92−{-# SPECIALIZE demandInput_ :: Parser ByteString ByteString #-}

93−{-# SPECIALIZE demandInput_ :: Parser Text Text #-}

94−

95−-- | This parser always succeeds. It returns 'True' if any input is

96−-- available either immediately or on demand, and 'False' if the end

97−-- of all input has been reached.

98−wantInput :: forall t . Chunk t => Parser t Bool

99−wantInput = Parser $ \t pos more _lose succ ->

100− case () of

101− _ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True

102− | more == Complete -> succ t pos more False

103− | otherwise -> let lose' t' pos' more' = succ t' pos' more' False

104− succ' t' pos' more' = succ t' pos' more' True

105− in prompt t pos more lose' succ'

106−{-# INLINE wantInput #-}

107−

108−-- | Match only if all input has been consumed.

109−endOfInput :: forall t . Chunk t => Parser t ()

110−endOfInput = Parser $ \t pos more lose succ ->

111− case () of

112− _| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput"

113− | more == Complete -> succ t pos more ()

114− | otherwise ->

115− let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()

116− succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput"

117− in runParser demandInput t pos more lose' succ'

118−{-# SPECIALIZE endOfInput :: Parser ByteString () #-}

119−{-# SPECIALIZE endOfInput :: Parser Text () #-}

120−

121−-- | Return an indication of whether the end of input has been

122−-- reached.

123−atEnd :: Chunk t => Parser t Bool

124−atEnd = not <$> wantInput

125−{-# INLINE atEnd #-}

126−

127−satisfySuspended :: forall t r . Chunk t

128− => (ChunkElem t -> Bool)

129− -> State t -> Pos -> More

130− -> Failure t (State t) r

131− -> Success t (State t) (ChunkElem t) r

132− -> IResult t r

133−satisfySuspended p t pos more lose succ =

134− runParser (demandInput >> go) t pos more lose succ

135− where go = Parser $ \t' pos' more' lose' succ' ->

136− case bufferElemAt (undefined :: t) pos' t' of

137− Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e

138− | otherwise -> lose' t' pos' more' [] "satisfyElem"

139− Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ'

140−{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool)

141− -> State ByteString -> Pos -> More

142− -> Failure ByteString (State ByteString) r

143− -> Success ByteString (State ByteString)

144− (ChunkElem ByteString) r

145− -> IResult ByteString r #-}

146−{-# SPECIALIZE satisfySuspended :: (ChunkElem Text -> Bool)

147− -> State Text -> Pos -> More

148− -> Failure Text (State Text) r

149− -> Success Text (State Text)

150− (ChunkElem Text) r

151− -> IResult Text r #-}

152−

153−-- | The parser @satisfyElem p@ succeeds for any chunk element for which the

154−-- predicate @p@ returns 'True'. Returns the element that is

155−-- actually parsed.

156−satisfyElem :: forall t . Chunk t

157− => (ChunkElem t -> Bool) -> Parser t (ChunkElem t)

158−satisfyElem p = Parser $ \t pos more lose succ ->

159− case bufferElemAt (undefined :: t) pos t of

160− Just (e, l) | p e -> succ t (pos + Pos l) more e

161− | otherwise -> lose t pos more [] "satisfyElem"

162− Nothing -> satisfySuspended p t pos more lose succ

163−{-# 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+57−137

@@ -1,8 +1,8 @@

1−{-# LANGUAGE CPP, BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,

1+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,

22 Rank2Types, RecordWildCards, TypeFamilies #-}

33-- |

44-- Module : Data.Attoparsec.Internal.Types

5−-- Copyright : Bryan O'Sullivan 2007-2015

5+-- Copyright : Bryan O'Sullivan 2007-2014

66-- License : BSD3

77--

88-- Maintainer : bos@serpentine.com

@@ -15,82 +15,62 @@

1515module Data.Attoparsec.Internal.Types

1616 (

1717 Parser(..)

18− , State

1918 , Failure

2019 , Success

2120 , Pos(..)

2221 , IResult(..)

2322 , More(..)

2423 , (<>)

25− , Chunk(..)

2624 ) where

2725

28−import Control.Applicative as App (Applicative(..), (<$>))

29−import Control.Applicative (Alternative(..))

26+import Control.Applicative (Alternative(..), Applicative(..), (<$>))

3027import Control.DeepSeq (NFData(rnf))

3128import Control.Monad (MonadPlus(..))

32−import qualified Control.Monad.Fail as Fail (MonadFail(..))

33−import Data.Monoid as Mon (Monoid(..))

34−import Data.Semigroup (Semigroup(..))

35−import Data.Word (Word8)

36−import Data.ByteString (ByteString)

37−import qualified Data.ByteString as BS

38−import Data.ByteString.Internal (w2c)

39−import Data.Text (Text)

40−import qualified Data.Text as Text

41−import Data.Text.Unsafe (Iter(..))

42−import Prelude hiding (succ)

43−import qualified Data.Attoparsec.ByteString.Buffer as B

44−import qualified Data.Attoparsec.Text.Buffer as T

29+import Data.Monoid (Monoid(..))

30+import Prelude hiding (getChar, succ)

4531

4632newtype Pos = Pos { fromPos :: Int }

4733 deriving (Eq, Ord, Show, Num)

4834

49−-- | The result of a parse. This is parameterised over the type @i@

35+-- | The result of a parse. This is parameterised over the type @t@

5036-- of string that was processed.

5137--

5238-- This type is an instance of 'Functor', where 'fmap' transforms the

5339-- value in a 'Done' result.

54−data IResult i r =

40+data IResult i t r =

5541 Fail i [String] String

56− -- ^ The parse failed. The @i@ parameter is the input that had

42+ -- ^ The parse failed. The 'i' parameter is the input that had

5743 -- not yet been consumed when the failure occurred. The

5844 -- @[@'String'@]@ is a list of contexts in which the error

5945 -- occurred. The 'String' is the message describing the error, if

6046 -- any.

61− | Partial (i -> IResult i r)

47+ | Partial (i -> IResult i t r)

6248 -- ^ Supply this continuation with more input so that the parser

63− -- can resume. To indicate that no more input is available, pass

64− -- an empty string to the continuation.

65− --

66− -- __Note__: if you get a 'Partial' result, do not call its

67− -- continuation more than once.

49+ -- can resume. To indicate that no more input is available, use

50+ -- an empty string.

6851 | Done i r

69− -- ^ The parse succeeded. The @i@ parameter is the input that had

52+ -- ^ The parse succeeded. The 'i' parameter is the input that had

7053 -- not yet been consumed (if any) when the parse succeeded.

7154

72−instance (Show i, Show r) => Show (IResult i r) where

73− showsPrec d ir = showParen (d > 10) $

74− case ir of

75− (Fail t stk msg) -> showString "Fail" . f t . f stk . f msg

76− (Partial _) -> showString "Partial _"

77− (Done t r) -> showString "Done" . f t . f r

78− where f :: Show a => a -> ShowS

79− f x = showChar ' ' . showsPrec 11 x

55+instance (Show i, Show r) => Show (IResult i t r) where

56+ show (Fail t stk msg) =

57+ unwords [ "Fail", show t, show stk, show msg]

58+ show (Partial _) = "Partial _"

59+ show (Done t r) = unwords ["Done", show t, show r]

8060

81−instance (NFData i, NFData r) => NFData (IResult i r) where

61+instance (NFData i, NFData r) => NFData (IResult i t r) where

8262 rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg

8363 rnf (Partial _) = ()

8464 rnf (Done t r) = rnf t `seq` rnf r

8565 {-# INLINE rnf #-}

8666

87−instance Functor (IResult i) where

67+instance Functor (IResult i t) where

8868 fmap _ (Fail t stk msg) = Fail t stk msg

8969 fmap f (Partial k) = Partial (fmap f . k)

9070 fmap f (Done t r) = Done t (f r)

9171

92−-- | The core parser type. This is parameterised over the type @i@

93−-- of string being processed.

72+-- | The core parser type. This is parameterised over the type @t@ of

73+-- string being processed.

9474--

9575-- This type is an instance of the following classes:

9676--

@@ -103,45 +83,36 @@ instance Functor (IResult i) where

10383-- 'mplus' executes the right-hand parser if the left-hand one

10484-- fails. When the parser on the right executes, the input is reset

10585-- to the same state as the parser on the left started with. (In

106−-- other words, attoparsec is a backtracking parser that supports

86+-- other words, Attoparsec is a backtracking parser that supports

10787-- arbitrary lookahead.)

10888--

10989-- * 'Alternative', which follows 'MonadPlus'.

110−newtype Parser i a = Parser {

111− runParser :: forall r.

112− State i -> Pos -> More

113− -> Failure i (State i) r

114− -> Success i (State i) a r

115− -> IResult i r

90+newtype Parser i t a = Parser {

91+ runParser :: forall r. t -> Pos -> More

92+ -> Failure i t r

93+ -> Success i t a r

94+ -> IResult i t r

11695 }

11796

118−type family State i

119−type instance State ByteString = B.Buffer

120−type instance State Text = T.Buffer

121−

12297type Failure i t r = t -> Pos -> More -> [String] -> String

123− -> IResult i r

124−type Success i t a r = t -> Pos -> More -> a -> IResult i r

98+ -> IResult i t r

99+type Success i t a r = t -> Pos -> More -> a -> IResult i t r

125100

126101-- | Have we read all available input?

127102data More = Complete | Incomplete

128103 deriving (Eq, Show)

129104

130−instance Semigroup More where

131− c@Complete <> _ = c

132− _ <> m = m

133−

134−instance Mon.Monoid More where

135− mappend = (<>)

136− mempty = Incomplete

105+instance Monoid More where

106+ mappend c@Complete _ = c

107+ mappend _ m = m

108+ mempty = Incomplete

137109

138−instance Monad (Parser i) where

139−#if !(MIN_VERSION_base(4,13,0))

140− fail = Fail.fail

110+instance Monad (Parser i t) where

111+ fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg

112+ where msg = "Failed reading: " ++ err

141113 {-# INLINE fail #-}

142−#endif

143114

144− return = App.pure

115+ return v = Parser $ \t pos more _lose succ -> succ t pos more v

145116 {-# INLINE return #-}

146117

147118 m >>= k = Parser $ \t !pos more lose succ ->

@@ -149,59 +120,50 @@ instance Monad (Parser i) where

149120 in runParser m t pos more lose succ'

150121 {-# INLINE (>>=) #-}

151122

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−

161−plus :: Parser i a -> Parser i a -> Parser i a

123+plus :: (Monoid t) => Parser i t a -> Parser i t a -> Parser i t a

162124plus f g = Parser $ \t pos more lose succ ->

163125 let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ

164126 in runParser f t pos more lose' succ

165127

166−instance MonadPlus (Parser i) where

128+instance (Monoid t) => MonadPlus (Parser i t) where

167129 mzero = fail "mzero"

168130 {-# INLINE mzero #-}

169131 mplus = plus

170132

171−instance Functor (Parser i) where

133+instance Functor (Parser i t) where

172134 fmap f p = Parser $ \t pos more lose succ ->

173135 let succ' t' pos' more' a = succ t' pos' more' (f a)

174136 in runParser p t pos more lose succ'

175137 {-# INLINE fmap #-}

176138

177−apP :: Parser i (a -> b) -> Parser i a -> Parser i b

139+apP :: Parser i t (a -> b) -> Parser i t a -> Parser i t b

178140apP d e = do

179141 b <- d

180142 a <- e

181143 return (b a)

182144{-# INLINE apP #-}

183145

184−instance Applicative (Parser i) where

185− pure v = Parser $ \t !pos more _lose succ -> succ t pos more v

146+instance Applicative (Parser i t) where

147+ pure = return

186148 {-# INLINE pure #-}

187149 (<*>) = apP

188150 {-# INLINE (<*>) #-}

189− m *> k = m >>= \_ -> k

151+

152+ -- These definitions are equal to the defaults, but this

153+ -- way the optimizer doesn't have to work so hard to figure

154+ -- that out.

155+ (*>) = (>>)

190156 {-# INLINE (*>) #-}

191− x <* y = x >>= \a -> y >> pure a

157+ x <* y = x >>= \a -> y >> return a

192158 {-# INLINE (<*) #-}

193159

194−instance Semigroup (Parser i a) where

195− (<>) = plus

196− {-# INLINE (<>) #-}

197−

198−instance Monoid (Parser i a) where

160+instance (Monoid t) => Monoid (Parser i t a) where

199161 mempty = fail "mempty"

200162 {-# INLINE mempty #-}

201− mappend = (<>)

163+ mappend = plus

202164 {-# INLINE mappend #-}

203165

204−instance Alternative (Parser i) where

166+instance (Monoid t) => Alternative (Parser i t) where

205167 empty = fail "empty"

206168 {-# INLINE empty #-}

207169

@@ -209,9 +171,8 @@ instance Alternative (Parser i) where

209171 {-# INLINE (<|>) #-}

210172

211173 many v = many_v

212− where

213− many_v = some_v <|> pure []

214− some_v = (:) <$> v <*> many_v

174+ where many_v = some_v <|> pure []

175+ some_v = (:) <$> v <*> many_v

215176 {-# INLINE many #-}

216177

217178 some v = some_v

@@ -220,47 +181,6 @@ instance Alternative (Parser i) where

220181 some_v = (:) <$> v <*> many_v

221182 {-# INLINE some #-}

222183

223−-- | A common interface for input chunks.

224−class Monoid c => Chunk c where

225− type ChunkElem c

226− -- | Test if the chunk is empty.

227− nullChunk :: c -> Bool

228− -- | Append chunk to a buffer.

229− pappendChunk :: State c -> c -> State c

230− -- | Position at the end of a buffer. The first argument is ignored.

231− atBufferEnd :: c -> State c -> Pos

232− -- | Return the buffer element at the given position along with its length.

233− bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int)

234− -- | Map an element to the corresponding character.

235− -- The first argument is ignored.

236− chunkElemToChar :: c -> ChunkElem c -> Char

237−

238−instance Chunk ByteString where

239− type ChunkElem ByteString = Word8

240− nullChunk = BS.null

241− {-# INLINE nullChunk #-}

242− pappendChunk = B.pappend

243− {-# INLINE pappendChunk #-}

244− atBufferEnd _ = Pos . B.length

245− {-# INLINE atBufferEnd #-}

246− bufferElemAt _ (Pos i) buf

247− | i < B.length buf = Just (B.unsafeIndex buf i, 1)

248− | otherwise = Nothing

249− {-# INLINE bufferElemAt #-}

250− chunkElemToChar _ = w2c

251− {-# INLINE chunkElemToChar #-}

252−

253−instance Chunk Text where

254− type ChunkElem Text = Char

255− nullChunk = Text.null

256− {-# INLINE nullChunk #-}

257− pappendChunk = T.pappend

258− {-# INLINE pappendChunk #-}

259− atBufferEnd _ = Pos . T.length

260− {-# INLINE atBufferEnd #-}

261− bufferElemAt _ (Pos i) buf

262− | i < T.length buf = let Iter c l = T.iter buf i in Just (c, l)

263− | otherwise = Nothing

264− {-# INLINE bufferElemAt #-}

265− chunkElemToChar _ = id

266− {-# INLINE chunkElemToChar #-}

184+(<>) :: (Monoid m) => m -> m -> m

185+(<>) = mappend

186+{-# INLINE (<>) #-}

Data/Attoparsec/Lazy.hs+1−1

@@ -1,6 +1,6 @@

11-- |

22-- Module : Data.Attoparsec.Lazy

3−-- Copyright : Bryan O'Sullivan 2007-2015

3+-- Copyright : Bryan O'Sullivan 2007-2014

44-- License : BSD3

55--

66-- Maintainer : bos@serpentine.com

Data/Attoparsec/Number.hs+2−15

@@ -1,25 +1,16 @@

11{-# LANGUAGE DeriveDataTypeable #-}

22-- |

33-- Module : Data.Attoparsec.Number

4−-- Copyright : Bryan O'Sullivan 2007-2015

4+-- Copyright : Bryan O'Sullivan 2007-2014

55-- License : BSD3

66--

77-- Maintainer : bos@serpentine.com

88-- Stability : experimental

99-- Portability : unknown

1010--

11−-- This module is deprecated, and both the module and 'Number' type

12−-- will be removed in the next major release. Use the

13−-- <http://hackage.haskell.org/package/scientific scientific> package

14−-- and the 'Data.Scientific.Scientific' type instead.

15−--

1611-- A simple number type, useful for parsing both exact and inexact

1712-- quantities without losing much precision.

18−module Data.Attoparsec.Number

19− {-# DEPRECATED "This module will be removed in the next major release." #-}

20− (

21− Number(..)

22− ) where

13+module Data.Attoparsec.Number ( Number(..) ) where

2314

2415import Control.DeepSeq (NFData(rnf))

2516import Data.Data (Data)

@@ -28,13 +19,9 @@ import Data.Typeable (Typeable)

2819

2920-- | A numeric type that can represent integers accurately, and

3021-- floating point numbers to the precision of a 'Double'.

31−--

32−-- /Note/: this type is deprecated, and will be removed in the next

33−-- major release. Use the 'Data.Scientific.Scientific' type instead.

3422data Number = I !Integer

3523 | D {-# UNPACK #-} !Double

3624 deriving (Typeable, Data)

37−{-# DEPRECATED Number "Use Scientific instead." #-}

3825

3926instance Show Number where

4027 show (I a) = show a

Data/Attoparsec/Text.hs+50−61

@@ -1,12 +1,8 @@

1−{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, TypeSynonymInstances #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-} -- Imports internal modules

4−#endif

5−{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}

1+{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}

73-- |

84-- Module : Data.Attoparsec.Text

9−-- Copyright : Bryan O'Sullivan 2007-2015

5+-- Copyright : Bryan O'Sullivan 2007-2014

106-- License : BSD3

117--

128-- Maintainer : bos@serpentine.com

@@ -72,7 +68,6 @@ module Data.Attoparsec.Text

7268 , skipSpace

7369 , I.skipWhile

7470 , I.scan

75− , I.runScanner

7671 , I.take

7772 , I.takeWhile

7873 , I.takeWhile1

@@ -126,11 +121,7 @@ module Data.Attoparsec.Text

126121 , I.atEnd

127122 ) where

128123

129−#if !MIN_VERSION_base(4,8,0)

130−import Control.Applicative (pure, (*>), (<*), (<$>))

131−import Data.Word (Word)

132−#endif

133−import Control.Applicative ((<|>))

124+import Control.Applicative (pure, (<$>), (*>), (<*), (<|>))

134125import Data.Attoparsec.Combinator

135126import Data.Attoparsec.Number (Number(..))

136127import Data.Scientific (Scientific)

@@ -139,9 +130,8 @@ import Data.Attoparsec.Text.Internal (Parser, Result, parse, takeWhile1)

139130import Data.Bits (Bits, (.|.), shiftL)

140131import Data.Char (isAlpha, isDigit, isSpace, ord)

141132import Data.Int (Int8, Int16, Int32, Int64)

142−import Data.List (intercalate)

143133import Data.Text (Text)

144−import Data.Word (Word8, Word16, Word32, Word64)

134+import Data.Word (Word8, Word16, Word32, Word64, Word)

145135import qualified Data.Attoparsec.Internal as I

146136import qualified Data.Attoparsec.Internal.Types as T

147137import qualified Data.Attoparsec.Text.Internal as I

@@ -149,50 +139,49 @@ import qualified Data.Text as T

149139

150140-- $parsec

151141--

152−-- Compared to Parsec 3, attoparsec makes several tradeoffs. It is

142+-- Compared to Parsec 3, Attoparsec makes several tradeoffs. It is

153143-- not intended for, or ideal for, all possible uses.

154144--

155−-- * While attoparsec can consume input incrementally, Parsec cannot.

145+-- * While Attoparsec can consume input incrementally, Parsec cannot.

156146-- Incremental input is a huge deal for efficient and secure network

157147-- and system programming, since it gives much more control to users

158148-- of the library over matters such as resource usage and the I/O

159149-- model to use.

160150--

161−-- * Much of the performance advantage of attoparsec is gained via

151+-- * Much of the performance advantage of Attoparsec is gained via

162152-- high-performance parsers such as 'I.takeWhile' and 'I.string'.

163153-- If you use complicated combinators that return lists of

164154-- characters, there is less performance difference between the two

165155-- libraries.

166156--

167−-- * Unlike Parsec 3, attoparsec does not support being used as a

157+-- * Unlike Parsec 3, Attoparsec does not support being used as a

168158-- monad transformer.

169159--

170−-- * attoparsec is specialised to deal only with strict 'Text'

160+-- * Attoparsec is specialised to deal only with strict 'Text'

171161-- input. Efficiency concerns rule out both lists and lazy text.

172162-- The usual use for lazy text would be to allow consumption of very

173163-- large input without a large footprint. For this need,

174−-- attoparsec's incremental input provides an excellent substitute,

164+-- Attoparsec's incremental input provides an excellent substitute,

175165-- with much more control over when input takes place. If you must

176166-- use lazy text, see the 'Lazy' module, which feeds lazy chunks to

177167-- a regular parser.

178168--

179169-- * Parsec parsers can produce more helpful error messages than

180−-- attoparsec parsers. This is a matter of focus: attoparsec avoids

170+-- Attoparsec parsers. This is a matter of focus: Attoparsec avoids

181171-- the extra book-keeping in favour of higher performance.

182172

183173-- $incremental

184174--

185−-- attoparsec supports incremental input, meaning that you can feed it

175+-- Attoparsec supports incremental input, meaning that you can feed it

186176-- a 'Text' that represents only part of the expected total amount

187177-- of data to parse. If your parser reaches the end of a fragment of

188178-- input and could consume more input, it will suspend parsing and

189179-- return a 'T.Partial' continuation.

190180--

191181-- Supplying the 'T.Partial' continuation with another string will

192−-- resume parsing at the point where it was suspended, with the string

193−-- you supplied used as new input at the end of the existing

194−-- input. You must be prepared for the result of the resumed parse to

195−-- be another 'Partial' continuation.

182+-- resume parsing at the point where it was suspended. You must be

183+-- prepared for the result of the resumed parse to be another

184+-- 'Partial' continuation.

196185--

197186-- To indicate that you have no more input, supply the 'Partial'

198187-- continuation with an 'T.empty' 'Text'.

@@ -204,19 +193,12 @@ import qualified Data.Text as T

204193-- If you do not need support for incremental input, consider using

205194-- the 'I.parseOnly' function to run your parser. It will never

206195-- prompt for more input.

207−--

208−-- /Note/: incremental input does /not/ imply that attoparsec will

209−-- release portions of its internal state for garbage collection as it

210−-- proceeds. Its internal representation is equivalent to a single

211−-- 'Text': if you feed incremental input to an a parser, it will

212−-- require memory proportional to the amount of input you supply.

213−-- (This is necessary to support arbitrary backtracking.)

214196

215197-- $performance

216198--

217−-- If you write an attoparsec-based parser carefully, it can be

218−-- realistic to expect it to perform similarly to a hand-rolled C

219−-- parser (measuring megabytes parsed per second).

199+-- If you write an Attoparsec-based parser carefully, it can be

200+-- realistic to expect it to perform within a factor of 2 of a

201+-- hand-rolled C parser (measuring megabytes parsed per second).

220202--

221203-- To actually achieve high performance, there are a few guidelines

222204-- that it is useful to follow.

@@ -266,10 +248,9 @@ maybeResult _ = Nothing

266248-- | Convert a 'Result' value to an 'Either' value. A 'Partial' result

267249-- is treated as failure.

268250eitherResult :: Result r -> Either String r

269−eitherResult (T.Done _ r) = Right r

270−eitherResult (T.Fail _ [] msg) = Left msg

271−eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)

272−eitherResult _ = Left "Result: incomplete input"

251+eitherResult (T.Done _ r) = Right r

252+eitherResult (T.Fail _ _ msg) = Left msg

253+eitherResult _ = Left "Result: incomplete input"

273254

274255-- | A predicate that matches either a carriage return @\'\\r\'@ or

275256-- newline @\'\\n\'@ character.

@@ -342,24 +323,6 @@ signed p = (negate <$> (I.char '-' *> p))

342323 <|> (I.char '+' *> p)

343324 <|> p

344325

345−-- | Parse a rational number.

346−--

347−-- The syntax accepted by this parser is the same as for 'double'.

348−--

349−-- /Note/: this parser is not safe for use with inputs from untrusted

350−-- sources. An input with a suitably large exponent such as

351−-- @"1e1000000000"@ will cause a huge 'Integer' to be allocated,

352−-- resulting in what is effectively a denial-of-service attack.

353−--

354−-- In most cases, it is better to use 'double' or 'scientific'

355−-- instead.

356−rational :: Fractional a => Parser a

357−{-# SPECIALIZE rational :: Parser Double #-}

358−{-# SPECIALIZE rational :: Parser Float #-}

359−{-# SPECIALIZE rational :: Parser Rational #-}

360−{-# SPECIALIZE rational :: Parser Scientific #-}

361−rational = scientifically realToFrac

362−

363326-- | Parse a rational number.

364327--

365328-- This parser accepts an optional leading sign character, followed by

@@ -387,12 +350,39 @@ rational = scientifically realToFrac

387350--

388351-- This function does not accept string representations of \"NaN\" or

389352-- \"Infinity\".

353+rational :: Fractional a => Parser a

354+{-# SPECIALIZE rational :: Parser Double #-}

355+{-# SPECIALIZE rational :: Parser Float #-}

356+{-# SPECIALIZE rational :: Parser Rational #-}

357+{-# SPECIALIZE rational :: Parser Scientific #-}

358+rational = scientifically realToFrac

359+

360+-- | Parse a rational number.

361+--

362+-- The syntax accepted by this parser is the same as for 'rational'.

363+--

364+-- /Note/: This function is almost ten times faster than 'rational',

365+-- but is slightly less accurate.

366+--

367+-- The 'Double' type supports about 16 decimal places of accuracy.

368+-- For 94.2% of numbers, this function and 'rational' give identical

369+-- results, but for the remaining 5.8%, this function loses precision

370+-- around the 15th decimal place. For 0.001% of numbers, this

371+-- function will lose precision at the 13th or 14th decimal place.

372+--

373+-- This function does not accept string representations of \"NaN\" or

374+-- \"Infinity\".

390375double :: Parser Double

391376double = scientifically Sci.toRealFloat

392377

393378-- | Parse a number, attempting to preserve both speed and precision.

394379--

395−-- The syntax accepted by this parser is the same as for 'double'.

380+-- The syntax accepted by this parser is the same as for 'rational'.

381+--

382+-- /Note/: This function is almost ten times faster than 'rational'.

383+-- On integral inputs, it gives perfectly accurate answers, and on

384+-- floating point inputs, it is slightly less accurate than

385+-- 'rational'.

396386--

397387-- This function does not accept string representations of \"NaN\" or

398388-- \"Infinity\".

@@ -403,11 +393,10 @@ number = scientifically $ \s ->

403393 in if e >= 0

404394 then I (c * 10 ^ e)

405395 else D (Sci.toRealFloat s)

406−{-# DEPRECATED number "Use 'scientific' instead." #-}

407396

408397-- | Parse a scientific number.

409398--

410−-- The syntax accepted by this parser is the same as for 'double'.

399+-- The syntax accepted by this parser is the same as for 'rational'.

411400scientific :: Parser Scientific

412401scientific = scientifically id

413402

Data/Attoparsec/Text/Buffer.hsdeleted−172

@@ -1,172 +0,0 @@

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, RecordWildCards,

2− UnboxedTuples #-}

3−

4−-- |

5−-- Module : Data.Attoparsec.Text.Buffer

6−-- Copyright : Bryan O'Sullivan 2007-2015

7−-- License : BSD3

8−--

9−-- Maintainer : bos@serpentine.com

10−-- Stability : experimental

11−-- Portability : GHC

12−--

13−-- An immutable buffer that supports cheap appends.

14−

15−-- A Buffer is divided into an immutable read-only zone, followed by a

16−-- mutable area that we've preallocated, but not yet written to.

17−--

18−-- We overallocate at the end of a Buffer so that we can cheaply

19−-- append. Since a user of an existing Buffer cannot see past the end

20−-- of its immutable zone into the data that will change during an

21−-- append, this is safe.

22−--

23−-- Once we run out of space at the end of a Buffer, we do the usual

24−-- doubling of the buffer size.

25−

26−module Data.Attoparsec.Text.Buffer

27− (

28− Buffer

29− , buffer

30− , unbuffer

31− , unbufferAt

32− , length

33− , pappend

34− , iter

35− , iter_

36− , substring

37− , dropWord16

38− ) where

39−

40−import Control.Exception (assert)

41−import Data.Bits (shiftR)

42−import Data.List (foldl1')

43−import Data.Monoid as Mon (Monoid(..))

44−import Data.Semigroup (Semigroup(..))

45−import Data.Text ()

46−import Data.Text.Internal (Text(..))

47−import Data.Text.Internal.Encoding.Utf16 (chr2)

48−import Data.Text.Internal.Unsafe.Char (unsafeChr)

49−import Data.Text.Unsafe (Iter(..))

50−import Foreign.Storable (sizeOf)

51−import GHC.Base (Int(..), indexIntArray#, unsafeCoerce#, writeIntArray#)

52−import GHC.ST (ST(..), runST)

53−import Prelude hiding (length)

54−import qualified Data.Text.Array as A

55−

56−-- If _cap is zero, this buffer is empty.

57−data Buffer = Buf {

58− _arr :: {-# UNPACK #-} !A.Array

59− , _off :: {-# UNPACK #-} !Int

60− , _len :: {-# UNPACK #-} !Int

61− , _cap :: {-# UNPACK #-} !Int

62− , _gen :: {-# UNPACK #-} !Int

63− }

64−

65−instance Show Buffer where

66− showsPrec p = showsPrec p . unbuffer

67−

68−-- | The initial 'Buffer' has no mutable zone, so we can avoid all

69−-- copies in the (hopefully) common case of no further input being fed

70−-- to us.

71−buffer :: Text -> Buffer

72−buffer (Text arr off len) = Buf arr off len len 0

73−

74−unbuffer :: Buffer -> Text

75−unbuffer (Buf arr off len _ _) = Text arr off len

76−

77−unbufferAt :: Int -> Buffer -> Text

78−unbufferAt s (Buf arr off len _ _) =

79− assert (s >= 0 && s <= len) $

80− Text arr (off+s) (len-s)

81−

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−

88−instance Monoid Buffer where

89− mempty = Buf A.empty 0 0 0 0

90− {-# INLINE mempty #-}

91−

92− mappend = (<>)

93−

94− mconcat [] = Mon.mempty

95− mconcat xs = foldl1' (<>) xs

96−

97−pappend :: Buffer -> Text -> Buffer

98−pappend (Buf _ _ _ 0 _) t = buffer t

99−pappend buf (Text arr off len) = append buf arr off len

100−

101−append :: Buffer -> A.Array -> Int -> Int -> Buffer

102−append (Buf arr0 off0 len0 cap0 gen0) !arr1 !off1 !len1 = runST $ do

103− let woff = sizeOf (0::Int) `shiftR` 1

104− newlen = len0 + len1

105− !gen = if gen0 == 0 then 0 else readGen arr0

106− if gen == gen0 && newlen <= cap0

107− then do

108− let newgen = gen + 1

109− marr <- unsafeThaw arr0

110− writeGen marr newgen

111− A.copyI marr (off0+len0) arr1 off1 (off0+newlen)

112− arr2 <- A.unsafeFreeze marr

113− return (Buf arr2 off0 newlen cap0 newgen)

114− else do

115− let newcap = newlen * 2

116− newgen = 1

117− marr <- A.new (newcap + woff)

118− writeGen marr newgen

119− A.copyI marr woff arr0 off0 (woff+len0)

120− A.copyI marr (woff+len0) arr1 off1 (woff+newlen)

121− arr2 <- A.unsafeFreeze marr

122− return (Buf arr2 woff newlen newcap newgen)

123−

124−length :: Buffer -> Int

125−length (Buf _ _ len _ _) = len

126−{-# INLINE length #-}

127−

128−substring :: Int -> Int -> Buffer -> Text

129−substring s l (Buf arr off len _ _) =

130− assert (s >= 0 && s <= len) .

131− assert (l >= 0 && l <= len-s) $

132− Text arr (off+s) l

133−{-# INLINE substring #-}

134−

135−dropWord16 :: Int -> Buffer -> Text

136−dropWord16 s (Buf arr off len _ _) =

137− assert (s >= 0 && s <= len) $

138− Text arr (off+s) (len-s)

139−{-# INLINE dropWord16 #-}

140−

141−-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16

142−-- array, returning the current character and the delta to add to give

143−-- the next offset to iterate at.

144−iter :: Buffer -> Int -> Iter

145−iter (Buf arr off _ _ _) i

146− | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1

147− | otherwise = Iter (chr2 m n) 2

148− where m = A.unsafeIndex arr j

149− n = A.unsafeIndex arr k

150− j = off + i

151− k = j + 1

152−{-# INLINE iter #-}

153−

154−-- | /O(1)/ Iterate one step through a UTF-16 array, returning the

155−-- delta to add to give the next offset to iterate at.

156−iter_ :: Buffer -> Int -> Int

157−iter_ (Buf arr off _ _ _) i | m < 0xD800 || m > 0xDBFF = 1

158− | otherwise = 2

159− where m = A.unsafeIndex arr (off+i)

160−{-# INLINE iter_ #-}

161−

162−unsafeThaw :: A.Array -> ST s (A.MArray s)

163−unsafeThaw A.Array{..} = ST $ \s# ->

164− (# s#, A.MArray (unsafeCoerce# aBA) #)

165−

166−readGen :: A.Array -> Int

167−readGen a = case indexIntArray# (A.aBA a) 0# of r# -> I# r#

168−

169−writeGen :: A.MArray s -> Int -> ST s ()

170−writeGen a (I# gen#) = ST $ \s0# ->

171− case writeIntArray# (A.maBA a) 0# gen# s0# of

172− s1# -> (# s1#, () #)

Data/Attoparsec/Text/FastSet.hs+27−85

@@ -1,20 +1,16 @@

1−{-# LANGUAGE BangPatterns #-}

2−

3−------------------------------------------------------------------------------

1+-----------------------------------------------------------------------------

42-- |

53-- Module : Data.Attoparsec.FastSet

6−-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015

4+-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2014

75-- License : BSD3

86--

97-- Maintainer : felipe.lessa@gmail.com

108-- Stability : experimental

119-- Portability : unknown

1210--

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−--

11+-- Fast set membership tests for 'Char' values. The set

12+-- representation is unboxed for efficiency. We test for

13+-- membership using a binary search.

1814--

1915-----------------------------------------------------------------------------

2016module Data.Attoparsec.Text.FastSet

@@ -30,92 +26,38 @@ module Data.Attoparsec.Text.FastSet

3026 , charClass

3127 ) where

3228

33−import Data.Bits ((.|.), (.&.), shiftR)

34−import Data.Function (on)

35−import Data.List (sort, sortBy)

29+import Data.List (sort)

3630import qualified Data.Array.Base as AB

3731import qualified Data.Array.Unboxed as A

3832import qualified Data.Text as T

3933

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 })

34+newtype FastSet = FastSet (A.UArray Int Char)

35+ deriving (Eq, Ord, Show)

6236

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

37+-- | Create a set.

38+set :: T.Text -> FastSet

39+set t = mkSet (T.length t) (sort $ T.unpack t)

9540

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]

41+fromList :: [Char] -> FastSet

42+fromList cs = mkSet (length cs) (sort cs)

10343

104−set :: T.Text -> FastSet

105−set = fromList . T.unpack

44+mkSet :: Int -> [Char] -> FastSet

45+mkSet l = FastSet . A.listArray (0,l-1)

10646

10747-- | Check the set for membership.

10848member :: 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

49+member c (FastSet a) = uncurry search (A.bounds a)

50+ where search lo hi

51+ | hi < lo = False

52+ | otherwise =

53+ let mid = (lo + hi) `quot` 2

54+ in case compare c (AB.unsafeAt a mid) of

55+ GT -> search (mid + 1) hi

56+ LT -> search lo (mid - 1)

57+ _ -> True

11658

11759charClass :: String -> FastSet

11860charClass = fromList . go

119− where go (a:'-':b:xs) = [a..b] ++ go xs

120− go (x:xs) = x : go xs

121− go _ = ""

61+ where go (a:'-':b:xs) = [a..b] ++ go xs

62+ go (x:xs) = x : go xs

63+ go _ = ""

Data/Attoparsec/Text/Internal.hs+125−132

@@ -3,14 +3,14 @@

33{-# OPTIONS_GHC -fno-warn-orphans #-}

44-- |

55-- Module : Data.Attoparsec.Text.Internal

6−-- Copyright : Bryan O'Sullivan 2007-2015

6+-- Copyright : Bryan O'Sullivan 2007-2014

77-- License : BSD3

88--

99-- Maintainer : bos@serpentine.com

1010-- Stability : experimental

1111-- Portability : unknown

1212--

13−-- Simple, efficient parser combinators for 'Text' strings, loosely

13+-- Simple, efficient parser combinators for 'T.Text' strings, loosely

1414-- based on the Parsec library.

1515

1616module Data.Attoparsec.Text.Internal

@@ -65,15 +65,11 @@ module Data.Attoparsec.Text.Internal

6565 , atEnd

6666 ) where

6767

68−import Control.Applicative ((<|>), (<$>), pure, (*>))

68+import Control.Applicative ((<|>), (<$>))

6969import Control.Monad (when)

7070import Data.Attoparsec.Combinator ((<?>))

71−import Data.Attoparsec.Internal

7271import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)

73−import qualified Data.Attoparsec.Text.Buffer as Buf

74−import Data.Attoparsec.Text.Buffer (Buffer, buffer)

75−import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)

76−import Data.List (intercalate)

72+import Data.Char (chr, ord)

7773import Data.String (IsString(..))

7874import Data.Text.Internal (Text(..))

7975import Prelude hiding (getChar, succ, take, takeWhile)

@@ -83,10 +79,10 @@ import qualified Data.Text as T

8379import qualified Data.Text.Lazy as L

8480import qualified Data.Text.Unsafe as T

8581

86−type Parser = T.Parser Text

87−type Result = IResult Text

88−type Failure r = T.Failure Text Buffer r

89−type Success a r = T.Success Text Buffer a r

82+type Parser = T.Parser Text Text

83+type Result = IResult Text Text

84+type Failure r = T.Failure Text Text r

85+type Success a r = T.Success Text Text a r

9086

9187instance (a ~ Text) => IsString (Parser a) where

9288 fromString = string . T.pack

@@ -157,49 +153,12 @@ take n = takeWith (max n 0) (const True)

157153--

158154-- The reason for its failure is that the first branch is a

159155-- partial match, and will consume the letters @\'f\'@ and @\'o\'@

160−-- before failing. In attoparsec, the above parser will /succeed/ on

156+-- before failing. In Attoparsec, the above parser will /succeed/ on

161157-- that input, because the failed first branch will consume nothing.

162158string :: Text -> Parser Text

163−string s = string_ (stringSuspended id) id s

159+string s = takeWith (T.length s) (==s)

164160{-# INLINE string #-}

165161

166−string_ :: (forall r. Text -> Text -> Buffer -> Pos -> More

167− -> Failure r -> Success Text r -> Result r)

168− -> (Text -> Text)

169− -> Text -> Parser Text

170−string_ suspended f s0 = T.Parser $ \t pos more lose succ ->

171− let s = f s0

172− ft = f (Buf.unbufferAt (fromPos pos) t)

173− in case T.commonPrefixes s ft of

174− Nothing

175− | T.null s -> succ t pos more T.empty

176− | T.null ft -> suspended s s t pos more lose succ

177− | otherwise -> lose t pos more [] "string"

178− Just (pfx,ssfx,tsfx)

179− | T.null ssfx -> let l = Pos (T.lengthWord16 pfx)

180− in succ t (pos + l) more (substring pos l t)

181− | not (T.null tsfx) -> lose t pos more [] "string"

182− | otherwise -> suspended s ssfx t pos more lose succ

183−{-# INLINE string_ #-}

184−

185−stringSuspended :: (Text -> Text)

186− -> Text -> Text -> Buffer -> Pos -> More

187− -> Failure r

188− -> Success Text r

189− -> Result r

190−stringSuspended f s000 s0 t0 pos0 more0 lose0 succ0 =

191− runParser (demandInput_ >>= go) t0 pos0 more0 lose0 succ0

192− where

193− go s' = T.Parser $ \t pos more lose succ ->

194− let s = f s'

195− in case T.commonPrefixes s0 s of

196− Nothing -> lose t pos more [] "string"

197− Just (_pfx,ssfx,tsfx)

198− | T.null ssfx -> let l = Pos (T.lengthWord16 s000)

199− in succ t (pos + l) more (substring pos l t)

200− | T.null tsfx -> stringSuspended f s000 ssfx t pos more lose succ

201− | otherwise -> lose t pos more [] "string"

202−

203162-- | Satisfy a literal string, ignoring case.

204163--

205164-- Note: this function is currently quite inefficient. Unicode case

@@ -222,24 +181,34 @@ stringCI s = go 0

222181

223182-- | Satisfy a literal string, ignoring case for characters in the ASCII range.

224183asciiCI :: Text -> Parser Text

225−asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s

184+asciiCI input = do

185+ (k,t) <- ensure n

186+ if asciiToLower t == s

187+ then advance k >> return t

188+ else fail "asciiCI"

189+ where

190+ n = T.length input

191+ s = asciiToLower input

192+

193+ -- convert letters in the ASCII range to lower-case

194+ asciiToLower = T.map f

195+ where

196+ offset = ord 'a' - ord 'A'

197+ f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)

198+ | otherwise = c

226199{-# INLINE asciiCI #-}

227200

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−

235201-- | Skip past input for as long as the predicate returns 'True'.

236202skipWhile :: (Char -> Bool) -> Parser ()

237203skipWhile p = go

238204 where

239205 go = do

240206 t <- T.takeWhile p <$> get

241− continue <- inputSpansChunks (size t)

242− when continue go

207+ advance (lengthOf t)

208+ eoc <- endOfChunk

209+ when eoc $ do

210+ input <- wantInput

211+ when input go

243212{-# INLINE skipWhile #-}

244213

245214-- | Consume input as long as the predicate returns 'False'

@@ -267,25 +236,19 @@ takeTill p = takeWhile (not . p)

267236-- parsers loop until a failure occurs. Careless use will thus result

268237-- in an infinite loop.

269238takeWhile :: (Char -> Bool) -> Parser Text

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

239+takeWhile p = (T.concat . reverse) `fmap` go []

281240 where

282241 go acc = do

283242 h <- T.takeWhile p <$> get

284− continue <- inputSpansChunks (size h)

285− if continue

286− then go (h:acc)

287− else return $ concatReverse (h:acc)

288−{-# INLINE takeWhileAcc #-}

243+ advance (lengthOf h)

244+ eoc <- endOfChunk

245+ if eoc

246+ then do

247+ input <- wantInput

248+ if input

249+ then go (h:acc)

250+ else return (h:acc)

251+ else return (h:acc)

289252

290253takeRest :: Parser [Text]

291254takeRest = go []

@@ -295,7 +258,7 @@ takeRest = go []

295258 if input

296259 then do

297260 s <- get

298− advance (size s)

261+ advance (lengthOf s)

299262 go (s:acc)

300263 else return (reverse acc)

301264

@@ -308,7 +271,7 @@ takeLazyText :: Parser L.Text

308271takeLazyText = L.fromChunks `fmap` takeRest

309272

310273data Scan s = Continue s

311− | Finished s {-# UNPACK #-} !Int Text

274+ | Finished {-# UNPACK #-} !Int T.Text

312275

313276scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r

314277scan_ f s0 p = go [] s0

@@ -317,17 +280,18 @@ scan_ f s0 p = go [] s0

317280 case T.uncons t of

318281 Just (c,t') -> case p s c of

319282 Just s' -> scanner s' (n+1) t'

320− Nothing -> Finished s n t

283+ Nothing -> Finished n t

321284 Nothing -> Continue s

322285 go acc s = do

323286 input <- get

324287 case scanner s 0 input of

325− Continue s' -> do continue <- inputSpansChunks (size input)

326− if continue

288+ Continue s' -> do advance (lengthOf input)

289+ more <- wantInput

290+ if more

327291 then go (input : acc) s'

328292 else f s' (input : acc)

329− Finished s' n t -> do advance (size input - size t)

330− f s' (T.take n input : acc)

293+ Finished n t -> do advance (lengthOf input - lengthOf t)

294+ f s (T.take n input : acc)

331295{-# INLINE scan_ #-}

332296

333297-- | A stateful scanner. The predicate consumes and transforms a

@@ -343,13 +307,16 @@ scan_ f s0 p = go [] s0

343307-- parsers loop until a failure occurs. Careless use will thus result

344308-- in an infinite loop.

345309scan :: s -> (s -> Char -> Maybe s) -> Parser Text

346−scan = scan_ $ \_ chunks -> return $! concatReverse chunks

310+scan = scan_ $ \_ chunks ->

311+ case chunks of

312+ [x] -> return x

313+ xs -> return . T.concat . reverse $ xs

347314{-# INLINE scan #-}

348315

349316-- | Like 'scan', but generalized to return the final state of the

350317-- scanner.

351318runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)

352−runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)

319+runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)

353320{-# INLINE runScanner #-}

354321

355322-- | Consume input as long as the predicate returns 'True', and return

@@ -362,14 +329,13 @@ takeWhile1 :: (Char -> Bool) -> Parser Text

362329takeWhile1 p = do

363330 (`when` demandInput) =<< endOfChunk

364331 h <- T.takeWhile p <$> get

365− let size' = size h

366− when (size' == 0) $ fail "takeWhile1"

367− advance size'

332+ let len = lengthOf h

333+ when (len == 0) $ fail "takeWhile1"

334+ advance len

368335 eoc <- endOfChunk

369336 if eoc

370− then takeWhileAcc p [h]

337+ then (h<>) `fmap` takeWhile p

371338 else return h

372−{-# INLINE takeWhile1 #-}

373339

374340-- | Match any character in a set.

375341--

@@ -418,13 +384,13 @@ peekChar :: Parser (Maybe Char)

418384peekChar = T.Parser $ \t pos more _lose succ ->

419385 case () of

420386 _| pos < lengthOf t ->

421− let T.Iter !c _ = Buf.iter t (fromPos pos)

387+ let T.Iter !c _ = T.iter t (fromPos pos)

422388 in succ t pos more (Just c)

423389 | more == Complete ->

424390 succ t pos more Nothing

425391 | otherwise ->

426392 let succ' t' pos' more' =

427− let T.Iter !c _ = Buf.iter t' (fromPos pos')

393+ let T.Iter !c _ = T.iter t' (fromPos pos')

428394 in succ t' pos' more' (Just c)

429395 lose' t' pos' more' = succ t' pos' more' Nothing

430396 in prompt t pos more lose' succ'

@@ -445,39 +411,30 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())

445411

446412-- | Terminal failure continuation.

447413failK :: Failure a

448−failK t (Pos pos) _more stack msg = Fail (Buf.dropWord16 pos t) stack msg

414+failK t (Pos pos) _more stack msg = Fail (T.dropWord16 pos t) stack msg

449415{-# INLINE failK #-}

450416

451417-- | Terminal success continuation.

452418successK :: Success a a

453−successK t (Pos pos) _more a = Done (Buf.dropWord16 pos t) a

419+successK t (Pos pos) _more a = Done (T.dropWord16 pos t) a

454420{-# INLINE successK #-}

455421

456422-- | Run a parser.

457423parse :: Parser a -> Text -> Result a

458−parse m s = runParser m (buffer s) 0 Incomplete failK successK

424+parse m s = runParser m s 0 Incomplete failK successK

459425{-# INLINE parse #-}

460426

461427-- | Run a parser that cannot be resupplied via a 'Partial' result.

462−--

463−-- This function does not force a parser to consume all of its input.

464−-- Instead, any residual input will be discarded. To force a parser

465−-- to consume all of its input, use something like this:

466−--

467−-- @

468−--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')

469−-- @

470428parseOnly :: Parser a -> Text -> Either String a

471−parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of

472− Fail _ [] err -> Left err

473− Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)

474− Done _ a -> Right a

475− _ -> error "parseOnly: impossible error!"

429+parseOnly m s = case runParser m s 0 Complete failK successK of

430+ Fail _ _ err -> Left err

431+ Done _ a -> Right a

432+ _ -> error "parseOnly: impossible error!"

476433{-# INLINE parseOnly #-}

477434

478435get :: Parser Text

479436get = T.Parser $ \t pos more _lose succ ->

480− succ t pos more (Buf.dropWord16 (fromPos pos) t)

437+ succ t pos more (T.dropWord16 (fromPos pos) t)

481438{-# INLINE get #-}

482439

483440endOfChunk :: Parser Bool

@@ -485,21 +442,11 @@ endOfChunk = T.Parser $ \t pos more _lose succ ->

485442 succ t pos more (pos == lengthOf t)

486443{-# INLINE endOfChunk #-}

487444

488−inputSpansChunks :: Pos -> Parser Bool

489−inputSpansChunks i = T.Parser $ \t pos_ more _lose succ ->

490− let pos = pos_ + i

491− in if pos < lengthOf t || more == Complete

492− then succ t pos more False

493− else let lose' t' pos' more' = succ t' pos' more' False

494− succ' t' pos' more' = succ t' pos' more' True

495− in prompt t pos more lose' succ'

496−{-# INLINE inputSpansChunks #-}

497−

498445advance :: Pos -> Parser ()

499446advance n = T.Parser $ \t pos more _lose succ -> succ t (pos+n) more ()

500447{-# INLINE advance #-}

501448

502−ensureSuspended :: Int -> Buffer -> Pos -> More

449+ensureSuspended :: Int -> Text -> Pos -> More

503450 -> Failure r -> Success (Pos, Text) r

504451 -> Result r

505452ensureSuspended n t pos more lose succ =

@@ -517,8 +464,53 @@ ensure n = T.Parser $ \t pos more lose succ ->

517464 Just n' -> succ t pos more (n', substring pos n' t)

518465 -- The uncommon case is kept out-of-line to reduce code size:

519466 Nothing -> ensureSuspended n t pos more lose succ

467+-- Non-recursive so the bounds check can be inlined:

520468{-# INLINE ensure #-}

521469

470+-- | Ask for input. If we receive any, pass it to a success

471+-- continuation, otherwise to a failure continuation.

472+prompt :: Text -> Pos -> More

473+ -> (Text -> Pos -> More -> IResult Text Text r)

474+ -> (Text -> Pos -> More -> IResult Text Text r)

475+ -> Result r

476+prompt t pos _more lose succ = Partial $ \s ->

477+ if T.null s

478+ then lose t pos Complete

479+ else succ (t <> s) pos Incomplete

480+

481+-- | Immediately demand more input via a 'Partial' continuation

482+-- result.

483+demandInput :: Parser ()

484+demandInput = T.Parser $ \t pos more lose succ ->

485+ case more of

486+ Complete -> lose t pos more [] "not enough input"

487+ _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"

488+ succ' t' pos' more' = succ t' pos' more' ()

489+ in prompt t pos more lose' succ'

490+

491+-- | This parser always succeeds. It returns 'True' if any input is

492+-- available either immediately or on demand, and 'False' if the end

493+-- of all input has been reached.

494+wantInput :: Parser Bool

495+wantInput = T.Parser $ \t pos more _lose succ ->

496+ case () of

497+ _ | pos < lengthOf t -> succ t pos more True

498+ | more == Complete -> succ t pos more False

499+ | otherwise -> let lose' t' pos' more' = succ t' pos' more' False

500+ succ' t' pos' more' = succ t' pos' more' True

501+ in prompt t pos more lose' succ'

502+

503+-- | Match only if all input has been consumed.

504+endOfInput :: Parser ()

505+endOfInput = T.Parser $ \t pos more lose succ ->

506+ case () of

507+ _| pos < lengthOf t -> lose t pos more [] "endOfInput"

508+ | more == Complete -> succ t pos more ()

509+ | otherwise ->

510+ let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()

511+ succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput"

512+ in runParser demandInput t pos more lose' succ'

513+

522514-- | Return both the result of a parse and the portion of the input

523515-- that was consumed while it was being parsed.

524516match :: Parser a -> Parser (Text, a)

@@ -527,23 +519,24 @@ match p = T.Parser $ \t pos more lose succ ->

527519 (substring pos (pos'-pos) t', a)

528520 in runParser p t pos more lose succ'

529521

530−-- | Ensure that at least @n@ code points of input are available.

531−-- Returns the number of words consumed while traversing.

532−lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos

522+-- | Return an indication of whether the end of input has been

523+-- reached.

524+atEnd :: Parser Bool

525+atEnd = not <$> wantInput

526+{-# INLINE atEnd #-}

527+

528+lengthAtLeast :: Pos -> Int -> Text -> Maybe Pos

533529lengthAtLeast pos n t = go 0 (fromPos pos)

534530 where go i !p

535531 | i == n = Just (Pos p - pos)

536532 | p == len = Nothing

537− | otherwise = go (i+1) (p + Buf.iter_ t p)

533+ | otherwise = go (i+1) (p + T.iter_ t p)

538534 Pos len = lengthOf t

539535{-# INLINE lengthAtLeast #-}

540536

541−substring :: Pos -> Pos -> Buffer -> Text

542−substring (Pos pos) (Pos n) = Buf.substring pos n

537+substring :: Pos -> Pos -> Text -> Text

538+substring (Pos pos) (Pos n) t = T.takeWord16 n (T.dropWord16 pos t)

543539{-# INLINE substring #-}

544540

545−lengthOf :: Buffer -> Pos

546−lengthOf = Pos . Buf.length

547−

548−size :: Text -> Pos

549−size (Text _ _ l) = Pos l

541+lengthOf :: Text -> Pos

542+lengthOf (Text _arr _off len) = Pos len

Data/Attoparsec/Text/Lazy.hs+10−13

@@ -1,12 +1,7 @@

1−{-# LANGUAGE CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-} -- Imports internal modules

4−#endif

5−

61{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}

72-- |

83-- Module : Data.Attoparsec.Text.Lazy

9−-- Copyright : Bryan O'Sullivan 2007-2015

4+-- Copyright : Bryan O'Sullivan 2007-2014

105-- License : BSD3

116--

127-- Maintainer : bos@serpentine.com

@@ -41,7 +36,6 @@ module Data.Attoparsec.Text.Lazy

4136 ) where

4237

4338import Control.DeepSeq (NFData(rnf))

44−import Data.List (intercalate)

4539import Data.Text.Lazy.Internal (Text(..), chunk)

4640import qualified Data.Attoparsec.Internal.Types as T

4741import qualified Data.Attoparsec.Text as A

@@ -51,16 +45,20 @@ import Data.Attoparsec.Text hiding (IResult(..), Result, eitherResult,

5145

5246-- | The result of a parse.

5347data Result r = Fail Text [String] String

54− -- ^ The parse failed. The 'Text' is the input

48+ -- ^ The parse failed. The 'ByteString' is the input

5549 -- that had not yet been consumed when the failure

5650 -- occurred. The @[@'String'@]@ is a list of contexts

5751 -- in which the error occurred. The 'String' is the

5852 -- message describing the error, if any.

5953 | Done Text r

60− -- ^ The parse succeeded. The 'Text' is the

54+ -- ^ The parse succeeded. The 'ByteString' is the

6155 -- input that had not yet been consumed (if any) when

6256 -- the parse succeeded.

63− deriving (Show)

57+

58+instance Show r => Show (Result r) where

59+ show (Fail bs stk msg) =

60+ "Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg

61+ show (Done bs r) = "Done " ++ show bs ++ " " ++ show r

6462

6563instance NFData r => NFData (Result r) where

6664 rnf (Fail bs ctxs msg) = rnf bs `seq` rnf ctxs `seq` rnf msg

@@ -96,6 +94,5 @@ maybeResult _ = Nothing

9694

9795-- | Convert a 'Result' value to an 'Either' value.

9896eitherResult :: Result r -> Either String r

99−eitherResult (Done _ r) = Right r

100−eitherResult (Fail _ [] msg) = Left msg

101−eitherResult (Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)

97+eitherResult (Done _ r) = Right r

98+eitherResult (Fail _ _ msg) = Left msg

Data/Attoparsec/Types.hs+2−3

@@ -1,6 +1,6 @@

11-- |

22-- Module : Data.Attoparsec.Types

3−-- Copyright : Bryan O'Sullivan 2007-2015

3+-- Copyright : Bryan O'Sullivan 2007-2014

44-- License : BSD3

55--

66-- Maintainer : bos@serpentine.com

@@ -14,7 +14,6 @@ module Data.Attoparsec.Types

1414 (

1515 Parser

1616 , IResult(..)

17− , Chunk(chunkElemToChar)

1817 ) where

1918

20−import Data.Attoparsec.Internal.Types (Parser(..), IResult(..), Chunk(..))

19+import Data.Attoparsec.Internal.Types (Parser(..), IResult(..))

Data/Attoparsec/Zepto.hs+46−88

@@ -1,12 +1,8 @@

1−{-# LANGUAGE CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-} -- Data.ByteString.Unsafe

4−#endif

5−{-# LANGUAGE BangPatterns #-}

1+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}

73-- |

84-- Module : Data.Attoparsec.Zepto

9−-- Copyright : Bryan O'Sullivan 2007-2015

5+-- Copyright : Bryan O'Sullivan 2007-2014

106-- License : BSD3

117--

128-- Maintainer : bos@serpentine.com

@@ -16,150 +12,112 @@

1612-- A tiny, highly specialized combinator parser for 'B.ByteString'

1713-- strings.

1814--

19−-- While the main attoparsec module generally performs well, this

15+-- While the main Attoparsec module generally performs well, this

2016-- module is particularly fast for simple non-recursive loops that

2117-- should not normally result in failed parses.

2218--

2319-- /Warning/: on more complex inputs involving recursion or failure,

2420-- parsers based on this module may be as much as /ten times slower/

25−-- than regular attoparsec! You should /only/ use this module when you

21+-- than regular Attoparsec! You should /only/ use this module when you

2622-- have benchmarks that prove that its use speeds your code up.

2723module Data.Attoparsec.Zepto

2824 (

2925 Parser

30− , ZeptoT

3126 , parse

32− , parseT

3327 , atEnd

3428 , string

3529 , take

3630 , takeWhile

3731 ) where

3832

39−import Control.Applicative

40−import Control.Monad (MonadPlus(..), ap)

41−import qualified Control.Monad.Fail as Fail

42−import Control.Monad.IO.Class (MonadIO(..))

43−import Data.ByteString (ByteString)

44−import Data.Functor.Identity (Identity(runIdentity))

45−import Data.Monoid as Mon (Monoid(..))

46−import Data.Semigroup (Semigroup(..))

4733import Data.Word (Word8)

48−import Prelude hiding (take, takeWhile)

34+import Control.Applicative

35+import Control.Monad

36+import Data.Monoid

4937import qualified Data.ByteString as B

5038import qualified Data.ByteString.Unsafe as B

39+import Data.ByteString (ByteString)

40+import Prelude hiding (take, takeWhile)

5141

5242newtype S = S {

5343 input :: ByteString

5444 }

5545

5646data Result a = Fail String

57− | OK !a S

47+ | OK !a

5848

5949-- | A simple parser.

6050--

6151-- This monad is strict in its state, and the monadic bind operator

6252-- ('>>=') evaluates each result to weak head normal form before

6353-- passing it along.

64−newtype ZeptoT m a = Parser {

65− runParser :: S -> m (Result a)

54+newtype Parser a = Parser {

55+ runParser :: S -> (# Result a, S #)

6656 }

6757

68−type Parser a = ZeptoT Identity a

69−

70−instance Monad m => Functor (ZeptoT m) where

71− fmap f m = Parser $ \s -> do

72− result <- runParser m s

73− case result of

74− OK a s' -> return (OK (f a) s')

75− Fail err -> return (Fail err)

58+instance Functor Parser where

59+ fmap f m = Parser $ \s -> case runParser m s of

60+ (# OK a, s' #) -> (# OK (f a), s' #)

61+ (# Fail err, s' #) -> (# Fail err, s' #)

7662 {-# INLINE fmap #-}

7763

78−instance MonadIO m => MonadIO (ZeptoT m) where

79− liftIO act = Parser $ \s -> do

80− result <- liftIO act

81− return (OK result s)

82− {-# INLINE liftIO #-}

83−

84−instance Monad m => Monad (ZeptoT m) where

85− return = pure

64+instance Monad Parser where

65+ return a = Parser $ \s -> (# OK a, s #)

8666 {-# INLINE return #-}

8767

88− m >>= k = Parser $ \s -> do

89− result <- runParser m s

90− case result of

91− OK a s' -> runParser (k a) s'

92− Fail err -> return (Fail err)

68+ m >>= k = Parser $ \s -> case runParser m s of

69+ (# OK a, s' #) -> runParser (k a) s'

70+ (# Fail err, s' #) -> (# Fail err, s' #)

9371 {-# INLINE (>>=) #-}

9472

95−#if !(MIN_VERSION_base(4,13,0))

96− fail = Fail.fail

97− {-# INLINE fail #-}

98−#endif

73+ fail msg = Parser $ \s -> (# Fail msg, s #)

9974

100−instance Monad m => Fail.MonadFail (ZeptoT m) where

101− fail msg = Parser $ \_ -> return (Fail msg)

102− {-# INLINE fail #-}

103−

104−instance Monad m => MonadPlus (ZeptoT m) where

75+instance MonadPlus Parser where

10576 mzero = fail "mzero"

10677 {-# INLINE mzero #-}

10778

108− mplus a b = Parser $ \s -> do

109− result <- runParser a s

110− case result of

111− ok@(OK _ _) -> return ok

112− _ -> runParser b s

79+ mplus a b = Parser $ \s ->

80+ case runParser a s of

81+ (# ok@(OK _), s' #) -> (# ok, s' #)

82+ (# _, _ #) -> case runParser b s of

83+ (# ok@(OK _), s'' #) -> (# ok, s'' #)

84+ (# err, s'' #) -> (# err, s'' #)

11385 {-# INLINE mplus #-}

11486

115−instance (Monad m) => Applicative (ZeptoT m) where

116− pure a = Parser $ \s -> return (OK a s)

87+instance Applicative Parser where

88+ pure = return

11789 {-# INLINE pure #-}

11890 (<*>) = ap

11991 {-# INLINE (<*>) #-}

12092

121−gets :: Monad m => (S -> a) -> ZeptoT m a

122−gets f = Parser $ \s -> return (OK (f s) s)

93+gets :: (S -> a) -> Parser a

94+gets f = Parser $ \s -> (# OK (f s), s #)

12395{-# INLINE gets #-}

12496

125−put :: Monad m => S -> ZeptoT m ()

126−put s = Parser $ \_ -> return (OK () s)

97+put :: S -> Parser ()

98+put s = Parser $ \_ -> (# OK (), s #)

12799{-# INLINE put #-}

128100

129101-- | Run a parser.

130102parse :: Parser a -> ByteString -> Either String a

131−parse p bs = case runIdentity (runParser p (S bs)) of

132− (OK a _) -> Right a

133− (Fail err) -> Left err

134−{-# INLINE parse #-}

135−

136−-- | Run a parser on top of the given base monad.

137−parseT :: Monad m => ZeptoT m a -> ByteString -> m (Either String a)

138−parseT p bs = do

139− result <- runParser p (S bs)

140− case result of

141− OK a _ -> return (Right a)

142− Fail err -> return (Left err)

143−{-# INLINE parseT #-}

144−

145−instance Monad m => Semigroup (ZeptoT m a) where

146− (<>) = mplus

147− {-# INLINE (<>) #-}

148−

149−instance Monad m => Mon.Monoid (ZeptoT m a) where

103+parse p bs = case runParser p (S bs) of

104+ (# OK a, _ #) -> Right a

105+ (# Fail err, _ #) -> Left err

106+

107+instance Monoid (Parser a) where

150108 mempty = fail "mempty"

151109 {-# INLINE mempty #-}

152− mappend = (<>)

110+ mappend = mplus

153111 {-# INLINE mappend #-}

154112

155−instance Monad m => Alternative (ZeptoT m) where

113+instance Alternative Parser where

156114 empty = fail "empty"

157115 {-# INLINE empty #-}

158116 (<|>) = mplus

159117 {-# INLINE (<|>) #-}

160118

161119-- | Consume input while the predicate returns 'True'.

162−takeWhile :: Monad m => (Word8 -> Bool) -> ZeptoT m ByteString

120+takeWhile :: (Word8 -> Bool) -> Parser ByteString

163121takeWhile p = do

164122 (h,t) <- gets (B.span p . input)

165123 put (S t)

@@ -167,7 +125,7 @@ takeWhile p = do

167125{-# INLINE takeWhile #-}

168126

169127-- | Consume @n@ bytes of input.

170−take :: Monad m => Int -> ZeptoT m ByteString

128+take :: Int -> Parser ByteString

171129take !n = do

172130 s <- gets input

173131 if B.length s >= n

@@ -176,7 +134,7 @@ take !n = do

176134{-# INLINE take #-}

177135

178136-- | Match a string exactly.

179−string :: Monad m => ByteString -> ZeptoT m ()

137+string :: ByteString -> Parser ()

180138string s = do

181139 i <- gets input

182140 if s `B.isPrefixOf` i

@@ -185,7 +143,7 @@ string s = do

185143{-# INLINE string #-}

186144

187145-- | Indicate whether the end of the input has been reached.

188−atEnd :: Monad m => ZeptoT m Bool

146+atEnd :: Parser Bool

189147atEnd = do

190148 i <- gets input

191149 return $! B.null i

README.markdown+6

@@ -16,6 +16,12 @@ 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+

1925Authors

2026-------

2127

attoparsec.cabal+27−83

@@ -1,13 +1,12 @@

11name: attoparsec

2−version: 0.13.2.2

3−x-revision: 3

2+version: 0.12.0.0

43license: BSD3

54license-file: LICENSE

65category: Text, Parsing

76author: Bryan O'Sullivan <bos@serpentine.com>

8−maintainer: Bryan O'Sullivan <bos@serpentine.com>, Ben Gamari <ben@smart-cactus.org>

7+maintainer: Bryan O'Sullivan <bos@serpentine.com>

98stability: experimental

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

9+tested-with: GHC == 7.0, GHC == 7.2, GHC == 7.4, GHC == 7.6, GHC == 7.8

1110synopsis: Fast combinator parsing for bytestrings and text

1211cabal-version: >= 1.8

1312homepage: https://github.com/bos/attoparsec

@@ -22,7 +21,6 @@ extra-source-files:

2221 benchmarks/*.cabal

2322 benchmarks/*.hs

2423 benchmarks/*.txt

25− benchmarks/json-data/*.json

2624 benchmarks/Makefile

2725 benchmarks/med.txt.bz2

2826 changelog.md

@@ -30,8 +28,9 @@ extra-source-files:

3028 examples/*.hs

3129 examples/Makefile

3230 tests/*.hs

31+ tests/Makefile

3332 tests/QC/*.hs

34− tests/QC/IPv6/*.hs

33+ tests/TestFastSet.hs

3534

3635Flag developer

3736 Description: Whether to build the library in development mode

@@ -40,21 +39,16 @@ Flag developer

4039

4140library

4241 build-depends: array,

43− base >= 4.3 && < 5,

42+ base >= 4.2 && < 5,

4443 bytestring,

4544 containers,

4645 deepseq,

4746 scientific >= 0.3.1 && < 0.4,

48− transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,

49− text >= 1.1.1.3

47+ text >= 0.11.3.1

5048 if impl(ghc < 7.4)

5149 build-depends:

52− bytestring < 0.10.4.0

53−

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

50+ bytestring < 0.10.4.0,

51+ text < 1.1

5852

5953 exposed-modules: Data.Attoparsec

6054 Data.Attoparsec.ByteString

@@ -62,19 +56,17 @@ library

6256 Data.Attoparsec.ByteString.Lazy

6357 Data.Attoparsec.Char8

6458 Data.Attoparsec.Combinator

65− Data.Attoparsec.Internal

66− Data.Attoparsec.Internal.Types

6759 Data.Attoparsec.Lazy

6860 Data.Attoparsec.Number

6961 Data.Attoparsec.Text

7062 Data.Attoparsec.Text.Lazy

7163 Data.Attoparsec.Types

7264 Data.Attoparsec.Zepto

73− other-modules: Data.Attoparsec.ByteString.Buffer

74− Data.Attoparsec.ByteString.FastSet

65+ other-modules: Data.Attoparsec.ByteString.FastSet

66+ Data.Attoparsec.ByteString.Fhthagn

7567 Data.Attoparsec.ByteString.Internal

76− Data.Attoparsec.Internal.Fhthagn

77− Data.Attoparsec.Text.Buffer

68+ Data.Attoparsec.Internal

69+ Data.Attoparsec.Internal.Types

7870 Data.Attoparsec.Text.FastSet

7971 Data.Attoparsec.Text.Internal

8072 ghc-options: -O2 -Wall

@@ -85,37 +77,12 @@ library

8577

8678test-suite tests

8779 type: exitcode-stdio-1.0

88− hs-source-dirs: tests .

80+ hs-source-dirs: tests

8981 main-is: QC.hs

90− other-modules: QC.Buffer

91− QC.ByteString

82+ other-modules: QC.ByteString

9283 QC.Combinator

9384 QC.Common

94− QC.IPv6.Internal

95− QC.IPv6.Types

96− QC.Rechunked

97− QC.Simple

9885 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

11986

12087 ghc-options:

12188 -Wall -threaded -rtsopts

@@ -124,41 +91,25 @@ test-suite tests

12491 ghc-options: -Werror

12592

12693 build-depends:

127− array,

128− base,

94+ attoparsec,

95+ base >= 4 && < 5,

12996 bytestring,

130− deepseq >= 1.1,

131− QuickCheck >= 2.13.2 && < 2.14,

132− quickcheck-unicode,

133− scientific,

134− tasty >= 0.11,

135− tasty-quickcheck >= 0.8,

136− text,

137− transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,

138− vector

139−

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

97+ QuickCheck >= 2.7,

98+ test-framework >= 0.8.0.2,

99+ test-framework-quickcheck2 >= 0.3.0.3,

100+ text

144101

145102benchmark benchmarks

146103 type: exitcode-stdio-1.0

147− hs-source-dirs: benchmarks benchmarks/warp-3.0.1.1 .

148− ghc-options: -O2 -Wall -rtsopts

104+ hs-source-dirs: benchmarks, .

105+ ghc-options: -O2 -Wall

149106 main-is: Benchmarks.hs

150107 other-modules:

151108 Common

152109 HeadersByteString

153− HeadersByteString.Atto

154110 HeadersText

155111 Links

156− Network.Wai.Handler.Warp.ReadInt

157− Network.Wai.Handler.Warp.RequestHeader

158112 Numbers

159− Sets

160− TextFastSet

161− Warp

162113 ghc-options: -O2 -Wall

163114

164115 if flag(developer)

@@ -168,27 +119,20 @@ benchmark benchmarks

168119 array,

169120 base == 4.*,

170121 bytestring >= 0.10.4.0,

171− case-insensitive,

172− containers,

173− criterion >= 1.0,

122+ criterion >= 0.8.1.0,

174123 deepseq >= 1.1,

175124 directory,

176125 filepath,

177− ghc-prim,

178− http-types,

179126 parsec >= 3.1.2,

180127 scientific,

181128 text >= 1.1.1.0,

182− transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,

183129 unordered-containers,

184130 vector

185131

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−

191132source-repository head

192133 type: git

193134 location: https://github.com/bos/attoparsec

194135

136+source-repository head

137+ type: mercurial

138+ location: https://bitbucket.org/bos/attoparsec

benchmarks/Aeson.hs+3−8

@@ -10,13 +10,7 @@ module Aeson

1010import Data.ByteString.Builder

1111 (Builder, byteString, toLazyByteString, charUtf8, word8)

1212

13−#if !MIN_VERSION_base(4,8,0)

14−import Control.Applicative ((*>), (<$>), (<*), pure)

15−import Data.Monoid (mappend, mempty)

16−#endif

17−

18−import Common (pathTo)

19−import Control.Applicative (liftA2)

13+import Control.Applicative ((*>), (<$>), (<*), liftA2, pure)

2014import Control.DeepSeq (NFData(..))

2115import Control.Monad (forM)

2216import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,

@@ -25,6 +19,7 @@ import Data.Bits ((.|.), shiftL)

2519import Data.ByteString (ByteString)

2620import Data.Char (chr)

2721import Data.List (sort)

22+import Data.Monoid (mappend, mempty)

2823import Data.Scientific (Scientific)

2924import Data.Text (Text)

3025import Data.Text.Encoding (decodeUtf8')

@@ -345,7 +340,7 @@ toByteString = L.toStrict . toLazyByteString

345340

346341aeson :: IO Benchmark

347342aeson = do

348− path <- pathTo "json-data"

343+ let path = "json-data"

349344 names <- sort . filter (`notElem` [".", ".."]) <$> getDirectoryContents path

350345 benches <- forM names $ \name -> do

351346 bs <- B.readFile (path </> name)

benchmarks/Benchmarks.hs−10

@@ -11,9 +11,7 @@ import Numbers (numbers)

1111import Common (chunksOf)

1212import Text.Parsec.Text ()

1313import Text.Parsec.Text.Lazy ()

14−import qualified Warp

1514import qualified Aeson

16−import qualified Genome

1715import qualified Data.Attoparsec.ByteString as AB

1816import qualified Data.Attoparsec.ByteString.Char8 as AC

1917import qualified Data.Attoparsec.ByteString.Lazy as ABL

@@ -28,7 +26,6 @@ import qualified HeadersByteString

2826import qualified HeadersText

2927import qualified Links

3028import qualified Text.Parsec as P

31−import qualified Sets

3229

3330main :: IO ()

3431main = do

@@ -71,14 +68,10 @@ main = do

7168 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl

7269 , bench "isAlpha_iso8859_15" $

7370 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

7671 ]

7772 , bgroup "takeWhile1" [

7873 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl

7974 , 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

8275 ]

8376 , bench "word32LE" $ nf (AB.parse word32LE) b

8477 , bgroup "scan" [

@@ -86,13 +79,10 @@ main = do

8679 , bench "long" $ nf (AB.parse quotedString) b

8780 ]

8881 , aeson

89− , Genome.genome

9082 , headersBS

9183 , headersT

9284 , Links.links

9385 , numbers

94− , Sets.benchmarks

95− , Warp.benchmarks

9686 ]

9787

9888-- Benchmarks bind and (potential) bounds-check merging.

benchmarks/Common.hs−10

@@ -3,14 +3,11 @@

44module Common (

55 chunksOf

6− , pathTo

76 , rechunkBS

87 , rechunkT

98 ) where

109

1110import Control.DeepSeq (NFData(rnf))

12−import System.Directory (doesDirectoryExist)

13−import System.FilePath ((</>))

1411import Text.Parsec (ParseError)

1512import qualified Data.ByteString as B

1613import qualified Data.ByteString.Lazy as BL

@@ -38,10 +35,3 @@ rechunkBS n = BL.fromChunks . map B.pack . chunksOf n . B.unpack

3835

3936rechunkT :: Int -> T.Text -> TL.Text

4037rechunkT n = TL.fromChunks . map T.pack . chunksOf n . T.unpack

41−

42−pathTo :: String -> IO FilePath

43−pathTo wat = do

44− exists <- doesDirectoryExist "benchmarks"

45− return $ if exists

46− then "benchmarks" </> wat

47− else wat

benchmarks/Genome.hsdeleted−75

@@ -1,75 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module Genome

4− (

5− genome

6− ) where

7−

8−import Control.Applicative

9−import Criterion.Main

10−import Data.ByteString (ByteString)

11−import qualified Data.ByteString.Char8 as B8

12−import qualified Data.ByteString.Lazy.Char8 as L8

13−import Data.Attoparsec.ByteString.Char8 as B

14−import qualified Data.Attoparsec.ByteString.Lazy as BL

15−import Data.Text (Text)

16−import qualified Data.Text as T

17−import qualified Data.Text.Lazy as TL

18−import Data.Attoparsec.Text as T

19−import qualified Data.Attoparsec.Text.Lazy as TL

20−import Common (rechunkBS, rechunkT)

21−

22−genome :: Benchmark

23−genome = bgroup "genome" [

24− bgroup "bytestring" [

25− bench "s" $ nf (map (B.parse searchBS)) (B8.tails geneB)

26− , bench "l" $ nf (map (BL.parse searchBS)) (L8.tails geneBL)

27− , bgroup "CI" [

28− bench "s" $ nf (map (B.parse searchBSCI)) (B8.tails geneB)

29− , bench "l" $ nf (map (BL.parse searchBSCI)) (L8.tails geneBL)

30− ]

31− ]

32− , bgroup "text" [

33− bench "s" $ nf (map (T.parse searchT)) (T.tails geneT)

34− , bench "l" $ nf (map (TL.parse searchT)) (TL.tails geneTL)

35− , bgroup "CI" [

36− bench "s" $ nf (map (T.parse searchTCI)) (T.tails geneT)

37− , bench "l" $ nf (map (TL.parse searchTCI)) (TL.tails geneTL)

38− ]

39− ]

40− ]

41− where geneB = B8.pack gene

42− geneBL = rechunkBS 4 geneB

43− geneT = T.pack gene

44− geneTL = rechunkT 4 geneT

45−

46−searchBS :: B.Parser ByteString

47−searchBS = "caac" *> ("aaca" <|> "aact")

48−

49−searchBSCI :: B.Parser ByteString

50−searchBSCI = B.stringCI "CAAC" *> (B.stringCI "AACA" <|> B.stringCI "AACT")

51−

52−searchT :: T.Parser Text

53−searchT = "caac" *> ("aaca" <|> "aact")

54−

55−searchTCI :: T.Parser Text

56−searchTCI = T.asciiCI "CAAC" *> (T.asciiCI "AACA" <|> T.asciiCI "AACT")

57−

58−-- Dictyostelium discoideum developmental protein DG1094 (gacT) gene,

59−-- partial cds. http://www.ncbi.nlm.nih.gov/nuccore/AF081586.1

60−

61−gene :: String

62−gene = "atcgatttagaaagatacaaagatagaaccatcaataataaacaagagaagagagcaagt\

63− \agagatattaataaagagattgaaagagagattgaaaagaagagattatcaccaagagaa\

64− \agattaaatttatttggtctttcttcctcatcttcatcagtgaattcaacattaacaaga\

65− \tctacagcaaatattatctctacaatagacggtagtggaggtagtaatcgtaatagtaaa\

66− \aattatggtaatggctcatcctcctcctcaaatagaagatatagtaatactattaatcaa\

67− \caattacaaatgcaattacaacaacttcaaatccaacaacaacaatatcaacaaactcaa\

68− \caatctcaaataccattacaatatcaacaacaacaacagcaacaacaacaacaaaccact\

69− \acaactacaactacatcaagtggtagtaatagattctcttcaaatagatataaaccagtt\

70− \gatcttacacaatcatcttcaaactttcgttattcacgtgaaatttatgatgatgattat\

71− \tattcaaataataatttaatgatgtttggtaatgagcaaccaaatcaaacaccaatttct\

72− \gtatcatcttcatctgcattcacacgtcaaagatctcaaagttgctttgaaccagagaat\

73− \cttgtattgctacaacaacaatatcaacaatatcaacaacaacaacaacaacaacaacaa\

74− \attccattccaagcaaatccacaatatagtaatgctgttattgaacaaaaattggatcaa\

75− \attagagataccattaataatttacatagagataaccgagtctctaga"

benchmarks/HeadersByteString.hs+34−15

@@ -1,33 +1,52 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

13module HeadersByteString (headers) where

3−import Common (pathTo, rechunkBS)

4−import Criterion.Main (bench, bgroup, nf, nfIO)

5+import Common (rechunkBS)

6+import Control.Applicative

7+import Criterion.Main (bench, bgroup, nf)

58import Criterion.Types (Benchmark)

6−import HeadersByteString.Atto (request, response)

7−import Network.Wai.Handler.Warp.RequestHeader (parseHeaderLines)

89import qualified Data.Attoparsec.ByteString.Char8 as B

910import qualified Data.Attoparsec.ByteString.Lazy as BL

1011import qualified Data.ByteString.Char8 as B

1112

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.

13+header = do

14+ name <- B.takeWhile1 (B.inClass "a-zA-Z0-9_-") <* B.char ':' <* B.skipSpace

15+ body <- (:) <$> bodyLine <*> many (B.takeWhile1 B.isSpace *> bodyLine)

16+ return (name, body)

17+

18+bodyLine = B.takeTill (\c -> c == '\r' || c == '\n') <* B.endOfLine

19+

20+requestLine =

21+ (,,) <$>

22+ (method <* B.skipSpace) <*>

23+ (B.takeTill B.isSpace <* B.skipSpace) <*>

24+ httpVersion

25+ where method = "GET" <|> "POST"

26+

27+httpVersion = "HTTP/" *> ((,) <$> (int <* B.char '.') <*> int)

28+

29+responseLine = (,,) <$>

30+ (httpVersion <* B.skipSpace) <*>

31+ (int <* B.skipSpace) <*>

32+ bodyLine

33+

34+int :: B.Parser Int

35+int = B.decimal

36+

37+request = (,) <$> (requestLine <* B.endOfLine) <*> many header

38+

39+response = (,) <$> responseLine <*> many header

2040

2141headers :: IO Benchmark

2242headers = do

23− req <- B.readFile =<< pathTo "http-request.txt"

24− resp <- B.readFile =<< pathTo "http-response.txt"

43+ req <- B.readFile "http-request.txt"

44+ resp <- B.readFile "http-response.txt"

2545 let reql = rechunkBS 4 req

2646 respl = rechunkBS 4 resp

2747 return $ bgroup "headers" [

2848 bgroup "B" [

2949 bench "request" $ nf (B.parseOnly request) req

30− , bench "warp" $ nfIO (parseHeaderLines (B.split '\n' req))

3150 , bench "response" $ nf (B.parseOnly response) resp

3251 ]

3352 , bgroup "BL" [

benchmarks/HeadersByteString/Atto.hsdeleted−57

@@ -1,57 +0,0 @@

1−{-# LANGUAGE BangPatterns, OverloadedStrings #-}

2−{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}

3−module HeadersByteString.Atto

4− (

5− request

6− , response

7− ) where

8−

9−import Control.Applicative

10−import Control.DeepSeq (NFData(..))

11−import Network.HTTP.Types.Version (HttpVersion, http11)

12−import qualified Data.Attoparsec.ByteString.Char8 as B

13−import qualified Data.ByteString.Char8 as B

14−

15−instance NFData HttpVersion where

16− rnf !_ = ()

17−

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−

26−header = do

27− name <- B.takeWhile1 isHeaderChar <* B.char ':' <* B.skipSpace

28− body <- bodyLine

29− return (name, body)

30−

31−bodyLine = B.takeTill (\c -> c == '\r' || c == '\n') <* B.endOfLine

32−

33−requestLine = do

34− m <- (B.takeTill B.isSpace <* B.char ' ')

35− (p,q) <- B.break (=='?') <$> (B.takeTill B.isSpace <* B.char ' ')

36− v <- httpVersion

37− return (m,p,q,v)

38−

39−httpVersion = http11 <$ "HTTP/1.1"

40−

41−responseLine = (,,) <$>

42− (httpVersion <* B.skipSpace) <*>

43− (int <* B.skipSpace) <*>

44− bodyLine

45−

46−int :: B.Parser Int

47−int = B.decimal

48−

49−request = (,) <$> (requestLine <* B.endOfLine) <*> manyheader

50−

51−response = (,) <$> responseLine <*> many header

52−

53−manyheader = do

54− c <- B.peekChar'

55− if c == '\r' || c == '\n'

56− then return []

57− else (:) <$> header <*> manyheader

benchmarks/HeadersText.hs+3−3

@@ -2,7 +2,7 @@

22{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

33module HeadersText (headers) where

5−import Common (pathTo, rechunkT)

5+import Common (rechunkT)

66import Control.Applicative

77import Criterion.Main (bench, bgroup, nf)

88import Criterion.Types (Benchmark)

@@ -41,8 +41,8 @@ response = (,) <$> responseLine <*> many header

4141

4242headers :: IO Benchmark

4343headers = do

44− req <- T.readFile =<< pathTo "http-request.txt"

45− resp <- T.readFile =<< pathTo "http-response.txt"

44+ req <- T.readFile "http-request.txt"

45+ resp <- T.readFile "http-response.txt"

4646 let reql = rechunkT 4 req

4747 respl = rechunkT 4 resp

4848 return $ bgroup "headers" [

benchmarks/Links.hs+2−2

@@ -5,8 +5,8 @@ module Links (links) where

55import Control.Applicative

66import Control.DeepSeq (NFData(..))

77import Criterion.Main (Benchmark, bench, nf)

8−import Data.Attoparsec.ByteString as A

9−import Data.Attoparsec.ByteString.Char8 as A8

8+import Data.Attoparsec as A

9+import Data.Attoparsec.Char8 as A8

1010import Data.ByteString.Char8 as B8

1111

1212data Link = Link {

benchmarks/Numbers.hs−1

@@ -1,5 +1,4 @@

11{-# LANGUAGE BangPatterns #-}

2−{-# OPTIONS_GHC -fno-warn-deprecations #-}

43module Numbers (numbers) where

benchmarks/Sets.hsdeleted−21

@@ -1,21 +0,0 @@

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.hsdeleted−121

@@ -1,121 +0,0 @@

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/Warp.hsdeleted−17

@@ -1,17 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module Warp (benchmarks) where

4−

5−import Criterion.Main (bench, bgroup, nf)

6−import Criterion.Types (Benchmark)

7−import Data.ByteString (ByteString)

8−import Network.Wai.Handler.Warp.ReadInt (readInt)

9−import qualified Data.Attoparsec.ByteString.Char8 as B

10−

11−benchmarks :: Benchmark

12−benchmarks = bgroup "warp" [

13− bgroup "decimal" [

14− bench "warp" $ nf (readInt :: ByteString -> Int) "31337"

15− , bench "atto" $ nf (B.parse (B.decimal :: B.Parser Int)) "31337"

16− ]

17− ]

benchmarks/attoparsec-benchmarks.cabal+3−13

@@ -11,31 +11,21 @@ executable attoparsec-benchmarks

1111 other-modules:

1212 Common

1313 HeadersByteString

14− HeadersByteString.Atto

1514 HeadersText

1615 Links

1716 Numbers

18− Network.Wai.Handler.Warp.ReadInt

19− Sets

20− TextFastSet

21− Warp

22− hs-source-dirs: .. . warp-3.0.1.1

23− ghc-options: -O2 -Wall -rtsopts

17+ hs-source-dirs: .. .

18+ ghc-options: -O2 -Wall

2419 build-depends:

2520 array,

2621 base == 4.*,

2722 bytestring >= 0.10.4.0,

28− case-insensitive,

29− containers,

30− criterion >= 1.0,

23+ criterion >= 0.8.1.0,

3124 deepseq >= 1.1,

3225 directory,

3326 filepath,

34− ghc-prim,

35− http-types,

3627 parsec >= 3.1.2,

3728 scientific >= 0.3.1,

3829 text >= 1.1.1.0,

39− transformers,

4030 unordered-containers,

4131 vector

benchmarks/http-request.txt+8−3

@@ -1,9 +1,14 @@

11GET / HTTP/1.1

22Host: twitter.com

3−Accept: text/html, application/xhtml+xml, application/xml; q=0.9, image/webp, */*; q=0.8

3+Accept: text/html, application/xhtml+xml, application/xml; q=0.9,

4+ image/webp, */*; q=0.8

45Accept-Encoding: gzip,deflate,sdch

56Accept-Language: en-GB,en-US;q=0.8,en;q=0.6

67Cache-Control: max-age=0

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

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

914

benchmarks/http-response.txt+4−2

@@ -3,8 +3,10 @@ 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; 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

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

810P3P: CP="This is not a P3P policy! See http://www.google.com/support/accounts/bin/answer.py?hl=en&answer=151657 for more info."

911Server: gws

1012X-XSS-Protection: 1; mode=block

benchmarks/warp-3.0.1.1/LICENSEdeleted−20

@@ -1,20 +0,0 @@

2−

3−Permission is hereby granted, free of charge, to any person obtaining

4−a copy of this software and associated documentation files (the

5−"Software"), to deal in the Software without restriction, including

6−without limitation the rights to use, copy, modify, merge, publish,

7−distribute, sublicense, and/or sell copies of the Software, and to

8−permit persons to whom the Software is furnished to do so, subject to

9−the following conditions:

10−

11−The above copyright notice and this permission notice shall be

12−included in all copies or substantial portions of the Software.

13−

14−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,

15−EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF

16−MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

17−NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE

18−LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION

19−OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION

20−WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/ReadInt.hsdeleted−67

@@ -1,67 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# LANGUAGE MagicHash #-}

3−{-# LANGUAGE BangPatterns #-}

4−

5−-- Copyright : Erik de Castro Lopo <erikd@mega-nerd.com>

6−-- License : BSD3

7−

8−module Network.Wai.Handler.Warp.ReadInt (

9− readInt

10− , readInt64

11− ) where

12−

13−-- This function lives in its own file because the MagicHash pragma interacts

14−-- poorly with the CPP pragma.

15−

16−import Data.ByteString (ByteString)

17−import qualified Data.ByteString as S

18−import Data.Int (Int64)

19−import GHC.Prim

20−import GHC.Types

21−import GHC.Word

22−

23−{-# INLINE readInt #-}

24−readInt :: Integral a => ByteString -> a

25−readInt bs = fromIntegral $ readInt64 bs

26−

27−-- This function is used to parse the Content-Length field of HTTP headers and

28−-- is a performance hot spot. It should only be replaced with something

29−-- significantly and provably faster.

30−--

31−-- It needs to be able work correctly on 32 bit CPUs for file sizes > 2G so we

32−-- use Int64 here and then make a generic 'readInt' that allows conversion to

33−-- Int and Integer.

34−

35−{-# NOINLINE readInt64 #-}

36−readInt64 :: ByteString -> Int64

37−readInt64 bs = S.foldl' (\ !i !c -> i * 10 + fromIntegral (mhDigitToInt c)) 0

38− $ S.takeWhile isDigit bs

39−

40−data Table = Table !Addr#

41−

42−{-# NOINLINE mhDigitToInt #-}

43−mhDigitToInt :: Word8 -> Int

44−mhDigitToInt (W8# i) = I# (word2Int# (indexWord8OffAddr# addr (word2Int# i)))

45− where

46− !(Table addr) = table

47− table :: Table

48− table = Table

49− "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

50− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

51− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

52− \\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x00\x00\x00\x00\x00\x00\

53− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

54− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

55− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

56− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

57− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

58− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

59− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

60− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

61− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

62− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

63− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\

64− \\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"#

65−

66−isDigit :: Word8 -> Bool

67−isDigit w = w >= 48 && w <= 57

benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/RequestHeader.hsdeleted−172

@@ -1,172 +0,0 @@

1−{-# LANGUAGE DeriveDataTypeable #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE BangPatterns #-}

4−

5−module Network.Wai.Handler.Warp.RequestHeader (

6− parseHeaderLines

7− , parseByteRanges

8− ) where

9−

10−import Control.Exception (Exception, throwIO)

11−import Control.Monad (when)

12−import Data.Typeable (Typeable)

13−import qualified Data.ByteString as S

14−import qualified Data.ByteString.Char8 as B (unpack, readInteger)

15−import Data.ByteString.Internal (ByteString(..), memchr)

16−import qualified Data.CaseInsensitive as CI

17−import Data.Word (Word8)

18−import Foreign.ForeignPtr (withForeignPtr)

19−import Foreign.Ptr (Ptr, plusPtr, minusPtr, nullPtr)

20−import Foreign.Storable (peek)

21−import qualified Network.HTTP.Types as H

22−-- import Network.Wai.Handler.Warp.Types

23−import qualified Network.HTTP.Types.Header as HH

24−-- $setup

25−-- >>> :set -XOverloadedStrings

26−

27−data InvalidRequest = NotEnoughLines [String]

28− | BadFirstLine String

29− | NonHttp

30− | IncompleteHeaders

31− | ConnectionClosedByPeer

32− | OverLargeHeader

33− deriving (Eq, Typeable, Show)

34−

35−instance Exception InvalidRequest

36−

37−----------------------------------------------------------------

38−

39−parseHeaderLines :: [ByteString]

40− -> IO (H.Method

41− ,ByteString -- Path

42− ,ByteString -- Path, parsed

43− ,ByteString -- Query

44− ,H.HttpVersion

45− ,H.RequestHeaders

46− )

47−parseHeaderLines [] = throwIO $ NotEnoughLines []

48−parseHeaderLines (firstLine:otherLines) = do

49− (method, path', query, httpversion) <- parseRequestLine firstLine

50− let path = H.extractPath path'

51− hdr = map parseHeader otherLines

52− return (method, path', path, query, httpversion, hdr)

53−

54−----------------------------------------------------------------

55−

56−-- |

57−--

58−-- >>> parseRequestLine "GET / HTTP/1.1"

59−-- ("GET","/","",HTTP/1.1)

60−-- >>> parseRequestLine "POST /cgi/search.cgi?key=foo HTTP/1.0"

61−-- ("POST","/cgi/search.cgi","?key=foo",HTTP/1.0)

62−-- >>> parseRequestLine "GET "

63−-- *** Exception: Warp: Invalid first line of request: "GET "

64−-- >>> parseRequestLine "GET /NotHTTP UNKNOWN/1.1"

65−-- *** Exception: Warp: Request line specified a non-HTTP request

66−parseRequestLine :: ByteString

67− -> IO (H.Method

68− ,ByteString -- Path

69− ,ByteString -- Query

70− ,H.HttpVersion)

71−parseRequestLine requestLine@(PS fptr off len) = withForeignPtr fptr $ \ptr -> do

72− when (len < 14) $ throwIO baderr

73− let methodptr = ptr `plusPtr` off

74− limptr = methodptr `plusPtr` len

75− lim0 = fromIntegral len

76−

77− pathptr0 <- memchr methodptr 32 lim0 -- ' '

78− when (pathptr0 == nullPtr || (limptr `minusPtr` pathptr0) < 11) $

79− throwIO baderr

80− let pathptr = pathptr0 `plusPtr` 1

81− lim1 = fromIntegral (limptr `minusPtr` pathptr0)

82−

83− httpptr0 <- memchr pathptr 32 lim1 -- ' '

84− when (httpptr0 == nullPtr || (limptr `minusPtr` httpptr0) < 9) $

85− throwIO baderr

86− let httpptr = httpptr0 `plusPtr` 1

87− lim2 = fromIntegral (httpptr0 `minusPtr` pathptr)

88−

89− checkHTTP httpptr

90− !hv <- httpVersion httpptr

91− queryptr <- memchr pathptr 63 lim2 -- '?'

92−

93− let !method = bs ptr methodptr pathptr0

94− !path

95− | queryptr == nullPtr = bs ptr pathptr httpptr0

96− | otherwise = bs ptr pathptr queryptr

97− !query

98− | queryptr == nullPtr = S.empty

99− | otherwise = bs ptr queryptr httpptr0

100−

101− return (method,path,query,hv)

102− where

103− baderr = BadFirstLine $ B.unpack requestLine

104− check :: Ptr Word8 -> Int -> Word8 -> IO ()

105− check p n w = do

106− w0 <- peek $ p `plusPtr` n

107− when (w0 /= w) $ throwIO NonHttp

108− checkHTTP httpptr = do

109− check httpptr 0 72 -- 'H'

110− check httpptr 1 84 -- 'T'

111− check httpptr 2 84 -- 'T'

112− check httpptr 3 80 -- 'P'

113− check httpptr 4 47 -- '/'

114− check httpptr 6 46 -- '.'

115− httpVersion httpptr = do

116− major <- peek $ httpptr `plusPtr` 5

117− minor <- peek $ httpptr `plusPtr` 7

118− return $ if major == (49 :: Word8) && minor == (49 :: Word8) then

119− H.http11

120− else

121− H.http10

122− bs ptr p0 p1 = PS fptr o l

123− where

124− o = p0 `minusPtr` ptr

125− l = p1 `minusPtr` p0

126−

127−----------------------------------------------------------------

128−

129−-- |

130−--

131−-- >>> parseHeader "Content-Length:47"

132−-- ("Content-Length","47")

133−-- >>> parseHeader "Accept-Ranges: bytes"

134−-- ("Accept-Ranges","bytes")

135−-- >>> parseHeader "Host: example.com:8080"

136−-- ("Host","example.com:8080")

137−-- >>> parseHeader "NoSemiColon"

138−-- ("NoSemiColon","")

139−

140−parseHeader :: ByteString -> H.Header

141−parseHeader s =

142− let (k, rest) = S.break (== 58) s -- ':'

143− rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest

144− in (CI.mk k, rest')

145−

146−parseByteRanges :: S.ByteString -> Maybe HH.ByteRanges

147−parseByteRanges bs1 = do

148− bs2 <- stripPrefix "bytes=" bs1

149− (r, bs3) <- range bs2

150− ranges (r:) bs3

151− where

152− range bs2 =

153− case stripPrefix "-" bs2 of

154− Just bs3 -> do

155− (i, bs4) <- B.readInteger bs3

156− Just (HH.ByteRangeSuffix i, bs4)

157− Nothing -> do

158− (i, bs3) <- B.readInteger bs2

159− bs4 <- stripPrefix "-" bs3

160− case B.readInteger bs4 of

161− Nothing -> Just (HH.ByteRangeFrom i, bs4)

162− Just (j, bs5) -> Just (HH.ByteRangeFromTo i j, bs5)

163− ranges front bs3 =

164− case stripPrefix "," bs3 of

165− Nothing -> Just (front [])

166− Just bs4 -> do

167− (r, bs5) <- range bs4

168− ranges (front . (r:)) bs5

169−

170− stripPrefix x y

171− | x `S.isPrefixOf` y = Just (S.drop (S.length x) y)

172− | otherwise = Nothing

changelog.md−71

@@ -1,74 +1,3 @@

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−

27−0.13.0.0

28−

29−* Made the parser type in the Zepto module a monad transformer

30− (needed by aeson's string unescaping parser).

31−

32−0.12.1.6

33−

34−* Fixed a case folding bug in the ByteString version of stringCI.

35−

36−0.12.1.5

37−

38−* Fixed an indexing bug in the new Text implementation of string,

39− reported by Michel Boucey.

40−

41−0.12.1.4

42−

43−* Fixed a case where the string parser would consume an unnecessary

44− amount of input before failing a match, when it could bail much

45− earlier (https://github.com/bos/attoparsec/issues/97)

46−

47−* Added more context to error messages

48− (https://github.com/bos/attoparsec/pull/79)

49−

50−0.12.1.3

51−

52−* Fixed incorrect tracking of Text lengths

53− (https://github.com/bos/attoparsec/issues/80)

54−

55−0.12.1.2

56−

57−* Fixed the incorrect tracking of capacity if the initial buffer was

58− empty (https://github.com/bos/attoparsec/issues/75)

59−

60−0.12.1.1

61−

62−* Fixed a data corruption bug that occurred under some circumstances

63− if a buffer grew after prompting for more input

64− (https://github.com/bos/attoparsec/issues/74)

65−

66−0.12.1.0

67−

68−* Now compatible with GHC 7.9

69−

70−* Reintroduced the Chunk class, used by the parsers package

71−

7210.12.0.0

732

743* A new internal representation makes almost all real-world parsers

examples/Makefile+2−6

@@ -1,4 +1,4 @@

1−CC := cc

1+CC := gcc

22CFLAGS := -O3 -Wall

33# To make the code about 6% faster:

44# CFLAGS += -fwhole-program --combine

@@ -12,8 +12,4 @@ c-http: rfc2616.c http_parser.c

1212clean:

1313 rm -f *.hi *.o c-http

1414

15−http_parser.c: http_parser.h

16− curl -O https://raw.githubusercontent.com/joyent/http-parser/master/http_parser.c

17−

18−http_parser.h:

19− curl -O https://raw.githubusercontent.com/joyent/http-parser/master/http_parser.h

15+vpath %.c $(HOME)/hg/http-parser

examples/Parsec_RFC2616.hs+6−9

@@ -23,16 +23,15 @@ token :: Stream s m Char => ParsecT s u m Char

2323token = satisfy $ \c -> S.notMember (fromEnum c) set

2424 where set = S.fromList . map fromEnum $ ['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255']

2525

26−isHorizontalSpace :: Char -> Bool

2726isHorizontalSpace c = c == ' ' || c == '\t'

2827

2928skipHSpaces :: Stream s m Char => ParsecT s u m ()

3029skipHSpaces = skipMany1 (satisfy isHorizontalSpace)

3130

3231data Request = Request {

33− _requestMethod :: String

34− , _requestUri :: String

35− , _requestProtocol :: String

32+ requestMethod :: String

33+ , requestUri :: String

34+ , requestProtocol :: String

3635 } deriving (Eq, Ord, Show)

3736

3837requestLine :: Stream s m Char => ParsecT s u m Request

@@ -48,8 +47,8 @@ endOfLine :: Stream s m Char => ParsecT s u m ()

4847endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ())

4948

5049data Header = Header {

51− _headerName :: String

52− , _headerValue :: [String]

50+ headerName :: String

51+ , headerValue :: [String]

5352 } deriving (Eq, Ord, Show)

5453

5554messageHeader :: Stream s m Char => ParsecT s u m Header

@@ -62,16 +61,14 @@ messageHeader = do

6261request :: Stream s m Char => ParsecT s u m (Request, [Header])

6362request = (,) <$> requestLine <*> many messageHeader <* endOfLine

6463

65−listy :: FilePath -> IO ()

6664listy arg = do

6765 r <- parseFromFile (many request) arg

6866 case r of

6967 Left err -> putStrLn $ arg ++ ": " ++ show err

7068 Right rs -> print (length rs)

7169

72−chunky :: FilePath -> IO ()

7370chunky arg = bracket (openFile arg ReadMode) hClose $ \h ->

74− loop (0::Int) =<< B.hGetContents h

71+ loop 0 =<< B.hGetContents h

7572 where

7673 loop !n bs

7774 | B.null bs = print n

examples/RFC2616.hs+49−24

@@ -5,61 +5,86 @@ module RFC2616

55 Header(..)

66 , Request(..)

77 , Response(..)

8+ , isToken

9+ , messageHeader

810 , request

11+ , requestLine

912 , response

13+ , responseLine

14+ , lowerHeader

15+ , lookupHeader

1016 ) where

1117

1218import Control.Applicative

13−import Data.Attoparsec.ByteString as P

14−import Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isDigit_w8)

15−import Data.ByteString (ByteString)

19+import Data.Attoparsec as P

20+import qualified Data.Attoparsec.Char8 as P8

21+import Data.Attoparsec.Char8 (char8, endOfLine, isDigit_w8)

1622import Data.Word (Word8)

17−import Data.Attoparsec.ByteString.Char8 (isEndOfLine, isHorizontalSpace)

23+import qualified Data.ByteString.Char8 as B hiding (map)

24+import qualified Data.ByteString as B (map)

1825

1926isToken :: Word8 -> Bool

2027isToken w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w

2128

2229skipSpaces :: Parser ()

23−skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace

30+skipSpaces = satisfy P8.isHorizontalSpace *> skipWhile P8.isHorizontalSpace

2431

2532data Request = Request {

26− requestMethod :: ByteString

27− , requestUri :: ByteString

28− , requestVersion :: ByteString

33+ requestMethod :: !B.ByteString

34+ , requestUri :: !B.ByteString

35+ , requestVersion :: !B.ByteString

2936 } deriving (Eq, Ord, Show)

3037

31−httpVersion :: Parser ByteString

38+httpVersion :: Parser B.ByteString

3239httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)

3340

3441requestLine :: Parser Request

35−requestLine = Request <$> (takeWhile1 isToken <* char8 ' ')

36− <*> (takeWhile1 (/=32) <* char8 ' ')

37− <*> (httpVersion <* endOfLine)

42+requestLine = do

43+ method <- P.takeWhile1 isToken <* char8 ' '

44+ uri <- P.takeWhile1 (/=32) <* char8 ' '

45+ version <- httpVersion <* endOfLine

46+ return $! Request method uri version

3847

3948data Header = Header {

40− headerName :: ByteString

41− , headerValue :: [ByteString]

49+ headerName :: !B.ByteString

50+ , headerValue :: [B.ByteString]

4251 } deriving (Eq, Ord, Show)

4352

4453messageHeader :: Parser Header

45−messageHeader = Header

46− <$> (P.takeWhile isToken <* char8 ':' <* skipWhile isHorizontalSpace)

47− <*> ((:) <$> (takeTill isEndOfLine <* endOfLine)

48− <*> (many $ skipSpaces *> takeTill isEndOfLine <* endOfLine))

54+messageHeader = do

55+ header <- P.takeWhile isToken <* char8 ':' <* skipWhile P8.isHorizontalSpace

56+ body <- takeTill P8.isEndOfLine <* endOfLine

57+ bodies <- many $ skipSpaces *> takeTill P8.isEndOfLine <* endOfLine

58+ return $! Header header (body:bodies)

4959

5060request :: Parser (Request, [Header])

5161request = (,) <$> requestLine <*> many messageHeader <* endOfLine

5262

5363data Response = Response {

54− responseVersion :: ByteString

55− , responseCode :: ByteString

56− , responseMsg :: ByteString

64+ responseVersion :: !B.ByteString

65+ , responseCode :: !B.ByteString

66+ , responseMsg :: !B.ByteString

5767 } deriving (Eq, Ord, Show)

5868

5969responseLine :: Parser Response

60−responseLine = Response <$> (httpVersion <* char8 ' ')

61− <*> (P.takeWhile isDigit_w8 <* char8 ' ')

62− <*> (takeTill isEndOfLine <* endOfLine)

70+responseLine = do

71+ version <- httpVersion <* char8 ' '

72+ code <- P.takeWhile isDigit_w8 <* char8 ' '

73+ msg <- P.takeTill P8.isEndOfLine <* endOfLine

74+ return $! Response version code msg

6375

6476response :: Parser (Response, [Header])

6577response = (,) <$> responseLine <*> many messageHeader <* endOfLine

78+

79+lowerHeader :: Header -> Header

80+lowerHeader (Header n v) = Header (B.map toLower n) (map (B.map toLower) v)

81+ where toLower w | w >= 65 && w <= 90 = w + 32

82+ | otherwise = w

83+

84+lookupHeader :: B.ByteString -> [Header] -> [B.ByteString]

85+lookupHeader k = go

86+ where

87+ go (Header n v:hs)

88+ | k == n = v

89+ | otherwise = go hs

90+ go _ = []

examples/Atto_RFC2616.hs → examples/TestRFC2616.hsrenamed+8−16

@@ -1,28 +1,21 @@

11{-# LANGUAGE BangPatterns #-}

2−

3−module Main (main) where

4−

5−import Control.Applicative

6−import Control.Exception (bracket)

7−import Control.Monad (forM_)

8−import Data.Attoparsec.ByteString

92import RFC2616

10−import System.Environment

3+import Control.Monad (forM_)

114import System.IO

5+import Control.Exception (bracket)

6+import System.Environment

127import qualified Data.ByteString.Char8 as B

8+import Data.Attoparsec

139

14−refill :: Handle -> IO B.ByteString

15−refill h = B.hGet h (80*1024)

10+refill h = B.hGet h (4*1024)

1611

17−listy :: FilePath -> Handle -> IO ()

1812listy file h = do

1913 r <- parseWith (refill h) (many request) =<< refill h

2014 case r of

2115 Fail _ _ msg -> hPutStrLn stderr $ file ++ ": " ++ msg

2216 Done _ reqs -> print (length reqs)

23−

24−incrementy :: FilePath -> Handle -> IO ()

25−incrementy file h = go (0::Int) =<< refill h

17+

18+incrementy file h = go 0 =<< refill h

2619 where

2720 go !n is = do

2821 r <- parseWith (refill h) request is

@@ -35,8 +28,7 @@ incrementy file h = go (0::Int) =<< refill h

3528 then print (n+1)

3629 else go (n+1) s

3730 | otherwise -> go (n+1) bs

38−

39−main :: IO ()

31+

4032main = do

4133 args <- getArgs

4234 forM_ args $ \arg ->

examples/attoparsec-examples.cabaldeleted−31

@@ -1,31 +0,0 @@

1−-- These examples are not intended to be installed.

2−-- So don't install 'em.

3−

4−name: attoparsec-examples

5−version: 0

6−cabal-version: >=1.6

7−build-type: Simple

8−

9−executable atto-rfc2616

10− main-is: Atto_RFC2616.hs

11− hs-source-dirs: .. .

12− ghc-options: -O2 -Wall -rtsopts

13− build-depends:

14− array,

15− base == 4.*,

16− bytestring >= 0.10.4.0,

17− deepseq >= 1.1,

18− scientific >= 0.3.1,

19− text >= 1.1.1.0

20−

21−executable parsec-rfc2616

22− main-is: Parsec_RFC2616.hs

23− hs-source-dirs: .

24− ghc-options: -O2 -Wall -rtsopts

25− build-depends:

26− array,

27− base == 4.*,

28− containers,

29− bytestring >= 0.10.4.0,

30− parsec,

31− text >= 1.1.1.0

examples/http-requests.txtdeleted−494

@@ -1,494 +0,0 @@

1−GET / HTTP/1.1

2−Host: www.reddit.com

3−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

4−Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8

5−Accept-Language: en-us,en;q=0.5

6−Accept-Encoding: gzip, deflate

7−Connection: keep-alive

8−

9−GET /reddit.v_EZwRzV-Ns.css HTTP/1.1

10−Host: www.redditstatic.com

11−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

12−Accept: text/css,*/*;q=0.1

13−Accept-Language: en-us,en;q=0.5

14−Accept-Encoding: gzip, deflate

15−Connection: keep-alive

16−Referer: http://www.reddit.com/

17−

18−GET /reddit-init.en-us.O1zuMqOOQvY.js HTTP/1.1

19−Host: www.redditstatic.com

20−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

21−Accept: */*

22−Accept-Language: en-us,en;q=0.5

23−Accept-Encoding: gzip, deflate

24−Connection: keep-alive

25−Referer: http://www.reddit.com/

26−

27−GET /reddit.en-us.31yAfSoTsfo.js HTTP/1.1

28−Host: www.redditstatic.com

29−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

30−Accept: */*

31−Accept-Language: en-us,en;q=0.5

32−Accept-Encoding: gzip, deflate

33−Connection: keep-alive

34−Referer: http://www.reddit.com/

35−

36−GET /kill.png HTTP/1.1

37−Host: www.redditstatic.com

38−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

39−Accept: image/png,image/*;q=0.8,*/*;q=0.5

40−Accept-Language: en-us,en;q=0.5

41−Accept-Encoding: gzip, deflate

42−Connection: keep-alive

43−Referer: http://www.reddit.com/

44−

45−GET /icon.png HTTP/1.1

46−Host: www.redditstatic.com

47−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

48−Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8

49−Accept-Language: en-us,en;q=0.5

50−Accept-Encoding: gzip, deflate

51−Connection: keep-alive

52−

53−GET /favicon.ico HTTP/1.1

54−Host: www.redditstatic.com

55−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

56−Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8

57−Accept-Language: en-us,en;q=0.5

58−Accept-Encoding: gzip, deflate

59−Connection: keep-alive

60−

61−GET /AMZM4CWd6zstSC8y.jpg HTTP/1.1

62−Host: b.thumbs.redditmedia.com

63−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

64−Accept: image/png,image/*;q=0.8,*/*;q=0.5

65−Accept-Language: en-us,en;q=0.5

66−Accept-Encoding: gzip, deflate

67−Connection: keep-alive

68−Referer: http://www.reddit.com/

69−

70−GET /jz1d5Nm0w97-YyNm.jpg HTTP/1.1

71−Host: b.thumbs.redditmedia.com

72−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

73−Accept: image/png,image/*;q=0.8,*/*;q=0.5

74−Accept-Language: en-us,en;q=0.5

75−Accept-Encoding: gzip, deflate

76−Connection: keep-alive

77−Referer: http://www.reddit.com/

78−

79−GET /aWGO99I6yOcNUKXB.jpg HTTP/1.1

80−Host: a.thumbs.redditmedia.com

81−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

82−Accept: image/png,image/*;q=0.8,*/*;q=0.5

83−Accept-Language: en-us,en;q=0.5

84−Accept-Encoding: gzip, deflate

85−Connection: keep-alive

86−Referer: http://www.reddit.com/

87−

88−GET /rZ_rD5TjrJM0E9Aj.css HTTP/1.1

89−Host: e.thumbs.redditmedia.com

90−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

91−Accept: text/css,*/*;q=0.1

92−Accept-Language: en-us,en;q=0.5

93−Accept-Encoding: gzip, deflate

94−Connection: keep-alive

95−Referer: http://www.reddit.com/

96−

97−GET /tmsPwagFzyTvrGRx.jpg HTTP/1.1

98−Host: a.thumbs.redditmedia.com

99−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

100−Accept: image/png,image/*;q=0.8,*/*;q=0.5

101−Accept-Language: en-us,en;q=0.5

102−Accept-Encoding: gzip, deflate

103−Connection: keep-alive

104−Referer: http://www.reddit.com/

105−

106−GET /KYgUaLvXCK3TCEJx.jpg HTTP/1.1

107−Host: a.thumbs.redditmedia.com

108−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

109−Accept: image/png,image/*;q=0.8,*/*;q=0.5

110−Accept-Language: en-us,en;q=0.5

111−Accept-Encoding: gzip, deflate

112−Connection: keep-alive

113−Referer: http://www.reddit.com/

114−

115−GET /81pzxT5x2ozuEaxX.jpg HTTP/1.1

116−Host: e.thumbs.redditmedia.com

117−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

118−Accept: image/png,image/*;q=0.8,*/*;q=0.5

119−Accept-Language: en-us,en;q=0.5

120−Accept-Encoding: gzip, deflate

121−Connection: keep-alive

122−Referer: http://www.reddit.com/

123−

124−GET /MFqCUiUVPO5V8t6x.jpg HTTP/1.1

125−Host: a.thumbs.redditmedia.com

126−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

127−Accept: image/png,image/*;q=0.8,*/*;q=0.5

128−Accept-Language: en-us,en;q=0.5

129−Accept-Encoding: gzip, deflate

130−Connection: keep-alive

131−Referer: http://www.reddit.com/

132−

133−GET /TFpYTiAO5aEowokv.jpg HTTP/1.1

134−Host: e.thumbs.redditmedia.com

135−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

136−Accept: image/png,image/*;q=0.8,*/*;q=0.5

137−Accept-Language: en-us,en;q=0.5

138−Accept-Encoding: gzip, deflate

139−Connection: keep-alive

140−Referer: http://www.reddit.com/

141−

142−GET /eMWMpmm9APNeNqcF.jpg HTTP/1.1

143−Host: e.thumbs.redditmedia.com

144−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

145−Accept: image/png,image/*;q=0.8,*/*;q=0.5

146−Accept-Language: en-us,en;q=0.5

147−Accept-Encoding: gzip, deflate

148−Connection: keep-alive

149−Referer: http://www.reddit.com/

150−

151−GET /S-IpsJrOKuaK9GZ8.jpg HTTP/1.1

152−Host: c.thumbs.redditmedia.com

153−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

154−Accept: image/png,image/*;q=0.8,*/*;q=0.5

155−Accept-Language: en-us,en;q=0.5

156−Accept-Encoding: gzip, deflate

157−Connection: keep-alive

158−Referer: http://www.reddit.com/

159−

160−GET /3V6dj9PDsNnheDXn.jpg HTTP/1.1

161−Host: c.thumbs.redditmedia.com

162−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

163−Accept: image/png,image/*;q=0.8,*/*;q=0.5

164−Accept-Language: en-us,en;q=0.5

165−Accept-Encoding: gzip, deflate

166−Connection: keep-alive

167−Referer: http://www.reddit.com/

168−

169−GET /wQ3-VmNXhv8sg4SJ.jpg HTTP/1.1

170−Host: c.thumbs.redditmedia.com

171−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

172−Accept: image/png,image/*;q=0.8,*/*;q=0.5

173−Accept-Language: en-us,en;q=0.5

174−Accept-Encoding: gzip, deflate

175−Connection: keep-alive

176−Referer: http://www.reddit.com/

177−

178−GET /ixd1C1njpczEWC22.jpg HTTP/1.1

179−Host: c.thumbs.redditmedia.com

180−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

181−Accept: image/png,image/*;q=0.8,*/*;q=0.5

182−Accept-Language: en-us,en;q=0.5

183−Accept-Encoding: gzip, deflate

184−Connection: keep-alive

185−Referer: http://www.reddit.com/

186−

187−GET /nGsQj15VyOHMwmq8.jpg HTTP/1.1

188−Host: c.thumbs.redditmedia.com

189−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

190−Accept: image/png,image/*;q=0.8,*/*;q=0.5

191−Accept-Language: en-us,en;q=0.5

192−Accept-Encoding: gzip, deflate

193−Connection: keep-alive

194−Referer: http://www.reddit.com/

195−

196−GET /zT4yQmDxQLbIxK1b.jpg HTTP/1.1

197−Host: c.thumbs.redditmedia.com

198−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

199−Accept: image/png,image/*;q=0.8,*/*;q=0.5

200−Accept-Language: en-us,en;q=0.5

201−Accept-Encoding: gzip, deflate

202−Connection: keep-alive

203−Referer: http://www.reddit.com/

204−

205−GET /L5e1HcZLv1iu4nrG.jpg HTTP/1.1

206−Host: f.thumbs.redditmedia.com

207−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

208−Accept: image/png,image/*;q=0.8,*/*;q=0.5

209−Accept-Language: en-us,en;q=0.5

210−Accept-Encoding: gzip, deflate

211−Connection: keep-alive

212−Referer: http://www.reddit.com/

213−

214−GET /WJFFPxD8X4JO_lIG.jpg HTTP/1.1

215−Host: f.thumbs.redditmedia.com

216−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

217−Accept: image/png,image/*;q=0.8,*/*;q=0.5

218−Accept-Language: en-us,en;q=0.5

219−Accept-Encoding: gzip, deflate

220−Connection: keep-alive

221−Referer: http://www.reddit.com/

222−

223−GET /hVMVTDdjuY3bQox5.jpg HTTP/1.1

224−Host: f.thumbs.redditmedia.com

225−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

226−Accept: image/png,image/*;q=0.8,*/*;q=0.5

227−Accept-Language: en-us,en;q=0.5

228−Accept-Encoding: gzip, deflate

229−Connection: keep-alive

230−Referer: http://www.reddit.com/

231−

232−GET /rnWf8CjBcyPQs5y_.jpg HTTP/1.1

233−Host: f.thumbs.redditmedia.com

234−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

235−Accept: image/png,image/*;q=0.8,*/*;q=0.5

236−Accept-Language: en-us,en;q=0.5

237−Accept-Encoding: gzip, deflate

238−Connection: keep-alive

239−Referer: http://www.reddit.com/

240−

241−GET /gZJL1jNylKbGV4d-.jpg HTTP/1.1

242−Host: d.thumbs.redditmedia.com

243−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

244−Accept: image/png,image/*;q=0.8,*/*;q=0.5

245−Accept-Language: en-us,en;q=0.5

246−Accept-Encoding: gzip, deflate

247−Connection: keep-alive

248−Referer: http://www.reddit.com/

249−

250−GET /aNd2zNRLXiMnKUFh.jpg HTTP/1.1

251−Host: c.thumbs.redditmedia.com

252−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

253−Accept: image/png,image/*;q=0.8,*/*;q=0.5

254−Accept-Language: en-us,en;q=0.5

255−Accept-Encoding: gzip, deflate

256−Connection: keep-alive

257−Referer: http://www.reddit.com/

258−

259−GET /droparrowgray.gif HTTP/1.1

260−Host: www.redditstatic.com

261−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

262−Accept: image/png,image/*;q=0.8,*/*;q=0.5

263−Accept-Language: en-us,en;q=0.5

264−Accept-Encoding: gzip, deflate

265−Connection: keep-alive

266−Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css

267−

268−GET /sprite-reddit.an0Lnf61Ap4.png HTTP/1.1

269−Host: www.redditstatic.com

270−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

271−Accept: image/png,image/*;q=0.8,*/*;q=0.5

272−Accept-Language: en-us,en;q=0.5

273−Accept-Encoding: gzip, deflate

274−Connection: keep-alive

275−Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css

276−

277−GET /ga.js HTTP/1.1

278−Host: www.google-analytics.com

279−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

280−Accept: */*

281−Accept-Language: en-us,en;q=0.5

282−Accept-Encoding: gzip, deflate

283−Connection: keep-alive

284−Referer: http://www.reddit.com/

285−If-Modified-Since: Tue, 29 Oct 2013 19:33:51 GMT

286−

287−GET /reddit/ads.html?sr=-reddit.com&bust2 HTTP/1.1

288−Host: static.adzerk.net

289−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

290−Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8

291−Accept-Language: en-us,en;q=0.5

292−Accept-Encoding: gzip, deflate

293−Connection: keep-alive

294−Referer: http://www.reddit.com/

295−

296−GET /pixel/of_destiny.png?v=hOlmDALJCWWdjzfBV4ZxJPmrdCLWB%2Ftq7Z%2Ffp4Q%2FxXbVPPREuMJMVGzKraTuhhNWxCCwi6yFEZg%3D&r=783333388 HTTP/1.1

297−Host: pixel.redditmedia.com

298−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

299−Accept: image/png,image/*;q=0.8,*/*;q=0.5

300−Accept-Language: en-us,en;q=0.5

301−Accept-Encoding: gzip, deflate

302−Connection: keep-alive

303−Referer: http://www.reddit.com/

304−

305−GET /UNcO-h_QcS9PD-Gn.jpg HTTP/1.1

306−Host: c.thumbs.redditmedia.com

307−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

308−Accept: image/png,image/*;q=0.8,*/*;q=0.5

309−Accept-Language: en-us,en;q=0.5

310−Accept-Encoding: gzip, deflate

311−Connection: keep-alive

312−Referer: http://e.thumbs.redditmedia.com/rZ_rD5TjrJM0E9Aj.css

313−

314−GET /welcome-lines.png HTTP/1.1

315−Host: www.redditstatic.com

316−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

317−Accept: image/png,image/*;q=0.8,*/*;q=0.5

318−Accept-Language: en-us,en;q=0.5

319−Accept-Encoding: gzip, deflate

320−Connection: keep-alive

321−Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css

322−

323−GET /welcome-upvote.png HTTP/1.1

324−Host: www.redditstatic.com

325−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

326−Accept: image/png,image/*;q=0.8,*/*;q=0.5

327−Accept-Language: en-us,en;q=0.5

328−Accept-Encoding: gzip, deflate

329−Connection: keep-alive

330−Referer: http://www.redditstatic.com/reddit.v_EZwRzV-Ns.css

331−

332−GET /__utm.gif?utmwv=5.5.1&utms=1&utmn=720496082&utmhn=www.reddit.com&utme=8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512705&utmac=UA-12131688-1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=qR~ HTTP/1.1

333−Host: www.google-analytics.com

334−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

335−Accept: image/png,image/*;q=0.8,*/*;q=0.5

336−Accept-Language: en-us,en;q=0.5

337−Accept-Encoding: gzip, deflate

338−Connection: keep-alive

339−Referer: http://www.reddit.com/

340−

341−GET /ImnpOQhbXUPkwceN.png HTTP/1.1

342−Host: a.thumbs.redditmedia.com

343−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

344−Accept: image/png,image/*;q=0.8,*/*;q=0.5

345−Accept-Language: en-us,en;q=0.5

346−Accept-Encoding: gzip, deflate

347−Connection: keep-alive

348−Referer: http://www.reddit.com/

349−

350−GET /ajax/libs/jquery/1.7.1/jquery.min.js HTTP/1.1

351−Host: ajax.googleapis.com

352−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

353−Accept: */*

354−Accept-Language: en-us,en;q=0.5

355−Accept-Encoding: gzip, deflate

356−Connection: keep-alive

357−Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2

358−

359−GET /__utm.gif?utmwv=5.5.1&utms=2&utmn=1493472678&utmhn=www.reddit.com&utmt=event&utme=5(AdBlock*enabled*false)(0)8(site*srpath*usertype*uitype)9(%20reddit.com*%20reddit.com-GET_listing*guest*web)11(3!2)&utmcs=UTF-8&utmsr=2560x1600&utmvp=1288x792&utmsc=24-bit&utmul=en-us&utmje=1&utmfl=13.0%20r0&utmdt=reddit%3A%20the%20front%20page%20of%20the%20internet&utmhid=2129416330&utmr=-&utmp=%2F&utmht=1400862512708&utmac=UA-12131688-1&utmni=1&utmcc=__utma%3D55650728.585571751.1400862513.1400862513.1400862513.1%3B%2B__utmz%3D55650728.1400862513.1.1.utmcsr%3D(direct)%7Cutmccn%3D(direct)%7Cutmcmd%3D(none)%3B&utmu=6R~ HTTP/1.1

360−Host: www.google-analytics.com

361−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

362−Accept: image/png,image/*;q=0.8,*/*;q=0.5

363−Accept-Language: en-us,en;q=0.5

364−Accept-Encoding: gzip, deflate

365−Connection: keep-alive

366−Referer: http://www.reddit.com/

367−

368−GET /ados.js?q=43 HTTP/1.1

369−Host: secure.adzerk.net

370−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

371−Accept: */*

372−Accept-Language: en-us,en;q=0.5

373−Accept-Encoding: gzip, deflate

374−Connection: keep-alive

375−Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2

376−

377−GET /fetch-trackers?callback=jQuery111005268222517967478_1400862512407&ids%5B%5D=t3_25jzeq-t8_k2ii&_=1400862512408 HTTP/1.1

378−Host: tracker.redditmedia.com

379−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

380−Accept: */*

381−Accept-Language: en-us,en;q=0.5

382−Accept-Encoding: gzip, deflate

383−Connection: keep-alive

384−Referer: http://www.reddit.com/

385−

386−GET /ados?t=1400862512892&request={%22Placements%22:[{%22A%22:5146,%22S%22:24950,%22D%22:%22main%22,%22AT%22:5},{%22A%22:5146,%22S%22:24950,%22D%22:%22sponsorship%22,%22AT%22:8}],%22Keywords%22:%22-reddit.com%22,%22Referrer%22:%22http%3A%2F%2Fwww.reddit.com%2F%22,%22IsAsync%22:true,%22WriteResults%22:true} HTTP/1.1

387−Host: engine.adzerk.net

388−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

389−Accept: */*

390−Accept-Language: en-us,en;q=0.5

391−Accept-Encoding: gzip, deflate

392−Connection: keep-alive

393−Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2

394−

395−GET /pixel/of_doom.png?id=t3_25jzeq-t8_k2ii&hash=da31d967485cdbd459ce1e9a5dde279fef7fc381&r=1738649500 HTTP/1.1

396−Host: pixel.redditmedia.com

397−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

398−Accept: image/png,image/*;q=0.8,*/*;q=0.5

399−Accept-Language: en-us,en;q=0.5

400−Accept-Encoding: gzip, deflate

401−Connection: keep-alive

402−Referer: http://www.reddit.com/

403−

404−GET /Extensions/adFeedback.js HTTP/1.1

405−Host: static.adzrk.net

406−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

407−Accept: */*

408−Accept-Language: en-us,en;q=0.5

409−Accept-Encoding: gzip, deflate

410−Connection: keep-alive

411−Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2

412−

413−GET /Extensions/adFeedback.css HTTP/1.1

414−Host: static.adzrk.net

415−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

416−Accept: text/css,*/*;q=0.1

417−Accept-Language: en-us,en;q=0.5

418−Accept-Encoding: gzip, deflate

419−Connection: keep-alive

420−Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2

421−

422−GET /reddit/ads-load.html?bust2 HTTP/1.1

423−Host: static.adzerk.net

424−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

425−Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8

426−Accept-Language: en-us,en;q=0.5

427−Accept-Encoding: gzip, deflate

428−Connection: keep-alive

429−Referer: http://www.reddit.com/

430−

431−GET /Advertisers/a774d7d6148046efa89403a8db635a81.jpg HTTP/1.1

432−Host: static.adzerk.net

433−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

434−Accept: image/png,image/*;q=0.8,*/*;q=0.5

435−Accept-Language: en-us,en;q=0.5

436−Accept-Encoding: gzip, deflate

437−Connection: keep-alive

438−Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2

439−

440−GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo1LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxNSwiZGkiOiI4NmI2Y2UzYWM5NDM0MjhkOTk2ZTg4MjYwZDE5ZTE1YyIsImRtIjoxLCJmYyI6NDE2MTI4LCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ1fQ&s=lwlbFf2Uywt7zVBFRj_qXXu7msY HTTP/1.1

441−Host: engine.adzerk.net

442−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

443−Accept: image/png,image/*;q=0.8,*/*;q=0.5

444−Accept-Language: en-us,en;q=0.5

445−Accept-Encoding: gzip, deflate

446−Connection: keep-alive

447−Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2

448−Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966

449−

450−GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9994987&PluID=0&ord=1400862593644&rtu=-1 HTTP/1.1

451−Host: bs.serving-sys.com

452−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

453−Accept: image/png,image/*;q=0.8,*/*;q=0.5

454−Accept-Language: en-us,en;q=0.5

455−Accept-Encoding: gzip, deflate

456−Connection: keep-alive

457−Referer: http://static.adzerk.net/reddit/ads.html?sr=-reddit.com&bust2

458−

459−GET /Advertisers/63cfd0044ffd49c0a71a6626f7a1d8f0.jpg HTTP/1.1

460−Host: static.adzerk.net

461−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

462−Accept: image/png,image/*;q=0.8,*/*;q=0.5

463−Accept-Language: en-us,en;q=0.5

464−Accept-Encoding: gzip, deflate

465−Connection: keep-alive

466−Referer: http://static.adzerk.net/reddit/ads-load.html?bust2

467−

468−GET /BurstingPipe/adServer.bs?cn=tf&c=19&mc=imp&pli=9962555&PluID=0&ord=1400862593645&rtu=-1 HTTP/1.1

469−Host: bs.serving-sys.com

470−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

471−Accept: image/png,image/*;q=0.8,*/*;q=0.5

472−Accept-Language: en-us,en;q=0.5

473−Accept-Encoding: gzip, deflate

474−Connection: keep-alive

475−Referer: http://static.adzerk.net/reddit/ads-load.html?bust2

476−Cookie: S_9994987=6754579095859875029; A4=01fmFvgRnI09SF00000; u2=d1263d39-874b-4a89-86cd-a2ab0860ed4e3Zl040

477−

478−GET /i.gif?e=eyJhdiI6NjIzNTcsImF0Ijo4LCJjbSI6MTE2MzUxLCJjaCI6Nzk4NCwiY3IiOjMzNzAxOCwiZGkiOiI3OTdlZjU3OWQ5NjE0ODdiODYyMGMyMGJkOTE4YzNiMSIsImRtIjoxLCJmYyI6NDE2MTMxLCJmbCI6MjEwNDY0LCJrdyI6Ii1yZWRkaXQuY29tIiwibWsiOiItcmVkZGl0LmNvbSIsIm53Ijo1MTQ2LCJwYyI6MCwicHIiOjIwMzYyLCJydCI6MSwicmYiOiJodHRwOi8vd3d3LnJlZGRpdC5jb20vIiwic3QiOjI0OTUwLCJ1ayI6InVlMS01ZWIwOGFlZWQ5YTc0MDFjOTE5NWNiOTMzZWI3Yzk2NiIsInRzIjoxNDAwODYyNTkzNjQ2fQ&s=OjzxzXAgQksbdQOHNm-bjZcnZPA HTTP/1.1

479−Host: engine.adzerk.net

480−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:15.0) Gecko/20100101 Firefox/15.0.1

481−Accept: image/png,image/*;q=0.8,*/*;q=0.5

482−Accept-Language: en-us,en;q=0.5

483−Accept-Encoding: gzip, deflate

484−Connection: keep-alive

485−Referer: http://static.adzerk.net/reddit/ads-load.html?bust2

486−Cookie: azk=ue1-5eb08aeed9a7401c9195cb933eb7c966

487−

488−GET /subscribe?host_int=1042356184&ns_map=571794054_374233948806,464381511_13349283399&user_id=245722467&nid=1399334269710011966&ts=1400862514 HTTP/1.1

489−Host: notify8.dropbox.com

490−Accept-Encoding: identity

491−Connection: keep-alive

492−X-Dropbox-Locale: en_US

493−User-Agent: DropboxDesktopClient/2.7.54 (Macintosh; 10.8; ('i32',); en_US)

494−

examples/rfc2616.c+21−27

@@ -1,22 +1,21 @@

11/*

2− * This is a simple driver for the http-parser package. It is

3− * intended to read one HTTP request after another from a file,

4− * nothing more.

2+ * This is a simple driver for Ryan Dahl's hand-bummed C http-parser

3+ * package. It is intended to read one HTTP request after another

4+ * from a file, nothing more.

55 *

66 * For "feature parity" with the Haskell code in RFC2616.hs, we

77 * allocate and populate a simple structure describing each request,

88 * since that's the sort of thing that many real applications would

99 * themselves do and the library doesn't do this for us.

1010 *

11− * For the http-parser source, see

12− * https://github.com/joyent/http-parser/blob/master/http_parser.c

11+ * For the http-parser source, see http://github.com/ry/http-parser/

1312 */

1413

1514/*

1615 * Turn off this preprocessor symbol to have the callbacks do nothing

1716 * at all, which "improves performance" by about 50%.

1817 */

19−/*#define LOOK_BUSY*/

18+#define LOOK_BUSY

2019

2120#include <assert.h>

2221#include <fcntl.h>

@@ -28,18 +27,18 @@

2827#include <unistd.h>

2928

3029#include "http_parser.h"

31−

30+

3231struct http_string {

3332 size_t len;

3433 char value[0];

3534};

36−

35+

3736struct http_header {

3837 struct http_string *name;

3938 struct http_string *value;

4039 struct http_header *next;

4140};

42−

41+

4342struct http_request {

4443 struct http_string *method;

4544 struct http_string *uri;

@@ -50,7 +49,7 @@ struct data {

5049 size_t count;

5150 struct http_request req;

5251};

53−

52+

5453static void *xmalloc(size_t size)

5554{

5655 void *ptr;

@@ -79,7 +78,7 @@ static void xstrcat(struct http_string **dst, const char *src, size_t len)

7978 *dst = xstrdup(src, len, 0);

8079 return;

8180 }

82−

81+

8382 p = xstrdup((*dst)->value, (*dst)->len, len);

8483 memcpy(p->value + (*dst)->len, src, len);

8584 p->len += len;

@@ -99,7 +98,7 @@ static int begin(http_parser *p)

9998static int url(http_parser *p, const char *at, size_t len)

10099{

101100#ifdef LOOK_BUSY

102− struct data *data = p->data;

101+ struct data *data = p->data;

103102

104103 xstrcat(&data->req.uri, at, len);

105104#endif

@@ -120,7 +119,7 @@ static int header_field(http_parser *p, const char *at, size_t len)

120119 hdr->name = xstrdup(at, len, 0);

121120 hdr->value = NULL;

122121 hdr->next = NULL;

123−

122+

124123 if (data->req.last != NULL)

125124 data->req.last->next = hdr;

126125 data->req.last = hdr;

@@ -151,7 +150,7 @@ static int complete(http_parser *p)

151150

152151 free(data->req.method);

153152 free(data->req.uri);

154−

153+

155154 for (hdr = data->req.headers; hdr != NULL; hdr = next) {

156155 next = hdr->next;

157156 free(hdr->name);

@@ -165,7 +164,7 @@ static int complete(http_parser *p)

165164 data->req.headers = NULL;

166165 data->req.last = NULL;

167166#endif

168−

167+

169168 /* Bludgeon http_parser into understanding that we really want to

170169 * keep parsing after a request that in principle ought to close

171170 * the "connection". */

@@ -181,21 +180,16 @@ static int complete(http_parser *p)

181180static void parse(const char *path, int fd)

182181{

183182 struct data data;

184− http_parser_settings s;

185183 http_parser p;

186184 ssize_t nread;

187185

188− memset(&s, 0, sizeof(s));

189− s.on_message_begin = begin;

190− s.on_url = url;

191− s.on_header_field = header_field;

192− s.on_header_value = header_value;

193− s.on_message_complete = complete;

194−

195− p.data = &data;

196−

197186 http_parser_init(&p, HTTP_REQUEST);

198−

187+ p.on_message_begin = begin;

188+ p.on_url = url;

189+ p.on_header_field = header_field;

190+ p.on_header_value = header_value;

191+ p.on_message_complete = complete;

192+ p.data = &data;

199193 data.count = 0;

200194 data.req.method = NULL;

201195 data.req.uri = NULL;

@@ -208,7 +202,7 @@ static void parse(const char *path, int fd)

208202

209203 nread = read(fd, buf, sizeof(buf));

210204

211− np = http_parser_execute(&p, &s, buf, nread);

205+ np = http_parser_execute(&p, buf, nread);

212206 if (np != nread) {

213207 fprintf(stderr, "%s: parse failed\n", path);

214208 break;

tests/Makefilenew file+14

@@ -0,0 +1,14 @@

1+all: TestFastSet.out qc.out

3+%.out: %.exe

4+ ./$< | tee $<.tmp

5+ mv $<.tmp $@

7+qc.exe: QC.hs

8+ ghc -O -fno-warn-orphans --make -o $@ $<

10+%.exe: %.hs

11+ ghc -O -fno-warn-orphans --make -o $@ $<

12+

13+clean:

14+ -rm -f *.hi *.o *.exe *.out

tests/QC.hs+2−6

@@ -1,19 +1,15 @@

11{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

22module Main (main) where

4−import qualified QC.Buffer as Buffer

54import qualified QC.ByteString as ByteString

65import qualified QC.Combinator as Combinator

7−import qualified QC.Simple as Simple

86import qualified QC.Text as Text

9−import Test.Tasty (defaultMain, testGroup)

7+import Test.Framework (defaultMain, testGroup)

108

119main = defaultMain tests

1210

13−tests = testGroup "tests" [

11+tests = [

1412 testGroup "bs" ByteString.tests

15− , testGroup "buf" Buffer.tests

1613 , testGroup "combinator" Combinator.tests

17− , testGroup "simple" Simple.tests

1814 , testGroup "text" Text.tests

1915 ]

tests/QC/Buffer.hsdeleted−96

@@ -1,96 +0,0 @@

1−{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,

2− TypeSynonymInstances #-}

3−

4−module QC.Buffer (tests) where

5−

6−#if !MIN_VERSION_base(4,8,0)

7−import Control.Applicative ((<$>))

8−import Data.Monoid (Monoid(mconcat))

9−#endif

10−import QC.Common ()

11−import Test.Tasty (TestTree)

12−import Test.Tasty.QuickCheck (testProperty)

13−import Test.QuickCheck

14−import qualified Data.Attoparsec.ByteString.Buffer as BB

15−import qualified Data.Attoparsec.Text.Buffer as BT

16−import qualified Data.ByteString as B

17−import qualified Data.ByteString.Unsafe as B

18−import qualified Data.Text as T

19−import qualified Data.Text.Unsafe as T

20−

21−data BP t b = BP [t] !t !b

22− deriving (Eq, Show)

23−

24−type BPB = BP B.ByteString BB.Buffer

25−type BPT = BP T.Text BT.Buffer

26−

27−instance Arbitrary BPB where

28− arbitrary = do

29− bss <- arbitrary

30− return $! toBP BB.buffer bss

31−

32− shrink (BP bss _ _) = toBP BB.buffer <$> shrink bss

33−

34−instance Arbitrary BPT where

35− arbitrary = do

36− bss <- arbitrary

37− return $! toBP BT.buffer bss

38−

39− shrink (BP bss _ _) = toBP BT.buffer <$> shrink bss

40−

41−toBP :: (Monoid a, Monoid b) => (a -> b) -> [a] -> BP a b

42−toBP buf bss = BP bss (mconcat bss) (mconcat (map buf bss))

43−

44−b_unbuffer :: BPB -> Property

45−b_unbuffer (BP _ts t buf) = t === BB.unbuffer buf

46−

47−t_unbuffer :: BPT -> Property

48−t_unbuffer (BP _ts t buf) = t === BT.unbuffer buf

49−

50−b_length :: BPB -> Property

51−b_length (BP _ts t buf) = B.length t === BB.length buf

52−

53−t_length :: BPT -> Property

54−t_length (BP _ts t buf) = T.lengthWord16 t === BT.length buf

55−

56−b_unsafeIndex :: BPB -> Gen Property

57−b_unsafeIndex (BP _ts t buf) = do

58− let l = B.length t

59− i <- choose (0,l-1)

60− return $ l === 0 .||. B.unsafeIndex t i === BB.unsafeIndex buf i

61−

62−t_iter :: BPT -> Gen Property

63−t_iter (BP _ts t buf) = do

64− let l = T.lengthWord16 t

65− i <- choose (0,l-1)

66− let it (T.Iter c q) = (c,q)

67− return $ l === 0 .||. it (T.iter t i) === it (BT.iter buf i)

68−

69−t_iter_ :: BPT -> Gen Property

70−t_iter_ (BP _ts t buf) = do

71− let l = T.lengthWord16 t

72− i <- choose (0,l-1)

73− return $ l === 0 .||. T.iter_ t i === BT.iter_ buf i

74−

75−b_unsafeDrop :: BPB -> Gen Property

76−b_unsafeDrop (BP _ts t buf) = do

77− i <- choose (0, B.length t)

78− return $ B.unsafeDrop i t === BB.unsafeDrop i buf

79−

80−t_dropWord16 :: BPT -> Gen Property

81−t_dropWord16 (BP _ts t buf) = do

82− i <- choose (0, T.lengthWord16 t)

83− return $ T.dropWord16 i t === BT.dropWord16 i buf

84−

85−tests :: [TestTree]

86−tests = [

87− testProperty "b_unbuffer" b_unbuffer

88− , testProperty "t_unbuffer" t_unbuffer

89− , testProperty "b_length" b_length

90− , testProperty "t_length" t_length

91− , testProperty "b_unsafeIndex" b_unsafeIndex

92− , testProperty "t_iter" t_iter

93− , testProperty "t_iter_" t_iter_

94− , testProperty "b_unsafeDrop" b_unsafeDrop

95− , testProperty "t_dropWord16" t_dropWord16

96− ]

tests/QC/ByteString.hs+9−39

@@ -1,23 +1,19 @@

1−{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}

1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}

22module QC.ByteString (tests) where

4−#if !MIN_VERSION_base(4,8,0)

5−import Control.Applicative ((<*>), (<$>))

6−#endif

7−import Data.Char (chr, ord, toUpper)

4+import Control.Applicative ((<$>), (<*>))

5+import Data.Char (chr, ord)

86import Data.Int (Int64)

97import Data.Word (Word8)

108import Prelude hiding (take, takeWhile)

11−import QC.Common (ASCII(..), liftOp, parseBS, toStrictBS)

12−import Test.Tasty (TestTree)

13−import Test.Tasty.QuickCheck (testProperty)

9+import QC.Common (liftOp, parseBS, toStrictBS)

10+import Test.Framework (Test)

11+import Test.Framework.Providers.QuickCheck2 (testProperty)

1412import Test.QuickCheck

1513import qualified Data.Attoparsec.ByteString as P

1614import qualified Data.Attoparsec.ByteString.Char8 as P8

17−import qualified Data.Attoparsec.ByteString.FastSet as S

1815import qualified Data.Attoparsec.ByteString.Lazy as PL

1916import qualified Data.ByteString as B

20−import qualified Data.ByteString.Char8 as B8

2117import qualified Data.ByteString.Lazy as L

2218import qualified Data.ByteString.Lazy.Char8 as L8

2319

@@ -26,11 +22,9 @@ import qualified Data.ByteString.Lazy.Char8 as L8

2622satisfy :: Word8 -> L.ByteString -> Property

2723satisfy w s = parseBS (P.satisfy (<=w)) (L.cons w s) === Just w

2824

29−satisfyWith :: Word8 -> L.ByteString -> Property

30−satisfyWith w s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))

25+satisfyWith :: Char -> L.ByteString -> Property

26+satisfyWith c s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))

3127 (L.cons (fromIntegral (ord c)) s) === Just c

32− where

33− c = chr (fromIntegral w)

3428

3529word8 :: Word8 -> L.ByteString -> Property

3630word8 w s = parseBS (P.word8 w) (L.cons w s) === Just w

@@ -68,18 +62,6 @@ string :: L.ByteString -> L.ByteString -> Property

6862string s t = parseBS (P.string s') (s `L.append` t) === Just s'

6963 where s' = toStrictBS s

7064

71−stringCI :: ASCII L.ByteString -> ASCII L.ByteString -> Property

72−stringCI (ASCII s) (ASCII t) =

73− parseBS (P8.stringCI up) (s `L.append` t) === Just s'

74− where s' = toStrictBS s

75− up = B8.map toUpper s'

76−

77−strings :: L.ByteString -> L.ByteString -> L.ByteString -> Property

78−strings s t u =

79− parseBS (P.string (toStrictBS s) >> P.string t') (L.concat [s,t,u])

80− === Just t'

81− where t' = toStrictBS t

82−

8365skipWhile :: Word8 -> L.ByteString -> Property

8466skipWhile w s =

8567 let t = L.dropWhile (<=w) s

@@ -149,15 +131,7 @@ scan s (Positive k) = parseBS p s === Just (toStrictBS $ L.take k s)

149131 where p = P.scan k $ \ n _ ->

150132 if n > 0 then let !n' = n - 1 in Just n' else Nothing

151133

152−members :: [Word8] -> Property

153−members s = property $ all (`S.memberWord8` set) s

154− where set = S.fromList s

155−

156−nonmembers :: [Word8] -> [Word8] -> Property

157−nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s'

158− where set = S.fromList s

159−

160−tests :: [TestTree]

134+tests :: [Test]

161135tests = [

162136 testProperty "anyWord8" anyWord8

163137 , testProperty "endOfInput" endOfInput

@@ -171,8 +145,6 @@ tests = [

171145 , testProperty "skip" skip

172146 , testProperty "skipWhile" skipWhile

173147 , testProperty "string" string

174− , testProperty "stringCI" stringCI

175− , testProperty "strings" strings

176148 , testProperty "take" take

177149 , testProperty "takeByteString" takeByteString

178150 , testProperty "takeCount" takeCount

@@ -182,6 +154,4 @@ tests = [

182154 , testProperty "takeWhile1" takeWhile1

183155 , testProperty "takeWhile1_empty" takeWhile1_empty

184156 , testProperty "word8" word8

185− , testProperty "members" members

186− , testProperty "nonmembers" nonmembers

187157 ]

tests/QC/Combinator.hs+5−18

@@ -1,15 +1,10 @@

1−{-# LANGUAGE CPP, OverloadedStrings #-}

2−

31module QC.Combinator where

5−#if !MIN_VERSION_base(4,8,0)

6−import Control.Applicative ((<*>), (<$>), (<*), (*>))

7−#endif

8−import Data.Maybe (fromJust, isJust)

3+import Control.Applicative

94import Data.Word (Word8)

10−import QC.Common (Repack, parseBS, repackBS, toLazyBS)

11−import Test.Tasty (TestTree)

12−import Test.Tasty.QuickCheck (testProperty)

5+import QC.Common (Repack, parseBS, repackBS)

6+import Test.Framework (Test)

7+import Test.Framework.Providers.QuickCheck2 (testProperty)

138import Test.QuickCheck

149import qualified Data.Attoparsec.ByteString.Char8 as P

1510import qualified Data.Attoparsec.Combinator as C

@@ -27,13 +22,6 @@ count (Positive (Small n)) rs s =

2722 (length <$> parseBS (C.count n (P.string s)) input) == Just n

2823 where input = repackBS rs (B.concat (replicate (n+1) s))

2924

30−lookAhead :: NonEmptyList Word8 -> Bool

31−lookAhead (NonEmpty xs) =

32− let ys = B.pack xs

33− withLookAheadThenConsume = (\x y -> (x, y)) <$> C.lookAhead (P.string ys) <*> P.string ys

34− mr = parseBS withLookAheadThenConsume $ toLazyBS ys

35− in isJust mr && fst (fromJust mr) == snd (fromJust mr)

36−

3725match :: Int -> NonNegative Int -> NonNegative Int -> Repack -> Bool

3826match n (NonNegative x) (NonNegative y) rs =

3927 parseBS (P.match parser) (repackBS rs input) == Just (input, n)

@@ -43,10 +31,9 @@ match n (NonNegative x) (NonNegative y) rs =

4331 B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'

4432 ]

4533

46−tests :: [TestTree]

34+tests :: [Test]

4735tests = [

4836 testProperty "choice" choice

4937 , testProperty "count" count

50− , testProperty "lookAhead" lookAhead

5138 , testProperty "match" match

5239 ]

tests/QC/Common.hs+4−34

@@ -1,9 +1,7 @@

1−{-# LANGUAGE CPP, FlexibleInstances #-}

21{-# OPTIONS_GHC -fno-warn-orphans #-}

32module QC.Common

43 (

5− ASCII(..)

6− , parseBS

4+ parseBS

75 , parseT

86 , toLazyBS

97 , toStrictBS

@@ -15,12 +13,9 @@ module QC.Common

1513 , liftOp

1614 ) where

1715

18−#if !MIN_VERSION_base(4,8,0)

19−import Control.Applicative ((<*>), (<$>))

20−#endif

16+import Control.Applicative ((<$>), (<*>))

2117import Data.Char (isAlpha)

2218import Test.QuickCheck

23−import Test.QuickCheck.Unicode (shrinkChar, string)

2419import qualified Data.ByteString as B

2520import qualified Data.ByteString.Lazy as BL

2621import qualified Data.Text as T

@@ -28,16 +23,6 @@ import qualified Data.Text.Lazy as TL

2823import qualified Data.Attoparsec.ByteString.Lazy as BL

2924import qualified Data.Attoparsec.Text.Lazy as TL

3025

31−#if !MIN_VERSION_base(4,4,0)

32−-- This should really be a dependency on the random package :-(

33−instance Random Word8 where

34− randomR = integralRandomR

35− random = randomR (minBound,maxBound)

36−

37−instance Arbitrary Word8 where

38− arbitrary = choose (minBound, maxBound)

39−#endif

40−

4126parseBS :: BL.Parser r -> BL.ByteString -> Maybe r

4227parseBS p = BL.maybeResult . BL.parse p

4328

@@ -52,22 +37,9 @@ toLazyBS = BL.fromChunks . (:[])

5237

5338instance Arbitrary B.ByteString where

5439 arbitrary = B.pack <$> arbitrary

55− shrink = map B.pack . shrink . B.unpack

5640

5741instance Arbitrary BL.ByteString where

5842 arbitrary = repackBS <$> arbitrary <*> arbitrary

59− shrink = map BL.pack . shrink . BL.unpack

60−

61−newtype ASCII a = ASCII { fromASCII :: a }

62− deriving (Eq, Ord, Show)

63−

64−instance Arbitrary (ASCII B.ByteString) where

65− arbitrary = (ASCII . B.pack) <$> listOf (choose (0,127))

66− shrink = map (ASCII . B.pack) . shrink . B.unpack . fromASCII

67−

68−instance Arbitrary (ASCII BL.ByteString) where

69− arbitrary = ASCII <$> (repackBS <$> arbitrary <*> (fromASCII <$> arbitrary))

70− shrink = map (ASCII . BL.pack) . shrink . BL.unpack . fromASCII

7143

7244type Repack = NonEmptyList (Positive (Small Int))

7345

@@ -84,12 +56,10 @@ repackBS_ = go . cycle

8456 go _ _ = error "unpossible"

8557

8658instance Arbitrary T.Text where

87− arbitrary = T.pack <$> string

88− shrink = map T.pack . shrinkList shrinkChar . T.unpack

59+ arbitrary = T.pack <$> arbitrary

8960

9061instance Arbitrary TL.Text where

91− arbitrary = TL.pack <$> string

92− shrink = map TL.pack . shrinkList shrinkChar . TL.unpack

62+ arbitrary = repackT <$> arbitrary <*> arbitrary

9363

9464repackT :: Repack -> T.Text -> TL.Text

9565repackT (NonEmpty bs) =

tests/QC/IPv6/Internal.hsdeleted−316

@@ -1,316 +0,0 @@

1−-- -----------------------------------------------------------------------------

2−

3−-- |

4−-- Module : Text.IPv6Addr

6−-- License : BSD-Style

7−-- Maintainer : michel.boucey@gmail.com

8−--

9−-- Dealing with IPv6 address text representations, canonization and manipulations.

10−--

11−

12−-- -----------------------------------------------------------------------------

13−

14−{-# LANGUAGE OverloadedStrings #-}

15−

16−module QC.IPv6.Internal where {-

17− ( expandTokens

18− , macAddr

19− , maybeIPv6AddrTokens

20− , ipv4AddrToIPv6AddrTokens

21− , ipv6TokensToText

22− , ipv6TokensToIPv6Addr

23− , isIPv6Addr

24− , maybeTokIPv6Addr

25− , maybeTokPureIPv6Addr

26− , fromDoubleColon

27− , fromIPv6Addr

28− , toDoubleColon

29− ) where -}

30−

31−import Debug.Trace

32−import Control.Monad (replicateM)

33−import Data.Attoparsec.Text

34−import Data.Char (isDigit,isHexDigit,toLower)

35−import Data.Monoid ((<>))

36−import Control.Applicative ((<|>),(<*))

37−import Data.List (group,isSuffixOf,elemIndex,elemIndices,intersperse)

38−import Data.Word (Word32)

39−import Numeric (showHex)

40−import qualified Data.Text as T

41−import qualified Data.Text.Read as R (decimal)

42−import Data.Maybe (fromJust)

43−

44−import QC.IPv6.Types

45−

46−tok0 = "0"

47−

48−-- | Returns the 'T.Text' of an IPv6 address.

49−fromIPv6Addr :: IPv6Addr -> T.Text

50−fromIPv6Addr (IPv6Addr t) = t

51−

52−-- | Given an arbitrary list of 'IPv6AddrToken', returns the corresponding 'T.Text'.

53−ipv6TokensToText :: [IPv6AddrToken] -> T.Text

54−ipv6TokensToText l = T.concat $ map ipv6TokenToText l

55−

56−-- | Returns the corresponding 'T.Text' of an IPv6 address token.

57−ipv6TokenToText :: IPv6AddrToken -> T.Text

58−ipv6TokenToText (SixteenBit s) = s

59−ipv6TokenToText Colon = ":"

60−ipv6TokenToText DoubleColon = "::"

61−ipv6TokenToText AllZeros = tok0 -- "A single 16-bit 0000 field MUST be represented as 0" (RFC 5952, 4.1)

62−ipv6TokenToText (IPv4Addr a) = a

63−

64−-- | Returns 'True' if a list of 'IPv6AddrToken' constitutes a valid IPv6 Address.

65−isIPv6Addr :: [IPv6AddrToken] -> Bool

66−isIPv6Addr [] = False

67−isIPv6Addr [DoubleColon] = True

68−isIPv6Addr [DoubleColon,SixteenBit tok1] = True

69−isIPv6Addr tks =

70− diffNext tks && (do

71− let cdctks = countDoubleColon tks

72− let lentks = length tks

73− let lasttk = last tks

74− let lenconst = (lentks == 15 && cdctks == 0) || (lentks < 15 && cdctks == 1)

75− firstValidToken tks &&

76− (case countIPv4Addr tks of

77− 0 -> case lasttk of

78− SixteenBit _ -> lenconst

79− DoubleColon -> lenconst

80− AllZeros -> lenconst

81− _ -> False

82− 1 -> case lasttk of

83− IPv4Addr _ -> (lentks == 13 && cdctks == 0) || (lentks < 12 && cdctks == 1)

84− _ -> False

85− otherwise -> False))

86− where diffNext [] = False

87− diffNext [_] = True

88− diffNext (t:ts) = do

89− let h = head ts

90− case t of

91− SixteenBit _ -> case h of

92− SixteenBit _ -> False

93− AllZeros -> False

94− _ -> diffNext ts

95− AllZeros -> case h of

96− SixteenBit _ -> False

97− AllZeros -> False

98− _ -> diffNext ts

99− _ -> diffNext ts

100− firstValidToken l =

101− case head l of

102− SixteenBit _ -> True

103− DoubleColon -> True

104− AllZeros -> True

105− _ -> False

106− countDoubleColon l = length $ elemIndices DoubleColon l

107− tok1 = "1"

108−

109−countIPv4Addr = foldr oneMoreIPv4Addr 0

110− where

111− oneMoreIPv4Addr t c = case t of

112− IPv4Addr _ -> c + 1

113− otherwise -> c

114−

115−-- | This is the main function which returns 'Just' the list of a tokenized IPv6

116−-- address text representation validated against RFC 4291 and canonized

117−-- in conformation with RFC 5952, or 'Nothing'.

118−maybeTokIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]

119−maybeTokIPv6Addr t =

120− case maybeIPv6AddrTokens t of

121− Just ltks -> if isIPv6Addr ltks

122− then Just $ (ipv4AddrReplacement . toDoubleColon . fromDoubleColon) ltks

123− else Nothing

124− Nothing -> Nothing

125− where

126− ipv4AddrReplacement ltks =

127− if ipv4AddrRewrite ltks

128− then init ltks ++ ipv4AddrToIPv6AddrTokens (last ltks)

129− else ltks

130−

131−-- | Returns 'Just' the list of tokenized pure IPv6 address, always rewriting an

132−-- embedded IPv4 address if present.

133−maybeTokPureIPv6Addr :: T.Text -> Maybe [IPv6AddrToken]

134−maybeTokPureIPv6Addr t = do

135− ltks <- maybeIPv6AddrTokens t

136− if isIPv6Addr ltks

137− then Just $ (toDoubleColon . ipv4AddrReplacement . fromDoubleColon) ltks

138− else Nothing

139− where

140− ipv4AddrReplacement ltks' = init ltks' ++ ipv4AddrToIPv6AddrTokens (last ltks')

141−

142−-- | Tokenize a 'T.Text' into 'Just' a list of 'IPv6AddrToken', or 'Nothing'.

143−maybeIPv6AddrTokens :: T.Text -> Maybe [IPv6AddrToken]

144−maybeIPv6AddrTokens s =

145− case readText s of

146− Done r l -> traceShow (r,l) $ if r==T.empty then Just l else Nothing

147− Fail {} -> Nothing

148− where

149− readText s = feed (parse (many1 $ ipv4Addr <|> sixteenBit <|> doubleColon <|> colon) s) T.empty

150−

151−-- | An embedded IPv4 address have to be rewritten to output a pure IPv6 Address

152−-- text representation in hexadecimal digits. But some well-known prefixed IPv6

153−-- addresses have to keep visible in their text representation the fact that

154−-- they deals with IPv4 to IPv6 transition process (RFC 5952 Section 5):

155−--

156−-- IPv4-compatible IPv6 address like "::1.2.3.4"

157−--

158−-- IPv4-mapped IPv6 address like "::ffff:1.2.3.4"

159−--

160−-- IPv4-translated address like "::ffff:0:1.2.3.4"

161−--

162−-- IPv4-translatable address like "64:ff9b::1.2.3.4"

163−--

164−-- ISATAP address like "fe80::5efe:1.2.3.4"

165−--

166−ipv4AddrRewrite :: [IPv6AddrToken] -> Bool

167−ipv4AddrRewrite tks =

168− case last tks of

169− IPv4Addr _ -> do

170− let itks = init tks

171− not (itks == [DoubleColon]

172− || itks == [DoubleColon,SixteenBit tokffff,Colon]

173− || itks == [DoubleColon,SixteenBit tokffff,Colon,AllZeros,Colon]

174− || itks == [SixteenBit "64",Colon,SixteenBit "ff9b",DoubleColon]

175− || [SixteenBit "200",Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks

176− || [AllZeros,Colon,SixteenBit tok5efe,Colon] `isSuffixOf` itks

177− || [DoubleColon,SixteenBit tok5efe,Colon] `isSuffixOf` itks)

178− _ -> False

179− where

180− tokffff = "ffff"

181− tok5efe = "5efe"

182−

183−-- | Rewrites an embedded 'IPv4Addr' into the corresponding list of pure 'IPv6Addr' tokens.

184−--

185−-- > ipv4AddrToIPv6AddrTokens (IPv4Addr "127.0.0.1") == [SixteenBits "7f0",Colon,SixteenBits "1"]

186−--

187−ipv4AddrToIPv6AddrTokens :: IPv6AddrToken -> [IPv6AddrToken]

188−ipv4AddrToIPv6AddrTokens t =

189− case t of

190− IPv4Addr a -> do

191− let m = toHex a

192− [ SixteenBit ((!!) m 0 <> addZero ((!!) m 1))

193− , Colon

194− , SixteenBit ((!!) m 2 <> addZero ((!!) m 3)) ]

195− _ -> [t]

196− where

197− toHex a = map (\x -> T.pack $ showHex (read (T.unpack x)::Int) "") $ T.split (=='.') a

198− addZero d = if T.length d == 1 then tok0 <> d else d

199−

200−expandTokens :: [IPv6AddrToken] -> [IPv6AddrToken]

201−expandTokens = map expandToken

202− where expandToken (SixteenBit s) = SixteenBit $ T.justifyRight 4 '0' s

203− expandToken AllZeros = SixteenBit "0000"

204− expandToken t = t

205−

206−fromDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]

207−fromDoubleColon tks =

208− if DoubleColon `notElem` tks

209− then tks

210− else do let s = splitAt (fromJust $ elemIndex DoubleColon tks) tks

211− let fsts = fst s

212− let snds = if not (null (snd s)) then tail(snd s) else []

213− let fste = if null fsts then [] else fsts ++ [Colon]

214− let snde = if null snds then [] else Colon : snds

215− fste ++ allZerosTokensReplacement(quantityOfAllZerosTokenToReplace tks) ++ snde

216− where

217− allZerosTokensReplacement x = intersperse Colon (replicate x AllZeros)

218− quantityOfAllZerosTokenToReplace x =

219− ntks tks - foldl (\c x -> if (x /= DoubleColon) && (x /= Colon) then c+1 else c) 0 x

220− where

221− ntks tks = if countIPv4Addr tks == 1 then 7 else 8

222−

223−toDoubleColon :: [IPv6AddrToken] -> [IPv6AddrToken]

224−toDoubleColon tks =

225− zerosToDoubleColon tks (zerosRunToReplace $ zerosRunsList tks)

226− where

227− zerosToDoubleColon :: [IPv6AddrToken] -> (Int,Int) -> [IPv6AddrToken]

228− -- No all zeros token, so no double colon replacement...

229− zerosToDoubleColon ls (_,0) = ls

230− -- "The symbol '::' MUST NOT be used to shorten just one 16-bit 0 field" (RFC 5952 4.2.2)

231− zerosToDoubleColon ls (_,1) = ls

232− zerosToDoubleColon ls (i,l) =

233− let ls' = filter (/= Colon) ls

234− in intersperse Colon (Prelude.take i ls') ++ [DoubleColon] ++ intersperse Colon (drop (i+l) ls')

235− zerosRunToReplace t =

236− let l = longestLengthZerosRun t

237− in (firstLongestZerosRunIndex t l,l)

238− where

239− firstLongestZerosRunIndex x y = sum . snd . unzip $ Prelude.takeWhile (/=(True,y)) x

240− longestLengthZerosRun x =

241− maximum $ map longest x

242− where longest t = case t of

243− (True,i) -> i

244− _ -> 0

245− zerosRunsList x = map helper $ groupZerosRuns x

246− where

247− helper h = (head h == AllZeros, lh) where lh = length h

248− groupZerosRuns = group . filter (/= Colon)

249−

250−ipv6TokensToIPv6Addr :: [IPv6AddrToken] -> Maybe IPv6Addr

251−ipv6TokensToIPv6Addr l = Just $ IPv6Addr $ ipv6TokensToText l

252−

253−fullSixteenBit :: T.Text -> Maybe IPv6AddrToken

254−fullSixteenBit t =

255− case parse ipv6AddrFullChunk t of

256− Done a b -> if a==T.empty then Just $ SixteenBit $ T.pack b else Nothing

257− _ -> Nothing

258−

259−macAddr :: Parser (Maybe [IPv6AddrToken])

260−macAddr = do

261− n1 <- count 2 hexaChar <* ":"

262− n2 <- count 2 hexaChar <* ":"

263− n3 <- count 2 hexaChar <* ":"

264− n4 <- count 2 hexaChar <* ":"

265− n5 <- count 2 hexaChar <* ":"

266− n6 <- count 2 hexaChar

267− return $ maybeIPv6AddrTokens $ T.pack $ concat [n1,n2,n3,n4,n5,n6]

268−

269−sixteenBit :: Parser IPv6AddrToken

270−sixteenBit = do

271− r <- ipv6AddrFullChunk <|> count 3 hexaChar <|> count 2 hexaChar <|> count 1 hexaChar

272− -- "Leading zeros MUST be suppressed" (RFC 5952, 4.1)

273− let r' = T.dropWhile (=='0') $ T.pack r

274− return $ if T.null r'

275− then AllZeros

276− -- Hexadecimal digits MUST be in lowercase (RFC 5952 4.3)

277− else SixteenBit $ T.toLower r'

278−

279−ipv4Addr :: Parser IPv6AddrToken

280−ipv4Addr = do

281− n1 <- manyDigits <* "."

282− if n1 /= T.empty

283− then do n2 <- manyDigits <* "."

284− if n2 /= T.empty

285− then do n3 <- manyDigits <* "."

286− if n3 /= T.empty

287− then do n4 <- manyDigits

288− if n4 /= T.empty

289− then return $ IPv4Addr $ T.intercalate "." [n1,n2,n3,n4]

290− else parserFailure

291− else parserFailure

292− else parserFailure

293− else parserFailure

294− where

295− parserFailure = fail "ipv4Addr parsing failure"

296− manyDigits = do

297− ds <- takeWhile1 isDigit

298− case R.decimal ds of

299− Right (n,_) -> return (if n < 256 then T.pack $ show n else T.empty)

300− Left _ -> return T.empty

301−

302−doubleColon :: Parser IPv6AddrToken

303−doubleColon = do

304− string "::"

305− return DoubleColon

306−

307−colon :: Parser IPv6AddrToken

308−colon = do

309− string ":"

310− return Colon

311−

312−ipv6AddrFullChunk :: Parser String

313−ipv6AddrFullChunk = count 4 hexaChar

314−

315−hexaChar :: Parser Char

316−hexaChar = satisfy (inClass "0-9a-fA-F")

tests/QC/IPv6/Types.hsdeleted−29

@@ -1,29 +0,0 @@

1−-- -----------------------------------------------------------------------------

2−

3−-- |

4−-- Module : Text.IPv6Addr

6−-- License : BSD-Style

7−-- Maintainer : michel.boucey@gmail.com

8−--

9−-- Dealing with IPv6 address text representations, canonization and manipulations.

10−--

11−

12−-- -----------------------------------------------------------------------------

13−

14−module QC.IPv6.Types where

15−

16−import qualified Data.Text as T

17−

18−data IPv6Addr = IPv6Addr T.Text

19−

20−instance Show IPv6Addr where

21− show (IPv6Addr addr) = T.unpack addr

22−

23−data IPv6AddrToken

24− = SixteenBit T.Text -- ^ A four hexadecimal digits group representing a 16-Bit chunk

25− | AllZeros -- ^ An all zeros 16-Bit chunk

26− | Colon -- ^ A separator between 16-Bit chunks

27− | DoubleColon -- ^ A double-colon stands for a unique compression of many consecutive 16-Bit chunks

28− | IPv4Addr T.Text -- ^ An embedded IPv4 address as representation of the last 32-Bit

29− deriving (Eq,Show)

tests/QC/Rechunked.hsdeleted−56

@@ -1,56 +0,0 @@

1−{-# LANGUAGE BangPatterns #-}

2−

3−module QC.Rechunked (

4− rechunkBS

5− , rechunkT

6− ) where

7−

8−import Control.Monad (forM, forM_)

9−import Control.Monad.ST (ST, runST)

10−import Data.List (unfoldr)

11−import Test.QuickCheck (Gen, choose)

12−import qualified Data.ByteString as B

13−import qualified Data.Text as T

14−import qualified Data.Vector as V

15−import qualified Data.Vector.Generic as G

16−import qualified Data.Vector.Generic.Mutable as M

17−

18−rechunkBS :: B.ByteString -> Gen [B.ByteString]

19−rechunkBS = fmap (map B.copy) . rechunk_ B.splitAt B.length

20−

21−rechunkT :: T.Text -> Gen [T.Text]

22−rechunkT = fmap (map T.copy) . rechunk_ T.splitAt T.length

23−

24−rechunk_ :: (Int -> a -> (a,a)) -> (a -> Int) -> a -> Gen [a]

25−rechunk_ split len xs = (unfoldr go . (,) xs) `fmap` rechunkSizes (len xs)

26− where go (b,r:rs) = Just (h, (t,rs))

27− where (h,t) = split r b

28− go (_,_) = Nothing

29−

30−rechunkSizes :: Int -> Gen [Int]

31−rechunkSizes n0 = shuffle =<< loop [] (0:repeat 1) n0

32− where loop _ [] _ = error "it's 2015, where's my Stream type?"

33− loop acc (lb:lbs) n

34− | n <= 0 = shuffle (reverse acc)

35− | otherwise = do

36− !i <- choose (lb,n)

37− loop (i:acc) lbs (n-i)

38−

39−shuffle :: [Int] -> Gen [Int]

40−shuffle (0:xs) = (0:) `fmap` shuffle xs

41−shuffle xs = fisherYates xs

42−

43−fisherYates :: [a] -> Gen [a]

44−fisherYates xs = (V.toList . V.backpermute v) `fmap` swapIndices (G.length v)

45− where

46− v = V.fromList xs

47− swapIndices n0 = do

48− swaps <- forM [0..n] $ \i -> ((,) i) `fmap` choose (i,n)

49− return (runST (swapAll swaps))

50− where

51− n = n0 - 1

52− swapAll :: [(Int,Int)] -> ST s (V.Vector Int)

53− swapAll ijs = do

54− mv <- G.unsafeThaw (G.enumFromTo 0 n :: V.Vector Int)

55− forM_ ijs $ uncurry (M.swap mv)

56− G.unsafeFreeze mv

tests/QC/Simple.hsdeleted−37

@@ -1,37 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

3−

4−module QC.Simple (

5− tests

6− ) where

7−

8−import Control.Applicative ((<|>))

9−import Data.ByteString (ByteString)

10−import Data.List (foldl')

11−import Data.Maybe (fromMaybe)

12−import QC.Rechunked (rechunkBS)

13−import Test.Tasty (TestTree)

14−import Test.Tasty.QuickCheck (testProperty)

15−import Test.QuickCheck (Property, counterexample, forAll)

16−import qualified Data.Attoparsec.ByteString.Char8 as A

17−

18−t_issue75 = expect issue75 "ab" (A.Done "" "b")

19−

20−issue75 :: A.Parser ByteString

21−issue75 = "a" >> ("b" <|> "")

22−

23−expect :: (Show r, Eq r) => A.Parser r -> ByteString -> A.Result r -> Property

24−expect p input wanted =

25− forAll (rechunkBS input) $ \in' ->

26− let result = parse p in'

27− in counterexample (show result ++ " /= " ++ show wanted) $

28− fromMaybe False (A.compareResults result wanted)

29−

30−parse :: A.Parser r -> [ByteString] -> A.Result r

31−parse p (x:xs) = foldl' A.feed (A.parse p x) xs

32−parse p [] = A.parse p ""

33−

34−tests :: [TestTree]

35−tests = [

36− testProperty "issue75" t_issue75

37− ]

tests/QC/Text.hs+66−100

@@ -1,84 +1,67 @@

1−{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}

1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}

22{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}

33module QC.Text (tests) where

5−#if !MIN_VERSION_base(4,8,0)

6−import Control.Applicative ((<*>), (<$>))

7−#endif

5+import Control.Applicative ((<$>), (<*>))

86import Data.Int (Int64)

9−import Data.Word (Word8)

107import Prelude hiding (take, takeWhile)

11−import QC.Common (liftOp, parseT)

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)

8+import QC.Common (parseT)

9+import Test.Framework (Test)

10+import Test.Framework.Providers.QuickCheck2 (testProperty)

1611import Test.QuickCheck

1712import qualified Data.Attoparsec.Text as P

1813import qualified Data.Attoparsec.Text.Lazy as PL

19−import qualified Data.Attoparsec.Text.FastSet as S

20−import qualified Data.ByteString as BS

2114import qualified Data.Char as Char

2215import qualified Data.Text as T

23−import qualified Data.Text.Encoding as TE

2416import qualified Data.Text.Lazy as L

2517

2618-- Basic byte-level combinators.

2719

28−satisfy :: Char -> L.Text -> Property

29−satisfy w s = parseT (P.satisfy (<=w)) (L.cons w s) === Just w

20+satisfy :: Char -> L.Text -> Bool

21+satisfy w s = parseT (P.satisfy (<=w)) (L.cons w s) == Just w

3022

31−satisfyWith :: Char -> L.Text -> Property

32−satisfyWith c s = parseT (P.satisfyWith id (<=c)) (L.cons c s) === Just c

23+satisfyWith :: Char -> L.Text -> Bool

24+satisfyWith c s = parseT (P.satisfyWith id (<=c)) (L.cons c s) == Just c

3325

34−char :: Char -> L.Text -> Property

35−char w s = parseT (P.char w) (L.cons w s) === Just w

26+char :: Char -> L.Text -> Bool

27+char w s = parseT (P.char w) (L.cons w s) == Just w

3628

37−skip :: Char -> L.Text -> Property

29+skip :: Char -> L.Text -> Bool

3830skip w s =

3931 case (parseT (P.skip (<w)) s, L.uncons s) of

40− (Nothing, mcs) -> maybe (property True) (expectFailure . it) mcs

41− (Just _, mcs) -> maybe (property False) it mcs

42− where it cs = liftOp "<" (<) (fst cs) w

32+ (Nothing, mcs) -> maybe True (not . it) mcs

33+ (Just _, mcs) -> maybe False it mcs

34+ where it cs = fst cs < w

4335

44−anyChar :: L.Text -> Property

36+anyChar :: L.Text -> Bool

4537anyChar s

46− | L.null s = p === Nothing

47− | otherwise = p === Just (L.head s)

38+ | L.null s = p == Nothing

39+ | otherwise = p == Just (L.head s)

4840 where p = parseT P.anyChar s

4941

50−notChar :: Char -> NonEmptyList Char -> Property

51−notChar w (NonEmpty s) = parseT (P.notChar w) bs === if v == w

42+notChar :: Char -> NonEmptyList Char -> Bool

43+notChar w (NonEmpty s) = parseT (P.notChar w) bs == if v == w

5244 then Nothing

5345 else Just v

5446 where v = L.head bs

5547 bs = L.pack s

5648

57−peekChar :: L.Text -> Property

49+peekChar :: L.Text -> Bool

5850peekChar s

59− | L.null s = p === Just (Nothing, s)

60− | otherwise = p === Just (Just (L.head s), s)

51+ | L.null s = p == Just (Nothing, s)

52+ | otherwise = p == Just (Just (L.head s), s)

6153 where p = parseT ((,) <$> P.peekChar <*> P.takeLazyText) s

6254

63−peekChar' :: L.Text -> Property

64−peekChar' s = parseT P.peekChar' s === (fst <$> L.uncons s)

55+peekChar' :: L.Text -> Bool

56+peekChar' s = parseT P.peekChar' s == (fst <$> L.uncons s)

6557

66−string :: L.Text -> L.Text -> Property

67−string s t = parseT (P.string s') (s `L.append` t) === Just s'

58+string :: L.Text -> L.Text -> Bool

59+string s t = parseT (P.string s') (s `L.append` t) == Just s'

6860 where s' = toStrict s

6961

70−strings :: L.Text -> L.Text -> L.Text -> Property

71−strings s t u =

72− parseT (P.string (toStrict s) >> P.string t') (L.concat [s,t,u])

73− === Just t'

74− where t' = toStrict t

75−

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

62+stringCI :: T.Text -> Bool

63+stringCI s = P.parseOnly (P.stringCI fs) s == Right s

8064 where fs = T.toCaseFold s

81− s = TE.decodeLatin1 (BS.pack ws)

8265

8366asciiCI :: T.Text -> Gen Bool

8467asciiCI x =

@@ -93,84 +76,72 @@ asciiCI x =

9376toStrict :: L.Text -> T.Text

9477toStrict = T.concat . L.toChunks

9578

96−skipWhile :: Char -> L.Text -> Property

79+skipWhile :: Char -> L.Text -> Bool

9780skipWhile w s =

9881 let t = L.dropWhile (<=w) s

9982 in case PL.parse (P.skipWhile (<=w)) s of

100− PL.Done t' () -> t === t'

101− _ -> property False

83+ PL.Done t' () -> t == t'

84+ _ -> False

10285

103−take :: Int -> L.Text -> Property

104−take n s = maybe (liftOp "<" (<) (L.length s) (fromIntegral n))

105− (=== T.take n (toStrict s)) $

86+take :: Int -> L.Text -> Bool

87+take n s = maybe (L.length s < fromIntegral n) (== T.take n (toStrict s)) $

10688 parseT (P.take n) s

10789

108−takeText :: L.Text -> Property

109−takeText s = maybe (property False) (=== toStrict s) . parseT P.takeText $ s

90+takeText :: L.Text -> Bool

91+takeText s = maybe False (== toStrict s) . parseT P.takeText $ s

11092

111−takeLazyText :: L.Text -> Property

112−takeLazyText s = maybe (property False) (=== s) . parseT P.takeLazyText $ s

93+takeLazyText :: L.Text -> Bool

94+takeLazyText s = maybe False (== s) . parseT P.takeLazyText $ s

11395

114−takeCount :: Positive Int -> L.Text -> Property

96+takeCount :: Positive Int -> L.Text -> Bool

11597takeCount (Positive k) s =

11698 case parseT (P.take k) s of

117− Nothing -> liftOp ">" (>) (fromIntegral k) (L.length s)

118− Just _s -> liftOp "<=" (<=) (fromIntegral k) (L.length s)

99+ Nothing -> fromIntegral k > L.length s

100+ Just _s -> fromIntegral k <= L.length s

119101

120−takeWhile :: Char -> L.Text -> Property

102+takeWhile :: Char -> L.Text -> Bool

121103takeWhile w s =

122104 let (h,t) = L.span (==w) s

123105 in case PL.parse (P.takeWhile (==w)) s of

124− PL.Done t' h' -> t === t' .&&. toStrict h === h'

125− _ -> property False

106+ PL.Done t' h' -> t == t' && toStrict h == h'

107+ _ -> False

126108

127−takeWhile1 :: Char -> L.Text -> Property

109+takeWhile1 :: Char -> L.Text -> Bool

128110takeWhile1 w s =

129− let s' = L.cons w s

130− (h,t) = L.span (<=w) s'

111+ let s' = L.cons w s

112+ (h,t) = L.span (<=w) s'

131113 in case PL.parse (P.takeWhile1 (<=w)) s' of

132− PL.Done t' h' -> t === t' .&&. toStrict h === h'

133− _ -> property False

114+ PL.Done t' h' -> t == t' && toStrict h == h'

115+ _ -> False

134116

135−takeTill :: Char -> L.Text -> Property

117+takeTill :: Char -> L.Text -> Bool

136118takeTill w s =

137119 let (h,t) = L.break (==w) s

138120 in case PL.parse (P.takeTill (==w)) s of

139− PL.Done t' h' -> t === t' .&&. toStrict h === h'

140− _ -> property False

121+ PL.Done t' h' -> t == t' && toStrict h == h'

122+ _ -> False

141123

142−takeWhile1_empty :: Property

143−takeWhile1_empty = parseT (P.takeWhile1 undefined) L.empty === Nothing

124+takeWhile1_empty :: Bool

125+takeWhile1_empty = parseT (P.takeWhile1 undefined) L.empty == Nothing

144126

145−endOfInput :: L.Text -> Property

146−endOfInput s = parseT P.endOfInput s === if L.null s

147− then Just ()

148− else Nothing

127+endOfInput :: L.Text -> Bool

128+endOfInput s = parseT P.endOfInput s == if L.null s

129+ then Just ()

130+ else Nothing

149131

150−endOfLine :: L.Text -> Property

132+endOfLine :: L.Text -> Bool

151133endOfLine s =

152134 case (parseT P.endOfLine s, L.uncons s) of

153− (Nothing, mcs) -> maybe (property True) (expectFailure . eol) mcs

154− (Just _, mcs) -> maybe (property False) eol mcs

155− where eol (c,s') = c === '\n' .||.

156− (c, fst <$> L.uncons s') === ('\r', Just '\n')

157−

158−scan :: L.Text -> Positive Int64 -> Property

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)

135+ (Nothing, mcs) -> maybe True (not . eol) mcs

136+ (Just _, mcs) -> maybe False eol mcs

137+ where eol (c,s') = c == '\n' || (c, fst <$> L.uncons s') == ('\r', Just '\n')

138+

139+scan :: L.Text -> Positive Int64 -> Bool

140+scan s (Positive k) = parseT p s == (Just $ toStrict $ L.take k s)

162141 where p = P.scan k $ \ n _ ->

163142 if n > 0 then let !n' = n - 1 in Just n' else Nothing

164143

165−members :: String -> Property

166−members s = property $ all (`S.member` set) s

167− where set = S.fromList s

168−

169−nonmembers :: String -> String -> Property

170−nonmembers s s' = property . not . any (`S.member` set) $ filter (not . (`elem` s)) s'

171− where set = S.fromList s

172−

173−tests :: [TestTree]

144+tests :: [Test]

174145tests = [

175146 testProperty "anyChar" anyChar

176147 , testProperty "asciiCI" asciiCI

@@ -186,7 +157,6 @@ tests = [

186157 , testProperty "skip" skip

187158 , testProperty "skipWhile" skipWhile

188159 , testProperty "string" string

189− , testProperty "strings" strings

190160 , testProperty "stringCI" stringCI

191161 , testProperty "take" take

192162 , testProperty "takeText" takeText

@@ -196,8 +166,4 @@ tests = [

196166 , testProperty "takeWhile" takeWhile

197167 , testProperty "takeWhile1" takeWhile1

198168 , testProperty "takeWhile1_empty" takeWhile1_empty

199− , testProperty "members" members

200− , testProperty "nonmembers" nonmembers

201− , testGroup "FastSet" FastSet.tests

202− , testGroup "Regressions" Regressions.tests

203169 ]

tests/QC/Text/FastSet.hsdeleted−15

@@ -1,15 +0,0 @@

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.hsdeleted−54

@@ -1,54 +0,0 @@

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− ]

tests/TestFastSet.hsnew file+25

@@ -0,0 +1,25 @@

1+module Main (main) where

3+import Data.Word (Word8)

4+import qualified Data.Attoparsec.FastSet as F

5+import System.Random (Random(..), RandomGen)

6+import Test.QuickCheck

8+integralRandomR :: (Integral a, RandomGen g) => (a, a) -> g -> (a, g)

9+integralRandomR (a,b) g = case randomR (fromIntegral a :: Int,

10+ fromIntegral b :: Int) g

11+ of (x,g') -> (fromIntegral x, g')

12+

13+instance Random Word8 where

14+ randomR = integralRandomR

15+ random = randomR (minBound,maxBound)

16+

17+instance Arbitrary Word8 where

18+ arbitrary = choose (minBound, maxBound)

19+

20+prop_AllMembers s =

21+ let set = F.fromList s

22+ in all (`F.memberWord8` set) s

23+

24+main = do

25+ quickCheck prop_AllMembers