master..aa60c09 · typeable/attoparsec

.travis.ymldeleted−161

since splitsnapshots

unifiedsplit

@@ -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/ByteString/Buffer.hs+8−10

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns #-}

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

2-- |

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

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

@@ -57,8 +57,9 @@ import Control.Exception (assert)

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

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

59import Data.List (foldl1')

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

60+#if !MIN_VERSION_base(4,8,0)

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

61+import Data.Monoid (Monoid(..))

62+#endif

62import Data.Word (Word8)

63import Data.Word (Word8)

63import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)

64import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)

64import Foreign.Ptr (castPtr, plusPtr)

65import Foreign.Ptr (castPtr, plusPtr)

@@ -87,17 +88,14 @@ buffer (PS fp off len) = Buf fp off len len 0

87unbuffer :: Buffer -> ByteString

88unbuffer :: Buffer -> ByteString

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

89unbuffer (Buf fp off len _ _) = PS fp off len

89

90

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−

95instance Monoid Buffer where

91instance Monoid Buffer where

96 mempty = Buf nullForeignPtr 0 0 0 0

92 mempty = Buf nullForeignPtr 0 0 0 0

97

93

98− mappend = (<>)

94+ mappend (Buf _ _ _ 0 _) b = b

95+ mappend a (Buf _ _ _ 0 _) = a

96+ mappend buf (Buf fp off len _ _) = append buf fp off len

99

97

100− mconcat [] = Mon.mempty

98+ mconcat [] = mempty

101 mconcat xs = foldl1' mappend xs

99 mconcat xs = foldl1' mappend xs

102

100

103pappend :: Buffer -> ByteString -> Buffer

101pappend :: Buffer -> ByteString -> Buffer

Data/Attoparsec/ByteString/Internal.hs+4−14

@@ -257,24 +257,15 @@ takeTill p = takeWhile (not . p)

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

258-- in an infinite loop.

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

260−takeWhile p = do

