master..85bc992 · typeable/attoparsec

.gitignore−1

since splitsnapshots

unifiedsplit

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

3/dist/

4.cabal-sandbox

5cabal.sandbox.config

6−*.sw[op]

.hgtags−5

@@ -56,8 +56,3 @@ c9c2b05707b2fffcd749d5817e3e0d04e6ad6d0d 0.12.1.0

569157c2b4c35aa5f683b4ac51e6ff52c696bc22e2 0.12.1.1

57682ba515f7ba62500ad79371b37b90932e0c0e3d 0.12.1.2

582066a72b79b478f59a9c7f1839c522fc59ba9af7 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+4−7

@@ -4,7 +4,7 @@

4#endif

5-- |

6-- Module : Data.Attoparsec.ByteString

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

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

8-- License : BSD3

9--

10-- Maintainer : bos@serpentine.com

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

63 , I.skipWhile

64 , I.take

65 , I.scan

66− , I.runScanner

67 , I.takeWhile

66 , I.takeWhile

68 , I.takeWhile1

67 , I.takeWhile1

69 , I.takeTill

68 , I.takeTill

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

97 ) where

96 ) where

98

97

99import Data.Attoparsec.Combinator

98import Data.Attoparsec.Combinator

100−import Data.List (intercalate)

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

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

102import qualified Data.Attoparsec.Internal as I

100import qualified Data.Attoparsec.Internal as I

103import qualified Data.ByteString as B

101import qualified Data.ByteString as B

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

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

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

225-- result is treated as failure.

223-- result is treated as failure.

226eitherResult :: Result r -> Either String r

224eitherResult :: Result r -> Either String r

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

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

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

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

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

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

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

Data/Attoparsec/ByteString/Buffer.hs+9−11

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

1−{-# LANGUAGE BangPatterns #-}

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

2-- |

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

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

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

5-- License : BSD3

6--

7-- Maintainer : bos@serpentine.com

@@ -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/Char8.hs+17−6

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

7

8-- |

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

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

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

11-- License : BSD3

12--

13-- Maintainer : bos@serpentine.com

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

70

71 -- * Efficient string handling

72 , I.string

73− , I.stringCI

73+ , stringCI

74 , skipSpace

75 , skipWhile

76 , I.take

@@ -128,10 +128,10 @@ module Data.Attoparsec.ByteString.Char8

128 ) where

129

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

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

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

132import Data.Word (Word)

133#endif

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

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

135import Control.Monad (void, when)

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

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

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

169-- 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@.

171

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

173+toLower :: Word8 -> Word8

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

175+ | otherwise = w

176+

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

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

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

180+{-# INLINE stringCI #-}

181+

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

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

173-- the consumed input.

183-- the consumed input.

174--

184--

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

444

454

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

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

446decimal :: Integral a => Parser a

456decimal :: Integral a => Parser a

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

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

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

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

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

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

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

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

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

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

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

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/ByteString/Internal.hs+33−84

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

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

1+{-# LANGUAGE BangPatterns, GADTs, 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

@@ -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,10 +65,7 @@ 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)

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

70import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)

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

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

@@ -78,7 +74,6 @@ import Data.Attoparsec.Internal

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

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

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

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

80import Data.ByteString (ByteString)

76import Data.ByteString (ByteString)

81−import Data.List (intercalate)

82import Data.Word (Word8)

77import Data.Word (Word8)

83import Foreign.ForeignPtr (withForeignPtr)

78import Foreign.ForeignPtr (withForeignPtr)

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

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

@@ -144,12 +139,19 @@ storable = hack undefined

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

139 return . inlinePerformIO . withForeignPtr fp $ \p ->

145 peek (castPtr $ p `plusPtr` o)

140 peek (castPtr $ p `plusPtr` o)

146

141

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

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

143+-- returns 'True'.

148−take :: Int -> Parser ByteString

144+takeWith :: Int -> (ByteString -> Bool) -> Parser ByteString

149−take n0 = do

145+takeWith n0 p = do

150 let n = max n0 0

146 let n = max n0 0

151 s <- ensure n

147 s <- ensure n

148+ if p s

152− advance n >> return s

149+ then advance n >> return s

150+ else fail "takeWith"

151+

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

153+take :: Int -> Parser ByteString

154+take n = takeWith n (const True)

