master..a02aa16 · typeable/attoparsec

.gitignore−1

since splitsnapshots

unifiedsplit

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

3/dist/

4.cabal-sandbox

5cabal.sandbox.config

6−*.sw[op]

.hgignore+1−5

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

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

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

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

2~$

3~$

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

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

5benchmarks/Arse

4benchmarks/Arse

6benchmarks/dist

5benchmarks/dist

7benchmarks/med.txt

6benchmarks/med.txt

8benchmarks/tiny

7benchmarks/tiny

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

10cabal.sandbox.config

8cabal.sandbox.config

11−examples/c-http

12−examples/http_parser.[ch]

13hpc.*\.html$

9hpc.*\.html$

14

10

15syntax: glob

11syntax: glob

.hgtags−11

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

50a3c7a521fd58595d6a470ab890cc54a80dd45bd7 0.11.3.1

5138326ce07aca6c8c3a014b0d454d2a5bfdbd6a52 0.11.3.2

52694039f4fc157a8ca5dce37959391615b6c3f535 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 @@

1-- |

2-- Module : Data.Attoparsec

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

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

4-- License : BSD3

5--

6-- 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

5-- |

1-- |

6-- Module : Data.Attoparsec.ByteString

2-- Module : Data.Attoparsec.ByteString

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

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

8-- License : BSD3

4-- License : BSD3

9--

5--

10-- Maintainer : bos@serpentine.com

6-- Maintainer : bos@serpentine.com

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

63 , I.skipWhile

59 , I.skipWhile

64 , I.take

60 , I.take

65 , I.scan

61 , I.scan

66− , I.runScanner

67 , I.takeWhile

62 , I.takeWhile

68 , I.takeWhile1

63 , I.takeWhile1

69 , I.takeTill

64 , I.takeTill

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

97 ) where

92 ) where

98

93

99import Data.Attoparsec.Combinator

94import Data.Attoparsec.Combinator

100−import Data.List (intercalate)

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

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

102import qualified Data.Attoparsec.Internal as I

96import qualified Data.Attoparsec.Internal as I

103import qualified Data.ByteString as B

97import qualified Data.ByteString as B

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

106

100

107-- $parsec

101-- $parsec

108--

102--

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

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

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

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

111--

105--

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

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

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

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

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

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

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

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

116-- model to use.

110-- model to use.

117--

111--

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

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

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

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

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

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

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

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

122-- libraries.

116-- libraries.

123--

117--

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

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

125-- monad transformer.

119-- monad transformer.

126--

120--

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

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

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

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

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

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

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

124-- 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

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

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

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

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

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

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

135-- to a regular parser.

129-- to a regular parser.

136--

130--

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

131-- * 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

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

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

140

134

141-- $incremental

135-- $incremental

142--

136--

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

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

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

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

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

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

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

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

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

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

148--

142--

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

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

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

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

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

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

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

146+-- 'T.Partial' continuation.

154--

147--

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

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

156-- continuation with an empty bytestring.

149-- continuation with an empty bytestring.

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

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

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

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

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

164-- prompt for more input.

157-- 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.)

172

158

173-- $performance

159-- $performance

174--

160--

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

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

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

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

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

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

178--

164--

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

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

180-- that it is useful to follow.

166-- that it is useful to follow.

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

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

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

225-- result is treated as failure.

211-- result is treated as failure.

226eitherResult :: Result r -> Either String r

212eitherResult :: Result r -> Either String r

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

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

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

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

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

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

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,

2 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 #-}

7

4

8-- |

5-- |

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

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

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

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

11-- License : BSD3

8-- License : BSD3

12--

9--

13-- Maintainer : bos@serpentine.com

10-- Maintainer : bos@serpentine.com

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

30

27

31 -- * Running parsers

28 -- * Running parsers

32 , A.parse

29 , A.parse

33− , A.feed

34 , A.parseOnly

30 , A.parseOnly

35− , A.parseWith

36 , A.parseTest

31 , A.parseTest

32+ , A.parseWith

37

33

38 -- ** Result conversion

34 -- ** Result conversion

39 , A.maybeResult

35 , A.maybeResult

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

70

66

71 -- * Efficient string handling

67 -- * Efficient string handling

72 , I.string

68 , I.string

73− , I.stringCI

69+ , stringCI

74 , skipSpace

70 , skipSpace

75 , skipWhile

71 , skipWhile

76 , I.take

72 , I.take

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

127 , I.atEnd

123 , I.atEnd

128 ) where

124 ) where

129

125

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

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

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

132−import Data.Word (Word)

133−#endif

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

135import Control.Monad (void, when)

127import Control.Monad (void, when)

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

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

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

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

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

143import Data.String (IsString(..))

135import Data.String (IsString(..))

144import Data.Scientific (Scientific)

136import Data.Scientific (Scientific)

145import qualified Data.Scientific as Sci

137import qualified Data.Scientific as Sci

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

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

147import Prelude hiding (takeWhile)

139import Prelude hiding (takeWhile)

148import qualified Data.Attoparsec.ByteString as A

140import qualified Data.Attoparsec.ByteString as A

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

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

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

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

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

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

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

171

163

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+

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

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

173-- the consumed input.

175-- the consumed input.

174--

176--

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

232

234

233-- | A fast digit predicate.

235-- | A fast digit predicate.

234isDigit_w8 :: Word8 -> Bool

236isDigit_w8 :: Word8 -> Bool

235−isDigit_w8 w = w - 48 <= 9

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