260+takeWhile p = concatReverse `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

261 where

271 go acc = do

262 go acc = do

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

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

273 continue <- inputSpansChunks (B.length s)

264 continue <- inputSpansChunks (B.length s)

274 if continue

265 if continue

275 then go (s:acc)

266 then go (s:acc)

276− else return $ concatReverse (s:acc)

267+ else return (s:acc)

277−{-# INLINE takeWhileAcc #-}

268+{-# INLINE takeWhile #-}

278

269

279takeRest :: Parser [ByteString]

270takeRest :: Parser [ByteString]

280takeRest = go []

271takeRest = go []

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

364 advance len

355 advance len

365 eoc <- endOfChunk

356 eoc <- endOfChunk

366 if eoc

357 if eoc

367− then takeWhileAcc p [s]

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

368 else return s

359 else return s

369−{-# INLINE takeWhile1 #-}

370

360

371-- | Match any byte in a set.

361-- | Match any byte in a set.

372--

362--

Data/Attoparsec/Internal/Types.hs+27−37

@@ -1,4 +1,4 @@

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

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

2 Rank2Types, RecordWildCards, TypeFamilies #-}

3-- |

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

@@ -25,13 +25,13 @@ module Data.Attoparsec.Internal.Types

25 , Chunk(..)

26 ) where

27

28+#if !MIN_VERSION_base(4,8,0)

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

29+import Control.Applicative (Applicative(..), (<$>))

30+import Data.Monoid (Monoid(..))

31+#endif

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

32import Control.Applicative (Alternative(..))

30import Control.DeepSeq (NFData(rnf))

33import Control.DeepSeq (NFData(rnf))

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

34import Control.Monad (MonadPlus(..))

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

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

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

35import Data.Word (Word8)

36import Data.ByteString (ByteString)

37import qualified Data.ByteString as BS

@@ -39,7 +39,7 @@ import Data.ByteString.Internal (w2c)

39import Data.Text (Text)

40import qualified Data.Text as Text

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

42−import Prelude hiding (succ)

42+import Prelude hiding (getChar, succ)

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

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

45

@@ -127,21 +127,17 @@ type Success i t a r = t -> Pos -> More -> a -> IResult i r

127data More = Complete | Incomplete

128 deriving (Eq, Show)

129

130−instance Semigroup More where

130+instance Monoid More where

131− c@Complete <> _ = c

131+ mappend c@Complete _ = c

132− _ <> m = m

132+ mappend _ m = m

133−

134−instance Mon.Monoid More where

135− mappend = (<>)

136− mempty = Incomplete

133+ mempty = Incomplete

137

134

138instance Monad (Parser i) where

135instance Monad (Parser i) where

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

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

140− fail = Fail.fail

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

141 {-# INLINE fail #-}

138 {-# INLINE fail #-}

142−#endif

143

139

144− return = App.pure

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

145 {-# INLINE return #-}

141 {-# INLINE return #-}

146

142

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

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

@@ -149,15 +145,6 @@ instance Monad (Parser i) where

149 in runParser m t pos more lose succ'

145 in runParser m t pos more lose succ'

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

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

151

147

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−

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

148plus :: Parser i a -> Parser i a -> Parser i a

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

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

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

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

@@ -182,23 +169,23 @@ apP d e = do

182{-# INLINE apP #-}

169{-# INLINE apP #-}

183

170

184instance Applicative (Parser i) where

171instance Applicative (Parser i) where

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

172+ pure = return

186 {-# INLINE pure #-}

173 {-# INLINE pure #-}

187 (<*>) = apP

174 (<*>) = apP

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

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

189− m *> k = m >>= \_ -> k

176+

177+ -- These definitions are equal to the defaults, but this

178+ -- way the optimizer doesn't have to work so hard to figure

179+ -- that out.

180+ (*>) = (>>)

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

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

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

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

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

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

193

184

194−instance Semigroup (Parser i a) where

195− (<>) = plus

196− {-# INLINE (<>) #-}

197−

198instance Monoid (Parser i a) where

185instance Monoid (Parser i a) where

199 mempty = fail "mempty"

186 mempty = fail "mempty"

200 {-# INLINE mempty #-}

187 {-# INLINE mempty #-}

201− mappend = (<>)

188+ mappend = plus

202 {-# INLINE mappend #-}

189 {-# INLINE mappend #-}

203

190

204instance Alternative (Parser i) where

191instance Alternative (Parser i) where

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

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

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

210

197

211 many v = many_v

198 many v = many_v

212− where

213− many_v = some_v <|> pure []

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

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

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

215 {-# INLINE many #-}

201 {-# INLINE many #-}

216

202

217 some v = some_v

203 some v = some_v

@@ -220,6 +206,10 @@ instance Alternative (Parser i) where

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

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

221 {-# INLINE some #-}

207 {-# INLINE some #-}

222

208

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

210+(<>) = mappend

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

212+

223-- | A common interface for input chunks.

213-- | A common interface for input chunks.

224class Monoid c => Chunk c where

214class Monoid c => Chunk c where

225 type ChunkElem c

215 type ChunkElem c

Data/Attoparsec/Text/Buffer.hs+8−12

@@ -40,8 +40,9 @@ module Data.Attoparsec.Text.Buffer

40import Control.Exception (assert)

41import Data.Bits (shiftR)

42import Data.List (foldl1')

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

43+#if !MIN_VERSION_base(4,8,0)

44−import Data.Semigroup (Semigroup(..))

44+import Data.Monoid (Monoid(..))

45+#endif

45import Data.Text ()

46import Data.Text ()

46import Data.Text.Internal (Text(..))

47import Data.Text.Internal (Text(..))

47import Data.Text.Internal.Encoding.Utf16 (chr2)

48import Data.Text.Internal.Encoding.Utf16 (chr2)

@@ -79,20 +80,15 @@ unbufferAt s (Buf arr off len _ _) =

79 assert (s >= 0 && s <= len) $

80 assert (s >= 0 && s <= len) $

80 Text arr (off+s) (len-s)

81 Text arr (off+s) (len-s)

81

82

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−

88instance Monoid Buffer where

83instance Monoid Buffer where

89 mempty = Buf A.empty 0 0 0 0

84 mempty = Buf A.empty 0 0 0 0

90− {-# INLINE mempty #-}

91

85

92− mappend = (<>)

86+ mappend (Buf _ _ _ 0 _) b = b

87+ mappend a (Buf _ _ _ 0 _) = a

88+ mappend buf (Buf arr off len _ _) = append buf arr off len

93

89

94− mconcat [] = Mon.mempty

90+ mconcat [] = mempty

95− mconcat xs = foldl1' (<>) xs

91+ mconcat xs = foldl1' mappend xs

96

92

97pappend :: Buffer -> Text -> Buffer

93pappend :: Buffer -> Text -> Buffer

98pappend (Buf _ _ _ 0 _) t = buffer t

94pappend (Buf _ _ _ 0 _) t = buffer t

Data/Attoparsec/Text/FastSet.hs+11−91

@@ -1,118 +1,38 @@

1−{-# LANGUAGE BangPatterns #-}

2−

3−------------------------------------------------------------------------------

4-- |

1-- |

5−-- Module : Data.Attoparsec.FastSet

2+-- Module : Data.Attoparsec.Text.FastSet

6−-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015

3+-- Copyright : Bryan O'Sullivan 2015

7-- License : BSD3

4-- License : BSD3

8--

5--

9−-- Maintainer : felipe.lessa@gmail.com

6+-- Maintainer : bos@serpentine.com

10-- Stability : experimental

7-- Stability : experimental

11-- Portability : unknown

8-- Portability : unknown

12--

9--

13−-- Fast set membership tests for 'Char' values. We test for

10+-- Fast set membership tests for 'Char' values.

14−-- membership using a hashtable implemented with Robin Hood

11+

15−-- collision resolution. The set representation is unboxed,

16−-- and the characters and hashes interleaved, for efficiency.

17−--

18−--

19−-----------------------------------------------------------------------------

20module Data.Attoparsec.Text.FastSet

12module Data.Attoparsec.Text.FastSet

21 (

13 (

22 -- * Data type

14 -- * Data type

23 FastSet

15 FastSet

24 -- * Construction

16 -- * Construction

25 , fromList

17 , fromList

26− , set

27 -- * Lookup

18 -- * Lookup

28 , member

19 , member

29 -- * Handy interface

20 -- * Handy interface

30 , charClass

21 , charClass

31 ) where

22 ) where

32

23

33−import Data.Bits ((.|.), (.&.), shiftR)

34−import Data.Function (on)

35−import Data.List (sort, sortBy)

36−import qualified Data.Array.Base as AB

24+import qualified Data.IntSet as I

37−import qualified Data.Array.Unboxed as A

38−import qualified Data.Text as T

25+import Data.Char (ord)

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

26

51−offset :: Entry -> Int

27+newtype FastSet = FastSet I.IntSet

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

28

82fromList :: String -> FastSet

29fromList :: String -> FastSet

83−fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved)

30+fromList = FastSet . I.fromList . map ord

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

31

107-- | Check the set for membership.

32-- | Check the set for membership.

108member :: Char -> FastSet -> Bool

33member :: Char -> FastSet -> Bool

109−member c a = go (2 * i)

34+member c (FastSet s) = I.member (ord c) s

110− where i = fastHash c .&. mask a

35+{-# INLINE member #-}

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

36

117charClass :: String -> FastSet

37charClass :: String -> FastSet

118charClass = fromList . go

38charClass = fromList . go

Data/Attoparsec/Text/Internal.hs+20−30

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns, FlexibleInstances, GADTs, OverloadedStrings,

1+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, GADTs, OverloadedStrings,

2 Rank2Types, RecordWildCards, TypeFamilies, TypeSynonymInstances #-}

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

4-- |

@@ -65,14 +65,17 @@ module Data.Attoparsec.Text.Internal

65 , atEnd

66 ) where

67

68+#if !MIN_VERSION_base(4,8,0)

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

69+import Control.Applicative ((<$>))

70+#endif

71+import Control.Applicative ((<|>))

69import Control.Monad (when)

72import Control.Monad (when)

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

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

71import Data.Attoparsec.Internal

74import Data.Attoparsec.Internal

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

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

73import qualified Data.Attoparsec.Text.Buffer as Buf

76import qualified Data.Attoparsec.Text.Buffer as Buf

74import Data.Attoparsec.Text.Buffer (Buffer, buffer)

77import Data.Attoparsec.Text.Buffer (Buffer, buffer)

75−import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)

78+import Data.Char (chr, ord)

76import Data.List (intercalate)

79import Data.List (intercalate)

77import Data.String (IsString(..))

80import Data.String (IsString(..))

78import Data.Text.Internal (Text(..))

81import Data.Text.Internal (Text(..))

@@ -222,16 +225,15 @@ stringCI s = go 0

222

225

223-- | Satisfy a literal string, ignoring case for characters in the ASCII range.

226-- | Satisfy a literal string, ignoring case for characters in the ASCII range.

224asciiCI :: Text -> Parser Text

227asciiCI :: Text -> Parser Text

225−asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s

228+asciiCI s = string_ (stringSuspended asciiToLower) asciiToLower s

229+ where

230+ asciiToLower = T.map f

231+ where

232+ offset = ord 'a' - ord 'A'

233+ f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)

234+ | otherwise = c

226{-# INLINE asciiCI #-}

235{-# INLINE asciiCI #-}

227

236

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

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

236skipWhile :: (Char -> Bool) -> Parser ()

238skipWhile :: (Char -> Bool) -> Parser ()

237skipWhile p = go

239skipWhile p = go

@@ -267,25 +269,14 @@ takeTill p = takeWhile (not . p)

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

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

268-- in an infinite loop.

270-- in an infinite loop.

269takeWhile :: (Char -> Bool) -> Parser Text

271takeWhile :: (Char -> Bool) -> Parser Text

270−takeWhile p = do

272+takeWhile p = concatReverse `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