153{-# INLINE take #-}

155{-# INLINE take #-}

154

156

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

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

@@ -168,59 +170,13 @@ take n0 = do

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

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

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

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

170string :: ByteString -> Parser ByteString

172string :: ByteString -> Parser ByteString

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

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

172{-# INLINE string #-}

174{-# INLINE string #-}

173

175

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

176+stringTransform :: (ByteString -> ByteString) -> ByteString

175−toLower :: Word8 -> Word8

177+ -> Parser ByteString

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

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

177− | otherwise = w

179+{-# 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

180

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

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

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

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

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

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.

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

215takeWhile :: (Word8 -> Bool) -> Parser 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 continue <- inputSpansChunks (B.length s)

274 if continue

221 if continue

275 then go (s:acc)

222 then go (s:acc)

276− else return $ concatReverse (s:acc)

223+ else return (s:acc)

277−{-# INLINE takeWhileAcc #-}

224+{-# INLINE takeWhile #-}

278

225

279takeRest :: Parser [ByteString]

226takeRest :: Parser [ByteString]

280takeRest = go []

227takeRest = go []

@@ -338,13 +285,16 @@ scan_ f s0 p = go [] s0

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

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

339-- in an infinite loop.

286-- in an infinite loop.

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

287scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString

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

288+scan = scan_ $ \_ chunks ->

289+ case chunks of

290+ [x] -> return x

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

342{-# INLINE scan #-}

292{-# INLINE scan #-}

343

293

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

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

345-- scanner.

295-- scanner.

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

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

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

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

348{-# INLINE runScanner #-}

298{-# INLINE runScanner #-}

349

299

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

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

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

364 advance len

314 advance len

365 eoc <- endOfChunk

315 eoc <- endOfChunk

366 if eoc

316 if eoc

367− then takeWhileAcc p [s]

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

368 else return s

318 else return s

369−{-# INLINE takeWhile1 #-}

370

319

371-- | Match any byte in a set.

320-- | Match any byte in a set.

372--

321--

@@ -467,10 +416,9 @@ parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK

467-- @

416-- @

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

417parseOnly :: Parser a -> ByteString -> Either String a

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

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

470− Fail _ [] err -> Left err

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

419+ Fail _ _ err -> Left err

472− Done _ a -> Right a

420+ Done _ a -> Right a

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

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

474{-# INLINE parseOnly #-}

422{-# INLINE parseOnly #-}

475

423

476get :: Parser ByteString

424get :: Parser ByteString

@@ -517,6 +465,7 @@ ensure n = T.Parser $ \t pos more lose succ ->

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

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

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

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

519 else ensureSuspended n t pos more lose succ

467 else ensureSuspended n t pos more lose succ

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

520{-# INLINE ensure #-}

469{-# INLINE ensure #-}

521

470

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

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

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

@@ -5,7 +5,7 @@

5

6-- |

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

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

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

9-- License : BSD3

10--

11-- Maintainer : bos@serpentine.com

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

41

42import Control.DeepSeq (NFData(rnf))

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

44−import Data.List (intercalate)

45import qualified Data.ByteString as B

44import qualified Data.ByteString as B

46import qualified Data.Attoparsec.ByteString as A

45import qualified Data.Attoparsec.ByteString as A

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

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

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

105

104

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

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

107eitherResult :: Result r -> Either String r

106eitherResult :: Result r -> Either String r

108−eitherResult (Done _ r) = Right r

107+eitherResult (Done _ r) = Right r

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

108+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+4−3

@@ -4,7 +4,7 @@

4#endif

5-- |

6-- Module : Data.Attoparsec.Combinator

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

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

8-- License : BSD3

9--

10-- Maintainer : bos@serpentine.com

@@ -40,10 +40,11 @@ module Data.Attoparsec.Combinator

40 ) where

41

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

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

43+import Control.Applicative (Applicative(..))

44import Data.Monoid (Monoid(mappend))

45#endif

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

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

47+ (<$>))

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

48import Control.Monad (MonadPlus(..))

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

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

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

50import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem)

Data/Attoparsec/Internal.hs+5−31

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

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

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

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

@@ -15,18 +15,13 @@ module Data.Attoparsec.Internal

15 ( compareResults

16 , prompt

17 , demandInput

18− , demandInput_

19 , wantInput

18 , wantInput

20 , endOfInput

19 , endOfInput

21 , atEnd

20 , atEnd

22 , satisfyElem

21 , satisfyElem

23− , concatReverse

24 ) where

22 ) where

25

23

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

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

24import Control.Applicative ((<$>))

28−import Data.Monoid (Monoid, mconcat)

29−#endif

30import Data.Attoparsec.Internal.Types

25import Data.Attoparsec.Internal.Types

31import Data.ByteString (ByteString)

26import Data.ByteString (ByteString)

32import Data.Text (Text)

27import Data.Text (Text)

@@ -45,8 +40,8 @@ compareResults (Done t0 r0) (Done t1 r1) =

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

40compareResults (Partial _) (Partial _) = Nothing

46compareResults _ _ = Just False

41compareResults _ _ = Just False

47

42

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

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

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

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

50prompt :: Chunk t

45prompt :: Chunk t

51 => State t -> Pos -> More

46 => State t -> Pos -> More

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

47 -> (State t -> Pos -> More -> IResult t r)

@@ -73,25 +68,12 @@ demandInput :: Chunk t => Parser t ()

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

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

74 case more of

69 case more of

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

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

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

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

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

72 succ' t' pos' more' = succ t' pos' more' ()

78 in prompt t pos more lose' succ'

73 in prompt t pos more lose' succ'

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

74{-# SPECIALIZE demandInput :: Parser ByteString () #-}

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

75{-# SPECIALIZE demandInput :: Parser Text () #-}

81

76

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

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

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

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

97-- of all input has been reached.

79-- of all input has been reached.

@@ -161,11 +143,3 @@ satisfyElem p = Parser $ \t pos more lose succ ->

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

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

162 Nothing -> satisfySuspended p t pos more lose succ

144 Nothing -> satisfySuspended p t pos more lose succ

163{-# INLINE satisfyElem #-}

145{-# 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+29−39

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

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

1+{-# LANGUAGE BangPatterns, CPP, 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

@@ -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(..))

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

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

31+#endif

32+import 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/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+1−1

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

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

Data/Attoparsec/Text.hs+6−9

@@ -6,7 +6,7 @@

6

7-- |

8-- Module : Data.Attoparsec.Text

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

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

10-- License : BSD3

11--

12-- Maintainer : bos@serpentine.com

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

72 , skipSpace

73 , I.skipWhile

74 , I.scan

75− , I.runScanner

76 , I.take

75 , I.take

77 , I.takeWhile

76 , I.takeWhile

78 , I.takeWhile1

77 , I.takeWhile1

@@ -127,10 +126,10 @@ module Data.Attoparsec.Text

127 ) where

126 ) where

128

127

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

128#if !MIN_VERSION_base(4,8,0)

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

129+import Control.Applicative (pure, (*>), (<*))

131import Data.Word (Word)

130import Data.Word (Word)

132#endif

131#endif

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

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

134import Data.Attoparsec.Combinator

133import Data.Attoparsec.Combinator

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

134import Data.Attoparsec.Number (Number(..))

136import Data.Scientific (Scientific)

135import Data.Scientific (Scientific)

@@ -139,7 +138,6 @@ import Data.Attoparsec.Text.Internal (Parser, Result, parse, takeWhile1)

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

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

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

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

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

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

142−import Data.List (intercalate)

143import Data.Text (Text)

141import Data.Text (Text)

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

142import Data.Word (Word8, Word16, Word32, Word64)

145import qualified Data.Attoparsec.Internal as I

143import qualified Data.Attoparsec.Internal as I

@@ -266,10 +264,9 @@ maybeResult _ = Nothing

266-- | Convert a 'Result' value to an 'Either' value. A 'Partial' result

264-- | Convert a 'Result' value to an 'Either' value. A 'Partial' result

267-- is treated as failure.

265-- is treated as failure.

268eitherResult :: Result r -> Either String r

266eitherResult :: Result r -> Either String r

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

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

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

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

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

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

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

273

270

274-- | A predicate that matches either a carriage return @\'\\r\'@ or

271-- | A predicate that matches either a carriage return @\'\\r\'@ or

275-- newline @\'\\n\'@ character.

272-- newline @\'\\n\'@ character.

Data/Attoparsec/Text/Buffer.hs+9−19

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

3

4-- |

5-- Module : Data.Attoparsec.Text.Buffer

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

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

7-- License : BSD3

8--

9-- Maintainer : bos@serpentine.com

@@ -28,7 +28,6 @@ module Data.Attoparsec.Text.Buffer

28 Buffer

29 , buffer

30 , unbuffer

31− , unbufferAt

32 , length

31 , length

33 , pappend

32 , pappend

34 , iter

33 , iter

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

40import Control.Exception (assert)

39import Control.Exception (assert)

41import Data.Bits (shiftR)

40import Data.Bits (shiftR)

42import Data.List (foldl1')

41import Data.List (foldl1')

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

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

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

43+import Data.Monoid (Monoid(..))

44+#endif

45import Data.Text ()

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

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

@@ -74,25 +74,15 @@ buffer (Text arr off len) = Buf arr off len len 0

74unbuffer :: Buffer -> Text

75unbuffer (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−

88instance Monoid Buffer where

77instance Monoid Buffer where

89 mempty = Buf A.empty 0 0 0 0

78 mempty = Buf A.empty 0 0 0 0

90− {-# INLINE mempty #-}

91

79

92− mappend = (<>)

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

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

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

93

83

94− mconcat [] = Mon.mempty

84+ mconcat [] = mempty

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

85+ mconcat xs = foldl1' mappend xs

96

86

97pappend :: Buffer -> Text -> Buffer

87pappend :: Buffer -> Text -> Buffer

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

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

Data/Attoparsec/Text/FastSet.hs+2−4

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

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

4-- |

5-- Module : Data.Attoparsec.FastSet

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

6+-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2014

7-- License : BSD3

8--

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

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

Data/Attoparsec/Text/Internal.hs+35−77

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

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

@@ -65,15 +65,14 @@ 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 ((<?>))

71import Data.Attoparsec.Internal

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

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

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

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

75+import Data.Char (chr, ord)

76−import Data.List (intercalate)

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

76import Data.String (IsString(..))

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

77import Data.Text.Internal (Text(..))

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

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

@@ -160,46 +159,9 @@ take n = takeWith (max n 0) (const True)

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

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

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

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

162string :: Text -> Parser Text

161string :: Text -> Parser Text

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

162+string s = takeWith (T.length s) (==s)

164{-# INLINE string #-}

163{-# INLINE string #-}

165

164

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.

165-- | Satisfy a literal string, ignoring case.

204--

166--

205-- Note: this function is currently quite inefficient. Unicode case

167-- Note: this function is currently quite inefficient. Unicode case

@@ -222,16 +184,23 @@ stringCI s = go 0

222

184

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

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

224asciiCI :: Text -> Parser Text

186asciiCI :: Text -> Parser Text

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

187+asciiCI input = do

188+ (k,t) <- ensure n

189+ if asciiToLower t == s

190+ then advance k >> return t

191+ else fail "asciiCI"

192+ where

193+ n = T.length input

194+ s = asciiToLower input

195+

196+ -- convert letters in the ASCII range to lower-case

197+ asciiToLower = T.map f

198+ where

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

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

201+ | otherwise = c

226{-# INLINE asciiCI #-}

202{-# INLINE asciiCI #-}

227

203

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

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

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

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

237skipWhile p = go

206skipWhile p = go

@@ -267,25 +236,14 @@ 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 continue <- inputSpansChunks (size h)

285 if continue

244 if continue

286 then go (h:acc)

245 then go (h:acc)

287− else return $ concatReverse (h:acc)

246+ else return (h:acc)

288−{-# INLINE takeWhileAcc #-}

289

247

290takeRest :: Parser [Text]

248takeRest :: Parser [Text]

291takeRest = go []

249takeRest = go []

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

308takeLazyText = L.fromChunks `fmap` takeRest

266takeLazyText = L.fromChunks `fmap` takeRest

309

267

310data Scan s = Continue s

268data Scan s = Continue s

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

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

312

270

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

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

314scan_ f s0 p = go [] s0

272scan_ f s0 p = go [] s0

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

317 case T.uncons t of

275 case T.uncons t of

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

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

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

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

320− Nothing -> Finished s n t

278+ Nothing -> Finished n t

321 Nothing -> Continue s

279 Nothing -> Continue s

322 go acc s = do

280 go acc s = do

323 input <- get

281 input <- get

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

326 if continue

284 if continue

327 then go (input : acc) s'

285 then go (input : acc) s'

328 else f s' (input : acc)

286 else f s' (input : acc)

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

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

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

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

331{-# INLINE scan_ #-}

289{-# INLINE scan_ #-}

332

290

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

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

@@ -343,13 +301,16 @@ scan_ f s0 p = go [] s0

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

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

344-- in an infinite loop.

302-- in an infinite loop.

345scan :: s -> (s -> Char -> Maybe s) -> Parser Text

303scan :: s -> (s -> Char -> Maybe s) -> Parser Text

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

304+scan = scan_ $ \_ chunks ->

305+ case chunks of

306+ [x] -> return x

307+ xs -> return . T.concat . reverse $ xs

347{-# INLINE scan #-}

308{-# INLINE scan #-}

348

309

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

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

350-- scanner.

311-- scanner.

351runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)

312runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)

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

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

353{-# INLINE runScanner #-}

314{-# INLINE runScanner #-}

354

315

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

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

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

367 advance size'

328 advance size'

368 eoc <- endOfChunk

329 eoc <- endOfChunk

369 if eoc

330 if eoc

370− then takeWhileAcc p [h]

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

371 else return h

332 else return h

372−{-# INLINE takeWhile1 #-}

373

333

374-- | Match any character in a set.

334-- | Match any character in a set.

375--

335--

@@ -469,10 +429,9 @@ parse m s = runParser m (buffer s) 0 Incomplete failK successK

469-- @

429-- @

470parseOnly :: Parser a -> Text -> Either String a

430parseOnly :: Parser a -> Text -> Either String a

471parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of

431parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of

472− Fail _ [] err -> Left err

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

432+ Fail _ _ err -> Left err

474− Done _ a -> Right a

433+ Done _ a -> Right a

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

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

476{-# INLINE parseOnly #-}

435{-# INLINE parseOnly #-}

477

436

478get :: Parser Text

437get :: Parser Text

@@ -517,6 +476,7 @@ ensure n = T.Parser $ \t pos more lose succ ->

517 Just n' -> succ t pos more (n', substring pos n' t)

476 Just n' -> succ t pos more (n', substring pos n' t)

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

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

519 Nothing -> ensureSuspended n t pos more lose succ

478 Nothing -> ensureSuspended n t pos more lose succ

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

520{-# INLINE ensure #-}

480{-# INLINE ensure #-}

521

481

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

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

@@ -527,8 +487,6 @@ match p = T.Parser $ \t pos more lose succ ->

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

487 (substring pos (pos'-pos) t', a)

528 in runParser p t pos more lose succ'

488 in runParser p t pos more lose succ'

529

489

530−-- | Ensure that at least @n@ code points of input are available.

531−-- Returns the number of words consumed while traversing.

532lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos

490lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos

533lengthAtLeast pos n t = go 0 (fromPos pos)

491lengthAtLeast pos n t = go 0 (fromPos pos)

534 where go i !p

492 where go i !p

Data/Attoparsec/Text/Lazy.hs+3−5

@@ -6,7 +6,7 @@

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

7-- |

8-- Module : Data.Attoparsec.Text.Lazy

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

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

10-- License : BSD3

11--

12-- Maintainer : bos@serpentine.com

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

41 ) where

42

43import Control.DeepSeq (NFData(rnf))

44−import Data.List (intercalate)

45import Data.Text.Lazy.Internal (Text(..), chunk)

44import Data.Text.Lazy.Internal (Text(..), chunk)

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

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

47import qualified Data.Attoparsec.Text as A

46import qualified Data.Attoparsec.Text as A

@@ -96,6 +95,5 @@ maybeResult _ = Nothing

96

95

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

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

98eitherResult :: Result r -> Either String r

97eitherResult :: Result r -> Either String r

99−eitherResult (Done _ r) = Right r

98+eitherResult (Done _ r) = Right r

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

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

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

Data/Attoparsec/Types.hs+1−1

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

Data/Attoparsec/Zepto.hs+44−82

@@ -2,11 +2,11 @@

2#if __GLASGOW_HASKELL__ >= 702

3{-# LANGUAGE Trustworthy #-} -- Data.ByteString.Unsafe

4#endif

5−{-# LANGUAGE BangPatterns #-}

5+{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}

6

7-- |

8-- Module : Data.Attoparsec.Zepto

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

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

10-- License : BSD3

11--

12-- Maintainer : bos@serpentine.com

@@ -27,139 +27,101 @@

27module Data.Attoparsec.Zepto

28 (

29 Parser

30− , ZeptoT

31 , parse

30 , parse

32− , parseT

33 , atEnd

31 , atEnd

34 , string

32 , string

35 , take

33 , take

36 , takeWhile

34 , takeWhile

37 ) where

35 ) where

38

36

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)

37import Data.Word (Word8)

48−import Prelude hiding (take, takeWhile)

38+import Control.Applicative

39+import Control.Monad

40+import Data.Monoid

49import qualified Data.ByteString as B

41import qualified Data.ByteString as B

50import qualified Data.ByteString.Unsafe as B

42import qualified Data.ByteString.Unsafe as B

43+import Data.ByteString (ByteString)

44+import Prelude hiding (take, takeWhile)

51

45

52newtype S = S {

46newtype S = S {

53 input :: ByteString

47 input :: ByteString

54 }

48 }

55

49

56data Result a = Fail String

50data Result a = Fail String

57− | OK !a S

51+ | OK !a

58

52

59-- | A simple parser.

53-- | A simple parser.

60--

54--

61-- This monad is strict in its state, and the monadic bind operator

55-- This monad is strict in its state, and the monadic bind operator

62-- ('>>=') evaluates each result to weak head normal form before

56-- ('>>=') evaluates each result to weak head normal form before

63-- passing it along.

57-- passing it along.

64−newtype ZeptoT m a = Parser {

58+newtype Parser a = Parser {

65− runParser :: S -> m (Result a)

59+ runParser :: S -> (# Result a, S #)

66 }

60 }

67

61

68−type Parser a = ZeptoT Identity a

69−

70−instance Monad m => Functor (ZeptoT m) where

62+instance Functor Parser where

71− fmap f m = Parser $ \s -> do

63+ 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')

64+ (# OK a, s' #) -> (# OK (f a), s' #)

75− Fail err -> return (Fail err)

65+ (# Fail err, s' #) -> (# Fail err, s' #)

76 {-# INLINE fmap #-}

66 {-# INLINE fmap #-}

77

67

78−instance MonadIO m => MonadIO (ZeptoT m) where

68+instance Monad Parser where

79− liftIO act = Parser $ \s -> do

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

70 {-# INLINE return #-}

87

71

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

72+ 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'

73+ (# OK a, s' #) -> runParser (k a) s'

92− Fail err -> return (Fail err)

74+ (# Fail err, s' #) -> (# Fail err, s' #)

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

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

94

76

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

96− fail = Fail.fail

77+ fail msg = Parser $ \s -> (# Fail msg, s #)

97− {-# INLINE fail #-}

98−#endif

99

78

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

79+instance MonadPlus Parser where

105 mzero = fail "mzero"

80 mzero = fail "mzero"

106 {-# INLINE mzero #-}

81 {-# INLINE mzero #-}

107

82

108− mplus a b = Parser $ \s -> do

83+ mplus a b = Parser $ \s ->

109− result <- runParser a s

84+ case runParser a s of

110− case result of

85+ (# ok@(OK _), s' #) -> (# ok, s' #)

86+ (# _, _ #) -> case runParser b s of

111− ok@(OK _ _) -> return ok

87+ (# ok@(OK _), s'' #) -> (# ok, s'' #)

112− _ -> runParser b s

88+ (# err, s'' #) -> (# err, s'' #)

113 {-# INLINE mplus #-}

89 {-# INLINE mplus #-}

114

90

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

91+instance Applicative Parser where

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

92+ pure = return

117 {-# INLINE pure #-}

93 {-# INLINE pure #-}

118 (<*>) = ap

94 (<*>) = ap

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

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

120

96

121−gets :: Monad m => (S -> a) -> ZeptoT m a

97+gets :: (S -> a) -> Parser a

122−gets f = Parser $ \s -> return (OK (f s) s)

98+gets f = Parser $ \s -> (# OK (f s), s #)

123{-# INLINE gets #-}

99{-# INLINE gets #-}

124

100

125−put :: Monad m => S -> ZeptoT m ()

101+put :: S -> Parser ()

126−put s = Parser $ \_ -> return (OK () s)

102+put s = Parser $ \_ -> (# OK (), s #)

127{-# INLINE put #-}

103{-# INLINE put #-}

128

104

129-- | Run a parser.

105-- | Run a parser.

130parse :: Parser a -> ByteString -> Either String a

106parse :: Parser a -> ByteString -> Either String a

131−parse p bs = case runIdentity (runParser p (S bs)) of

107+parse p bs = case runParser p (S bs) of

132− (OK a _) -> Right a

108+ (# 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)

109+ (# Fail err, _ #) -> Left err

143−{-# INLINE parseT #-}

110+

144−

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

112 mempty = fail "mempty"

151 {-# INLINE mempty #-}

113 {-# INLINE mempty #-}

152− mappend = (<>)

114+ mappend = mplus

153 {-# INLINE mappend #-}

115 {-# INLINE mappend #-}

154

116

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

117+instance Alternative Parser where

156 empty = fail "empty"

118 empty = fail "empty"

157 {-# INLINE empty #-}

119 {-# INLINE empty #-}

158 (<|>) = mplus

120 (<|>) = mplus

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

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

160

122

161-- | Consume input while the predicate returns 'True'.

123-- | Consume input while the predicate returns 'True'.

162−takeWhile :: Monad m => (Word8 -> Bool) -> ZeptoT m ByteString

124+takeWhile :: (Word8 -> Bool) -> Parser ByteString

163takeWhile p = do

125takeWhile p = do

164 (h,t) <- gets (B.span p . input)

126 (h,t) <- gets (B.span p . input)

165 put (S t)

127 put (S t)

@@ -167,7 +129,7 @@ takeWhile p = do

167{-# INLINE takeWhile #-}

129{-# INLINE takeWhile #-}

168

130

169-- | Consume @n@ bytes of input.

131-- | Consume @n@ bytes of input.

170−take :: Monad m => Int -> ZeptoT m ByteString

132+take :: Int -> Parser ByteString

171take !n = do

133take !n = do

172 s <- gets input

134 s <- gets input

173 if B.length s >= n

135 if B.length s >= n

@@ -176,7 +138,7 @@ take !n = do

176{-# INLINE take #-}

138{-# INLINE take #-}

177

139

178-- | Match a string exactly.

140-- | Match a string exactly.

179−string :: Monad m => ByteString -> ZeptoT m ()

141+string :: ByteString -> Parser ()

180string s = do

142string s = do

181 i <- gets input

143 i <- gets input

182 if s `B.isPrefixOf` i

144 if s `B.isPrefixOf` i

@@ -185,7 +147,7 @@ string s = do

185{-# INLINE string #-}

147{-# INLINE string #-}

186

148

187-- | Indicate whether the end of the input has been reached.

149-- | Indicate whether the end of the input has been reached.

188−atEnd :: Monad m => ZeptoT m Bool

150+atEnd :: Parser Bool

189atEnd = do

151atEnd = do

190 i <- gets input

152 i <- gets input

191 return $! B.null i

153 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+11−56

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

1name: attoparsec

2−version: 0.13.2.2

2+version: 0.12.1.3

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

@@ -31,7 +29,6 @@ extra-source-files:

31 examples/Makefile

29 examples/Makefile

32 tests/*.hs

30 tests/*.hs

33 tests/QC/*.hs

31 tests/QC/*.hs

34− tests/QC/IPv6/*.hs

35

32

36Flag developer

33Flag developer

37 Description: Whether to build the library in development mode

34 Description: Whether to build the library in development mode

@@ -40,22 +37,16 @@ Flag developer

40

37

41library

38library

42 build-depends: array,

39 build-depends: array,

43− base >= 4.3 && < 5,

40+ base >= 4.2 && < 5,

44 bytestring,

41 bytestring,

45 containers,

42 containers,

46 deepseq,

43 deepseq,

47 scientific >= 0.3.1 && < 0.4,

44 scientific >= 0.3.1 && < 0.4,

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

49 text >= 1.1.1.3

45 text >= 1.1.1.3

50 if impl(ghc < 7.4)

46 if impl(ghc < 7.4)

51 build-depends:

47 build-depends:

52 bytestring < 0.10.4.0

48 bytestring < 0.10.4.0

53

49

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

50 exposed-modules: Data.Attoparsec

60 Data.Attoparsec.ByteString

51 Data.Attoparsec.ByteString

61 Data.Attoparsec.ByteString.Char8

52 Data.Attoparsec.ByteString.Char8

@@ -91,31 +82,9 @@ test-suite tests

91 QC.ByteString

82 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

85 QC.Rechunked

97 QC.Simple

86 QC.Simple

98 QC.Text

87 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

88

120 ghc-options:

89 ghc-options:

121 -Wall -threaded -rtsopts

90 -Wall -threaded -rtsopts

@@ -125,23 +94,17 @@ test-suite tests

125

94

126 build-depends:

95 build-depends:

127 array,

96 array,

128− base,

97+ base >= 4 && < 5,

129 bytestring,

98 bytestring,

130 deepseq >= 1.1,

99 deepseq >= 1.1,

131− QuickCheck >= 2.13.2 && < 2.14,

100+ QuickCheck >= 2.7,

132 quickcheck-unicode,

101 quickcheck-unicode,

133 scientific,

102 scientific,

134− tasty >= 0.11,

103+ test-framework >= 0.8.0.2,

135− tasty-quickcheck >= 0.8,

104+ test-framework-quickcheck2 >= 0.3.0.3,

136 text,

105 text,

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

138 vector

106 vector

139

107

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

108benchmark benchmarks

146 type: exitcode-stdio-1.0

109 type: exitcode-stdio-1.0

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

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

@@ -153,11 +116,7 @@ benchmark benchmarks

153 HeadersByteString.Atto

116 HeadersByteString.Atto

154 HeadersText

117 HeadersText

155 Links

118 Links

156− Network.Wai.Handler.Warp.ReadInt

157− Network.Wai.Handler.Warp.RequestHeader

158 Numbers

119 Numbers

159− Sets

160− TextFastSet

161 Warp

120 Warp

162 ghc-options: -O2 -Wall

121 ghc-options: -O2 -Wall

163

122

@@ -169,7 +128,6 @@ benchmark benchmarks

169 base == 4.*,

128 base == 4.*,

170 bytestring >= 0.10.4.0,

129 bytestring >= 0.10.4.0,

171 case-insensitive,

130 case-insensitive,

172− containers,

173 criterion >= 1.0,

131 criterion >= 1.0,

174 deepseq >= 1.1,

132 deepseq >= 1.1,

175 directory,

133 directory,

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

179 parsec >= 3.1.2,

137 parsec >= 3.1.2,

180 scientific,

138 scientific,

181 text >= 1.1.1.0,

139 text >= 1.1.1.0,

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

183 unordered-containers,

140 unordered-containers,

184 vector

141 vector

185

142

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

143source-repository head

192 type: git

144 type: git

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

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

194

146

147+source-repository head

148+ type: mercurial

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

benchmarks/Aeson.hs+2−6

@@ -10,13 +10,8 @@ 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)

15−import Data.Monoid (mappend, mempty)

16−#endif

17−

18import Common (pathTo)

13import Common (pathTo)

19−import Control.Applicative (liftA2)

14+import Control.Applicative ((*>), (<$>), (<*), liftA2, pure)

20import Control.DeepSeq (NFData(..))

15import Control.DeepSeq (NFData(..))

21import Control.Monad (forM)

16import Control.Monad (forM)

22import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,

17import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,

@@ -25,6 +20,7 @@ import Data.Bits ((.|.), shiftL)

25import Data.ByteString (ByteString)

20import Data.ByteString (ByteString)

26import Data.Char (chr)

21import Data.Char (chr)

27import Data.List (sort)

22import Data.List (sort)

23+import Data.Monoid (mappend, mempty)

28import Data.Scientific (Scientific)

24import Data.Scientific (Scientific)

29import Data.Text (Text)

25import Data.Text (Text)

30import Data.Text.Encoding (decodeUtf8')

26import Data.Text.Encoding (decodeUtf8')

benchmarks/Benchmarks.hs−6

@@ -28,7 +28,6 @@ import qualified HeadersByteString

28import qualified HeadersText

29import qualified Links

30import qualified Text.Parsec as P

31−import qualified Sets

32

31

33main :: IO ()

32main :: IO ()

34main = do

33main = do

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

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

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

72 , bench "isAlpha_iso8859_15" $

71 , bench "isAlpha_iso8859_15" $

73 nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl

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

73 ]

77 , bgroup "takeWhile1" [

74 , bgroup "takeWhile1" [

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

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

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

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

77 ]

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

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

84 , bgroup "scan" [

79 , bgroup "scan" [

@@ -91,7 +86,6 @@ main = do

91 , headersT

86 , headersT

92 , Links.links

87 , Links.links

93 , numbers

88 , numbers

94− , Sets.benchmarks

95 , Warp.benchmarks

89 , Warp.benchmarks

96 ]

90 ]

97

91

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/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/attoparsec-benchmarks.cabal−4

@@ -16,8 +16,6 @@ executable attoparsec-benchmarks

16 Links

17 Numbers

18 Network.Wai.Handler.Warp.ReadInt

19− Sets

20− TextFastSet

21 Warp

19 Warp

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

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

23 ghc-options: -O2 -Wall -rtsopts

21 ghc-options: -O2 -Wall -rtsopts

@@ -26,7 +24,6 @@ executable attoparsec-benchmarks

26 base == 4.*,

24 base == 4.*,

27 bytestring >= 0.10.4.0,

25 bytestring >= 0.10.4.0,

28 case-insensitive,

26 case-insensitive,

29− containers,

30 criterion >= 1.0,

27 criterion >= 1.0,

31 deepseq >= 1.1,

28 deepseq >= 1.1,

32 directory,

29 directory,

@@ -36,6 +33,5 @@ executable attoparsec-benchmarks

36 parsec >= 3.1.2,

33 parsec >= 3.1.2,

37 scientific >= 0.3.1,

34 scientific >= 0.3.1,

38 text >= 1.1.1.0,

35 text >= 1.1.1.0,

39− transformers,

40 unordered-containers,

36 unordered-containers,

41 vector

37 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/Network/Wai/Handler/Warp/RequestHeader.hs+1−1

@@ -139,7 +139,7 @@ parseRequestLine requestLine@(PS fptr off len) = withForeignPtr fptr $ \ptr -> d

139

140parseHeader :: ByteString -> H.Header

141parseHeader s =

142− let (k, rest) = S.break (== 58) s -- ':'

142+ let (k, rest) = S.breakByte 58 s -- ':'

143 rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest

144 in (CI.mk k, rest')

145

changelog.md−49

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

500.12.1.3

10.12.1.3

51

2

52* Fixed incorrect tracking of Text lengths

3* Fixed incorrect tracking of Text lengths

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

@@ -3,13 +3,13 @@

3

4module QC.Buffer (tests) where

5

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

7import Control.Applicative ((<$>))

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

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

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+9−25

@@ -2,22 +2,22 @@

2module QC.ByteString (tests) where

3

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

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

5+import Control.Applicative ((<*>))

6#endif

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

7−import Data.Char (chr, ord, toUpper)

8+import Data.Char (chr, ord)

8import Data.Int (Int64)

9import Data.Int (Int64)

9import Data.Word (Word8)

10import Data.Word (Word8)

10import Prelude hiding (take, takeWhile)

11import Prelude hiding (take, takeWhile)

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

12+import QC.Common (liftOp, parseBS, toStrictBS)

12−import Test.Tasty (TestTree)

13+import Test.Framework (Test)

13−import Test.Tasty.QuickCheck (testProperty)

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

14import Test.QuickCheck

15import Test.QuickCheck

15import qualified Data.Attoparsec.ByteString as P

16import qualified Data.Attoparsec.ByteString as P

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

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

17import qualified Data.Attoparsec.ByteString.FastSet as S

18import qualified Data.Attoparsec.ByteString.FastSet as S

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

19import qualified Data.Attoparsec.ByteString.Lazy as PL

19import qualified Data.ByteString as B

20import qualified Data.ByteString as B

20−import qualified Data.ByteString.Char8 as B8

21import qualified Data.ByteString.Lazy as L

22import qualified Data.ByteString.Lazy.Char8 as L8

23

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

@@ -68,18 +66,6 @@ string :: L.ByteString -> L.ByteString -> Property

68string s t = parseBS (P.string s') (s `L.append` t) === Just s'

66string s t = parseBS (P.string s') (s `L.append` t) === Just s'

69 where s' = toStrictBS s

67 where s' = toStrictBS s

70

68

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−

83skipWhile :: Word8 -> L.ByteString -> Property

69skipWhile :: Word8 -> L.ByteString -> Property

84skipWhile w s =

70skipWhile w s =

85 let t = L.dropWhile (<=w) s

71 let t = L.dropWhile (<=w) s

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

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

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

158 where set = S.fromList s

144 where set = S.fromList s

159

145

160−tests :: [TestTree]

146+tests :: [Test]

161tests = [

147tests = [

162 testProperty "anyWord8" anyWord8

148 testProperty "anyWord8" anyWord8

163 , testProperty "endOfInput" endOfInput

149 , testProperty "endOfInput" endOfInput

@@ -171,8 +157,6 @@ tests = [

171 , testProperty "skip" skip

157 , testProperty "skip" skip

172 , testProperty "skipWhile" skipWhile

158 , testProperty "skipWhile" skipWhile

173 , testProperty "string" string

159 , testProperty "string" string

174− , testProperty "stringCI" stringCI

175− , testProperty "strings" strings

176 , testProperty "take" take

160 , testProperty "take" take

177 , testProperty "takeByteString" takeByteString

161 , testProperty "takeByteString" takeByteString

178 , testProperty "takeCount" takeCount

162 , testProperty "takeCount" takeCount

tests/QC/Combinator.hs+5−7

@@ -1,15 +1,13 @@

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

1+{-# LANGUAGE OverloadedStrings #-}

2

3module QC.Combinator where

4

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

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

5+import Control.Applicative

7−#endif

8import Data.Maybe (fromJust, isJust)

6import Data.Maybe (fromJust, isJust)

9import Data.Word (Word8)

7import Data.Word (Word8)

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

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

11−import Test.Tasty (TestTree)

9+import Test.Framework (Test)

12−import Test.Tasty.QuickCheck (testProperty)

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

13import Test.QuickCheck

11import Test.QuickCheck

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

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

15import qualified Data.Attoparsec.Combinator as C

13import qualified Data.Attoparsec.Combinator as C

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

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

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

44 ]

42 ]

45

43

46−tests :: [TestTree]

44+tests :: [Test]

47tests = [

45tests = [

48 testProperty "choice" choice

46 testProperty "choice" choice

49 , testProperty "count" count

47 , testProperty "count" count

tests/QC/Common.hs+4−27

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

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

1+{-# LANGUAGE CPP #-}

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

3module QC.Common

4 (

5− ASCII(..)

6− , parseBS

5+ parseBS

7 , parseT

6 , parseT

8 , toLazyBS

7 , toLazyBS

9 , toStrictBS

8 , toStrictBS

@@ -16,8 +15,9 @@ module QC.Common

16 ) where

15 ) where

17

16

18#if !MIN_VERSION_base(4,8,0)

17#if !MIN_VERSION_base(4,8,0)

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

18+import Control.Applicative ((<*>))

20#endif

19#endif

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

21import Data.Char (isAlpha)

22import Test.QuickCheck

23import Test.QuickCheck.Unicode (shrinkChar, string)

@@ -28,16 +28,6 @@ import qualified Data.Text.Lazy as TL

28import qualified Data.Attoparsec.ByteString.Lazy as BL

29import qualified Data.Attoparsec.Text.Lazy as TL

30

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

31parseBS :: BL.Parser r -> BL.ByteString -> Maybe r

42parseBS p = BL.maybeResult . BL.parse p

32parseBS p = BL.maybeResult . BL.parse p

43

33

@@ -52,22 +42,9 @@ toLazyBS = BL.fromChunks . (:[])

52

42

53instance Arbitrary B.ByteString where

43instance Arbitrary B.ByteString where

54 arbitrary = B.pack <$> arbitrary

44 arbitrary = B.pack <$> arbitrary

55− shrink = map B.pack . shrink . B.unpack

56

45

57instance Arbitrary BL.ByteString where

46instance Arbitrary BL.ByteString where

58 arbitrary = repackBS <$> arbitrary <*> arbitrary

47 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

48

72type Repack = NonEmptyList (Positive (Small Int))

49type Repack = NonEmptyList (Positive (Small Int))

73

50

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

@@ -29,7 +29,7 @@ rechunk_ split len xs = (unfoldr go . (,) xs) `fmap` rechunkSizes (len xs)

29

30rechunkSizes :: Int -> Gen [Int]

31rechunkSizes n0 = shuffle =<< loop [] (0:repeat 1) n0

32− where loop _ [] _ = error "it's 2015, where's my Stream type?"

32+ where loop _ [] _ = error "it's 2014, where's my Stream type?"

33 loop acc (lb:lbs) n

34 | n <= 0 = shuffle (reverse acc)

35 | otherwise = do

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+8−26

@@ -3,24 +3,20 @@

3module QC.Text (tests) where

4

5#if !MIN_VERSION_base(4,8,0)

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

6+import Control.Applicative ((<*>))

7#endif

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

8import Data.Int (Int64)

9import Data.Int (Int64)

9−import Data.Word (Word8)

10import Prelude hiding (take, takeWhile)

11import QC.Common (liftOp, parseT)

12−import qualified QC.Text.FastSet as FastSet

12+import Test.Framework (Test)

13−import qualified QC.Text.Regressions as Regressions

14−import Test.Tasty (TestTree, testGroup)

15−import Test.Tasty.QuickCheck (testProperty)

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

16import Test.QuickCheck

14import Test.QuickCheck

17import qualified Data.Attoparsec.Text as P

15import qualified Data.Attoparsec.Text as P

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

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

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

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

20−import qualified Data.ByteString as BS

21import qualified Data.Char as Char

18import qualified Data.Char as Char

22import qualified Data.Text as T

19import qualified Data.Text as T

23−import qualified Data.Text.Encoding as TE

24import qualified Data.Text.Lazy as L

20import qualified Data.Text.Lazy as L

25

21

26-- Basic byte-level combinators.

22-- Basic byte-level combinators.

@@ -67,18 +63,9 @@ string :: L.Text -> L.Text -> Property

67string s t = parseT (P.string s') (s `L.append` t) === Just s'

63string s t = parseT (P.string s') (s `L.append` t) === Just s'

68 where s' = toStrict s

64 where s' = toStrict s

69

65

70−strings :: L.Text -> L.Text -> L.Text -> Property

66+stringCI :: T.Text -> Property

71−strings s t u =

72− parseT (P.string (toStrict s) >> P.string t') (L.concat [s,t,u])

73− === Just t'

74− where t' = toStrict t

75−

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

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

78−stringCI :: [Word8] -> Property

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

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

80 where fs = T.toCaseFold s

68 where fs = T.toCaseFold s

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

82

69

83asciiCI :: T.Text -> Gen Bool

70asciiCI :: T.Text -> Gen Bool

84asciiCI x =

71asciiCI x =

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

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

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

157

144

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

145scan :: 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)

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

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

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

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

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

164

149

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

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

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

171 where set = S.fromList s

156 where set = S.fromList s

172

157

173−tests :: [TestTree]

158+tests :: [Test]

174tests = [

159tests = [

175 testProperty "anyChar" anyChar

160 testProperty "anyChar" anyChar

176 , testProperty "asciiCI" asciiCI

161 , testProperty "asciiCI" asciiCI

@@ -186,7 +171,6 @@ tests = [

186 , testProperty "skip" skip

171 , testProperty "skip" skip

187 , testProperty "skipWhile" skipWhile

172 , testProperty "skipWhile" skipWhile

188 , testProperty "string" string

173 , testProperty "string" string

189− , testProperty "strings" strings

190 , testProperty "stringCI" stringCI

174 , testProperty "stringCI" stringCI

191 , testProperty "take" take

175 , testProperty "take" take

192 , testProperty "takeText" takeText

176 , testProperty "takeText" takeText

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

198 , testProperty "takeWhile1_empty" takeWhile1_empty

182 , testProperty "takeWhile1_empty" takeWhile1_empty

199 , testProperty "members" members

183 , testProperty "members" members

200 , testProperty "nonmembers" nonmembers

184 , testProperty "nonmembers" nonmembers

201− , testGroup "FastSet" FastSet.tests

202− , testGroup "Regressions" Regressions.tests

203 ]

185 ]

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