236{-# INLINE isDigit_w8 #-}

238{-# INLINE isDigit_w8 #-}

237

239

238-- | Match any character.

240-- | Match any character.

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

269

271

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

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

271isSpace_w8 :: Word8 -> Bool

273isSpace_w8 :: Word8 -> Bool

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

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

273{-# INLINE isSpace_w8 #-}

275{-# INLINE isSpace_w8 #-}

274

276

275

277

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

444

446

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

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

446decimal :: Integral a => Parser a

448decimal :: Integral a => Parser a

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

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

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

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

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

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

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

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

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

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

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

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

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

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

472 <|> p

475 <|> p

473

476

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−

492-- | Parse a rational number.

477-- | Parse a rational number.

493--

478--

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

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

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

516--

501--

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

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

518-- \"Infinity\".

503-- \"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\".

519double :: Parser Double

526double :: Parser Double

520double = scientifically Sci.toRealFloat

527double = scientifically Sci.toRealFloat

521

528

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

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

523--

530--

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+-- \"

525number :: Parser Number

540number :: Parser Number

526number = scientifically $ \s ->

541number = scientifically $ \s ->

527 let e = Sci.base10Exponent s

542 let e = Sci.base10Exponent s

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

529 in if e >= 0

544 in if e >= 0

530 then I (c * 10 ^ e)

545 then I (c * 10 ^ e)

531 else D (Sci.toRealFloat s)

546 else D (Sci.toRealFloat s)

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

533

547

534-- | Parse a scientific number.

548-- | Parse a scientific number.

535--

549--

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'.

537scientific :: Parser Scientific

551scientific :: Parser Scientific

538scientific = scientifically id

552scientific = scientifically id

539

553

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

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

3-----------------------------------------------------------------------------

4-- |

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

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

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

7-- License : BSD3

8--

9-- Maintainer : bos@serpentine.com

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

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

1{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings,

2 RecordWildCards, MagicHash, UnboxedTuples #-}

3

4−module Data.Attoparsec.Internal.Fhthagn

4+module Data.Attoparsec.ByteString.Fhthagn

5 (

6 inlinePerformIO

7 ) where

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

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

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

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

2− RecordWildCards #-}

3-- |

2-- |

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

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

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

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

6-- License : BSD3

5-- License : BSD3

7--

6--

8-- Maintainer : bos@serpentine.com

7-- Maintainer : bos@serpentine.com

9-- Stability : experimental

8-- Stability : experimental

10-- Portability : unknown

9-- Portability : unknown

11--

10--

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

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

13-- loosely based on the Parsec library.

12-- loosely based on the Parsec library.

14

13

15module Data.Attoparsec.ByteString.Internal

14module Data.Attoparsec.ByteString.Internal

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

47 -- * Efficient string handling

46 -- * Efficient string handling

48 , skipWhile

47 , skipWhile

49 , string

48 , string

50− , stringCI

49+ , stringTransform

51 , take

50 , take

52 , scan

51 , scan

53 , runScanner

52 , runScanner

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

66 , atEnd

65 , atEnd

67 ) where

66 ) where

68

67

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

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

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

71−#endif

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

73import Control.Monad (when)

69import Control.Monad (when)

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

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

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

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

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

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

77−import Data.Attoparsec.Internal

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

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

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

80−import Data.ByteString (ByteString)

81−import Data.List (intercalate)

82import Data.Word (Word8)

74import Data.Word (Word8)

83import Foreign.ForeignPtr (withForeignPtr)

75import Foreign.ForeignPtr (withForeignPtr)

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

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

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

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

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

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

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

79+import Data.ByteString (ByteString)

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

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

89import qualified Data.ByteString as B8

81import qualified Data.ByteString as B8

90import qualified Data.ByteString.Char8 as B

82import qualified Data.ByteString.Char8 as B

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

92import qualified Data.ByteString.Lazy as L

84import qualified Data.ByteString.Lazy as L

93import qualified Data.ByteString.Unsafe as B

85import qualified Data.ByteString.Unsafe as B

94

86

95−type Parser = T.Parser ByteString

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

96−type Result = IResult ByteString

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

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

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

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

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

99

91

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

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

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

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

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

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

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

142 hack dummy = do

134 hack dummy = do

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

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

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

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

145 peek (castPtr $ p `plusPtr` o)

137 peek (castPtr $ p `plusPtr` o)

146

138

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

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

140+-- returns 'True'.

148−take :: Int -> Parser ByteString

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

149−take n0 = do

142+takeWith n0 p = do

150 let n = max n0 0

143 let n = max n0 0

151 s <- ensure n

144 s <- ensure n

145+ if p s

152− advance n >> return 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)

153{-# INLINE take #-}

152{-# INLINE take #-}

154

153

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

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

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

165--

164--

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

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

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

166-- 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

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

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

170−string :: ByteString -> Parser ByteString

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

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

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

172{-# INLINE string #-}

171{-# INLINE string #-}

173

172

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

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

175−toLower :: Word8 -> Word8

174+ -> Parser B.ByteString

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

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

177− | otherwise = w

176+{-# INLINE stringTransform #-}

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"

224

177

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

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

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

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

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

228 where

181 where

229 go = do

182 go = do

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

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

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

184+ advance (B.length t)

232− when continue go

185+ eoc <- endOfChunk

186+ when eoc $ do

187+ input <- wantInput

188+ when input go

233{-# INLINE skipWhile #-}

189{-# INLINE skipWhile #-}

234

190

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

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

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

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

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

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

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

244-- in an infinite loop.

200-- in an infinite loop.

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

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

246takeTill p = takeWhile (not . p)

202takeTill p = takeWhile (not . p)

247{-# INLINE takeTill #-}

203{-# INLINE takeTill #-}

248

204

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

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

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

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

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

258-- in an infinite loop.

214-- in an infinite loop.

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

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

260−takeWhile p = do

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

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

270 where

217 where

271 go acc = do

218 go acc = do

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

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

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

220+ advance (B.length s)

274− if continue

221+ eoc <- endOfChunk

222+ if eoc

223+ then do

224+ input <- wantInput

225+ if input

275− then go (s:acc)

226+ then go (s:acc)

276− else return $ concatReverse (s:acc)

227+ else return (s:acc)

277−{-# INLINE takeWhileAcc #-}

228+ else return (s:acc)

229+{-# INLINE takeWhile #-}

278

230

279−takeRest :: Parser [ByteString]

231+takeRest :: Parser [B.ByteString]

280takeRest = go []

232takeRest = go []

281 where

233 where

282 go acc = do

234 go acc = do

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

289 else return (reverse acc)

241 else return (reverse acc)

290

242

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

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

292−takeByteString :: Parser ByteString

244+takeByteString :: Parser B.ByteString

293takeByteString = B.concat `fmap` takeRest

245takeByteString = B.concat `fmap` takeRest

294

246

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

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

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

298

250

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

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

300

252

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

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

302 -> Parser r

254 -> Parser r

303scan_ f s0 p = go [] s0

255scan_ f s0 p = go [] s0

304 where

256 where

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

319 bs <- get

271 bs <- get

320 let T i s' = inlinePerformIO $ scanner bs

272 let T i s' = inlinePerformIO $ scanner bs

321 !h = B.unsafeTake i bs

273 !h = B.unsafeTake i bs

322− continue <- inputSpansChunks i

274+ advance i

323− if continue

275+ eoc <- endOfChunk

276+ if eoc

277+ then do

278+ input <- wantInput

279+ if input

324− then go (h:acc) s'

280+ then go (h:acc) s'

281+ else f s' (h:acc)

325 else f s' (h:acc)

282 else f s' (h:acc)

326{-# INLINE scan_ #-}

283{-# INLINE scan_ #-}

327

284

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

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

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

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

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

339-- in an infinite loop.

296-- in an infinite loop.

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

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

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

298+scan = scan_ $ \_ chunks ->

299+ case chunks of

300+ [x] -> return x

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

342{-# INLINE scan #-}

302{-# INLINE scan #-}

343

303

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

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

345-- scanner.

305-- scanner.

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

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

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

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

348{-# INLINE runScanner #-}

308{-# INLINE runScanner #-}

349

309

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

310-- | 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)

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

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

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

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

355-- there is no input left.

315-- there is no input left.

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

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

357takeWhile1 p = do

317takeWhile1 p = do

358 (`when` demandInput) =<< endOfChunk

318 (`when` demandInput) =<< endOfChunk

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

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

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

364 advance len

324 advance len

365 eoc <- endOfChunk

325 eoc <- endOfChunk

366 if eoc

326 if eoc

367− then takeWhileAcc p [s]

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

368 else return s

328 else return s

369−{-# INLINE takeWhile1 #-}

370

329

371-- | Match any byte in a set.

330-- | Match any byte in a set.

372--

331--

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

414peekWord8 :: Parser (Maybe Word8)

373peekWord8 :: Parser (Maybe Word8)

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

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

416 case () of

375 case () of

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

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

418− let !w = Buf.unsafeIndex t pos_

377+ let !w = B.unsafeIndex t pos_

419 in succ t pos more (Just w)

378 in succ t pos more (Just w)

420 | more == Complete ->

379 | more == Complete ->

421 succ t pos more Nothing

380 succ t pos more Nothing

422 | otherwise ->

381 | 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_

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

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

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

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

426 in prompt t pos more lose' succ'

385 in prompt t pos more lose' succ'

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

431peekWord8' :: Parser Word8

390peekWord8' :: Parser Word8

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

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

433 if lengthAtLeast pos 1 t

392 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))

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

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

436 in ensureSuspended 1 t pos more lose succ'

395 in ensureSuspended 1 t pos more lose succ'

437{-# INLINE peekWord8' #-}

396{-# INLINE peekWord8' #-}

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

443

402

444-- | Terminal failure continuation.

403-- | Terminal failure continuation.

445failK :: Failure a

404failK :: 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

447{-# INLINE failK #-}

406{-# INLINE failK #-}

448

407

449-- | Terminal success continuation.

408-- | Terminal success continuation.

450successK :: Success a a

409successK :: 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

452{-# INLINE successK #-}

411{-# INLINE successK #-}

453

412

454-- | Run a parser.

413-- | Run a parser.

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

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

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

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

457{-# INLINE parse #-}

416{-# INLINE parse #-}

458

417

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

418-- | 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

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

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

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

470− Fail _ [] err -> Left err

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

421+ Fail _ _ err -> Left err

472− Done _ a -> Right a

422+ Done _ a -> Right a

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

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

474{-# INLINE parseOnly #-}

424{-# INLINE parseOnly #-}

475

425

476get :: Parser ByteString

426get :: Parser ByteString

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

427get = 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)

479{-# INLINE get #-}

429{-# INLINE get #-}

480

430

481endOfChunk :: Parser Bool

431endOfChunk :: Parser Bool

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

432endOfChunk = 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)

484{-# INLINE endOfChunk #-}

434{-# INLINE endOfChunk #-}

485

435

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−

496advance :: Int -> Parser ()

436advance :: Int -> Parser ()

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

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

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

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

499{-# INLINE advance #-}

439{-# INLINE advance #-}

500

440

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

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

502 -> Failure r

442 -> Failure r

503 -> Success ByteString r

443 -> Success ByteString r

504 -> Result r

444 -> Result r

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

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

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

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

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

519 else ensureSuspended n t pos more lose succ

459 else ensureSuspended n t pos more lose succ

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

520{-# INLINE ensure #-}

461{-# INLINE ensure #-}

521

462

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+

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

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

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

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

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

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

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

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

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

528 in runParser p t pos more lose succ'

514 in runParser p t pos more lose succ'

529

515

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+

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

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

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

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

532{-# INLINE lengthAtLeast #-}

524{-# INLINE lengthAtLeast #-}

533

525

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

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

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

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

536{-# INLINE substring #-}

528{-# 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−

6-- |

1-- |

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

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

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

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

9-- License : BSD3

4-- License : BSD3

10--

5--

11-- Maintainer : bos@serpentine.com

6-- Maintainer : bos@serpentine.com

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

41

36

42import Control.DeepSeq (NFData(rnf))

37import Control.DeepSeq (NFData(rnf))

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

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

44−import Data.List (intercalate)

45import qualified Data.ByteString as B

39import qualified Data.ByteString as B

46import qualified Data.Attoparsec.ByteString as A

40import qualified Data.Attoparsec.ByteString as A

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

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

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

105

99

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

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

107eitherResult :: Result r -> Either String r

101eitherResult :: Result r -> Either String r

108−eitherResult (Done _ r) = Right r

102+eitherResult (Done _ r) = Right r

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

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

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

Data/Attoparsec/Char8.hs+1−1

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

1-- |

2-- Module : Data.Attoparsec.Char8

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

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

4-- License : BSD3

5--

6-- Maintainer : bos@serpentine.com

Data/Attoparsec/Combinator.hs+42−59

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

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

1+{-# LANGUAGE BangPatterns #-}

2−#if __GLASGOW_HASKELL__ >= 702

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

4−#endif

5-- |

2-- |

6-- Module : Data.Attoparsec.Combinator

3-- 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

8-- License : BSD3

5-- License : BSD3

9--

6--

10-- Maintainer : bos@serpentine.com

7-- Maintainer : bos@serpentine.com

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

33 , skipMany1

30 , skipMany1

34 , eitherP

31 , eitherP

35 , feed

32 , feed

36− , satisfyElem

37− , endOfInput

38− , atEnd

39− , lookAhead

40 ) where

33 ) where

41

34

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, (<|>), (*>), (<$>))

47import Control.Monad (MonadPlus(..))

37import Control.Monad (MonadPlus(..))

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

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

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

50import Data.ByteString (ByteString)

39import Data.ByteString (ByteString)

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

51import Data.Text (Text)

41import Data.Text (Text)

52import qualified Data.Attoparsec.Zepto as Z

42import qualified Data.Attoparsec.Zepto as Z

53import Prelude hiding (succ)

43import Prelude hiding (succ)

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

56-- input appears to have been consumed.

46-- input appears to have been consumed.

57--

47--

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

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

59−-- attoparsec parsers always backtrack on failure.

49+-- Attoparsec parsers always backtrack on failure.

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

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

61try p = p

51try p = p

62{-# INLINE try #-}

52{-# INLINE try #-}

63

53

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

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

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

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

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

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

67− -> Parser i a

57+ -> Parser i t a

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

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

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

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

70 in runParser p t pos more lose' succ

60 in runParser p t pos more lose' succ

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

76-- action.

66-- action.

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

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

78choice = foldr (<|>) empty

68choice = foldr (<|>) empty

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

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

80− -> Parser ByteString a #-}

70+ -> Parser ByteString ByteString a #-}

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

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

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

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

83

73

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

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

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

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

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

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

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

90option x p = p <|> pure x

80option x p = p <|> pure x

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

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

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

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

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

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

94

84

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

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

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

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

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

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

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

134--

124--

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

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

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

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

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

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

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

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

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

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

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

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

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

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

142

132

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

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

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

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

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

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

146--

136--

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

155

145

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

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

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

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

158--

148--

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

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

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

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

161sepBy1 p s = scan

151sepBy1 p s = scan

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

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

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

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

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

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

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

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

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

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

167

157

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

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

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

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

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

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

171--

161--

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

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

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

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

174sepBy1' p s = scan

164sepBy1' p s = scan

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

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

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

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

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

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

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

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

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

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

180

170

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

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

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

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

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

191manyTill p end = scan

181manyTill p end = scan

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

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

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

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

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

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

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

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

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

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

197

187

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

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

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

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

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

210manyTill' p end = scan

200manyTill' p end = scan

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

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

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

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

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

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

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

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

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

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

216

206

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

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

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

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

219skipMany p = scan

209skipMany p = scan

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

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

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

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

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

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

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

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

224

214

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

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

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

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

227skipMany1 p = p *> skipMany p

217skipMany1 p = p *> skipMany p

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

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

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

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

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

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

231

221

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

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

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

241

231

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

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

243-- input.

233-- input.

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

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

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

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

246feed (Partial k) d = k d

236feed (Partial k) d = k d

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

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

248{-# INLINE feed #-}

238{-# 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 #-}

2-- |

3-- Module : Data.Attoparsec.Internal

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

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

5-- License : BSD3

6--

7-- Maintainer : bos@serpentine.com

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

12-- library.

13

14module Data.Attoparsec.Internal

15+ (

15− ( compareResults

16+ compareResults

16− , prompt

17− , demandInput

18− , demandInput_

19− , wantInput

20− , endOfInput

21− , atEnd

22− , satisfyElem

23− , concatReverse

24 ) where

17 ) where

25

18

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

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

28−import Data.Monoid (Monoid, mconcat)

29−#endif

30import Data.Attoparsec.Internal.Types

19import Data.Attoparsec.Internal.Types

31−import Data.ByteString (ByteString)

32−import Data.Text (Text)

33import Prelude hiding (succ)

20import Prelude hiding (succ)

34

21

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

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

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

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

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

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

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

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

26-- (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 t, Eq r) => IResult i t r -> IResult i t r -> Maybe Bool

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

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

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

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

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

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

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

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

45compareResults (Partial _) (Partial _) = Nothing

32compareResults (Partial _) (Partial _) = Nothing

46compareResults _ _ = Just False

33compareResults _ _ = 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+59−139

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

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

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

2 Rank2Types, RecordWildCards, TypeFamilies #-}

3-- |

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

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

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

6-- License : BSD3

7--

8-- Maintainer : bos@serpentine.com

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

15module Data.Attoparsec.Internal.Types

16 (

17 Parser(..)

18− , State

19 , Failure

18 , Failure

20 , Success

19 , Success

21 , Pos(..)

20 , Pos(..)

22 , IResult(..)

21 , IResult(..)

23 , More(..)

22 , More(..)

24 , (<>)

23 , (<>)

25− , Chunk(..)

26 ) where

24 ) where

27

25

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

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

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

30import Control.DeepSeq (NFData(rnf))

27import Control.DeepSeq (NFData(rnf))

31import Control.Monad (MonadPlus(..))

28import Control.Monad (MonadPlus(..))

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

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

29+import Data.Monoid (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)

30+import Prelude hiding (getChar, succ)

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

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

45

31

46newtype Pos = Pos { fromPos :: Int }

32newtype Pos = Pos { fromPos :: Int }

47 deriving (Eq, Ord, Show, Num)

33 deriving (Eq, Ord, Show, Num)

48

34

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@

50-- of string that was processed.

36-- of string that was processed.

51--

37--

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

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

53-- value in a 'Done' result.

39-- value in a 'Done' result.

54−data IResult i r =

40+data IResult i t r =

55− Fail i [String] String

41+ Fail t [String] String

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

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

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

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

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

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

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

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

60 -- any.

46 -- any.

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

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

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

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

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

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

64− -- an empty string to the continuation.

50+ -- an empty string.

65− --

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

67− -- continuation more than once.

68− | Done i r

51+ | Done t r

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

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

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

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

71

54

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

55+instance (Show t, Show r) => Show (IResult i t 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

56+ show (Fail t stk msg) =

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

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

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

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

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

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

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

80

60

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

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

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

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

83 rnf (Partial _) = ()

63 rnf (Partial _) = ()

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

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

85 {-# INLINE rnf #-}

65 {-# INLINE rnf #-}

86

66

87−instance Functor (IResult i) where

67+instance Functor (IResult i t) where

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

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

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

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

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

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

91

71

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

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

93−-- of string being processed.

73+-- string being processed.

94--

74--

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

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

96--

76--

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

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

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

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

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

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

85-- 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

107-- arbitrary lookahead.)

87-- arbitrary lookahead.)

108--

88--

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

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

110−newtype Parser i a = Parser {

90+newtype Parser i t a = Parser {

111− runParser :: forall r.

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

112− State i -> Pos -> More

113− -> Failure i (State i) r

92+ -> Failure i t r

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

93+ -> Success i t a r

115− -> IResult i r

94+ -> IResult i t r

116 }

95 }

117

96

118−type family State i

119−type instance State ByteString = B.Buffer

120−type instance State Text = T.Buffer

121−

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

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

123− -> IResult i r

98+ -> IResult i t r

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

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

125

100

126-- | Have we read all available input?

101-- | Have we read all available input?

127data More = Complete | Incomplete

102data More = Complete | Incomplete

128 deriving (Eq, Show)

103 deriving (Eq, Show)

129

104

130−instance Semigroup More where

105+instance Monoid More where

131− c@Complete <> _ = c

106+ mappend c@Complete _ = c

132− _ <> m = m

107+ mappend _ m = m

133−

134−instance Mon.Monoid More where

135− mappend = (<>)

136− mempty = Incomplete

108+ mempty = Incomplete

137

109

138−instance Monad (Parser i) where

110+instance Monad (Parser i t) where

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

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

140− fail = Fail.fail

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

141 {-# INLINE fail #-}

113 {-# INLINE fail #-}

142−#endif

143

114

144− return = App.pure

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

145 {-# INLINE return #-}

116 {-# INLINE return #-}

146

117

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

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

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

149 in runParser m t pos more lose succ'

120 in runParser m t pos more lose succ'

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

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

151

122

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

162plus f g = Parser $ \t pos more lose succ ->

124plus f g = Parser $ \t pos more lose succ ->

163 let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ

125 let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ

164 in runParser f t pos more lose' succ

126 in runParser f t pos more lose' succ

165

127

166−instance MonadPlus (Parser i) where

128+instance (Monoid t) => MonadPlus (Parser i t) where

167 mzero = fail "mzero"

129 mzero = fail "mzero"

168 {-# INLINE mzero #-}

130 {-# INLINE mzero #-}

169 mplus = plus

131 mplus = plus

170

132

171−instance Functor (Parser i) where

133+instance Functor (Parser i t) where

172 fmap f p = Parser $ \t pos more lose succ ->

134 fmap f p = Parser $ \t pos more lose succ ->

173 let succ' t' pos' more' a = succ t' pos' more' (f a)

135 let succ' t' pos' more' a = succ t' pos' more' (f a)

174 in runParser p t pos more lose succ'

136 in runParser p t pos more lose succ'

175 {-# INLINE fmap #-}

137 {-# INLINE fmap #-}

176

138

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

178apP d e = do

140apP d e = do

179 b <- d

141 b <- d

180 a <- e

142 a <- e

181 return (b a)

143 return (b a)

182{-# INLINE apP #-}

144{-# INLINE apP #-}

183

145

184−instance Applicative (Parser i) where

146+instance Applicative (Parser i t) where

185− pure v = Parser $ \t !pos more _lose succ -> succ t pos more v

147+ pure = return

186 {-# INLINE pure #-}

148 {-# INLINE pure #-}

187 (<*>) = apP

149 (<*>) = apP

188 {-# INLINE (<*>) #-}

150 {-# 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+ (*>) = (>>)

190 {-# INLINE (*>) #-}

156 {-# INLINE (*>) #-}

191− x <* y = x >>= \a -> y >> pure a

157+ x <* y = x >>= \a -> y >> return a

192 {-# INLINE (<*) #-}

158 {-# INLINE (<*) #-}

193

159

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

199 mempty = fail "mempty"

161 mempty = fail "mempty"

200 {-# INLINE mempty #-}

162 {-# INLINE mempty #-}

201− mappend = (<>)

163+ mappend = plus

202 {-# INLINE mappend #-}

164 {-# INLINE mappend #-}

203

165

204−instance Alternative (Parser i) where

166+instance (Monoid t) => Alternative (Parser i t) where

205 empty = fail "empty"

167 empty = fail "empty"

206 {-# INLINE empty #-}

168 {-# INLINE empty #-}

207

169

@@ -209,9 +171,8 @@ instance Alternative (Parser i) where

209 {-# INLINE (<|>) #-}

171 {-# INLINE (<|>) #-}

210

172

211 many v = many_v

173 many v = many_v

212− where

213− many_v = some_v <|> pure []

174+ where many_v = some_v <|> pure []

214− some_v = (:) <$> v <*> many_v

175+ some_v = (:) <$> v <*> many_v

215 {-# INLINE many #-}

176 {-# INLINE many #-}

216

177

217 some v = some_v

178 some v = some_v

@@ -220,47 +181,6 @@ instance Alternative (Parser i) where

220 some_v = (:) <$> v <*> many_v

181 some_v = (:) <$> v <*> many_v

221 {-# INLINE some #-}

182 {-# INLINE some #-}

222

183

223−-- | A common interface for input chunks.

184+(<>) :: (Monoid m) => m -> m -> m

224−class Monoid c => Chunk c where

185+(<>) = mappend

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 #-}

186+{-# INLINE (<>) #-}

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 #-}

Data/Attoparsec/Lazy.hs+1−1

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

1-- |

2-- Module : Data.Attoparsec.Lazy

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

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

4-- License : BSD3

5--

6-- Maintainer : bos@serpentine.com

Data/Attoparsec/Number.hs+2−15

@@ -1,25 +1,16 @@

1{-# LANGUAGE DeriveDataTypeable #-}

2-- |

3-- Module : Data.Attoparsec.Number

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

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

5-- License : BSD3

6--

7-- Maintainer : bos@serpentine.com

8-- Stability : experimental

9-- Portability : unknown

10--

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−--

16-- A simple number type, useful for parsing both exact and inexact

11-- A simple number type, useful for parsing both exact and inexact

17-- quantities without losing much precision.

12-- quantities without losing much precision.

18−module Data.Attoparsec.Number

13+module Data.Attoparsec.Number ( Number(..) ) where

19− {-# DEPRECATED "This module will be removed in the next major release." #-}

20− (

21− Number(..)

22− ) where

23

14

24import Control.DeepSeq (NFData(rnf))

15import Control.DeepSeq (NFData(rnf))

25import Data.Data (Data)

16import Data.Data (Data)

@@ -28,13 +19,9 @@ import Data.Typeable (Typeable)

28

19

29-- | A numeric type that can represent integers accurately, and

20-- | A numeric type that can represent integers accurately, and

30-- floating point numbers to the precision of a 'Double'.

21-- 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.

34data Number = I !Integer

22data Number = I !Integer

35 | D {-# UNPACK #-} !Double

23 | D {-# UNPACK #-} !Double

36 deriving (Typeable, Data)

24 deriving (Typeable, Data)

37−{-# DEPRECATED Number "Use Scientific instead." #-}

38

25

39instance Show Number where

26instance Show Number where

40 show (I a) = show a

27 show (I a) = show a

Data/Attoparsec/Text.hs+50−61

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

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

1+{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}

2−#if __GLASGOW_HASKELL__ >= 702

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

4−#endif

5−{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}

6

2

7-- |

3-- |

8-- Module : Data.Attoparsec.Text

4-- Module : Data.Attoparsec.Text

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

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

10-- License : BSD3

6-- License : BSD3

11--

7--

12-- Maintainer : bos@serpentine.com

8-- Maintainer : bos@serpentine.com

@@ -72,7 +68,6 @@ module Data.Attoparsec.Text

72 , skipSpace

68 , skipSpace

73 , I.skipWhile

69 , I.skipWhile

74 , I.scan

70 , I.scan

75− , I.runScanner

76 , I.take

71 , I.take

77 , I.takeWhile

72 , I.takeWhile

78 , I.takeWhile1

73 , I.takeWhile1

@@ -126,11 +121,7 @@ module Data.Attoparsec.Text

126 , I.atEnd

121 , I.atEnd

127 ) where

122 ) where

128

123

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

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

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

131−import Data.Word (Word)

132−#endif

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

134import Data.Attoparsec.Combinator

125import Data.Attoparsec.Combinator

135import Data.Attoparsec.Number (Number(..))

126import Data.Attoparsec.Number (Number(..))

136import Data.Scientific (Scientific)

127import Data.Scientific (Scientific)

@@ -139,9 +130,8 @@ import Data.Attoparsec.Text.Internal (Parser, Result, parse, takeWhile1)

139import Data.Bits (Bits, (.|.), shiftL)

130import Data.Bits (Bits, (.|.), shiftL)

140import Data.Char (isAlpha, isDigit, isSpace, ord)

131import Data.Char (isAlpha, isDigit, isSpace, ord)

141import Data.Int (Int8, Int16, Int32, Int64)

132import Data.Int (Int8, Int16, Int32, Int64)

142−import Data.List (intercalate)

143import Data.Text (Text)

133import Data.Text (Text)

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

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

145import qualified Data.Attoparsec.Internal as I

135import qualified Data.Attoparsec.Internal as I

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

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

147import qualified Data.Attoparsec.Text.Internal as I

137import qualified Data.Attoparsec.Text.Internal as I

@@ -149,50 +139,49 @@ import qualified Data.Text as T

149

139

150-- $parsec

140-- $parsec

151--

141--

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

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

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

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

154--

144--

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

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

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

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

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

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

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

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

159-- model to use.

149-- model to use.

160--

150--

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

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

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

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

163-- If you use complicated combinators that return lists of

153-- If you use complicated combinators that return lists of

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

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

165-- libraries.

155-- libraries.

166--

156--

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

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

168-- monad transformer.

158-- monad transformer.

169--

159--

170−-- * attoparsec is specialised to deal only with strict 'Text'

160+-- * Attoparsec is specialised to deal only with strict 'Text'

171-- input. Efficiency concerns rule out both lists and lazy text.

161-- input. Efficiency concerns rule out both lists and lazy text.

172-- The usual use for lazy text would be to allow consumption of very

162-- The usual use for lazy text would be to allow consumption of very

173-- large input without a large footprint. For this need,

163-- 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,

175-- with much more control over when input takes place. If you must

165-- with much more control over when input takes place. If you must

176-- use lazy text, see the 'Lazy' module, which feeds lazy chunks to

166-- use lazy text, see the 'Lazy' module, which feeds lazy chunks to

177-- a regular parser.

167-- a regular parser.

178--

168--

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

169-- * 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

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

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

182

172

183-- $incremental

173-- $incremental

184--

174--

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

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

186-- a 'Text' that represents only part of the expected total amount

176-- a 'Text' that represents only part of the expected total amount

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

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

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

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

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

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

190--

180--

191-- Supplying the 'T.Partial' continuation with another string will

181-- Supplying the 'T.Partial' continuation with another string will

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

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

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

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

195−-- be another 'Partial' continuation.

184+-- 'Partial' continuation.

196--

185--

197-- To indicate that you have no more input, supply the 'Partial'

186-- To indicate that you have no more input, supply the 'Partial'

198-- continuation with an 'T.empty' 'Text'.

187-- continuation with an 'T.empty' 'Text'.

@@ -204,19 +193,12 @@ import qualified Data.Text as T

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

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

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

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

206-- prompt for more input.

195-- 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.)

214

196

215-- $performance

197-- $performance

216--

198--

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

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

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

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

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

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

220--

202--

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

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

222-- that it is useful to follow.

204-- that it is useful to follow.

@@ -266,10 +248,9 @@ maybeResult _ = Nothing

266-- | Convert a 'Result' value to an 'Either' value. A 'Partial' result

248-- | Convert a 'Result' value to an 'Either' value. A 'Partial' result

267-- is treated as failure.

249-- is treated as failure.

268eitherResult :: Result r -> Either String r

250eitherResult :: Result r -> Either String r

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

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

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

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

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

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

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

273

254

274-- | A predicate that matches either a carriage return @\'\\r\'@ or

255-- | A predicate that matches either a carriage return @\'\\r\'@ or

275-- newline @\'\\n\'@ character.

256-- newline @\'\\n\'@ character.

@@ -342,24 +323,6 @@ signed p = (negate <$> (I.char '-' *> p))

342 <|> (I.char '+' *> p)

323 <|> (I.char '+' *> p)

343 <|> p

324 <|> p

344

325

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−

363-- | Parse a rational number.

326-- | Parse a rational number.

364--

327--

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

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

@@ -387,12 +350,39 @@ rational = scientifically realToFrac

387--

350--

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

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

389-- \"Infinity\".

352-- \"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\".

390double :: Parser Double

375double :: Parser Double

391double = scientifically Sci.toRealFloat

376double = scientifically Sci.toRealFloat

392

377

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

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

394--

379--

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'.

396--

386--

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

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

398-- \"Infinity\".

388-- \"Infinity\".

@@ -403,11 +393,10 @@ number = scientifically $ \s ->

403 in if e >= 0

393 in if e >= 0

404 then I (c * 10 ^ e)

394 then I (c * 10 ^ e)

405 else D (Sci.toRealFloat s)

395 else D (Sci.toRealFloat s)

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

407

396

408-- | Parse a scientific number.

397-- | Parse a scientific number.

409--

398--

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'.

411scientific :: Parser Scientific

400scientific :: Parser Scientific

412scientific = scientifically id

401scientific = scientifically id

413

402

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 #-}

1+-----------------------------------------------------------------------------

2−

3−------------------------------------------------------------------------------

4-- |

2-- |

5-- Module : Data.Attoparsec.FastSet

3-- Module : Data.Attoparsec.FastSet

6−-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015

4+-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2014

7-- License : BSD3

5-- License : BSD3

8--

6--

9-- Maintainer : felipe.lessa@gmail.com

7-- Maintainer : felipe.lessa@gmail.com

10-- Stability : experimental

8-- Stability : experimental

11-- Portability : unknown

9-- Portability : unknown

12--

10--

13−-- Fast set membership tests for 'Char' values. We test for

11+-- Fast set membership tests for 'Char' values. The set

14−-- membership using a hashtable implemented with Robin Hood

15−-- collision resolution. The set representation is unboxed,

12+-- representation is unboxed for efficiency. We test for

16−-- and the characters and hashes interleaved, for efficiency.

13+-- membership using a binary search.

17−--

18--

14--

19-----------------------------------------------------------------------------

15-----------------------------------------------------------------------------

20module Data.Attoparsec.Text.FastSet

16module Data.Attoparsec.Text.FastSet

@@ -30,92 +26,38 @@ module Data.Attoparsec.Text.FastSet

30 , charClass

26 , charClass

31 ) where

27 ) where

32

28

33−import Data.Bits ((.|.), (.&.), shiftR)

29+import Data.List (sort)

34−import Data.Function (on)

35−import Data.List (sort, sortBy)

36import qualified Data.Array.Base as AB

30import qualified Data.Array.Base as AB

37import qualified Data.Array.Unboxed as A

31import qualified Data.Array.Unboxed as A

38import qualified Data.Text as T

32import qualified Data.Text as T

39

33

40−data FastSet = FastSet {

34+newtype FastSet = FastSet (A.UArray Int Char)

41− table :: {-# UNPACK #-} !(A.UArray Int Int)

35+ deriving (Eq, Ord, Show)

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

36

63−pad :: Int -> [Entry] -> [Entry]

37+-- | Create a set.

64−pad = go 0

38+set :: T.Text -> FastSet

65− where -- ensure that we pad enough so that lookups beyond the

39+set t = mkSet (T.length t) (sort $ T.unpack t)

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

40

96−ordNub :: Eq a => [a] -> [a]

41+fromList :: [Char] -> FastSet

97−ordNub [] = []

42+fromList cs = mkSet (length cs) (sort cs)

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

43

104−set :: T.Text -> FastSet

44+mkSet :: Int -> [Char] -> FastSet

105−set = fromList . T.unpack

45+mkSet l = FastSet . A.listArray (0,l-1)

106

46

107-- | Check the set for membership.

47-- | Check the set for membership.

108member :: Char -> FastSet -> Bool

48member :: Char -> FastSet -> Bool

109−member c a = go (2 * i)

49+member c (FastSet a) = uncurry search (A.bounds a)

110− where i = fastHash c .&. mask a

50+ where search lo hi

111− lookupAt j b = (i' <= i) && (c == c' || b)

51+ | hi < lo = False

112− where c' = toEnum $ AB.unsafeAt (table a) j

52+ | otherwise =

53+ let mid = (lo + hi) `quot` 2

113− i' = AB.unsafeAt (table a) $ j + 1

54+ in case compare c (AB.unsafeAt a mid) of

114− go j = lookupAt j . lookupAt (j + 2) . lookupAt (j + 4) .

55+ GT -> search (mid + 1) hi

115− lookupAt (j + 6) . go $ j + 8

56+ LT -> search lo (mid - 1)

57+ _ -> True

116

58

117charClass :: String -> FastSet

59charClass :: String -> FastSet

118charClass = fromList . go

60charClass = fromList . go

119− where go (a:'-':b:xs) = [a..b] ++ go xs

61+ where go (a:'-':b:xs) = [a..b] ++ go xs

120− go (x:xs) = x : go xs

62+ go (x:xs) = x : go xs

121− go _ = ""

63+ go _ = ""

Data/Attoparsec/Text/Internal.hs+125−132

@@ -3,14 +3,14 @@

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

4-- |

5-- Module : Data.Attoparsec.Text.Internal

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

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

7-- License : BSD3

8--

9-- Maintainer : bos@serpentine.com

10-- Stability : experimental

11-- Portability : unknown

12--

13−-- Simple, efficient parser combinators for 'Text' strings, loosely

13+-- Simple, efficient parser combinators for 'T.Text' strings, loosely

14-- based on the Parsec library.

15

16module Data.Attoparsec.Text.Internal

@@ -65,15 +65,11 @@ module Data.Attoparsec.Text.Internal

65 , atEnd

66 ) where

67

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

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

69import Control.Monad (when)

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

71−import Data.Attoparsec.Internal

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

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

73−import qualified Data.Attoparsec.Text.Buffer as Buf

72+import Data.Char (chr, ord)

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

75−import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)

76−import Data.List (intercalate)

77import Data.String (IsString(..))

73import Data.String (IsString(..))

78import Data.Text.Internal (Text(..))

74import Data.Text.Internal (Text(..))

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

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

@@ -83,10 +79,10 @@ import qualified Data.Text as T

83import qualified Data.Text.Lazy as L

79import qualified Data.Text.Lazy as L

84import qualified Data.Text.Unsafe as T

80import qualified Data.Text.Unsafe as T

85

81

86−type Parser = T.Parser Text

82+type Parser = T.Parser Text Text

87−type Result = IResult Text

83+type Result = IResult Text Text

88−type Failure r = T.Failure Text Buffer r

84+type Failure r = T.Failure Text Text r

89−type Success a r = T.Success Text Buffer a r

85+type Success a r = T.Success Text Text a r

90

86

91instance (a ~ Text) => IsString (Parser a) where

87instance (a ~ Text) => IsString (Parser a) where

92 fromString = string . T.pack

88 fromString = string . T.pack

@@ -157,49 +153,12 @@ take n = takeWith (max n 0) (const True)

157--

153--

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

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

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

155-- 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

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

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

162string :: Text -> Parser Text

158string :: Text -> Parser Text

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

159+string s = takeWith (T.length s) (==s)

164{-# INLINE string #-}

160{-# INLINE string #-}

165

161

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−

203-- | Satisfy a literal string, ignoring case.

162-- | Satisfy a literal string, ignoring case.

204--

163--

205-- Note: this function is currently quite inefficient. Unicode case

164-- Note: this function is currently quite inefficient. Unicode case

@@ -222,24 +181,34 @@ stringCI s = go 0

222

181

223-- | Satisfy a literal string, ignoring case for characters in the ASCII range.

182-- | Satisfy a literal string, ignoring case for characters in the ASCII range.

224asciiCI :: Text -> Parser Text

183asciiCI :: 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

226{-# INLINE asciiCI #-}

199{-# INLINE asciiCI #-}

227

200

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−

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

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

236skipWhile :: (Char -> Bool) -> Parser ()

202skipWhile :: (Char -> Bool) -> Parser ()

237skipWhile p = go

203skipWhile p = go

238 where

204 where

239 go = do

205 go = do

240 t <- T.takeWhile p <$> get

206 t <- T.takeWhile p <$> get

241− continue <- inputSpansChunks (size t)

207+ advance (lengthOf t)

242− when continue go

208+ eoc <- endOfChunk

209+ when eoc $ do

210+ input <- wantInput

211+ when input go

243{-# INLINE skipWhile #-}

212{-# INLINE skipWhile #-}

244

213

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

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

@@ -267,25 +236,19 @@ takeTill p = takeWhile (not . p)

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

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

268-- in an infinite loop.

237-- in an infinite loop.

269takeWhile :: (Char -> Bool) -> Parser Text

238takeWhile :: (Char -> Bool) -> Parser Text

270−takeWhile p = do

239+takeWhile p = (T.concat . reverse) `fmap` go []

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

281 where

240 where

282 go acc = do

241 go acc = do

283 h <- T.takeWhile p <$> get

242 h <- T.takeWhile p <$> get

284− continue <- inputSpansChunks (size h)

243+ advance (lengthOf h)

285− if continue

244+ eoc <- endOfChunk

245+ if eoc

246+ then do

247+ input <- wantInput

248+ if input

286− then go (h:acc)

249+ then go (h:acc)

287− else return $ concatReverse (h:acc)

250+ else return (h:acc)

288−{-# INLINE takeWhileAcc #-}

251+ else return (h:acc)

289

252

290takeRest :: Parser [Text]

253takeRest :: Parser [Text]

291takeRest = go []

254takeRest = go []

@@ -295,7 +258,7 @@ takeRest = go []

295 if input

258 if input

296 then do

259 then do

297 s <- get

260 s <- get

298− advance (size s)

261+ advance (lengthOf s)

299 go (s:acc)

262 go (s:acc)

300 else return (reverse acc)

263 else return (reverse acc)

301

264

@@ -308,7 +271,7 @@ takeLazyText :: Parser L.Text

308takeLazyText = L.fromChunks `fmap` takeRest

271takeLazyText = L.fromChunks `fmap` takeRest

309

272

310data Scan s = Continue s

273data Scan s = Continue s

311− | Finished s {-# UNPACK #-} !Int Text

274+ | Finished {-# UNPACK #-} !Int T.Text

312

275

313scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r

276scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r

314scan_ f s0 p = go [] s0

277scan_ f s0 p = go [] s0

@@ -317,17 +280,18 @@ scan_ f s0 p = go [] s0

317 case T.uncons t of

280 case T.uncons t of

318 Just (c,t') -> case p s c of

281 Just (c,t') -> case p s c of

319 Just s' -> scanner s' (n+1) t'

282 Just s' -> scanner s' (n+1) t'

320− Nothing -> Finished s n t

283+ Nothing -> Finished n t

321 Nothing -> Continue s

284 Nothing -> Continue s

322 go acc s = do

285 go acc s = do

323 input <- get

286 input <- get

324 case scanner s 0 input of

287 case scanner s 0 input of

325− Continue s' -> do continue <- inputSpansChunks (size input)

288+ Continue s' -> do advance (lengthOf input)

326− if continue

289+ more <- wantInput

290+ if more

327 then go (input : acc) s'

291 then go (input : acc) s'

328 else f s' (input : acc)

292 else f s' (input : acc)

329− Finished s' n t -> do advance (size input - size t)

293+ Finished n t -> do advance (lengthOf input - lengthOf t)

330− f s' (T.take n input : acc)

294+ f s (T.take n input : acc)

331{-# INLINE scan_ #-}

295{-# INLINE scan_ #-}

332

296

333-- | A stateful scanner. The predicate consumes and transforms a

297-- | A stateful scanner. The predicate consumes and transforms a

@@ -343,13 +307,16 @@ scan_ f s0 p = go [] s0

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

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

344-- in an infinite loop.

308-- in an infinite loop.

345scan :: s -> (s -> Char -> Maybe s) -> Parser Text

309scan :: 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

347{-# INLINE scan #-}

314{-# INLINE scan #-}

348

315

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

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

350-- scanner.

317-- scanner.

351runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)

318runScanner :: 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)

353{-# INLINE runScanner #-}

320{-# INLINE runScanner #-}

354

321

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

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

@@ -362,14 +329,13 @@ takeWhile1 :: (Char -> Bool) -> Parser Text

362takeWhile1 p = do

329takeWhile1 p = do

363 (`when` demandInput) =<< endOfChunk

330 (`when` demandInput) =<< endOfChunk

364 h <- T.takeWhile p <$> get

331 h <- T.takeWhile p <$> get

365− let size' = size h

332+ let len = lengthOf h

366− when (size' == 0) $ fail "takeWhile1"

333+ when (len == 0) $ fail "takeWhile1"

367− advance size'

334+ advance len

368 eoc <- endOfChunk

335 eoc <- endOfChunk

369 if eoc

336 if eoc

370− then takeWhileAcc p [h]

337+ then (h<>) `fmap` takeWhile p

371 else return h

338 else return h

372−{-# INLINE takeWhile1 #-}

373

339

374-- | Match any character in a set.

340-- | Match any character in a set.

375--

341--

@@ -418,13 +384,13 @@ peekChar :: Parser (Maybe Char)

418peekChar = T.Parser $ \t pos more _lose succ ->

384peekChar = T.Parser $ \t pos more _lose succ ->

419 case () of

385 case () of

420 _| pos < lengthOf t ->

386 _| pos < lengthOf t ->

421− let T.Iter !c _ = Buf.iter t (fromPos pos)

387+ let T.Iter !c _ = T.iter t (fromPos pos)

422 in succ t pos more (Just c)

388 in succ t pos more (Just c)

423 | more == Complete ->

389 | more == Complete ->

424 succ t pos more Nothing

390 succ t pos more Nothing

425 | otherwise ->

391 | otherwise ->

426 let succ' t' pos' more' =

392 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')

428 in succ t' pos' more' (Just c)

394 in succ t' pos' more' (Just c)

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

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

430 in prompt t pos more lose' succ'

396 in prompt t pos more lose' succ'

@@ -445,39 +411,30 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())

445

411

446-- | Terminal failure continuation.

412-- | Terminal failure continuation.

447failK :: Failure a

413failK :: 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

449{-# INLINE failK #-}

415{-# INLINE failK #-}

450

416

451-- | Terminal success continuation.

417-- | Terminal success continuation.

452successK :: Success a a

418successK :: 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

454{-# INLINE successK #-}

420{-# INLINE successK #-}

455

421

456-- | Run a parser.

422-- | Run a parser.

457parse :: Parser a -> Text -> Result a

423parse :: 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

459{-# INLINE parse #-}

425{-# INLINE parse #-}

460

426

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

427-- | 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−-- @

470parseOnly :: Parser a -> Text -> Either String a

428parseOnly :: Parser a -> Text -> Either String a

471−parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of

429+parseOnly m s = case runParser m s 0 Complete failK successK of

472− Fail _ [] err -> Left err

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

430+ Fail _ _ err -> Left err

474− Done _ a -> Right a

431+ Done _ a -> Right a

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

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

476{-# INLINE parseOnly #-}

433{-# INLINE parseOnly #-}

477

434

478get :: Parser Text

435get :: Parser Text

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

436get = 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)

481{-# INLINE get #-}

438{-# INLINE get #-}

482

439

483endOfChunk :: Parser Bool

440endOfChunk :: Parser Bool

@@ -485,21 +442,11 @@ endOfChunk = T.Parser $ \t pos more _lose succ ->

485 succ t pos more (pos == lengthOf t)

442 succ t pos more (pos == lengthOf t)

486{-# INLINE endOfChunk #-}

443{-# INLINE endOfChunk #-}

487

444

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−

498advance :: Pos -> Parser ()

445advance :: Pos -> Parser ()

499advance n = T.Parser $ \t pos more _lose succ -> succ t (pos+n) more ()

446advance n = T.Parser $ \t pos more _lose succ -> succ t (pos+n) more ()

500{-# INLINE advance #-}

447{-# INLINE advance #-}

501

448

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

449+ensureSuspended :: Int -> Text -> Pos -> More

503 -> Failure r -> Success (Pos, Text) r

450 -> Failure r -> Success (Pos, Text) r

504 -> Result r

451 -> Result r

505ensureSuspended n t pos more lose succ =

452ensureSuspended n t pos more lose succ =

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

517 Just n' -> succ t pos more (n', substring pos n' t)

464 Just n' -> succ t pos more (n', substring pos n' t)

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

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

519 Nothing -> ensureSuspended n t pos more lose succ

466 Nothing -> ensureSuspended n t pos more lose succ

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

520{-# INLINE ensure #-}

468{-# INLINE ensure #-}

521

469

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+

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

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

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

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

524match :: Parser a -> Parser (Text, a)

516match :: Parser a -> Parser (Text, a)

@@ -527,23 +519,24 @@ match p = T.Parser $ \t pos more lose succ ->

527 (substring pos (pos'-pos) t', a)

519 (substring pos (pos'-pos) t', a)

528 in runParser p t pos more lose succ'

520 in runParser p t pos more lose succ'

529

521

530−-- | Ensure that at least @n@ code points of input are available.

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

531−-- Returns the number of words consumed while traversing.

523+-- reached.

524+atEnd :: Parser Bool

525+atEnd = not <$> wantInput

526+{-# INLINE atEnd #-}

527+

532−lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos

528+lengthAtLeast :: Pos -> Int -> Text -> Maybe Pos

533lengthAtLeast pos n t = go 0 (fromPos pos)

529lengthAtLeast pos n t = go 0 (fromPos pos)

534 where go i !p

530 where go i !p

535 | i == n = Just (Pos p - pos)

531 | i == n = Just (Pos p - pos)

536 | p == len = Nothing

532 | p == len = Nothing

537− | otherwise = go (i+1) (p + Buf.iter_ t p)

533+ | otherwise = go (i+1) (p + T.iter_ t p)

538 Pos len = lengthOf t

534 Pos len = lengthOf t

539{-# INLINE lengthAtLeast #-}

535{-# INLINE lengthAtLeast #-}

540

536

541−substring :: Pos -> Pos -> Buffer -> Text

537+substring :: Pos -> Pos -> Text -> Text

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

538+substring (Pos pos) (Pos n) t = T.takeWord16 n (T.dropWord16 pos t)

543{-# INLINE substring #-}

539{-# INLINE substring #-}

544

540

545−lengthOf :: Buffer -> Pos

546−lengthOf = Pos . Buf.length

547−

548−size :: Text -> Pos

541+lengthOf :: Text -> Pos

549−size (Text _ _ l) = Pos l

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−

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

1{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}

7-- |

2-- |

8-- Module : Data.Attoparsec.Text.Lazy

3-- Module : Data.Attoparsec.Text.Lazy

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

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

10-- License : BSD3

5-- License : BSD3

11--

6--

12-- Maintainer : bos@serpentine.com

7-- Maintainer : bos@serpentine.com

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

41 ) where

36 ) where

42

37

43import Control.DeepSeq (NFData(rnf))

38import Control.DeepSeq (NFData(rnf))

44−import Data.List (intercalate)

45import Data.Text.Lazy.Internal (Text(..), chunk)

39import Data.Text.Lazy.Internal (Text(..), chunk)

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

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

47import qualified Data.Attoparsec.Text as A

41import qualified Data.Attoparsec.Text as A

@@ -51,16 +45,20 @@ import Data.Attoparsec.Text hiding (IResult(..), Result, eitherResult,

51

45

52-- | The result of a parse.

46-- | The result of a parse.

53data Result r = Fail Text [String] String

47data Result r = Fail Text [String] String

54− -- ^ The parse failed. The 'Text' is the input

48+ -- ^ The parse failed. The 'ByteString' is the input

55 -- that had not yet been consumed when the failure

49 -- that had not yet been consumed when the failure

56 -- occurred. The @[@'String'@]@ is a list of contexts

50 -- occurred. The @[@'String'@]@ is a list of contexts

57 -- in which the error occurred. The 'String' is the

51 -- in which the error occurred. The 'String' is the

58 -- message describing the error, if any.

52 -- message describing the error, if any.

59 | Done Text r

53 | Done Text r

60− -- ^ The parse succeeded. The 'Text' is the

54+ -- ^ The parse succeeded. The 'ByteString' is the

61 -- input that had not yet been consumed (if any) when

55 -- input that had not yet been consumed (if any) when

62 -- the parse succeeded.

56 -- 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

64

62

65instance NFData r => NFData (Result r) where

63instance NFData r => NFData (Result r) where

66 rnf (Fail bs ctxs msg) = rnf bs `seq` rnf ctxs `seq` rnf msg

64 rnf (Fail bs ctxs msg) = rnf bs `seq` rnf ctxs `seq` rnf msg

@@ -96,6 +94,5 @@ maybeResult _ = Nothing

96

94

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

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

98eitherResult :: Result r -> Either String r

96eitherResult :: Result r -> Either String r

99−eitherResult (Done _ r) = Right r

97+eitherResult (Done _ r) = Right r

100−eitherResult (Fail _ [] msg) = Left msg

98+eitherResult (Fail _ _ msg) = Left msg

101−eitherResult (Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)

Data/Attoparsec/Types.hs+2−3

@@ -1,6 +1,6 @@

1-- |

2-- Module : Data.Attoparsec.Types

3−-- Copyright : Bryan O'Sullivan 2007-2015

3+-- Copyright : Bryan O'Sullivan 2007-2014

4-- License : BSD3

5--

6-- Maintainer : bos@serpentine.com

@@ -14,7 +14,6 @@ module Data.Attoparsec.Types

14 (

15 Parser

16 , IResult(..)

17− , Chunk(chunkElemToChar)

18 ) where

17 ) where

19

18

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 #-}

1+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-} -- Data.ByteString.Unsafe

4−#endif

5−{-# LANGUAGE BangPatterns #-}

6

2

7-- |

3-- |

8-- Module : Data.Attoparsec.Zepto

4-- Module : Data.Attoparsec.Zepto

9−-- Copyright : Bryan O'Sullivan 2007-2015

5+-- Copyright : Bryan O'Sullivan 2007-2014

10-- License : BSD3

6-- License : BSD3

11--

7--

12-- Maintainer : bos@serpentine.com

8-- Maintainer : bos@serpentine.com

@@ -16,150 +12,112 @@

16-- A tiny, highly specialized combinator parser for 'B.ByteString'

12-- A tiny, highly specialized combinator parser for 'B.ByteString'

17-- strings.

13-- strings.

18--

14--

19−-- While the main attoparsec module generally performs well, this

15+-- While the main Attoparsec module generally performs well, this

20-- module is particularly fast for simple non-recursive loops that

16-- module is particularly fast for simple non-recursive loops that

21-- should not normally result in failed parses.

17-- should not normally result in failed parses.

22--

18--

23-- /Warning/: on more complex inputs involving recursion or failure,

19-- /Warning/: on more complex inputs involving recursion or failure,

24-- parsers based on this module may be as much as /ten times slower/

20-- 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

26-- have benchmarks that prove that its use speeds your code up.

22-- have benchmarks that prove that its use speeds your code up.

27module Data.Attoparsec.Zepto

23module Data.Attoparsec.Zepto

28 (

24 (

29 Parser

25 Parser

30− , ZeptoT

31 , parse

26 , parse

32− , parseT

33 , atEnd

27 , atEnd

34 , string

28 , string

35 , take

29 , take

36 , takeWhile

30 , takeWhile

37 ) where

31 ) where

38

32

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(..))

47import Data.Word (Word8)

33import Data.Word (Word8)

48−import Prelude hiding (take, takeWhile)

34+import Control.Applicative

35+import Control.Monad

36+import Data.Monoid

49import qualified Data.ByteString as B

37import qualified Data.ByteString as B

50import qualified Data.ByteString.Unsafe as B

38import qualified Data.ByteString.Unsafe as B

39+import Data.ByteString (ByteString)

40+import Prelude hiding (take, takeWhile)

51

41

52newtype S = S {

42newtype S = S {

53 input :: ByteString

43 input :: ByteString

54 }

44 }

55

45

56data Result a = Fail String

46data Result a = Fail String

57− | OK !a S

47+ | OK !a

58

48

59-- | A simple parser.

49-- | A simple parser.

60--

50--

61-- This monad is strict in its state, and the monadic bind operator

51-- This monad is strict in its state, and the monadic bind operator

62-- ('>>=') evaluates each result to weak head normal form before

52-- ('>>=') evaluates each result to weak head normal form before

63-- passing it along.

53-- passing it along.

64−newtype ZeptoT m a = Parser {

54+newtype Parser a = Parser {

65− runParser :: S -> m (Result a)

55+ runParser :: S -> (# Result a, S #)

66 }

56 }

67

57

68−type Parser a = ZeptoT Identity a

69−

70−instance Monad m => Functor (ZeptoT m) where

58+instance Functor Parser where

71− fmap f m = Parser $ \s -> do

59+ fmap f m = Parser $ \s -> case runParser m s of

72− result <- runParser m s

73− case result of

74− OK a s' -> return (OK (f a) s')

60+ (# OK a, s' #) -> (# OK (f a), s' #)

75− Fail err -> return (Fail err)

61+ (# Fail err, s' #) -> (# Fail err, s' #)

76 {-# INLINE fmap #-}

62 {-# INLINE fmap #-}

77

63

78−instance MonadIO m => MonadIO (ZeptoT m) where

64+instance Monad Parser where

79− liftIO act = Parser $ \s -> do

65+ return a = Parser $ \s -> (# OK a, s #)

80− result <- liftIO act

81− return (OK result s)

82− {-# INLINE liftIO #-}

83−

84−instance Monad m => Monad (ZeptoT m) where

85− return = pure

86 {-# INLINE return #-}

66 {-# INLINE return #-}

87

67

88− m >>= k = Parser $ \s -> do

68+ m >>= k = Parser $ \s -> case runParser m s of

89− result <- runParser m s

90− case result of

91− OK a s' -> runParser (k a) s'

69+ (# OK a, s' #) -> runParser (k a) s'

92− Fail err -> return (Fail err)

70+ (# Fail err, s' #) -> (# Fail err, s' #)

93 {-# INLINE (>>=) #-}

71 {-# INLINE (>>=) #-}

94

72

95−#if !(MIN_VERSION_base(4,13,0))

96− fail = Fail.fail

73+ fail msg = Parser $ \s -> (# Fail msg, s #)

97− {-# INLINE fail #-}

98−#endif

99

74

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

105 mzero = fail "mzero"

76 mzero = fail "mzero"

106 {-# INLINE mzero #-}

77 {-# INLINE mzero #-}

107

78

108− mplus a b = Parser $ \s -> do

79+ mplus a b = Parser $ \s ->

109− result <- runParser a s

80+ case runParser a s of

110− case result of

81+ (# ok@(OK _), s' #) -> (# ok, s' #)

82+ (# _, _ #) -> case runParser b s of

111− ok@(OK _ _) -> return ok

83+ (# ok@(OK _), s'' #) -> (# ok, s'' #)

112− _ -> runParser b s

84+ (# err, s'' #) -> (# err, s'' #)

113 {-# INLINE mplus #-}

85 {-# INLINE mplus #-}

114

86

115−instance (Monad m) => Applicative (ZeptoT m) where

87+instance Applicative Parser where

116− pure a = Parser $ \s -> return (OK a s)

88+ pure = return

117 {-# INLINE pure #-}

89 {-# INLINE pure #-}

118 (<*>) = ap

90 (<*>) = ap

119 {-# INLINE (<*>) #-}

91 {-# INLINE (<*>) #-}

120

92

121−gets :: Monad m => (S -> a) -> ZeptoT m a

93+gets :: (S -> a) -> Parser a

122−gets f = Parser $ \s -> return (OK (f s) s)

94+gets f = Parser $ \s -> (# OK (f s), s #)

123{-# INLINE gets #-}

95{-# INLINE gets #-}

124

96

125−put :: Monad m => S -> ZeptoT m ()

97+put :: S -> Parser ()

126−put s = Parser $ \_ -> return (OK () s)

98+put s = Parser $ \_ -> (# OK (), s #)

127{-# INLINE put #-}

99{-# INLINE put #-}

128

100

129-- | Run a parser.

101-- | Run a parser.

130parse :: Parser a -> ByteString -> Either String a

102parse :: Parser a -> ByteString -> Either String a

131−parse p bs = case runIdentity (runParser p (S bs)) of

103+parse p bs = case runParser p (S bs) of

132− (OK a _) -> Right a

104+ (# 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)

105+ (# Fail err, _ #) -> Left err

143−{-# INLINE parseT #-}

106+

144−

107+instance Monoid (Parser a) where

145−instance Monad m => Semigroup (ZeptoT m a) where

146− (<>) = mplus

147− {-# INLINE (<>) #-}

148−

149−instance Monad m => Mon.Monoid (ZeptoT m a) where

150 mempty = fail "mempty"

108 mempty = fail "mempty"

151 {-# INLINE mempty #-}

109 {-# INLINE mempty #-}

152− mappend = (<>)

110+ mappend = mplus

153 {-# INLINE mappend #-}

111 {-# INLINE mappend #-}

154

112

155−instance Monad m => Alternative (ZeptoT m) where

113+instance Alternative Parser where

156 empty = fail "empty"

114 empty = fail "empty"

157 {-# INLINE empty #-}

115 {-# INLINE empty #-}

158 (<|>) = mplus

116 (<|>) = mplus

159 {-# INLINE (<|>) #-}

117 {-# INLINE (<|>) #-}

160

118

161-- | Consume input while the predicate returns 'True'.

119-- | Consume input while the predicate returns 'True'.

162−takeWhile :: Monad m => (Word8 -> Bool) -> ZeptoT m ByteString

120+takeWhile :: (Word8 -> Bool) -> Parser ByteString

163takeWhile p = do

121takeWhile p = do

164 (h,t) <- gets (B.span p . input)

122 (h,t) <- gets (B.span p . input)

165 put (S t)

123 put (S t)

@@ -167,7 +125,7 @@ takeWhile p = do

167{-# INLINE takeWhile #-}

125{-# INLINE takeWhile #-}

168

126

169-- | Consume @n@ bytes of input.

127-- | Consume @n@ bytes of input.

170−take :: Monad m => Int -> ZeptoT m ByteString

128+take :: Int -> Parser ByteString

171take !n = do

129take !n = do

172 s <- gets input

130 s <- gets input

173 if B.length s >= n

131 if B.length s >= n

@@ -176,7 +134,7 @@ take !n = do

176{-# INLINE take #-}

134{-# INLINE take #-}

177

135

178-- | Match a string exactly.

136-- | Match a string exactly.

179−string :: Monad m => ByteString -> ZeptoT m ()

137+string :: ByteString -> Parser ()

180string s = do

138string s = do

181 i <- gets input

139 i <- gets input

182 if s `B.isPrefixOf` i

140 if s `B.isPrefixOf` i

@@ -185,7 +143,7 @@ string s = do

185{-# INLINE string #-}

143{-# INLINE string #-}

186

144

187-- | Indicate whether the end of the input has been reached.

145-- | Indicate whether the end of the input has been reached.

188−atEnd :: Monad m => ZeptoT m Bool

146+atEnd :: Parser Bool

189atEnd = do

147atEnd = do

190 i <- gets input

148 i <- gets input

191 return $! B.null i

149 return $! B.null i

README.markdown+6

@@ -16,6 +16,12 @@ Master [git repository](https://github.com/bos/attoparsec):

16

17* `git clone git://github.com/bos/attoparsec.git`

18

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+

19Authors

25Authors

20-------

26-------

21

27

attoparsec.cabal+27−83

@@ -1,13 +1,12 @@

1name: attoparsec

2−version: 0.13.2.2

2+version: 0.12.0.0

3−x-revision: 3

4license: BSD3

3license: BSD3

5license-file: LICENSE

4license-file: LICENSE

6category: Text, Parsing

5category: Text, Parsing

7author: Bryan O'Sullivan <bos@serpentine.com>

6author: 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>

9stability: experimental

8stability: 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

11synopsis: Fast combinator parsing for bytestrings and text

10synopsis: Fast combinator parsing for bytestrings and text

12cabal-version: >= 1.8

11cabal-version: >= 1.8

13homepage: https://github.com/bos/attoparsec

12homepage: https://github.com/bos/attoparsec

@@ -22,7 +21,6 @@ extra-source-files:

22 benchmarks/*.cabal

21 benchmarks/*.cabal

23 benchmarks/*.hs

22 benchmarks/*.hs

24 benchmarks/*.txt

23 benchmarks/*.txt

25− benchmarks/json-data/*.json

26 benchmarks/Makefile

24 benchmarks/Makefile

27 benchmarks/med.txt.bz2

25 benchmarks/med.txt.bz2

28 changelog.md

26 changelog.md

@@ -30,8 +28,9 @@ extra-source-files:

30 examples/*.hs

28 examples/*.hs

31 examples/Makefile

29 examples/Makefile

32 tests/*.hs

30 tests/*.hs

31+ tests/Makefile

33 tests/QC/*.hs

32 tests/QC/*.hs

34− tests/QC/IPv6/*.hs

33+ tests/TestFastSet.hs

35

34

36Flag developer

35Flag developer

37 Description: Whether to build the library in development mode

36 Description: Whether to build the library in development mode

@@ -40,21 +39,16 @@ Flag developer

40

39

41library

40library

42 build-depends: array,

41 build-depends: array,

43− base >= 4.3 && < 5,

42+ base >= 4.2 && < 5,

44 bytestring,

43 bytestring,

45 containers,

44 containers,

46 deepseq,

45 deepseq,

47 scientific >= 0.3.1 && < 0.4,

46 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

50 if impl(ghc < 7.4)

48 if impl(ghc < 7.4)

51 build-depends:

49 build-depends:

52− bytestring < 0.10.4.0

50+ bytestring < 0.10.4.0,

53−

51+ text < 1.1

54− if !impl(ghc >= 8.0)

55− -- Data.Semigroup && Control.Monad.Fail are available in base-4.9+

56− build-depends: fail == 4.9.*,

57− semigroups >=0.16.1 && <0.20

58

52

59 exposed-modules: Data.Attoparsec

53 exposed-modules: Data.Attoparsec

60 Data.Attoparsec.ByteString

54 Data.Attoparsec.ByteString

@@ -62,19 +56,17 @@ library

62 Data.Attoparsec.ByteString.Lazy

56 Data.Attoparsec.ByteString.Lazy

63 Data.Attoparsec.Char8

57 Data.Attoparsec.Char8

64 Data.Attoparsec.Combinator

58 Data.Attoparsec.Combinator

65− Data.Attoparsec.Internal

66− Data.Attoparsec.Internal.Types

67 Data.Attoparsec.Lazy

59 Data.Attoparsec.Lazy

68 Data.Attoparsec.Number

60 Data.Attoparsec.Number

69 Data.Attoparsec.Text

61 Data.Attoparsec.Text

70 Data.Attoparsec.Text.Lazy

62 Data.Attoparsec.Text.Lazy

71 Data.Attoparsec.Types

63 Data.Attoparsec.Types

72 Data.Attoparsec.Zepto

64 Data.Attoparsec.Zepto

73− other-modules: Data.Attoparsec.ByteString.Buffer

65+ other-modules: Data.Attoparsec.ByteString.FastSet

74− Data.Attoparsec.ByteString.FastSet

66+ Data.Attoparsec.ByteString.Fhthagn

75 Data.Attoparsec.ByteString.Internal

67 Data.Attoparsec.ByteString.Internal

76− Data.Attoparsec.Internal.Fhthagn

68+ Data.Attoparsec.Internal

77− Data.Attoparsec.Text.Buffer

69+ Data.Attoparsec.Internal.Types

78 Data.Attoparsec.Text.FastSet

70 Data.Attoparsec.Text.FastSet

79 Data.Attoparsec.Text.Internal

71 Data.Attoparsec.Text.Internal

80 ghc-options: -O2 -Wall

72 ghc-options: -O2 -Wall

@@ -85,37 +77,12 @@ library

85

77

86test-suite tests

78test-suite tests

87 type: exitcode-stdio-1.0

79 type: exitcode-stdio-1.0

88− hs-source-dirs: tests .

80+ hs-source-dirs: tests

89 main-is: QC.hs

81 main-is: QC.hs

90− other-modules: QC.Buffer

82+ other-modules: QC.ByteString

91− QC.ByteString

92 QC.Combinator

83 QC.Combinator

93 QC.Common

84 QC.Common

94− QC.IPv6.Internal

95− QC.IPv6.Types

96− QC.Rechunked

97− QC.Simple

98 QC.Text

85 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

119

86

120 ghc-options:

87 ghc-options:

121 -Wall -threaded -rtsopts

88 -Wall -threaded -rtsopts

@@ -124,41 +91,25 @@ test-suite tests

124 ghc-options: -Werror

91 ghc-options: -Werror

125

92

126 build-depends:

93 build-depends:

127− array,

94+ attoparsec,

128− base,

95+ base >= 4 && < 5,

129 bytestring,

96 bytestring,

130− deepseq >= 1.1,

131− QuickCheck >= 2.13.2 && < 2.14,

97+ QuickCheck >= 2.7,

132− quickcheck-unicode,

98+ test-framework >= 0.8.0.2,

133− scientific,

99+ test-framework-quickcheck2 >= 0.3.0.3,

134− tasty >= 0.11,

135− tasty-quickcheck >= 0.8,

136− text,

100+ 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

144

101

145benchmark benchmarks

102benchmark benchmarks

146 type: exitcode-stdio-1.0

103 type: exitcode-stdio-1.0

147− hs-source-dirs: benchmarks benchmarks/warp-3.0.1.1 .

104+ hs-source-dirs: benchmarks, .

148− ghc-options: -O2 -Wall -rtsopts

105+ ghc-options: -O2 -Wall

149 main-is: Benchmarks.hs

106 main-is: Benchmarks.hs

150 other-modules:

107 other-modules:

151 Common

108 Common

152 HeadersByteString

109 HeadersByteString

153− HeadersByteString.Atto

154 HeadersText

110 HeadersText

155 Links

111 Links

156− Network.Wai.Handler.Warp.ReadInt

157− Network.Wai.Handler.Warp.RequestHeader

158 Numbers

112 Numbers

159− Sets

160− TextFastSet

161− Warp

162 ghc-options: -O2 -Wall

113 ghc-options: -O2 -Wall

163

114

164 if flag(developer)

115 if flag(developer)

@@ -168,27 +119,20 @@ benchmark benchmarks

168 array,

119 array,

169 base == 4.*,

120 base == 4.*,

170 bytestring >= 0.10.4.0,

121 bytestring >= 0.10.4.0,

171− case-insensitive,

172− containers,

173− criterion >= 1.0,

122+ criterion >= 0.8.1.0,

174 deepseq >= 1.1,

123 deepseq >= 1.1,

175 directory,

124 directory,

176 filepath,

125 filepath,

177− ghc-prim,

178− http-types,

179 parsec >= 3.1.2,

126 parsec >= 3.1.2,

180 scientific,

127 scientific,

181 text >= 1.1.1.0,

128 text >= 1.1.1.0,

182− transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,

183 unordered-containers,

129 unordered-containers,

184 vector

130 vector

185

131

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−

191source-repository head

132source-repository head

192 type: git

133 type: git

193 location: https://github.com/bos/attoparsec

134 location: https://github.com/bos/attoparsec

194

135

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

10import Data.ByteString.Builder

11 (Builder, byteString, toLazyByteString, charUtf8, word8)

12

13−#if !MIN_VERSION_base(4,8,0)

14−import Control.Applicative ((*>), (<$>), (<*), pure)

13+import Control.Applicative ((*>), (<$>), (<*), liftA2, pure)

15−import Data.Monoid (mappend, mempty)

16−#endif

17−

18−import Common (pathTo)

19−import Control.Applicative (liftA2)

20import Control.DeepSeq (NFData(..))

14import Control.DeepSeq (NFData(..))

21import Control.Monad (forM)

15import Control.Monad (forM)

22import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,

16import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,

@@ -25,6 +19,7 @@ import Data.Bits ((.|.), shiftL)

25import Data.ByteString (ByteString)

19import Data.ByteString (ByteString)

26import Data.Char (chr)

20import Data.Char (chr)

27import Data.List (sort)

21import Data.List (sort)

22+import Data.Monoid (mappend, mempty)

28import Data.Scientific (Scientific)

23import Data.Scientific (Scientific)

29import Data.Text (Text)

24import Data.Text (Text)

30import Data.Text.Encoding (decodeUtf8')

25import Data.Text.Encoding (decodeUtf8')

@@ -345,7 +340,7 @@ toByteString = L.toStrict . toLazyByteString

345

340

346aeson :: IO Benchmark

341aeson :: IO Benchmark

347aeson = do

342aeson = do

348− path <- pathTo "json-data"

343+ let path = "json-data"

349 names <- sort . filter (`notElem` [".", ".."]) <$> getDirectoryContents path

344 names <- sort . filter (`notElem` [".", ".."]) <$> getDirectoryContents path

350 benches <- forM names $ \name -> do

345 benches <- forM names $ \name -> do

351 bs <- B.readFile (path </> name)

346 bs <- B.readFile (path </> name)

benchmarks/Benchmarks.hs−11

@@ -1,6 +1,5 @@

1{-# LANGUAGE BangPatterns, CPP #-}

2

3−import Common ()

4import Control.Applicative (many)

3import Control.Applicative (many)

5import Criterion.Main (bench, bgroup, defaultMain, nf)

4import Criterion.Main (bench, bgroup, defaultMain, nf)

6import Data.Bits

5import Data.Bits

@@ -11,9 +10,7 @@ import Numbers (numbers)

11import Common (chunksOf)

10import Common (chunksOf)

12import Text.Parsec.Text ()

11import Text.Parsec.Text ()

13import Text.Parsec.Text.Lazy ()

12import Text.Parsec.Text.Lazy ()

14−import qualified Warp

15import qualified Aeson

13import qualified Aeson

16−import qualified Genome

17import qualified Data.Attoparsec.ByteString as AB

14import qualified Data.Attoparsec.ByteString as AB

18import qualified Data.Attoparsec.ByteString.Char8 as AC

15import qualified Data.Attoparsec.ByteString.Char8 as AC

19import qualified Data.Attoparsec.ByteString.Lazy as ABL

16import qualified Data.Attoparsec.ByteString.Lazy as ABL

@@ -28,7 +25,6 @@ import qualified HeadersByteString

28import qualified HeadersText

25import qualified HeadersText

29import qualified Links

26import qualified Links

30import qualified Text.Parsec as P

27import qualified Text.Parsec as P

31−import qualified Sets

32

28

33main :: IO ()

29main :: IO ()

34main = do

30main = do

@@ -71,14 +67,10 @@ main = do

71 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl

67 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl

72 , bench "isAlpha_iso8859_15" $

68 , bench "isAlpha_iso8859_15" $

73 nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl

69 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

76 ]

70 ]

77 , bgroup "takeWhile1" [

71 , bgroup "takeWhile1" [

78 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl

72 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl

79 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile1 AC.isAlpha_ascii)) bl

73 , 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

82 ]

74 ]

83 , bench "word32LE" $ nf (AB.parse word32LE) b

75 , bench "word32LE" $ nf (AB.parse word32LE) b

84 , bgroup "scan" [

76 , bgroup "scan" [

@@ -86,13 +78,10 @@ main = do

86 , bench "long" $ nf (AB.parse quotedString) b

78 , bench "long" $ nf (AB.parse quotedString) b

87 ]

79 ]

88 , aeson

80 , aeson

89− , Genome.genome

90 , headersBS

81 , headersBS

91 , headersT

82 , headersT

92 , Links.links

83 , Links.links

93 , numbers

84 , numbers

94− , Sets.benchmarks

95− , Warp.benchmarks

96 ]

85 ]

97

86

98-- Benchmarks bind and (potential) bounds-check merging.

87-- Benchmarks bind and (potential) bounds-check merging.

benchmarks/Common.hs+1−25

@@ -1,21 +1,10 @@

1{-# LANGUAGE CPP #-}

2{-# OPTIONS_GHC -fno-warn-orphans #-}

3

4−module Common (

4+module Common (chunksOf) where

5− chunksOf

6− , pathTo

7− , rechunkBS

8− , rechunkT

9− ) where

10

5

11import Control.DeepSeq (NFData(rnf))

6import Control.DeepSeq (NFData(rnf))

12−import System.Directory (doesDirectoryExist)

13−import System.FilePath ((</>))

14import Text.Parsec (ParseError)

7import Text.Parsec (ParseError)

15−import qualified Data.ByteString as B

16−import qualified Data.ByteString.Lazy as BL

17−import qualified Data.Text as T

18−import qualified Data.Text.Lazy as TL

19

8

20#if !MIN_VERSION_bytestring(0,10,0)

9#if !MIN_VERSION_bytestring(0,10,0)

21import Data.ByteString.Internal (ByteString(..))

10import Data.ByteString.Internal (ByteString(..))

@@ -32,16 +21,3 @@ chunksOf k = go

32 where go xs = case splitAt k xs of

21 where go xs = case splitAt k xs of

33 ([],_) -> []

22 ([],_) -> []

34 (y, ys) -> y : go ys

23 (y, ys) -> y : go ys

35−

36−rechunkBS :: Int -> B.ByteString -> BL.ByteString

37−rechunkBS n = BL.fromChunks . map B.pack . chunksOf n . B.unpack

38−

39−rechunkT :: Int -> T.Text -> TL.Text

40−rechunkT 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+37−27

@@ -1,37 +1,47 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

1module HeadersByteString (headers) where

3module HeadersByteString (headers) where

2

4

3−import Common (pathTo, rechunkBS)

5+import Common ()

6+import Control.Applicative

4−import Criterion.Main (bench, bgroup, nf, nfIO)

7+import Criterion.Main (bench, bgroup, nf)

5import Criterion.Types (Benchmark)

8import Criterion.Types (Benchmark)

6−import HeadersByteString.Atto (request, response)

7−import Network.Wai.Handler.Warp.RequestHeader (parseHeaderLines)

8import qualified Data.Attoparsec.ByteString.Char8 as B

9import qualified Data.Attoparsec.ByteString.Char8 as B

9−import qualified Data.Attoparsec.ByteString.Lazy as BL

10import qualified Data.ByteString.Char8 as B

11

12−-- Note: In the benchmarks for parsing an http request

12+header = do

13−-- from a strict bytestring, we consider warp's implementation,

13+ name <- B.takeWhile1 (B.inClass "a-zA-Z0-9_-") <* B.char ':' <* B.skipSpace

14−-- which has highly optimized code for handling the first

14+ body <- (:) <$> bodyLine <*> many (B.takeWhile1 B.isSpace *> bodyLine)

15−-- line in particular. It's treatment of the headers

15+ return (name, body)

16−-- is more relaxed from the treatment they are given by the

16+

17−-- attoparsec parser benchmarked here. Consequently, it

17+bodyLine = B.takeTill (\c -> c == '\r' || c == '\n') <* B.endOfLine

18−-- is should not be possible to match its performance since

18+

19−-- it accepts header names with disallowed characters.

19+requestLine =

20+ (,,) <$>

21+ (method <* B.skipSpace) <*>

22+ (B.takeTill B.isSpace <* B.skipSpace) <*>

23+ httpVersion

24+ where method = "GET" <|> "POST"

25+

26+httpVersion = "HTTP/" *> ((,) <$> (int <* B.char '.') <*> int)

27+

28+responseLine = (,,) <$>

29+ (httpVersion <* B.skipSpace) <*>

30+ (int <* B.skipSpace) <*>

31+ bodyLine

32+

33+int :: B.Parser Int

34+int = B.decimal

35+

36+request = (,) <$> (requestLine <* B.endOfLine) <*> many header

37+

38+response = (,) <$> responseLine <*> many header

20

39

21headers :: IO Benchmark

40headers :: IO Benchmark

22headers = do

41headers = do

23− req <- B.readFile =<< pathTo "http-request.txt"

42+ req <- B.readFile "http-request.txt"

24− resp <- B.readFile =<< pathTo "http-response.txt"

43+ resp <- B.readFile "http-response.txt"

25− let reql = rechunkBS 4 req

26− respl = rechunkBS 4 resp

27− return $ bgroup "headers" [

44+ return $ bgroup "headersBS" [

28− bgroup "B" [

29− bench "request" $ nf (B.parseOnly request) req

45+ bench "request" $ nf (B.parseOnly request) req

30− , bench "warp" $ nfIO (parseHeaderLines (B.split '\n' req))

31− , bench "response" $ nf (B.parseOnly response) resp

46+ , bench "response" $ nf (B.parseOnly response) resp

32− ]

33− , bgroup "BL" [

34− bench "request" $ nf (BL.parse request) reql

35− , bench "response" $ nf (BL.parse response) respl

36− ]

37 ]

47 ]

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+5−15

@@ -2,13 +2,11 @@

2{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

3module HeadersText (headers) where

4

5−import Common (pathTo, rechunkT)

6import Control.Applicative

5import Control.Applicative

7import Criterion.Main (bench, bgroup, nf)

6import Criterion.Main (bench, bgroup, nf)

8import Criterion.Types (Benchmark)

7import Criterion.Types (Benchmark)

9import Data.Char (isSpace)

8import Data.Char (isSpace)

10import qualified Data.Attoparsec.Text as T

9import qualified Data.Attoparsec.Text as T

11−import qualified Data.Attoparsec.Text.Lazy as TL

12import qualified Data.Text.IO as T

10import qualified Data.Text.IO as T

13

11

14header = do

12header = do

@@ -41,17 +39,9 @@ response = (,) <$> responseLine <*> many header

41

39

42headers :: IO Benchmark

40headers :: IO Benchmark

43headers = do

41headers = do

44− req <- T.readFile =<< pathTo "http-request.txt"

42+ req <- T.readFile "http-request.txt"

45− resp <- T.readFile =<< pathTo "http-response.txt"

43+ resp <- T.readFile "http-response.txt"

46− let reql = rechunkT 4 req

47− respl = rechunkT 4 resp

48− return $ bgroup "headers" [

44+ return $ bgroup "headersT" [

49− bgroup "T" [

50− bench "request" $ nf (T.parseOnly request) req

45+ bench "request" $ nf (T.parseOnly request) req

51− , bench "response" $ nf (T.parseOnly response) resp

46+ , bench "response" $ nf (T.parseOnly response) resp

52− ]

53− , bgroup "TL" [

54− bench "request" $ nf (TL.parse request) reql

55− , bench "response" $ nf (TL.parse response) respl

56− ]

57 ]

47 ]

benchmarks/Links.hs+2−2

@@ -5,8 +5,8 @@ module Links (links) where

5import Control.Applicative

6import Control.DeepSeq (NFData(..))

7import Criterion.Main (Benchmark, bench, nf)

8−import Data.Attoparsec.ByteString as A

8+import Data.Attoparsec as A

9−import Data.Attoparsec.ByteString.Char8 as A8

9+import Data.Attoparsec.Char8 as A8

10import Data.ByteString.Char8 as B8

11

12data Link = Link {

benchmarks/Numbers.hs−1

@@ -1,5 +1,4 @@

1{-# LANGUAGE BangPatterns #-}

2−{-# OPTIONS_GHC -fno-warn-deprecations #-}

3

2

4module Numbers (numbers) where

3module Numbers (numbers) where

5

4

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

11 other-modules:

12 Common

13 HeadersByteString

14− HeadersByteString.Atto

15 HeadersText

14 HeadersText

16 Links

15 Links

17 Numbers

16 Numbers

18− Network.Wai.Handler.Warp.ReadInt

19− Sets

20− TextFastSet

21− Warp

22− hs-source-dirs: .. . warp-3.0.1.1

17+ hs-source-dirs: .. .

23− ghc-options: -O2 -Wall -rtsopts

18+ ghc-options: -O2 -Wall

24 build-depends:

19 build-depends:

25 array,

20 array,

26 base == 4.*,

21 base == 4.*,

27 bytestring >= 0.10.4.0,

22 bytestring >= 0.10.4.0,

28− case-insensitive,

29− containers,

30− criterion >= 1.0,

23+ criterion >= 0.8.1.0,

31 deepseq >= 1.1,

24 deepseq >= 1.1,

32 directory,

25 directory,

33 filepath,

26 filepath,

34− ghc-prim,

35− http-types,

36 parsec >= 3.1.2,

27 parsec >= 3.1.2,

37 scientific >= 0.3.1,

28 scientific >= 0.3.1,

38 text >= 1.1.1.0,

29 text >= 1.1.1.0,

39− transformers,

40 unordered-containers,

30 unordered-containers,

41 vector

31 vector

benchmarks/http-request.txt+8−3

@@ -1,9 +1,14 @@

1GET / HTTP/1.1

2Host: 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

4Accept-Encoding: gzip,deflate,sdch

5Accept-Encoding: gzip,deflate,sdch

5Accept-Language: en-GB,en-US;q=0.8,en;q=0.6

6Accept-Language: en-GB,en-US;q=0.8,en;q=0.6

6Cache-Control: max-age=0

7Cache-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+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)

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

12+ AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.86

13+ Safari/537.36

9

14

benchmarks/http-response.txt+4−2

@@ -3,8 +3,10 @@ Date: Fri, 09 May 2014 04:24:57 GMT

3Expires: -1

4Cache-Control: private, max-age=0

5Content-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

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

7−Set-Cookie: NID=67=-WlfaDG6VSEPk7abAjrK98HBSoCD2ID6JKkUR95tEumzDmg7Fc8pSQ8; expires=Sat, 08-Nov-2014 04:24:57 GMT; path=/; domain=.google.com; HttpOnly

8+Set-Cookie: NID=67=-WlfaDG6VSEPk7abAjrK98HBSoCD2ID6JKkUR95tEumzDmg7Fc8pSQ8;

9+ expires=Sat, 08-Nov-2014 04:24:57 GMT; path=/; domain=.google.com; HttpOnly

8P3P: CP="This is not a P3P policy! See http://www.google.com/support/accounts/bin/answer.py?hl=en&answer=151657 for more info."

10P3P: CP="This is not a P3P policy! See http://www.google.com/support/accounts/bin/answer.py?hl=en&answer=151657 for more info."

9Server: gws

11Server: gws

10X-XSS-Protection: 1; mode=block

12X-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−

720.12.0.0

10.12.0.0

73

2

74* A new internal representation makes almost all real-world parsers

3* A new internal representation makes almost all real-world parsers

examples/Makefile+2−6

@@ -1,4 +1,4 @@

1−CC := cc

1+CC := gcc

2CFLAGS := -O3 -Wall

3# To make the code about 6% faster:

4# CFLAGS += -fwhole-program --combine

@@ -12,8 +12,4 @@ c-http: rfc2616.c http_parser.c

12clean:

13 rm -f *.hi *.o c-http

14

15−http_parser.c: http_parser.h

15+vpath %.c $(HOME)/hg/http-parser

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

examples/Parsec_RFC2616.hs+6−9

@@ -23,16 +23,15 @@ token :: Stream s m Char => ParsecT s u m Char

23token = satisfy $ \c -> S.notMember (fromEnum c) set

24 where set = S.fromList . map fromEnum $ ['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255']

25

26−isHorizontalSpace :: Char -> Bool

27isHorizontalSpace c = c == ' ' || c == '\t'

26isHorizontalSpace c = c == ' ' || c == '\t'

28

27

29skipHSpaces :: Stream s m Char => ParsecT s u m ()

28skipHSpaces :: Stream s m Char => ParsecT s u m ()

30skipHSpaces = skipMany1 (satisfy isHorizontalSpace)

29skipHSpaces = skipMany1 (satisfy isHorizontalSpace)

31

30

32data Request = Request {

31data Request = Request {

33− _requestMethod :: String

32+ requestMethod :: String

34− , _requestUri :: String

33+ , requestUri :: String

35− , _requestProtocol :: String

34+ , requestProtocol :: String

36 } deriving (Eq, Ord, Show)

35 } deriving (Eq, Ord, Show)

37

36

38requestLine :: Stream s m Char => ParsecT s u m Request

37requestLine :: Stream s m Char => ParsecT s u m Request

@@ -48,8 +47,8 @@ endOfLine :: Stream s m Char => ParsecT s u m ()

48endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ())

47endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ())

49

48

50data Header = Header {

49data Header = Header {

51− _headerName :: String

50+ headerName :: String

52− , _headerValue :: [String]

51+ , headerValue :: [String]

53 } deriving (Eq, Ord, Show)

52 } deriving (Eq, Ord, Show)

54

53

55messageHeader :: Stream s m Char => ParsecT s u m Header

54messageHeader :: Stream s m Char => ParsecT s u m Header

@@ -62,16 +61,14 @@ messageHeader = do

62request :: Stream s m Char => ParsecT s u m (Request, [Header])

61request :: Stream s m Char => ParsecT s u m (Request, [Header])

63request = (,) <$> requestLine <*> many messageHeader <* endOfLine

62request = (,) <$> requestLine <*> many messageHeader <* endOfLine

64

63

65−listy :: FilePath -> IO ()

66listy arg = do

64listy arg = do

67 r <- parseFromFile (many request) arg

65 r <- parseFromFile (many request) arg

68 case r of

66 case r of

69 Left err -> putStrLn $ arg ++ ": " ++ show err

67 Left err -> putStrLn $ arg ++ ": " ++ show err

70 Right rs -> print (length rs)

68 Right rs -> print (length rs)

71

69

72−chunky :: FilePath -> IO ()

73chunky arg = bracket (openFile arg ReadMode) hClose $ \h ->

70chunky arg = bracket (openFile arg ReadMode) hClose $ \h ->

74− loop (0::Int) =<< B.hGetContents h

71+ loop 0 =<< B.hGetContents h

75 where

72 where

76 loop !n bs

73 loop !n bs

77 | B.null bs = print n

74 | B.null bs = print n

examples/RFC2616.hs+49−24

@@ -5,61 +5,86 @@ module RFC2616

5 Header(..)

6 , Request(..)

7 , Response(..)

8+ , isToken

9+ , messageHeader

8 , request

10 , request

11+ , requestLine

9 , response

12 , response

13+ , responseLine

14+ , lowerHeader

15+ , lookupHeader

10 ) where

16 ) where

11

17

12import Control.Applicative

18import Control.Applicative

13−import Data.Attoparsec.ByteString as P

19+import Data.Attoparsec as P

20+import qualified Data.Attoparsec.Char8 as P8

14−import Data.Attoparsec.ByteString.Char8 (char8, endOfLine, isDigit_w8)

21+import Data.Attoparsec.Char8 (char8, endOfLine, isDigit_w8)

15−import Data.ByteString (ByteString)

16import Data.Word (Word8)

22import 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)

18

25

19isToken :: Word8 -> Bool

26isToken :: Word8 -> Bool

20isToken w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w

27isToken w = w <= 127 && notInClass "\0-\31()<>@,;:\\\"/[]?={} \t" w

21

28

22skipSpaces :: Parser ()

29skipSpaces :: Parser ()

23−skipSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace

30+skipSpaces = satisfy P8.isHorizontalSpace *> skipWhile P8.isHorizontalSpace

24

31

25data Request = Request {

32data Request = Request {

26− requestMethod :: ByteString

33+ requestMethod :: !B.ByteString

27− , requestUri :: ByteString

34+ , requestUri :: !B.ByteString

28− , requestVersion :: ByteString

35+ , requestVersion :: !B.ByteString

29 } deriving (Eq, Ord, Show)

36 } deriving (Eq, Ord, Show)

30

37

31−httpVersion :: Parser ByteString

38+httpVersion :: Parser B.ByteString

32httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)

39httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)

33

40

34requestLine :: Parser Request

41requestLine :: Parser Request

42+requestLine = do

35−requestLine = Request <$> (takeWhile1 isToken <* char8 ' ')

43+ method <- P.takeWhile1 isToken <* char8 ' '

36− <*> (takeWhile1 (/=32) <* char8 ' ')

44+ uri <- P.takeWhile1 (/=32) <* char8 ' '

37− <*> (httpVersion <* endOfLine)

45+ version <- httpVersion <* endOfLine

46+ return $! Request method uri version

38

47

39data Header = Header {

48data Header = Header {

40− headerName :: ByteString

49+ headerName :: !B.ByteString

41− , headerValue :: [ByteString]

50+ , headerValue :: [B.ByteString]

42 } deriving (Eq, Ord, Show)

51 } deriving (Eq, Ord, Show)

43

52

44messageHeader :: Parser Header

53messageHeader :: Parser Header

45−messageHeader = Header

54+messageHeader = do

46− <$> (P.takeWhile isToken <* char8 ':' <* skipWhile isHorizontalSpace)

55+ header <- P.takeWhile isToken <* char8 ':' <* skipWhile P8.isHorizontalSpace

47− <*> ((:) <$> (takeTill isEndOfLine <* endOfLine)

56+ body <- takeTill P8.isEndOfLine <* endOfLine

48− <*> (many $ skipSpaces *> takeTill isEndOfLine <* endOfLine))

57+ bodies <- many $ skipSpaces *> takeTill P8.isEndOfLine <* endOfLine

58+ return $! Header header (body:bodies)

49

59

50request :: Parser (Request, [Header])

60request :: Parser (Request, [Header])

51request = (,) <$> requestLine <*> many messageHeader <* endOfLine

61request = (,) <$> requestLine <*> many messageHeader <* endOfLine

52

62

53data Response = Response {

63data Response = Response {

54− responseVersion :: ByteString

64+ responseVersion :: !B.ByteString

55− , responseCode :: ByteString

65+ , responseCode :: !B.ByteString

56− , responseMsg :: ByteString

66+ , responseMsg :: !B.ByteString

57 } deriving (Eq, Ord, Show)

67 } deriving (Eq, Ord, Show)

58

68

59responseLine :: Parser Response

69responseLine :: Parser Response

70+responseLine = do

60−responseLine = Response <$> (httpVersion <* char8 ' ')

71+ version <- httpVersion <* char8 ' '

61− <*> (P.takeWhile isDigit_w8 <* char8 ' ')

72+ code <- P.takeWhile isDigit_w8 <* char8 ' '

62− <*> (takeTill isEndOfLine <* endOfLine)

73+ msg <- P.takeTill P8.isEndOfLine <* endOfLine

74+ return $! Response version code msg

63

75

64response :: Parser (Response, [Header])

76response :: Parser (Response, [Header])

65response = (,) <$> responseLine <*> many messageHeader <* endOfLine

77response = (,) <$> 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 @@

1{-# 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

9import RFC2616

2import RFC2616

10−import System.Environment

3+import Control.Monad (forM_)

11import System.IO

4import System.IO

5+import Control.Exception (bracket)

6+import System.Environment

12import qualified Data.ByteString.Char8 as B

7import qualified Data.ByteString.Char8 as B

8+import Data.Attoparsec

13

9

14−refill :: Handle -> IO B.ByteString

15−refill h = B.hGet h (80*1024)

10+refill h = B.hGet h (4*1024)

16

11

17−listy :: FilePath -> Handle -> IO ()

18listy file h = do

12listy file h = do

19 r <- parseWith (refill h) (many request) =<< refill h

13 r <- parseWith (refill h) (many request) =<< refill h

20 case r of

14 case r of

21 Fail _ _ msg -> hPutStrLn stderr $ file ++ ": " ++ msg

15 Fail _ _ msg -> hPutStrLn stderr $ file ++ ": " ++ msg

22 Done _ reqs -> print (length reqs)

16 Done _ reqs -> print (length reqs)

23−

17+

24−incrementy :: FilePath -> Handle -> IO ()

25−incrementy file h = go (0::Int) =<< refill h

18+incrementy file h = go 0 =<< refill h

26 where

19 where

27 go !n is = do

20 go !n is = do

28 r <- parseWith (refill h) request is

21 r <- parseWith (refill h) request is

@@ -35,8 +28,7 @@ incrementy file h = go (0::Int) =<< refill h

35 then print (n+1)

28 then print (n+1)

36 else go (n+1) s

29 else go (n+1) s

37 | otherwise -> go (n+1) bs

30 | otherwise -> go (n+1) bs

38−

31+

39−main :: IO ()

40main = do

32main = do

41 args <- getArgs

33 args <- getArgs

42 forM_ args $ \arg ->

34 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 @@

1/*

2− * This is a simple driver for the http-parser package. It is

2+ * This is a simple driver for Ryan Dahl's hand-bummed C http-parser

3− * intended to read one HTTP request after another from a file,

3+ * package. It is intended to read one HTTP request after another

4− * nothing more.

4+ * from a file, nothing more.

5 *

6 * For "feature parity" with the Haskell code in RFC2616.hs, we

7 * allocate and populate a simple structure describing each request,

8 * since that's the sort of thing that many real applications would

9 * themselves do and the library doesn't do this for us.

10 *

11− * For the http-parser source, see

11+ * For the http-parser source, see http://github.com/ry/http-parser/

12− * https://github.com/joyent/http-parser/blob/master/http_parser.c

13 */

12 */

14

13

15/*

14/*

16 * Turn off this preprocessor symbol to have the callbacks do nothing

15 * Turn off this preprocessor symbol to have the callbacks do nothing

17 * at all, which "improves performance" by about 50%.

16 * at all, which "improves performance" by about 50%.

18 */

17 */

19−/*#define LOOK_BUSY*/

18+#define LOOK_BUSY

20

19

21#include <assert.h>

20#include <assert.h>

22#include <fcntl.h>

21#include <fcntl.h>

@@ -28,18 +27,18 @@

28#include <unistd.h>

27#include <unistd.h>

29

28

30#include "http_parser.h"

29#include "http_parser.h"

31−

30+

32struct http_string {

31struct http_string {

33 size_t len;

32 size_t len;

34 char value[0];

33 char value[0];

35};

34};

36−

35+

37struct http_header {

36struct http_header {

38 struct http_string *name;

37 struct http_string *name;

39 struct http_string *value;

38 struct http_string *value;

40 struct http_header *next;

39 struct http_header *next;

41};

40};

42−

41+

43struct http_request {

42struct http_request {

44 struct http_string *method;

43 struct http_string *method;

45 struct http_string *uri;

44 struct http_string *uri;

@@ -50,7 +49,7 @@ struct data {

50 size_t count;

49 size_t count;

51 struct http_request req;

50 struct http_request req;

52};

51};

53−

52+

54static void *xmalloc(size_t size)

53static void *xmalloc(size_t size)

55{

54{

56 void *ptr;

55 void *ptr;

@@ -79,7 +78,7 @@ static void xstrcat(struct http_string **dst, const char *src, size_t len)

79 *dst = xstrdup(src, len, 0);

78 *dst = xstrdup(src, len, 0);

80 return;

79 return;

81 }

80 }

82−

81+

83 p = xstrdup((*dst)->value, (*dst)->len, len);

82 p = xstrdup((*dst)->value, (*dst)->len, len);

84 memcpy(p->value + (*dst)->len, src, len);

83 memcpy(p->value + (*dst)->len, src, len);

85 p->len += len;

84 p->len += len;

@@ -99,7 +98,7 @@ static int begin(http_parser *p)

99static int url(http_parser *p, const char *at, size_t len)

98static int url(http_parser *p, const char *at, size_t len)

100{

99{

101#ifdef LOOK_BUSY

100#ifdef LOOK_BUSY

102− struct data *data = p->data;

101+ struct data *data = p->data;

103

102

104 xstrcat(&data->req.uri, at, len);

103 xstrcat(&data->req.uri, at, len);

105#endif

104#endif

@@ -120,7 +119,7 @@ static int header_field(http_parser *p, const char *at, size_t len)

120 hdr->name = xstrdup(at, len, 0);

119 hdr->name = xstrdup(at, len, 0);

121 hdr->value = NULL;

120 hdr->value = NULL;

122 hdr->next = NULL;

121 hdr->next = NULL;

123−

122+

124 if (data->req.last != NULL)

123 if (data->req.last != NULL)

125 data->req.last->next = hdr;

124 data->req.last->next = hdr;

126 data->req.last = hdr;

125 data->req.last = hdr;

@@ -151,7 +150,7 @@ static int complete(http_parser *p)

151

150

152 free(data->req.method);

151 free(data->req.method);

153 free(data->req.uri);

152 free(data->req.uri);

154−

153+

155 for (hdr = data->req.headers; hdr != NULL; hdr = next) {

154 for (hdr = data->req.headers; hdr != NULL; hdr = next) {

156 next = hdr->next;

155 next = hdr->next;

157 free(hdr->name);

156 free(hdr->name);

@@ -165,7 +164,7 @@ static int complete(http_parser *p)

165 data->req.headers = NULL;

164 data->req.headers = NULL;

166 data->req.last = NULL;

165 data->req.last = NULL;

167#endif

166#endif

168−

167+

169 /* Bludgeon http_parser into understanding that we really want to

168 /* Bludgeon http_parser into understanding that we really want to

170 * keep parsing after a request that in principle ought to close

169 * keep parsing after a request that in principle ought to close

171 * the "connection". */

170 * the "connection". */

@@ -181,21 +180,16 @@ static int complete(http_parser *p)

181static void parse(const char *path, int fd)

180static void parse(const char *path, int fd)

182{

181{

183 struct data data;

182 struct data data;

184− http_parser_settings s;

185 http_parser p;

183 http_parser p;

186 ssize_t nread;

184 ssize_t nread;

187

185

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−

197 http_parser_init(&p, HTTP_REQUEST);

186 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;

199 data.count = 0;

193 data.count = 0;

200 data.req.method = NULL;

194 data.req.method = NULL;

201 data.req.uri = NULL;

195 data.req.uri = NULL;

@@ -208,7 +202,7 @@ static void parse(const char *path, int fd)

208

202

209 nread = read(fd, buf, sizeof(buf));

203 nread = read(fd, buf, sizeof(buf));

210

204

211− np = http_parser_execute(&p, &s, buf, nread);

205+ np = http_parser_execute(&p, buf, nread);

212 if (np != nread) {

206 if (np != nread) {

213 fprintf(stderr, "%s: parse failed\n", path);

207 fprintf(stderr, "%s: parse failed\n", path);

214 break;

208 break;

tests/Makefilenew file+14

@@ -0,0 +1,14 @@

1+all: TestFastSet.out qc.out

2+

3+%.out: %.exe

4+ ./$< | tee $<.tmp

5+ mv $<.tmp $@

6+

7+qc.exe: QC.hs

8+ ghc -O -fno-warn-orphans --make -o $@ $<

9+

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 @@

1{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

2module Main (main) where

3

4−import qualified QC.Buffer as Buffer

5import qualified QC.ByteString as ByteString

4import qualified QC.ByteString as ByteString

6import qualified QC.Combinator as Combinator

5import qualified QC.Combinator as Combinator

7−import qualified QC.Simple as Simple

8import qualified QC.Text as Text

6import qualified QC.Text as Text

9−import Test.Tasty (defaultMain, testGroup)

7+import Test.Framework (defaultMain, testGroup)

10

8

11main = defaultMain tests

9main = defaultMain tests

12

10

13−tests = testGroup "tests" [

11+tests = [

14 testGroup "bs" ByteString.tests

12 testGroup "bs" ByteString.tests

15− , testGroup "buf" Buffer.tests

16 , testGroup "combinator" Combinator.tests

13 , testGroup "combinator" Combinator.tests

17− , testGroup "simple" Simple.tests

18 , testGroup "text" Text.tests

14 , testGroup "text" Text.tests

19 ]

15 ]

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+65−99

@@ -1,163 +1,133 @@

1−{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}

1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}

2module QC.ByteString (tests) where

3

4−#if !MIN_VERSION_base(4,8,0)

5−import Control.Applicative ((<*>), (<$>))

4+import Control.Applicative ((<$>), (<*>))

6−#endif

7−import Data.Char (chr, ord, toUpper)

5+import Data.Char (chr, ord)

8import Data.Int (Int64)

6import Data.Int (Int64)

9import Data.Word (Word8)

7import Data.Word (Word8)

10import Prelude hiding (take, takeWhile)

8import Prelude hiding (take, takeWhile)

11−import QC.Common (ASCII(..), liftOp, parseBS, toStrictBS)

9+import QC.Common (parseBS, toStrictBS)

12−import Test.Tasty (TestTree)

10+import Test.Framework (Test)

13−import Test.Tasty.QuickCheck (testProperty)

11+import Test.Framework.Providers.QuickCheck2 (testProperty)

14import Test.QuickCheck

12import Test.QuickCheck

15import qualified Data.Attoparsec.ByteString as P

13import qualified Data.Attoparsec.ByteString as P

16import qualified Data.Attoparsec.ByteString.Char8 as P8

14import qualified Data.Attoparsec.ByteString.Char8 as P8

17−import qualified Data.Attoparsec.ByteString.FastSet as S

18import qualified Data.Attoparsec.ByteString.Lazy as PL

15import qualified Data.Attoparsec.ByteString.Lazy as PL

19import qualified Data.ByteString as B

16import qualified Data.ByteString as B

20−import qualified Data.ByteString.Char8 as B8

21import qualified Data.ByteString.Lazy as L

17import qualified Data.ByteString.Lazy as L

22import qualified Data.ByteString.Lazy.Char8 as L8

18import qualified Data.ByteString.Lazy.Char8 as L8

23

19

24-- Basic byte-level combinators.

20-- Basic byte-level combinators.

25

21

26−satisfy :: Word8 -> L.ByteString -> Property

22+satisfy :: Word8 -> L.ByteString -> Bool

27−satisfy w s = parseBS (P.satisfy (<=w)) (L.cons w s) === Just w

23+satisfy w s = parseBS (P.satisfy (<=w)) (L.cons w s) == Just w

28

24

29−satisfyWith :: Word8 -> L.ByteString -> Property

25+satisfyWith :: Char -> L.ByteString -> Bool

30−satisfyWith w s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))

26+satisfyWith c s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))

31− (L.cons (fromIntegral (ord c)) s) === Just c

27+ (L.cons (fromIntegral (ord c)) s) == Just c

32− where

33− c = chr (fromIntegral w)

34

28

35−word8 :: Word8 -> L.ByteString -> Property

29+word8 :: Word8 -> L.ByteString -> Bool

36−word8 w s = parseBS (P.word8 w) (L.cons w s) === Just w

30+word8 w s = parseBS (P.word8 w) (L.cons w s) == Just w

37

31

38−skip :: Word8 -> L.ByteString -> Property

32+skip :: Word8 -> L.ByteString -> Bool

39skip w s =

33skip w s =

40 case (parseBS (P.skip (<w)) s, L.uncons s) of

34 case (parseBS (P.skip (<w)) s, L.uncons s) of

41− (Nothing, mcs) -> maybe (property True) (expectFailure . it) mcs

35+ (Nothing, mcs) -> maybe True (not . it) mcs

42− (Just _, mcs) -> maybe (property False) it mcs

36+ (Just _, mcs) -> maybe False it mcs

43− where it cs = liftOp "<" (<) (fst cs) w

37+ where it cs = fst cs < w

44

38

45−anyWord8 :: L.ByteString -> Property

39+anyWord8 :: L.ByteString -> Bool

46anyWord8 s

40anyWord8 s

47− | L.null s = p === Nothing

41+ | L.null s = p == Nothing

48− | otherwise = p === Just (L.head s)

42+ | otherwise = p == Just (L.head s)

49 where p = parseBS P.anyWord8 s

43 where p = parseBS P.anyWord8 s

50

44

51−notWord8 :: Word8 -> NonEmptyList Word8 -> Property

45+notWord8 :: Word8 -> NonEmptyList Word8 -> Bool

52−notWord8 w (NonEmpty s) = parseBS (P.notWord8 w) bs === if v == w

46+notWord8 w (NonEmpty s) = parseBS (P.notWord8 w) bs == if v == w

53− then Nothing

47+ then Nothing

54− else Just v

48+ else Just v

55 where v = L.head bs

49 where v = L.head bs

56 bs = L.pack s

50 bs = L.pack s

57

51

58−peekWord8 :: L.ByteString -> Property

52+peekWord8 :: L.ByteString -> Bool

59peekWord8 s

53peekWord8 s

60− | L.null s = p === Just (Nothing, s)

54+ | L.null s = p == Just (Nothing, s)

61− | otherwise = p === Just (Just (L.head s), s)

55+ | otherwise = p == Just (Just (L.head s), s)

62 where p = parseBS ((,) <$> P.peekWord8 <*> P.takeLazyByteString) s

56 where p = parseBS ((,) <$> P.peekWord8 <*> P.takeLazyByteString) s

63

57

64−peekWord8' :: L.ByteString -> Property

58+peekWord8' :: L.ByteString -> Bool

65−peekWord8' s = parseBS P.peekWord8' s === (fst <$> L.uncons s)

59+peekWord8' s = parseBS P.peekWord8' s == (fst <$> L.uncons s)

66

60

67−string :: L.ByteString -> L.ByteString -> Property

61+string :: L.ByteString -> L.ByteString -> Bool

68−string s t = parseBS (P.string s') (s `L.append` t) === Just s'

62+string s t = parseBS (P.string s') (s `L.append` t) == Just s'

69 where s' = toStrictBS s

63 where s' = toStrictBS s

70

64

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−

83−skipWhile :: Word8 -> L.ByteString -> Property

65+skipWhile :: Word8 -> L.ByteString -> Bool

84skipWhile w s =

66skipWhile w s =

85 let t = L.dropWhile (<=w) s

67 let t = L.dropWhile (<=w) s

86 in case PL.parse (P.skipWhile (<=w)) s of

68 in case PL.parse (P.skipWhile (<=w)) s of

87− PL.Done t' () -> t === t'

69+ PL.Done t' () -> t == t'

88− _ -> property False

70+ _ -> False

89

71

90−takeCount :: Positive Int -> L.ByteString -> Property

72+takeCount :: Positive Int -> L.ByteString -> Bool

91takeCount (Positive k) s =

73takeCount (Positive k) s =

92 case parseBS (P.take k) s of

74 case parseBS (P.take k) s of

93− Nothing -> liftOp ">" (>) (fromIntegral k) (L.length s)

75+ Nothing -> fromIntegral k > L.length s

94− Just _s -> liftOp "<=" (<=) (fromIntegral k) (L.length s)

76+ Just _s -> fromIntegral k <= L.length s

95

77

96−takeWhile :: Word8 -> L.ByteString -> Property

78+takeWhile :: Word8 -> L.ByteString -> Bool

97takeWhile w s =

79takeWhile w s =

98 let (h,t) = L.span (==w) s

80 let (h,t) = L.span (==w) s

99 in case PL.parse (P.takeWhile (==w)) s of

81 in case PL.parse (P.takeWhile (==w)) s of

100− PL.Done t' h' -> t === t' .&&. toStrictBS h === h'

82+ PL.Done t' h' -> t == t' && toStrictBS h == h'

101− _ -> property False

83+ _ -> False

102

84

103−take :: Int -> L.ByteString -> Property

85+take :: Int -> L.ByteString -> Bool

104−take n s = maybe (property $ L.length s < fromIntegral n)

86+take n s = maybe (L.length s < fromIntegral n) (== B.take n (toStrictBS s)) $

105− (=== B.take n (toStrictBS s)) $

106 parseBS (P.take n) s

87 parseBS (P.take n) s

107

88

108−takeByteString :: L.ByteString -> Property

89+takeByteString :: L.ByteString -> Bool

109−takeByteString s = maybe (property False) (=== toStrictBS s) .

90+takeByteString s = maybe False (== toStrictBS s) . parseBS P.takeByteString $ s

110− parseBS P.takeByteString $ s

111

91

112−takeLazyByteString :: L.ByteString -> Property

92+takeLazyByteString :: L.ByteString -> Bool

113−takeLazyByteString s = maybe (property False) (=== s) .

114− parseBS P.takeLazyByteString $ s

93+takeLazyByteString s = maybe False (== s) . parseBS P.takeLazyByteString $ s

115

94

116−takeWhile1 :: Word8 -> L.ByteString -> Property

95+takeWhile1 :: Word8 -> L.ByteString -> Bool

117takeWhile1 w s =

96takeWhile1 w s =

118 let s' = L.cons w s

97 let s' = L.cons w s

119 (h,t) = L.span (<=w) s'

98 (h,t) = L.span (<=w) s'

120 in case PL.parse (P.takeWhile1 (<=w)) s' of

99 in case PL.parse (P.takeWhile1 (<=w)) s' of

121− PL.Done t' h' -> t === t' .&&. toStrictBS h === h'

100+ PL.Done t' h' -> t == t' && toStrictBS h == h'

122− _ -> property False

101+ _ -> False

123

102

124−takeTill :: Word8 -> L.ByteString -> Property

103+takeTill :: Word8 -> L.ByteString -> Bool

125takeTill w s =

104takeTill w s =

126 let (h,t) = L.break (==w) s

105 let (h,t) = L.break (==w) s

127 in case PL.parse (P.takeTill (==w)) s of

106 in case PL.parse (P.takeTill (==w)) s of

128− PL.Done t' h' -> t === t' .&&. toStrictBS h === h'

107+ PL.Done t' h' -> t == t' && toStrictBS h == h'

129− _ -> property False

108+ _ -> False

130

109

131−takeWhile1_empty :: Property

110+takeWhile1_empty :: Bool

132−takeWhile1_empty = parseBS (P.takeWhile1 undefined) L.empty === Nothing

111+takeWhile1_empty = parseBS (P.takeWhile1 undefined) L.empty == Nothing

133

112

134−endOfInput :: L.ByteString -> Property

113+endOfInput :: L.ByteString -> Bool

135−endOfInput s = parseBS P.endOfInput s === if L.null s

114+endOfInput s = parseBS P.endOfInput s == if L.null s

136− then Just ()

115+ then Just ()

137− else Nothing

116+ else Nothing

138

117

139−endOfLine :: L.ByteString -> Property

118+endOfLine :: L.ByteString -> Bool

140endOfLine s =

119endOfLine s =

141 case (parseBS P8.endOfLine s, L8.uncons s) of

120 case (parseBS P8.endOfLine s, L8.uncons s) of

142− (Nothing, mcs) -> maybe (property True) (expectFailure . eol) mcs

121+ (Nothing, mcs) -> maybe True (not . eol) mcs

143− (Just _, mcs) -> maybe (property False) eol mcs

122+ (Just _, mcs) -> maybe False eol mcs

144− where eol (c,s') = c === '\n' .||.

145− (c, fst <$> L8.uncons s') === ('\r', Just '\n')

123+ where eol (c,s') = c == '\n' || (c, fst <$> L8.uncons s') == ('\r', Just '\n')

146

124

147−scan :: L.ByteString -> Positive Int64 -> Property

125+scan :: L.ByteString -> Positive Int64 -> Bool

148−scan s (Positive k) = parseBS p s === Just (toStrictBS $ L.take k s)

126+scan s (Positive k) = parseBS p s == (Just $ toStrictBS $ L.take k s)

149 where p = P.scan k $ \ n _ ->

127 where p = P.scan k $ \ n _ ->

150 if n > 0 then let !n' = n - 1 in Just n' else Nothing

128 if n > 0 then let !n' = n - 1 in Just n' else Nothing

151

129

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]

130+tests :: [Test]

161tests = [

131tests = [

162 testProperty "anyWord8" anyWord8

132 testProperty "anyWord8" anyWord8

163 , testProperty "endOfInput" endOfInput

133 , testProperty "endOfInput" endOfInput

@@ -171,8 +141,6 @@ tests = [

171 , testProperty "skip" skip

141 , testProperty "skip" skip

172 , testProperty "skipWhile" skipWhile

142 , testProperty "skipWhile" skipWhile

173 , testProperty "string" string

143 , testProperty "string" string

174− , testProperty "stringCI" stringCI

175− , testProperty "strings" strings

176 , testProperty "take" take

144 , testProperty "take" take

177 , testProperty "takeByteString" takeByteString

145 , testProperty "takeByteString" takeByteString

178 , testProperty "takeCount" takeCount

146 , testProperty "takeCount" takeCount

@@ -182,6 +150,4 @@ tests = [

182 , testProperty "takeWhile1" takeWhile1

150 , testProperty "takeWhile1" takeWhile1

183 , testProperty "takeWhile1_empty" takeWhile1_empty

151 , testProperty "takeWhile1_empty" takeWhile1_empty

184 , testProperty "word8" word8

152 , testProperty "word8" word8

185− , testProperty "members" members

186− , testProperty "nonmembers" nonmembers

187 ]

153 ]

tests/QC/Combinator.hs+5−18

@@ -1,15 +1,10 @@

1−{-# LANGUAGE CPP, OverloadedStrings #-}

2−

3module QC.Combinator where

1module QC.Combinator where

4

2

5−#if !MIN_VERSION_base(4,8,0)

6−import Control.Applicative ((<*>), (<$>), (<*), (*>))

3+import Control.Applicative

7−#endif

8−import Data.Maybe (fromJust, isJust)

9import Data.Word (Word8)

4import Data.Word (Word8)

10−import QC.Common (Repack, parseBS, repackBS, toLazyBS)

5+import QC.Common (Repack, parseBS, repackBS)

11−import Test.Tasty (TestTree)

6+import Test.Framework (Test)

12−import Test.Tasty.QuickCheck (testProperty)

7+import Test.Framework.Providers.QuickCheck2 (testProperty)

13import Test.QuickCheck

8import Test.QuickCheck

14import qualified Data.Attoparsec.ByteString.Char8 as P

9import qualified Data.Attoparsec.ByteString.Char8 as P

15import qualified Data.Attoparsec.Combinator as C

10import qualified Data.Attoparsec.Combinator as C

@@ -27,13 +22,6 @@ count (Positive (Small n)) rs s =

27 (length <$> parseBS (C.count n (P.string s)) input) == Just n

22 (length <$> parseBS (C.count n (P.string s)) input) == Just n

28 where input = repackBS rs (B.concat (replicate (n+1) s))

23 where input = repackBS rs (B.concat (replicate (n+1) s))

29

24

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−

37match :: Int -> NonNegative Int -> NonNegative Int -> Repack -> Bool

25match :: Int -> NonNegative Int -> NonNegative Int -> Repack -> Bool

38match n (NonNegative x) (NonNegative y) rs =

26match n (NonNegative x) (NonNegative y) rs =

39 parseBS (P.match parser) (repackBS rs input) == Just (input, n)

27 parseBS (P.match parser) (repackBS rs input) == Just (input, n)

@@ -43,10 +31,9 @@ match n (NonNegative x) (NonNegative y) rs =

43 B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'

31 B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'

44 ]

32 ]

45

33

46−tests :: [TestTree]

34+tests :: [Test]

47tests = [

35tests = [

48 testProperty "choice" choice

36 testProperty "choice" choice

49 , testProperty "count" count

37 , testProperty "count" count

50− , testProperty "lookAhead" lookAhead

51 , testProperty "match" match

38 , testProperty "match" match

52 ]

39 ]

tests/QC/Common.hs+4−45

@@ -1,9 +1,7 @@

1−{-# LANGUAGE CPP, FlexibleInstances #-}

2{-# OPTIONS_GHC -fno-warn-orphans #-}

1{-# OPTIONS_GHC -fno-warn-orphans #-}

3module QC.Common

2module QC.Common

4 (

3 (

5− ASCII(..)

6− , parseBS

4+ parseBS

7 , parseT

5 , parseT

8 , toLazyBS

6 , toLazyBS

9 , toStrictBS

7 , toStrictBS

@@ -12,15 +10,10 @@ module QC.Common

12 , repackBS_

10 , repackBS_

13 , repackT

11 , repackT

14 , repackT_

12 , repackT_

15− , liftOp

16 ) where

13 ) where

17

14

18−#if !MIN_VERSION_base(4,8,0)

19−import Control.Applicative ((<*>), (<$>))

15+import Control.Applicative ((<$>), (<*>))

20−#endif

21−import Data.Char (isAlpha)

22import Test.QuickCheck

16import Test.QuickCheck

23−import Test.QuickCheck.Unicode (shrinkChar, string)

24import qualified Data.ByteString as B

17import qualified Data.ByteString as B

25import qualified Data.ByteString.Lazy as BL

18import qualified Data.ByteString.Lazy as BL

26import qualified Data.Text as T

19import qualified Data.Text as T

@@ -28,16 +21,6 @@ import qualified Data.Text.Lazy as TL

28import qualified Data.Attoparsec.ByteString.Lazy as BL

21import qualified Data.Attoparsec.ByteString.Lazy as BL

29import qualified Data.Attoparsec.Text.Lazy as TL

22import qualified Data.Attoparsec.Text.Lazy as TL

30

23

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−

41parseBS :: BL.Parser r -> BL.ByteString -> Maybe r

24parseBS :: BL.Parser r -> BL.ByteString -> Maybe r

42parseBS p = BL.maybeResult . BL.parse p

25parseBS p = BL.maybeResult . BL.parse p

43

26

@@ -52,22 +35,9 @@ toLazyBS = BL.fromChunks . (:[])

52

35

53instance Arbitrary B.ByteString where

36instance Arbitrary B.ByteString where

54 arbitrary = B.pack <$> arbitrary

37 arbitrary = B.pack <$> arbitrary

55− shrink = map B.pack . shrink . B.unpack

56

38

57instance Arbitrary BL.ByteString where

39instance Arbitrary BL.ByteString where

58 arbitrary = repackBS <$> arbitrary <*> arbitrary

40 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

71

41

72type Repack = NonEmptyList (Positive (Small Int))

42type Repack = NonEmptyList (Positive (Small Int))

73

43

@@ -84,12 +54,10 @@ repackBS_ = go . cycle

84 go _ _ = error "unpossible"

54 go _ _ = error "unpossible"

85

55

86instance Arbitrary T.Text where

56instance Arbitrary T.Text where

87− arbitrary = T.pack <$> string

57+ arbitrary = T.pack <$> arbitrary

88− shrink = map T.pack . shrinkList shrinkChar . T.unpack

89

58

90instance Arbitrary TL.Text where

59instance Arbitrary TL.Text where

91− arbitrary = TL.pack <$> string

60+ arbitrary = repackT <$> arbitrary <*> arbitrary

92− shrink = map TL.pack . shrinkList shrinkChar . TL.unpack

93

61

94repackT :: Repack -> T.Text -> TL.Text

62repackT :: Repack -> T.Text -> TL.Text

95repackT (NonEmpty bs) =

63repackT (NonEmpty bs) =

@@ -102,12 +70,3 @@ repackT_ = go . cycle

102 | otherwise = let (h,t) = T.splitAt b s

70 | otherwise = let (h,t) = T.splitAt b s

103 in h : go bs t

71 in h : go bs t

104 go _ _ = error "unpossible"

72 go _ _ = error "unpossible"

105−

106−liftOp :: (Show a, Testable prop) =>

107− String -> (a -> a -> prop) -> a -> a -> Property

108−liftOp name f x y = counterexample desc (f x y)

109− where op = case name of

110− (c:_) | isAlpha c -> " `" ++ name ++ "` "

111− | otherwise -> " " ++ name ++ " "

112− _ -> " ??? "

113− desc = "not (" ++ show x ++ op ++ show y ++ ")"

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 #-}

2{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}

3module QC.Text (tests) where

4

5−#if !MIN_VERSION_base(4,8,0)

6−import Control.Applicative ((<*>), (<$>))

5+import Control.Applicative ((<$>), (<*>))

7−#endif

8import Data.Int (Int64)

6import Data.Int (Int64)

9−import Data.Word (Word8)

10import Prelude hiding (take, takeWhile)

7import Prelude hiding (take, takeWhile)

11−import QC.Common (liftOp, parseT)

8+import QC.Common (parseT)

12−import qualified QC.Text.FastSet as FastSet

9+import Test.Framework (Test)

13−import qualified QC.Text.Regressions as Regressions

14−import Test.Tasty (TestTree, testGroup)

15−import Test.Tasty.QuickCheck (testProperty)

10+import Test.Framework.Providers.QuickCheck2 (testProperty)

16import Test.QuickCheck

11import Test.QuickCheck

17import qualified Data.Attoparsec.Text as P

12import qualified Data.Attoparsec.Text as P

18import qualified Data.Attoparsec.Text.Lazy as PL

13import qualified Data.Attoparsec.Text.Lazy as PL

19−import qualified Data.Attoparsec.Text.FastSet as S

20−import qualified Data.ByteString as BS

21import qualified Data.Char as Char

14import qualified Data.Char as Char

22import qualified Data.Text as T

15import qualified Data.Text as T

23−import qualified Data.Text.Encoding as TE

24import qualified Data.Text.Lazy as L

16import qualified Data.Text.Lazy as L

25

17

26-- Basic byte-level combinators.

18-- Basic byte-level combinators.

27

19

28−satisfy :: Char -> L.Text -> Property

20+satisfy :: Char -> L.Text -> Bool

29−satisfy w s = parseT (P.satisfy (<=w)) (L.cons w s) === Just w

21+satisfy w s = parseT (P.satisfy (<=w)) (L.cons w s) == Just w

30

22

31−satisfyWith :: Char -> L.Text -> Property

23+satisfyWith :: Char -> L.Text -> Bool

32−satisfyWith c s = parseT (P.satisfyWith id (<=c)) (L.cons c s) === Just c

24+satisfyWith c s = parseT (P.satisfyWith id (<=c)) (L.cons c s) == Just c

33

25

34−char :: Char -> L.Text -> Property

26+char :: Char -> L.Text -> Bool

35−char w s = parseT (P.char w) (L.cons w s) === Just w

27+char w s = parseT (P.char w) (L.cons w s) == Just w

36

28

37−skip :: Char -> L.Text -> Property

29+skip :: Char -> L.Text -> Bool

38skip w s =

30skip w s =

39 case (parseT (P.skip (<w)) s, L.uncons s) of

31 case (parseT (P.skip (<w)) s, L.uncons s) of

40− (Nothing, mcs) -> maybe (property True) (expectFailure . it) mcs

32+ (Nothing, mcs) -> maybe True (not . it) mcs

41− (Just _, mcs) -> maybe (property False) it mcs

33+ (Just _, mcs) -> maybe False it mcs

42− where it cs = liftOp "<" (<) (fst cs) w

34+ where it cs = fst cs < w

43

35

44−anyChar :: L.Text -> Property

36+anyChar :: L.Text -> Bool

45anyChar s

37anyChar s

46− | L.null s = p === Nothing

38+ | L.null s = p == Nothing

47− | otherwise = p === Just (L.head s)

39+ | otherwise = p == Just (L.head s)

48 where p = parseT P.anyChar s

40 where p = parseT P.anyChar s

49

41

50−notChar :: Char -> NonEmptyList Char -> Property

42+notChar :: Char -> NonEmptyList Char -> Bool

51−notChar w (NonEmpty s) = parseT (P.notChar w) bs === if v == w

43+notChar w (NonEmpty s) = parseT (P.notChar w) bs == if v == w

52 then Nothing

44 then Nothing

53 else Just v

45 else Just v

54 where v = L.head bs

46 where v = L.head bs

55 bs = L.pack s

47 bs = L.pack s

56

48

57−peekChar :: L.Text -> Property

49+peekChar :: L.Text -> Bool

58peekChar s

50peekChar s

59− | L.null s = p === Just (Nothing, s)

51+ | L.null s = p == Just (Nothing, s)

60− | otherwise = p === Just (Just (L.head s), s)

52+ | otherwise = p == Just (Just (L.head s), s)

61 where p = parseT ((,) <$> P.peekChar <*> P.takeLazyText) s

53 where p = parseT ((,) <$> P.peekChar <*> P.takeLazyText) s

62

54

63−peekChar' :: L.Text -> Property

55+peekChar' :: L.Text -> Bool

64−peekChar' s = parseT P.peekChar' s === (fst <$> L.uncons s)

56+peekChar' s = parseT P.peekChar' s == (fst <$> L.uncons s)

65

57

66−string :: L.Text -> L.Text -> Property

58+string :: L.Text -> L.Text -> Bool

67−string s t = parseT (P.string s') (s `L.append` t) === Just s'

59+string s t = parseT (P.string s') (s `L.append` t) == Just s'

68 where s' = toStrict s

60 where s' = toStrict s

69

61

70−strings :: L.Text -> L.Text -> L.Text -> Property

62+stringCI :: T.Text -> Bool

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

63+stringCI s = P.parseOnly (P.stringCI fs) s == Right s

80 where fs = T.toCaseFold s

64 where fs = T.toCaseFold s

81− s = TE.decodeLatin1 (BS.pack ws)

82

65

83asciiCI :: T.Text -> Gen Bool

66asciiCI :: T.Text -> Gen Bool

84asciiCI x =

67asciiCI x =

@@ -93,84 +76,72 @@ asciiCI x =

93toStrict :: L.Text -> T.Text

76toStrict :: L.Text -> T.Text

94toStrict = T.concat . L.toChunks

77toStrict = T.concat . L.toChunks

95

78

96−skipWhile :: Char -> L.Text -> Property

79+skipWhile :: Char -> L.Text -> Bool

97skipWhile w s =

80skipWhile w s =

98 let t = L.dropWhile (<=w) s

81 let t = L.dropWhile (<=w) s

99 in case PL.parse (P.skipWhile (<=w)) s of

82 in case PL.parse (P.skipWhile (<=w)) s of

100− PL.Done t' () -> t === t'

83+ PL.Done t' () -> t == t'

101− _ -> property False

84+ _ -> False

102

85

103−take :: Int -> L.Text -> Property

86+take :: Int -> L.Text -> Bool

104−take n s = maybe (liftOp "<" (<) (L.length s) (fromIntegral n))

87+take n s = maybe (L.length s < fromIntegral n) (== T.take n (toStrict s)) $

105− (=== T.take n (toStrict s)) $

106 parseT (P.take n) s

88 parseT (P.take n) s

107

89

108−takeText :: L.Text -> Property

90+takeText :: L.Text -> Bool

109−takeText s = maybe (property False) (=== toStrict s) . parseT P.takeText $ s

91+takeText s = maybe False (== toStrict s) . parseT P.takeText $ s

110

92

111−takeLazyText :: L.Text -> Property

93+takeLazyText :: L.Text -> Bool

112−takeLazyText s = maybe (property False) (=== s) . parseT P.takeLazyText $ s

94+takeLazyText s = maybe False (== s) . parseT P.takeLazyText $ s

113

95

114−takeCount :: Positive Int -> L.Text -> Property

96+takeCount :: Positive Int -> L.Text -> Bool

115takeCount (Positive k) s =

97takeCount (Positive k) s =

116 case parseT (P.take k) s of

98 case parseT (P.take k) s of

117− Nothing -> liftOp ">" (>) (fromIntegral k) (L.length s)

99+ Nothing -> fromIntegral k > L.length s

118− Just _s -> liftOp "<=" (<=) (fromIntegral k) (L.length s)

100+ Just _s -> fromIntegral k <= L.length s

119

101

120−takeWhile :: Char -> L.Text -> Property

102+takeWhile :: Char -> L.Text -> Bool

121takeWhile w s =

103takeWhile w s =

122 let (h,t) = L.span (==w) s

104 let (h,t) = L.span (==w) s

123 in case PL.parse (P.takeWhile (==w)) s of

105 in case PL.parse (P.takeWhile (==w)) s of

124− PL.Done t' h' -> t === t' .&&. toStrict h === h'

106+ PL.Done t' h' -> t == t' && toStrict h == h'

125− _ -> property False

107+ _ -> False

126

108

127−takeWhile1 :: Char -> L.Text -> Property

109+takeWhile1 :: Char -> L.Text -> Bool

128takeWhile1 w s =

110takeWhile1 w s =

129− let s' = L.cons w s

111+ let s' = L.cons w s

130− (h,t) = L.span (<=w) s'

112+ (h,t) = L.span (<=w) s'

131 in case PL.parse (P.takeWhile1 (<=w)) s' of

113 in case PL.parse (P.takeWhile1 (<=w)) s' of

132− PL.Done t' h' -> t === t' .&&. toStrict h === h'

114+ PL.Done t' h' -> t == t' && toStrict h == h'

133− _ -> property False

115+ _ -> False

134

116

135−takeTill :: Char -> L.Text -> Property

117+takeTill :: Char -> L.Text -> Bool

136takeTill w s =

118takeTill w s =

137 let (h,t) = L.break (==w) s

119 let (h,t) = L.break (==w) s

138 in case PL.parse (P.takeTill (==w)) s of

120 in case PL.parse (P.takeTill (==w)) s of

139− PL.Done t' h' -> t === t' .&&. toStrict h === h'

121+ PL.Done t' h' -> t == t' && toStrict h == h'

140− _ -> property False

122+ _ -> False

141

123

142−takeWhile1_empty :: Property

124+takeWhile1_empty :: Bool

143−takeWhile1_empty = parseT (P.takeWhile1 undefined) L.empty === Nothing

125+takeWhile1_empty = parseT (P.takeWhile1 undefined) L.empty == Nothing

144

126

145−endOfInput :: L.Text -> Property

127+endOfInput :: L.Text -> Bool

146−endOfInput s = parseT P.endOfInput s === if L.null s

128+endOfInput s = parseT P.endOfInput s == if L.null s

147− then Just ()

129+ then Just ()

148− else Nothing

130+ else Nothing

149

131

150−endOfLine :: L.Text -> Property

132+endOfLine :: L.Text -> Bool

151endOfLine s =

133endOfLine s =

152 case (parseT P.endOfLine s, L.uncons s) of

134 case (parseT P.endOfLine s, L.uncons s) of

153− (Nothing, mcs) -> maybe (property True) (expectFailure . eol) mcs

135+ (Nothing, mcs) -> maybe True (not . eol) mcs

154− (Just _, mcs) -> maybe (property False) eol mcs

136+ (Just _, mcs) -> maybe False eol mcs

155− where eol (c,s') = c === '\n' .||.

156− (c, fst <$> L.uncons s') === ('\r', Just '\n')

137+ where eol (c,s') = c == '\n' || (c, fst <$> L.uncons s') == ('\r', Just '\n')

157−

138+

158−scan :: L.Text -> Positive Int64 -> Property

139+scan :: L.Text -> Positive Int64 -> Bool

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)

140+scan s (Positive k) = parseT p s == (Just $ toStrict $ L.take k s)

162 where p = P.scan k $ \ n _ ->

141 where p = P.scan k $ \ n _ ->

163 if n > 0 then let !n' = n - 1 in Just n' else Nothing

142 if n > 0 then let !n' = n - 1 in Just n' else Nothing

164

143

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]

174tests = [

145tests = [

175 testProperty "anyChar" anyChar

146 testProperty "anyChar" anyChar

176 , testProperty "asciiCI" asciiCI

147 , testProperty "asciiCI" asciiCI

@@ -186,7 +157,6 @@ tests = [

186 , testProperty "skip" skip

157 , testProperty "skip" skip

187 , testProperty "skipWhile" skipWhile

158 , testProperty "skipWhile" skipWhile

188 , testProperty "string" string

159 , testProperty "string" string

189− , testProperty "strings" strings

190 , testProperty "stringCI" stringCI

160 , testProperty "stringCI" stringCI

191 , testProperty "take" take

161 , testProperty "take" take

192 , testProperty "takeText" takeText

162 , testProperty "takeText" takeText

@@ -196,8 +166,4 @@ tests = [

196 , testProperty "takeWhile" takeWhile

166 , testProperty "takeWhile" takeWhile

197 , testProperty "takeWhile1" takeWhile1

167 , testProperty "takeWhile1" takeWhile1

198 , testProperty "takeWhile1_empty" takeWhile1_empty

168 , testProperty "takeWhile1_empty" takeWhile1_empty

199− , testProperty "members" members

200− , testProperty "nonmembers" nonmembers

201− , testGroup "FastSet" FastSet.tests

202− , testGroup "Regressions" Regressions.tests

203 ]

169 ]

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

2+

3+import Data.Word (Word8)

4+import qualified Data.Attoparsec.FastSet as F

5+import System.Random (Random(..), RandomGen)

6+import Test.QuickCheck

7+

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