273 where

282 go acc = do

274 go acc = do

283 h <- T.takeWhile p <$> get

275 h <- T.takeWhile p <$> get

284 continue <- inputSpansChunks (size h)

276 continue <- inputSpansChunks (size h)

285 if continue

277 if continue

286 then go (h:acc)

278 then go (h:acc)

287− else return $ concatReverse (h:acc)

279+ else return (h:acc)

288−{-# INLINE takeWhileAcc #-}

289

280

290takeRest :: Parser [Text]

281takeRest :: Parser [Text]

291takeRest = go []

282takeRest = go []

@@ -308,7 +299,7 @@ takeLazyText :: Parser L.Text

308takeLazyText = L.fromChunks `fmap` takeRest

299takeLazyText = L.fromChunks `fmap` takeRest

309

300

310data Scan s = Continue s

301data Scan s = Continue s

311− | Finished s {-# UNPACK #-} !Int Text

302+ | Finished {-# UNPACK #-} !Int Text

312

303

313scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r

304scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r

314scan_ f s0 p = go [] s0

305scan_ f s0 p = go [] s0

@@ -317,7 +308,7 @@ scan_ f s0 p = go [] s0

317 case T.uncons t of

308 case T.uncons t of

318 Just (c,t') -> case p s c of

309 Just (c,t') -> case p s c of

319 Just s' -> scanner s' (n+1) t'

310 Just s' -> scanner s' (n+1) t'

320− Nothing -> Finished s n t

311+ Nothing -> Finished n t

321 Nothing -> Continue s

312 Nothing -> Continue s

322 go acc s = do

313 go acc s = do

323 input <- get

314 input <- get

@@ -326,8 +317,8 @@ scan_ f s0 p = go [] s0

326 if continue

317 if continue

327 then go (input : acc) s'

318 then go (input : acc) s'

328 else f s' (input : acc)

319 else f s' (input : acc)

329− Finished s' n t -> do advance (size input - size t)

320+ Finished n t -> do advance (size input - size t)

330− f s' (T.take n input : acc)

321+ f s (T.take n input : acc)

331{-# INLINE scan_ #-}

322{-# INLINE scan_ #-}

332

323

333-- | A stateful scanner. The predicate consumes and transforms a

324-- | A stateful scanner. The predicate consumes and transforms a

@@ -367,9 +358,8 @@ takeWhile1 p = do

367 advance size'

358 advance size'

368 eoc <- endOfChunk

359 eoc <- endOfChunk

369 if eoc

360 if eoc

370− then takeWhileAcc p [h]

361+ then (h<>) `fmap` takeWhile p

371 else return h

362 else return h

372−{-# INLINE takeWhile1 #-}

373

363

374-- | Match any character in a set.

364-- | Match any character in a set.

375--

365--

Data/Attoparsec/Zepto.hs+8−17

@@ -38,17 +38,18 @@ module Data.Attoparsec.Zepto

38

39import Control.Applicative

40import Control.Monad (MonadPlus(..), ap)

41−import qualified Control.Monad.Fail as Fail

42import Control.Monad.IO.Class (MonadIO(..))

41import Control.Monad.IO.Class (MonadIO(..))

43import Data.ByteString (ByteString)

42import Data.ByteString (ByteString)

44import Data.Functor.Identity (Identity(runIdentity))

43import Data.Functor.Identity (Identity(runIdentity))

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

46−import Data.Semigroup (Semigroup(..))

47import Data.Word (Word8)

44import Data.Word (Word8)

48import Prelude hiding (take, takeWhile)

45import Prelude hiding (take, takeWhile)

49import qualified Data.ByteString as B

46import qualified Data.ByteString as B

50import qualified Data.ByteString.Unsafe as B

47import qualified Data.ByteString.Unsafe as B

51

48

49+#if !MIN_VERSION_base(4,8,0)

50+import Data.Monoid (Monoid(..))

51+#endif

52+

52newtype S = S {

53newtype S = S {

53 input :: ByteString

54 input :: ByteString

54 }

55 }

@@ -82,7 +83,7 @@ instance MonadIO m => MonadIO (ZeptoT m) where

82 {-# INLINE liftIO #-}

83 {-# INLINE liftIO #-}

83

84

84instance Monad m => Monad (ZeptoT m) where

85instance Monad m => Monad (ZeptoT m) where

85− return = pure

86+ return a = Parser $ \s -> return (OK a s)

86 {-# INLINE return #-}

87 {-# INLINE return #-}

87

88

88 m >>= k = Parser $ \s -> do

89 m >>= k = Parser $ \s -> do

@@ -92,12 +93,6 @@ instance Monad m => Monad (ZeptoT m) where

92 Fail err -> return (Fail err)

93 Fail err -> return (Fail err)

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

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

94

95

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

96− fail = Fail.fail

97− {-# INLINE fail #-}

98−#endif

99−

100−instance Monad m => Fail.MonadFail (ZeptoT m) where

101 fail msg = Parser $ \_ -> return (Fail msg)

96 fail msg = Parser $ \_ -> return (Fail msg)

102 {-# INLINE fail #-}

97 {-# INLINE fail #-}

103

98

@@ -113,7 +108,7 @@ instance Monad m => MonadPlus (ZeptoT m) where

113 {-# INLINE mplus #-}

108 {-# INLINE mplus #-}

114

109

115instance (Monad m) => Applicative (ZeptoT m) where

110instance (Monad m) => Applicative (ZeptoT m) where

116− pure a = Parser $ \s -> return (OK a s)

111+ pure = return

117 {-# INLINE pure #-}

112 {-# INLINE pure #-}

118 (<*>) = ap

113 (<*>) = ap

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

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

@@ -142,14 +137,10 @@ parseT p bs = do

142 Fail err -> return (Left err)

137 Fail err -> return (Left err)

143{-# INLINE parseT #-}

138{-# INLINE parseT #-}

144

139

145−instance Monad m => Semigroup (ZeptoT m a) where

146− (<>) = mplus

147− {-# INLINE (<>) #-}

148−

149−instance Monad m => Mon.Monoid (ZeptoT m a) where

140+instance Monad m => Monoid (ZeptoT m a) where

150 mempty = fail "mempty"

141 mempty = fail "mempty"

151 {-# INLINE mempty #-}

142 {-# INLINE mempty #-}

152− mappend = (<>)

143+ mappend = mplus

153 {-# INLINE mappend #-}

144 {-# INLINE mappend #-}

154

145

155instance Monad m => Alternative (ZeptoT m) where

146instance Monad m => Alternative (ZeptoT m) where

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+14−50

@@ -1,13 +1,12 @@

1name: attoparsec

2−version: 0.13.2.2

2+version: 0.13.0.2

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.1, GHC == 7.2.1, GHC == 7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3

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

@@ -40,22 +38,17 @@ Flag developer

40

38

41library

39library

42 build-depends: array,

40 build-depends: array,

43− base >= 4.3 && < 5,

41+ base >= 4.2 && < 5,

44 bytestring,

42 bytestring,

45 containers,

43 containers,

46 deepseq,

44 deepseq,

47 scientific >= 0.3.1 && < 0.4,

45 scientific >= 0.3.1 && < 0.4,

48− transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,

46+ transformers,

49 text >= 1.1.1.3

47 text >= 1.1.1.3

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

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−

59 exposed-modules: Data.Attoparsec

52 exposed-modules: Data.Attoparsec

60 Data.Attoparsec.ByteString

53 Data.Attoparsec.ByteString

61 Data.Attoparsec.ByteString.Char8

54 Data.Attoparsec.ByteString.Char8

@@ -96,26 +89,6 @@ test-suite tests

96 QC.Rechunked

89 QC.Rechunked

97 QC.Simple

90 QC.Simple

98 QC.Text

91 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

92

120 ghc-options:

93 ghc-options:

121 -Wall -threaded -rtsopts

94 -Wall -threaded -rtsopts

@@ -125,23 +98,19 @@ test-suite tests

125

98

126 build-depends:

99 build-depends:

127 array,

100 array,

128− base,

101+ base >= 4 && < 5,

129 bytestring,

102 bytestring,

103+ containers,

130 deepseq >= 1.1,

104 deepseq >= 1.1,

131− QuickCheck >= 2.13.2 && < 2.14,

105+ QuickCheck >= 2.7,

132 quickcheck-unicode,

106 quickcheck-unicode,

133 scientific,

107 scientific,

134− tasty >= 0.11,

108+ test-framework >= 0.8.0.2,

135− tasty-quickcheck >= 0.8,

109+ test-framework-quickcheck2 >= 0.3.0.3,

136 text,

110 text,

137− transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,

111+ transformers,

138 vector

112 vector

139

113

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−

145benchmark benchmarks

114benchmark benchmarks

146 type: exitcode-stdio-1.0

115 type: exitcode-stdio-1.0

147 hs-source-dirs: benchmarks benchmarks/warp-3.0.1.1 .

116 hs-source-dirs: benchmarks benchmarks/warp-3.0.1.1 .

@@ -153,8 +122,6 @@ benchmark benchmarks

153 HeadersByteString.Atto

122 HeadersByteString.Atto

154 HeadersText

123 HeadersText

155 Links

124 Links

156− Network.Wai.Handler.Warp.ReadInt

157− Network.Wai.Handler.Warp.RequestHeader

158 Numbers

125 Numbers

159 Sets

126 Sets

160 TextFastSet

127 TextFastSet

@@ -179,16 +146,13 @@ benchmark benchmarks

179 parsec >= 3.1.2,

146 parsec >= 3.1.2,

180 scientific,

147 scientific,

181 text >= 1.1.1.0,

148 text >= 1.1.1.0,

182− transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,

183 unordered-containers,

149 unordered-containers,

184 vector

150 vector

185

151

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

152source-repository head

192 type: git

153 type: git

193 location: https://github.com/bos/attoparsec

154 location: https://github.com/bos/attoparsec

194

155

156+source-repository head

157+ type: mercurial

158+ location: https://bitbucket.org/bos/attoparsec

benchmarks/Benchmarks.hs−4

@@ -71,14 +71,10 @@ main = do

71 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl

72 , bench "isAlpha_iso8859_15" $

73 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 ]

74 ]

77 , bgroup "takeWhile1" [

75 , bgroup "takeWhile1" [

78 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl

76 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl

79 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile1 AC.isAlpha_ascii)) bl

77 , 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 ]

78 ]

83 , bench "word32LE" $ nf (AB.parse word32LE) b

79 , bench "word32LE" $ nf (AB.parse word32LE) b

84 , bgroup "scan" [

80 , bgroup "scan" [

benchmarks/HeadersByteString.hs+1−10

@@ -9,15 +9,6 @@ import qualified Data.Attoparsec.ByteString.Char8 as B

9import 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

13−-- from a strict bytestring, we consider warp's implementation,

14−-- which has highly optimized code for handling the first

15−-- line in particular. It's treatment of the headers

16−-- is more relaxed from the treatment they are given by the

17−-- attoparsec parser benchmarked here. Consequently, it

18−-- is should not be possible to match its performance since

19−-- it accepts header names with disallowed characters.

20−

21headers :: IO Benchmark

12headers :: IO Benchmark

22headers = do

13headers = do

23 req <- B.readFile =<< pathTo "http-request.txt"

14 req <- B.readFile =<< pathTo "http-request.txt"

@@ -27,7 +18,7 @@ headers = do

27 return $ bgroup "headers" [

18 return $ bgroup "headers" [

28 bgroup "B" [

19 bgroup "B" [

29 bench "request" $ nf (B.parseOnly request) req

20 bench "request" $ nf (B.parseOnly request) req

30− , bench "warp" $ nfIO (parseHeaderLines (B.split '\n' req))

21+ , bench "warp" $ nfIO (parseHeaderLines [req])

31 , bench "response" $ nf (B.parseOnly response) resp

22 , bench "response" $ nf (B.parseOnly response) resp

32 ]

23 ]

33 , bgroup "BL" [

24 , bgroup "BL" [

benchmarks/HeadersByteString/Atto.hs+1−9

@@ -15,16 +15,8 @@ import qualified Data.ByteString.Char8 as B

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

26header = do

18header = do

27− name <- B.takeWhile1 isHeaderChar <* B.char ':' <* B.skipSpace

19+ name <- B.takeWhile1 (B.inClass "a-zA-Z0-9_-") <* B.char ':' <* B.skipSpace

28 body <- bodyLine

20 body <- bodyLine

29 return (name, body)

21 return (name, body)

30

22

benchmarks/TextFastSet.hs+1−3

@@ -62,9 +62,7 @@ resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries)

62

63pad :: Int -> [Entry] -> [Entry]

64pad = 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

65+ where go !_ !m [] = replicate (max 1 m) empty

68 go k m (e:entries) = map (const empty) [k..i - 1] ++ e :

66 go k m (e:entries) = map (const empty) [k..i - 1] ++ e :

69 go (i + 1) (m + i - k - 1) entries

67 go (i + 1) (m + i - k - 1) entries

70 where i = index e

68 where i = index e

benchmarks/attoparsec-benchmarks.cabal−1

@@ -17,7 +17,6 @@ executable attoparsec-benchmarks

17 Numbers

18 Network.Wai.Handler.Warp.ReadInt

19 Sets

20− TextFastSet

21 Warp

20 Warp

22 hs-source-dirs: .. . warp-3.0.1.1

21 hs-source-dirs: .. . warp-3.0.1.1

23 ghc-options: -O2 -Wall -rtsopts

22 ghc-options: -O2 -Wall -rtsopts

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

changelog.md−21

@@ -1,24 +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−

220.13.0.1

10.13.0.1

23

2

24* Fixed a bug in the implementations of inClass and notInClass for

3* Fixed a bug in the implementations of inClass and notInClass for

tests/QC.hs+2−2

@@ -6,11 +6,11 @@ import qualified QC.ByteString as ByteString

6import qualified QC.Combinator as Combinator

7import qualified QC.Simple as Simple

8import qualified QC.Text as Text

9−import Test.Tasty (defaultMain, testGroup)

9+import Test.Framework (defaultMain, testGroup)

10

11main = defaultMain tests

12

13−tests = testGroup "tests" [

13+tests = [

14 testGroup "bs" ByteString.tests

15 , testGroup "buf" Buffer.tests

16 , testGroup "combinator" Combinator.tests

tests/QC/Buffer.hs+3−3

@@ -8,8 +8,8 @@ import Control.Applicative ((<$>))

8import Data.Monoid (Monoid(mconcat))

9#endif

10import QC.Common ()

11−import Test.Tasty (TestTree)

11+import Test.Framework (Test)

12−import Test.Tasty.QuickCheck (testProperty)

12+import Test.Framework.Providers.QuickCheck2 (testProperty)

13import Test.QuickCheck

14import qualified Data.Attoparsec.ByteString.Buffer as BB

15import qualified Data.Attoparsec.Text.Buffer as BT

@@ -82,7 +82,7 @@ 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]

85+tests :: [Test]

86tests = [

87 testProperty "b_unbuffer" b_unbuffer

88 , testProperty "t_unbuffer" t_unbuffer

tests/QC/ByteString.hs+5−7

@@ -9,8 +9,8 @@ import Data.Int (Int64)

9import Data.Word (Word8)

10import Prelude hiding (take, takeWhile)

11import QC.Common (ASCII(..), liftOp, parseBS, toStrictBS)

12−import Test.Tasty (TestTree)

12+import Test.Framework (Test)

13−import Test.Tasty.QuickCheck (testProperty)

13+import Test.Framework.Providers.QuickCheck2 (testProperty)

14import Test.QuickCheck

15import qualified Data.Attoparsec.ByteString as P

16import qualified Data.Attoparsec.ByteString.Char8 as P8

@@ -26,11 +26,9 @@ import qualified Data.ByteString.Lazy.Char8 as L8

26satisfy :: Word8 -> L.ByteString -> Property

27satisfy w s = parseBS (P.satisfy (<=w)) (L.cons w s) === Just w

28

29−satisfyWith :: Word8 -> L.ByteString -> Property

29+satisfyWith :: Char -> L.ByteString -> Property

30−satisfyWith w s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))

30+satisfyWith c s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))

31 (L.cons (fromIntegral (ord c)) s) === Just c

32− where

33− c = chr (fromIntegral w)

34

32

35word8 :: Word8 -> L.ByteString -> Property

33word8 :: Word8 -> L.ByteString -> Property

36word8 w s = parseBS (P.word8 w) (L.cons w s) === Just w

34word8 w s = parseBS (P.word8 w) (L.cons w s) === Just w

@@ -157,7 +155,7 @@ nonmembers :: [Word8] -> [Word8] -> Property

157nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s'

155nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s'

158 where set = S.fromList s

156 where set = S.fromList s

159

157

160−tests :: [TestTree]

158+tests :: [Test]

161tests = [

159tests = [

162 testProperty "anyWord8" anyWord8

160 testProperty "anyWord8" anyWord8

163 , testProperty "endOfInput" endOfInput

161 , testProperty "endOfInput" endOfInput

tests/QC/Combinator.hs+3−3

@@ -8,8 +8,8 @@ import Control.Applicative ((<*>), (<$>), (<*), (*>))

8import Data.Maybe (fromJust, isJust)

9import Data.Word (Word8)

10import QC.Common (Repack, parseBS, repackBS, toLazyBS)

11−import Test.Tasty (TestTree)

11+import Test.Framework (Test)

12−import Test.Tasty.QuickCheck (testProperty)

12+import Test.Framework.Providers.QuickCheck2 (testProperty)

13import Test.QuickCheck

14import qualified Data.Attoparsec.ByteString.Char8 as P

15import qualified Data.Attoparsec.Combinator as C

@@ -43,7 +43,7 @@ match n (NonNegative x) (NonNegative y) rs =

43 B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'

44 ]

45

46−tests :: [TestTree]

46+tests :: [Test]

47tests = [

48 testProperty "choice" choice

49 , testProperty "count" count

tests/QC/Simple.hs+3−3

@@ -10,8 +10,8 @@ import Data.ByteString (ByteString)

10import Data.List (foldl')

11import Data.Maybe (fromMaybe)

12import QC.Rechunked (rechunkBS)

13−import Test.Tasty (TestTree)

13+import Test.Framework (Test)

14−import Test.Tasty.QuickCheck (testProperty)

14+import Test.Framework.Providers.QuickCheck2 (testProperty)

15import Test.QuickCheck (Property, counterexample, forAll)

16import qualified Data.Attoparsec.ByteString.Char8 as A

17

@@ -31,7 +31,7 @@ parse :: A.Parser r -> [ByteString] -> A.Result r

31parse p (x:xs) = foldl' A.feed (A.parse p x) xs

32parse p [] = A.parse p ""

33

34−tests :: [TestTree]

34+tests :: [Test]

35tests = [

36 testProperty "issue75" t_issue75

37 ]

tests/QC/Text.hs+6−18

@@ -6,21 +6,16 @@ module QC.Text (tests) where

6import Control.Applicative ((<*>), (<$>))

7#endif

8import Data.Int (Int64)

9−import Data.Word (Word8)

10import Prelude hiding (take, takeWhile)

9import Prelude hiding (take, takeWhile)

11import QC.Common (liftOp, parseT)

10import QC.Common (liftOp, parseT)

12−import qualified QC.Text.FastSet as FastSet

11+import Test.Framework (Test)

13−import qualified QC.Text.Regressions as Regressions

14−import Test.Tasty (TestTree, testGroup)

15−import Test.Tasty.QuickCheck (testProperty)

12+import Test.Framework.Providers.QuickCheck2 (testProperty)

16import Test.QuickCheck

13import Test.QuickCheck

17import qualified Data.Attoparsec.Text as P

14import qualified Data.Attoparsec.Text as P

18import qualified Data.Attoparsec.Text.Lazy as PL

15import qualified Data.Attoparsec.Text.Lazy as PL

19import qualified Data.Attoparsec.Text.FastSet as S

16import qualified Data.Attoparsec.Text.FastSet as S

20−import qualified Data.ByteString as BS

21import qualified Data.Char as Char

17import qualified Data.Char as Char

22import qualified Data.Text as T

18import qualified Data.Text as T

23−import qualified Data.Text.Encoding as TE

24import qualified Data.Text.Lazy as L

19import qualified Data.Text.Lazy as L

25

20

26-- Basic byte-level combinators.

21-- Basic byte-level combinators.

@@ -73,12 +68,9 @@ strings s t u =

73 === Just t'

68 === Just t'

74 where t' = toStrict t

69 where t' = toStrict t

75

70

76−-- | Note: "simple, and efficient" works for well formed input...

77−-- i.e. e.g. Latin1 texts

78−stringCI :: [Word8] -> Property

71+stringCI :: T.Text -> Property

79−stringCI ws = P.parseOnly (P.stringCI fs) s === Right s

72+stringCI s = P.parseOnly (P.stringCI fs) s === Right s

80 where fs = T.toCaseFold s

73 where fs = T.toCaseFold s

81− s = TE.decodeLatin1 (BS.pack ws)

82

74

83asciiCI :: T.Text -> Gen Bool

75asciiCI :: T.Text -> Gen Bool

84asciiCI x =

76asciiCI x =

@@ -156,9 +148,7 @@ endOfLine s =

156 (c, fst <$> L.uncons s') === ('\r', Just '\n')

148 (c, fst <$> L.uncons s') === ('\r', Just '\n')

157

149

158scan :: L.Text -> Positive Int64 -> Property

150scan :: L.Text -> Positive Int64 -> Property

159−-- for some reason, if counterexample is removed, this test fails?

160−scan s (Positive k) = counterexample (show s)

161− $ parseT p s === Just (toStrict $ L.take k s)

151+scan s (Positive k) = parseT p s === Just (toStrict $ L.take k s)

162 where p = P.scan k $ \ n _ ->

152 where p = P.scan k $ \ n _ ->

163 if n > 0 then let !n' = n - 1 in Just n' else Nothing

153 if n > 0 then let !n' = n - 1 in Just n' else Nothing

164

154

@@ -170,7 +160,7 @@ nonmembers :: String -> String -> Property

170nonmembers s s' = property . not . any (`S.member` set) $ filter (not . (`elem` s)) s'

160nonmembers s s' = property . not . any (`S.member` set) $ filter (not . (`elem` s)) s'

171 where set = S.fromList s

161 where set = S.fromList s

172

162

173−tests :: [TestTree]

163+tests :: [Test]

174tests = [

164tests = [

175 testProperty "anyChar" anyChar

165 testProperty "anyChar" anyChar

176 , testProperty "asciiCI" asciiCI

166 , testProperty "asciiCI" asciiCI

@@ -198,6 +188,4 @@ tests = [

198 , testProperty "takeWhile1_empty" takeWhile1_empty

188 , testProperty "takeWhile1_empty" takeWhile1_empty

199 , testProperty "members" members

189 , testProperty "members" members

200 , testProperty "nonmembers" nonmembers

190 , testProperty "nonmembers" nonmembers

201− , testGroup "FastSet" FastSet.tests

202− , testGroup "Regressions" Regressions.tests

203 ]

191 ]

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