git.iko.soy/typeable/attoparsec
on master help sign in
.gitignore+1
since splitsnapshots
unifiedsplit
@@ -3,3 +3,4 @@
3/dist/
3/dist/
4.cabal-sandbox
4.cabal-sandbox
5cabal.sandbox.config
5cabal.sandbox.config
6+*.sw[op]
.hgtags+3
@@ -58,3 +58,6 @@ c9c2b05707b2fffcd749d5817e3e0d04e6ad6d0d 0.12.1.0
582066a72b79b478f59a9c7f1839c522fc59ba9af7 0.12.1.3
582066a72b79b478f59a9c7f1839c522fc59ba9af7 0.12.1.3
59ef875ad3bebef2b6fb1bd7063de6a46a06d0d4b4 0.12.1.4
59ef875ad3bebef2b6fb1bd7063de6a46a06d0d4b4 0.12.1.4
60dc1fcff28d13a508f677c7b06af6420877842493 0.12.1.5
60dc1fcff28d13a508f677c7b06af6420877842493 0.12.1.5
61+013e04e4526bfd5e9e4a611b42e6f03c413bea91 0.12.1.6
62+0ddbce995b77b8db391b4d6519f13feddf4b5bf3 0.13.0.0
63+46c16463ec20ad46c9cd0bfb1050c4268f34b749 0.13.0.1
.travis.ymlnew file+161
@@ -0,0 +1,161 @@
1+# This Travis job script has been generated by a script via
2+#
3+# haskell-ci '--tests-jobs=>=7.4' '--no-benchmarks' 'attoparsec.cabal'
4+#
5+# For more information, see https://github.com/haskell-CI/haskell-ci
6+#
7+# version: 0.3.20190815
8+#
9+language: c
10+dist: xenial
11+git:
12+ # whether to recursively clone submodules
13+ submodules: false
14+cache:
15+ directories:
16+ - $HOME/.cabal/packages
17+ - $HOME/.cabal/store
18+before_cache:
19+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
20+ # remove files that are regenerated by 'cabal update'
21+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
22+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
23+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
24+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
25+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
26+ - rm -rfv $CABALHOME/packages/head.hackage
27+matrix:
28+ include:
29+ - compiler: ghc-8.8.1
30+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}
31+ - compiler: ghc-8.6.5
32+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}
33+ - compiler: ghc-8.4.4
34+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}
35+ - compiler: ghc-8.2.2
36+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}
37+ - compiler: ghc-8.0.2
38+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}}
39+ - compiler: ghc-7.10.3
40+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}}
41+ - compiler: ghc-7.8.4
42+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}}
43+ - compiler: ghc-7.6.3
44+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.6.3","cabal-install-2.4"]}}
45+ - compiler: ghc-7.4.2
46+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.4.2","cabal-install-2.4"]}}
47+ - compiler: ghc-7.2.2
48+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.2.2","cabal-install-2.4"]}}
49+ - compiler: ghc-7.0.4
50+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.0.4","cabal-install-2.4"]}}
51+before_install:
52+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
53+ - WITHCOMPILER="-w $HC"
54+ - HCPKG="$HC-pkg"
55+ - unset CC
56+ - CABAL=/opt/ghc/bin/cabal
57+ - CABALHOME=$HOME/.cabal
58+ - export PATH="$CABALHOME/bin:$PATH"
59+ - TOP=$(pwd)
60+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
61+ - echo $HCNUMVER
62+ - CABAL="$CABAL -vnormal+nowrap+markoutput"
63+ - set -o pipefail
64+ - |
65+ echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk
66+ echo 'BEGIN { state = "output"; }' >> .colorful.awk
67+ echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk
68+ echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk
69+ echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk
70+ echo ' if (state == "cabal") {' >> .colorful.awk
71+ echo ' print blue($0)' >> .colorful.awk
72+ echo ' } else {' >> .colorful.awk
73+ echo ' print $0' >> .colorful.awk
74+ echo ' }' >> .colorful.awk
75+ echo '}' >> .colorful.awk
76+ - cat .colorful.awk
77+ - |
78+ color_cabal_output () {
79+ awk -f $TOP/.colorful.awk
80+ }
81+ - echo text | color_cabal_output
82+install:
83+ - ${CABAL} --version
84+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
85+ - TEST=--enable-tests
86+ - if [ $HCNUMVER -lt 70400 ] ; then TEST=--disable-tests ; fi
87+ - BENCH=--enable-benchmarks
88+ - BENCH=--disable-benchmarks
89+ - HEADHACKAGE=false
90+ - rm -f $CABALHOME/config
91+ - |
92+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
93+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config
94+ echo "write-ghc-environment-files: always" >> $CABALHOME/config
95+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
96+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
97+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config
98+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
99+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
100+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
101+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
102+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
103+ echo "install-dirs user" >> $CABALHOME/config
104+ echo " prefix: $CABALHOME" >> $CABALHOME/config
105+ echo "repository hackage.haskell.org" >> $CABALHOME/config
106+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
107+ - cat $CABALHOME/config
108+ - rm -fv cabal.project cabal.project.local cabal.project.freeze
109+ - travis_retry ${CABAL} v2-update -v
110+ # Generate cabal.project
111+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
112+ - touch cabal.project
113+ - |
114+ echo "packages: ." >> cabal.project
115+ - |
116+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(attoparsec)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
117+ - cat cabal.project || true
118+ - cat cabal.project.local || true
119+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
120+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output
121+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
122+ - rm cabal.project.freeze
123+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output
124+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output
125+script:
126+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
127+ # Packaging...
128+ - ${CABAL} v2-sdist all | color_cabal_output
129+ # Unpacking...
130+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
131+ - cd ${DISTDIR} || false
132+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
133+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
134+ - PKGDIR_attoparsec="$(find . -maxdepth 1 -type d -regex '.*/attoparsec-[0-9.]*')"
135+ # Generate cabal.project
136+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
137+ - touch cabal.project
138+ - |
139+ echo "packages: ${PKGDIR_attoparsec}" >> cabal.project
140+ - |
141+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(attoparsec)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
142+ - cat cabal.project || true
143+ - cat cabal.project.local || true
144+ # Building...
145+ # this builds all libraries and executables (without tests/benchmarks)
146+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
147+ # Building with tests and benchmarks...
148+ # build & run tests, build benchmarks
149+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
150+ # Testing...
151+ - if [ $HCNUMVER -ge 70400 ] ; then ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output ; fi
152+ # cabal check...
153+ - (cd ${PKGDIR_attoparsec} && ${CABAL} -vnormal check)
154+ # haddock...
155+ - ${CABAL} v2-haddock $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
156+ # Building without installed constraints for packages in global-db...
157+ - rm -f cabal.project.local
158+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
159+
160+# REGENDATA ["--tests-jobs=>=7.4","--no-benchmarks","attoparsec.cabal"]
161+# EOF
Data/Attoparsec/ByteString.hs+1
@@ -63,6 +63,7 @@ module Data.Attoparsec.ByteString
63 , I.skipWhile
63 , I.skipWhile
64 , I.take
64 , I.take
65 , I.scan
65 , I.scan
66+ , I.runScanner
66 , I.takeWhile
67 , I.takeWhile
67 , I.takeWhile1
68 , I.takeWhile1
68 , I.takeTill
69 , I.takeTill
Data/Attoparsec/ByteString/Buffer.hs+10−8
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP #-}
1+{-# LANGUAGE BangPatterns #-}
2-- |
2-- |
3-- Module : Data.Attoparsec.ByteString.Buffer
3-- Module : Data.Attoparsec.ByteString.Buffer
4-- Copyright : Bryan O'Sullivan 2007-2015
4-- Copyright : Bryan O'Sullivan 2007-2015
@@ -57,9 +57,8 @@ import Control.Exception (assert)
57import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
57import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
58import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
58import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
59import Data.List (foldl1')
59import Data.List (foldl1')
60−#if !MIN_VERSION_base(4,8,0)
60+import Data.Monoid as Mon (Monoid(..))
61−import Data.Monoid (Monoid(..))
61+import Data.Semigroup (Semigroup(..))
62−#endif
63import Data.Word (Word8)
62import Data.Word (Word8)
64import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
63import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
65import Foreign.Ptr (castPtr, plusPtr)
64import Foreign.Ptr (castPtr, plusPtr)
@@ -88,14 +87,17 @@ buffer (PS fp off len) = Buf fp off len len 0
88unbuffer :: Buffer -> ByteString
87unbuffer :: Buffer -> ByteString
89unbuffer (Buf fp off len _ _) = PS fp off len
88unbuffer (Buf fp off len _ _) = PS fp off len
90
89
90+instance Semigroup Buffer where
91+ (Buf _ _ _ 0 _) <> b = b
92+ a <> (Buf _ _ _ 0 _) = a
93+ buf <> (Buf fp off len _ _) = append buf fp off len
94+
91instance Monoid Buffer where
95instance Monoid Buffer where
92 mempty = Buf nullForeignPtr 0 0 0 0
96 mempty = Buf nullForeignPtr 0 0 0 0
93
97
94− mappend (Buf _ _ _ 0 _) b = b
98+ mappend = (<>)
95− mappend a (Buf _ _ _ 0 _) = a
96− mappend buf (Buf fp off len _ _) = append buf fp off len
97
99
98− mconcat [] = mempty
100+ mconcat [] = Mon.mempty
99 mconcat xs = foldl1' mappend xs
101 mconcat xs = foldl1' mappend xs
100
102
101pappend :: Buffer -> ByteString -> Buffer
103pappend :: Buffer -> ByteString -> Buffer
Data/Attoparsec/ByteString/Char8.hs+4−5
@@ -128,10 +128,10 @@ module Data.Attoparsec.ByteString.Char8
128 ) where
128 ) where
129
129
130#if !MIN_VERSION_base(4,8,0)
130#if !MIN_VERSION_base(4,8,0)
131−import Control.Applicative (pure, (*>), (<*))
131+import Control.Applicative (pure, (*>), (<*), (<$>))
132import Data.Word (Word)
132import Data.Word (Word)
133#endif
133#endif
134−import Control.Applicative ((<$>), (<|>))
134+import Control.Applicative ((<|>))
135import Control.Monad (void, when)
135import Control.Monad (void, when)
136import Data.Attoparsec.ByteString.FastSet (charClass, memberChar)
136import Data.Attoparsec.ByteString.FastSet (charClass, memberChar)
137import Data.Attoparsec.ByteString.Internal (Parser)
137import Data.Attoparsec.ByteString.Internal (Parser)
@@ -444,9 +444,8 @@ hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit
444
444
445-- | Parse and decode an unsigned decimal number.
445-- | Parse and decode an unsigned decimal number.
446decimal :: Integral a => Parser a
446decimal :: Integral a => Parser a
447−decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig
447+decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDigit_w8
448− where isDig w = w >= 48 && w <= 57
449− step a w = a * 10 + fromIntegral (w - 48)
448+ where step a w = a * 10 + fromIntegral (w - 48)
450{-# SPECIALISE decimal :: Parser Int #-}
449{-# SPECIALISE decimal :: Parser Int #-}
451{-# SPECIALISE decimal :: Parser Int8 #-}
450{-# SPECIALISE decimal :: Parser Int8 #-}
452{-# SPECIALISE decimal :: Parser Int16 #-}
451{-# SPECIALISE decimal :: Parser Int16 #-}
Data/Attoparsec/ByteString/Internal.hs+22−11
@@ -1,4 +1,5 @@
1−{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RankNTypes, RecordWildCards #-}
1+{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,
2+ RecordWildCards #-}
2-- |
3-- |
3-- Module : Data.Attoparsec.ByteString.Internal
4-- Module : Data.Attoparsec.ByteString.Internal
4-- Copyright : Bryan O'Sullivan 2007-2015
5-- Copyright : Bryan O'Sullivan 2007-2015
@@ -65,7 +66,10 @@ module Data.Attoparsec.ByteString.Internal
65 , atEnd
66 , atEnd
66 ) where
67 ) where
67
68
69+#if !MIN_VERSION_base(4,8,0)
68−import Control.Applicative ((<|>), (<$>))
70+import Control.Applicative ((<$>))
71+#endif
72+import Control.Applicative ((<|>))
69import Control.Monad (when)
73import Control.Monad (when)
70import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
74import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
71import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
75import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
@@ -253,15 +257,24 @@ takeTill p = takeWhile (not . p)
253-- parsers loop until a failure occurs. Careless use will thus result
257-- parsers loop until a failure occurs. Careless use will thus result
254-- in an infinite loop.
258-- in an infinite loop.
255takeWhile :: (Word8 -> Bool) -> Parser ByteString
259takeWhile :: (Word8 -> Bool) -> Parser ByteString
256−takeWhile p = (B.concat . reverse) `fmap` go []
260+takeWhile p = do
261+ s <- B8.takeWhile p <$> get
262+ continue <- inputSpansChunks (B.length s)
263+ if continue
264+ then takeWhileAcc p [s]
265+ else return s
266+{-# INLINE takeWhile #-}
267+
268+takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
269+takeWhileAcc p = go
257 where
270 where
258 go acc = do
271 go acc = do
259 s <- B8.takeWhile p <$> get
272 s <- B8.takeWhile p <$> get
260 continue <- inputSpansChunks (B.length s)
273 continue <- inputSpansChunks (B.length s)
261 if continue
274 if continue
262 then go (s:acc)
275 then go (s:acc)
263− else return (s:acc)
276+ else return $ concatReverse (s:acc)
264−{-# INLINE takeWhile #-}
277+{-# INLINE takeWhileAcc #-}
265
278
266takeRest :: Parser [ByteString]
279takeRest :: Parser [ByteString]
267takeRest = go []
280takeRest = go []
@@ -325,16 +338,13 @@ scan_ f s0 p = go [] s0
325-- parsers loop until a failure occurs. Careless use will thus result
338-- parsers loop until a failure occurs. Careless use will thus result
326-- in an infinite loop.
339-- in an infinite loop.
327scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
340scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
328−scan = scan_ $ \_ chunks ->
341+scan = scan_ $ \_ chunks -> return $! concatReverse chunks
329− case chunks of
330− [x] -> return x
331− xs -> return $! B.concat $ reverse xs
332{-# INLINE scan #-}
342{-# INLINE scan #-}
333
343
334-- | Like 'scan', but generalized to return the final state of the
344-- | Like 'scan', but generalized to return the final state of the
335-- scanner.
345-- scanner.
336runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
346runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
337−runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
347+runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
338{-# INLINE runScanner #-}
348{-# INLINE runScanner #-}
339
349
340-- | Consume input as long as the predicate returns 'True', and return
350-- | Consume input as long as the predicate returns 'True', and return
@@ -354,8 +364,9 @@ takeWhile1 p = do
354 advance len
364 advance len
355 eoc <- endOfChunk
365 eoc <- endOfChunk
356 if eoc
366 if eoc
357− then (s<>) `fmap` takeWhile p
367+ then takeWhileAcc p [s]
358 else return s
368 else return s
369+{-# INLINE takeWhile1 #-}
359
370
360-- | Match any byte in a set.
371-- | Match any byte in a set.
361--
372--
Data/Attoparsec/Combinator.hs+2−3
@@ -40,11 +40,10 @@ module Data.Attoparsec.Combinator
40 ) where
40 ) where
41
41
42#if !MIN_VERSION_base(4,8,0)
42#if !MIN_VERSION_base(4,8,0)
43−import Control.Applicative (Applicative(..))
43+import Control.Applicative (Applicative(..), (<$>))
44import Data.Monoid (Monoid(mappend))
44import Data.Monoid (Monoid(mappend))
45#endif
45#endif
46−import Control.Applicative (Alternative(..), empty, liftA2, many, (<|>),
46+import Control.Applicative (Alternative(..), empty, liftA2, many, (<|>))
47− (<$>))
48import Control.Monad (MonadPlus(..))
47import Control.Monad (MonadPlus(..))
49import Data.Attoparsec.Internal.Types (Parser(..), IResult(..))
48import Data.Attoparsec.Internal.Types (Parser(..), IResult(..))
50import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem)
49import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem)
Data/Attoparsec/Internal.hs+13−1
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
1+{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}
2-- |
2-- |
3-- Module : Data.Attoparsec.Internal
3-- Module : Data.Attoparsec.Internal
4-- Copyright : Bryan O'Sullivan 2007-2015
4-- Copyright : Bryan O'Sullivan 2007-2015
@@ -20,9 +20,13 @@ module Data.Attoparsec.Internal
20 , endOfInput
20 , endOfInput
21 , atEnd
21 , atEnd
22 , satisfyElem
22 , satisfyElem
23+ , concatReverse
23 ) where
24 ) where
24
25
26+#if !MIN_VERSION_base(4,8,0)
25import Control.Applicative ((<$>))
27import Control.Applicative ((<$>))
28+import Data.Monoid (Monoid, mconcat)
29+#endif
26import Data.Attoparsec.Internal.Types
30import Data.Attoparsec.Internal.Types
27import Data.ByteString (ByteString)
31import Data.ByteString (ByteString)
28import Data.Text (Text)
32import Data.Text (Text)
@@ -157,3 +161,11 @@ satisfyElem p = Parser $ \t pos more lose succ ->
157 | otherwise -> lose t pos more [] "satisfyElem"
161 | otherwise -> lose t pos more [] "satisfyElem"
158 Nothing -> satisfySuspended p t pos more lose succ
162 Nothing -> satisfySuspended p t pos more lose succ
159{-# INLINE satisfyElem #-}
163{-# INLINE satisfyElem #-}
164+
165+-- | Concatenate a monoid after reversing its elements. Used to
166+-- glue together a series of textual chunks that have been accumulated
167+-- \"backwards\".
168+concatReverse :: Monoid m => [m] -> m
169+concatReverse [x] = x
170+concatReverse xs = mconcat (reverse xs)
171+{-# INLINE concatReverse #-}
Data/Attoparsec/Internal/Types.hs+38−28
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, OverloadedStrings,
1+{-# LANGUAGE CPP, BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,
2 Rank2Types, RecordWildCards, TypeFamilies #-}
2 Rank2Types, RecordWildCards, TypeFamilies #-}
3-- |
3-- |
4-- Module : Data.Attoparsec.Internal.Types
4-- Module : Data.Attoparsec.Internal.Types
@@ -25,13 +25,13 @@ module Data.Attoparsec.Internal.Types
25 , Chunk(..)
25 , Chunk(..)
26 ) where
26 ) where
27
27
28−#if !MIN_VERSION_base(4,8,0)
29−import Control.Applicative (Applicative(..))
28+import Control.Applicative as App (Applicative(..), (<$>))
30−import Data.Monoid (Monoid(..))
29+import Control.Applicative (Alternative(..))
31−#endif
32−import Control.Applicative (Alternative(..), (<$>))
33import Control.DeepSeq (NFData(rnf))
30import Control.DeepSeq (NFData(rnf))
34import Control.Monad (MonadPlus(..))
31import 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)
35import Data.Word (Word8)
36import Data.ByteString (ByteString)
36import Data.ByteString (ByteString)
37import qualified Data.ByteString as BS
37import qualified Data.ByteString as BS
@@ -39,7 +39,7 @@ import Data.ByteString.Internal (w2c)
39import Data.Text (Text)
39import Data.Text (Text)
40import qualified Data.Text as Text
40import qualified Data.Text as Text
41import Data.Text.Unsafe (Iter(..))
41import Data.Text.Unsafe (Iter(..))
42−import Prelude hiding (getChar, succ)
42+import Prelude hiding (succ)
43import qualified Data.Attoparsec.ByteString.Buffer as B
43import qualified Data.Attoparsec.ByteString.Buffer as B
44import qualified Data.Attoparsec.Text.Buffer as T
44import qualified Data.Attoparsec.Text.Buffer as T
45
45
@@ -127,17 +127,21 @@ type Success i t a r = t -> Pos -> More -> a -> IResult i r
127data More = Complete | Incomplete
127data More = Complete | Incomplete
128 deriving (Eq, Show)
128 deriving (Eq, Show)
129
129
130−instance Monoid More where
130+instance Semigroup More where
131− mappend c@Complete _ = c
131+ c@Complete <> _ = c
132− mappend _ m = m
132+ _ <> m = m
133+
134+instance Mon.Monoid More where
135+ mappend = (<>)
133− mempty = Incomplete
136+ mempty = Incomplete
134
137
135instance Monad (Parser i) where
138instance Monad (Parser i) where
136− fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg
139+#if !(MIN_VERSION_base(4,13,0))
137− where msg = "Failed reading: " ++ err
140+ fail = Fail.fail
138 {-# INLINE fail #-}
141 {-# INLINE fail #-}
142+#endif
139
143
140− return v = Parser $ \t pos more _lose succ -> succ t pos more v
144+ return = App.pure
141 {-# INLINE return #-}
145 {-# INLINE return #-}
142
146
143 m >>= k = Parser $ \t !pos more lose succ ->
147 m >>= k = Parser $ \t !pos more lose succ ->
@@ -145,6 +149,15 @@ instance Monad (Parser i) where
145 in runParser m t pos more lose succ'
149 in runParser m t pos more lose succ'
146 {-# INLINE (>>=) #-}
150 {-# INLINE (>>=) #-}
147
151
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+
148plus :: Parser i a -> Parser i a -> Parser i a
161plus :: Parser i a -> Parser i a -> Parser i a
149plus f g = Parser $ \t pos more lose succ ->
162plus f g = Parser $ \t pos more lose succ ->
150 let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ
163 let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ
@@ -169,23 +182,23 @@ apP d e = do
169{-# INLINE apP #-}
182{-# INLINE apP #-}
170
183
171instance Applicative (Parser i) where
184instance Applicative (Parser i) where
172− pure = return
185+ pure v = Parser $ \t !pos more _lose succ -> succ t pos more v
173 {-# INLINE pure #-}
186 {-# INLINE pure #-}
174 (<*>) = apP
187 (<*>) = apP
175 {-# INLINE (<*>) #-}
188 {-# INLINE (<*>) #-}
176−
189+ m *> k = m >>= \_ -> k
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− (*>) = (>>)
181 {-# INLINE (*>) #-}
190 {-# INLINE (*>) #-}
182− x <* y = x >>= \a -> y >> return a
191+ x <* y = x >>= \a -> y >> pure a
183 {-# INLINE (<*) #-}
192 {-# INLINE (<*) #-}
184
193
194+instance Semigroup (Parser i a) where
195+ (<>) = plus
196+ {-# INLINE (<>) #-}
197+
185instance Monoid (Parser i a) where
198instance Monoid (Parser i a) where
186 mempty = fail "mempty"
199 mempty = fail "mempty"
187 {-# INLINE mempty #-}
200 {-# INLINE mempty #-}
188− mappend = plus
201+ mappend = (<>)
189 {-# INLINE mappend #-}
202 {-# INLINE mappend #-}
190
203
191instance Alternative (Parser i) where
204instance Alternative (Parser i) where
@@ -196,8 +209,9 @@ instance Alternative (Parser i) where
196 {-# INLINE (<|>) #-}
209 {-# INLINE (<|>) #-}
197
210
198 many v = many_v
211 many v = many_v
212+ where
199− where many_v = some_v <|> pure []
213+ many_v = some_v <|> pure []
200− some_v = (:) <$> v <*> many_v
214+ some_v = (:) <$> v <*> many_v
201 {-# INLINE many #-}
215 {-# INLINE many #-}
202
216
203 some v = some_v
217 some v = some_v
@@ -206,10 +220,6 @@ instance Alternative (Parser i) where
206 some_v = (:) <$> v <*> many_v
220 some_v = (:) <$> v <*> many_v
207 {-# INLINE some #-}
221 {-# INLINE some #-}
208
222
209−(<>) :: (Monoid m) => m -> m -> m
210−(<>) = mappend
211−{-# INLINE (<>) #-}
212−
213-- | A common interface for input chunks.
223-- | A common interface for input chunks.
214class Monoid c => Chunk c where
224class Monoid c => Chunk c where
215 type ChunkElem c
225 type ChunkElem c
Data/Attoparsec/Text.hs+3−2
@@ -72,6 +72,7 @@ module Data.Attoparsec.Text
72 , skipSpace
72 , skipSpace
73 , I.skipWhile
73 , I.skipWhile
74 , I.scan
74 , I.scan
75+ , I.runScanner
75 , I.take
76 , I.take
76 , I.takeWhile
77 , I.takeWhile
77 , I.takeWhile1
78 , I.takeWhile1
@@ -126,10 +127,10 @@ module Data.Attoparsec.Text
126 ) where
127 ) where
127
128
128#if !MIN_VERSION_base(4,8,0)
129#if !MIN_VERSION_base(4,8,0)
129−import Control.Applicative (pure, (*>), (<*))
130+import Control.Applicative (pure, (*>), (<*), (<$>))
130import Data.Word (Word)
131import Data.Word (Word)
131#endif
132#endif
132−import Control.Applicative ((<$>), (<|>))
133+import Control.Applicative ((<|>))
133import Data.Attoparsec.Combinator
134import Data.Attoparsec.Combinator
134import Data.Attoparsec.Number (Number(..))
135import Data.Attoparsec.Number (Number(..))
135import Data.Scientific (Scientific)
136import Data.Scientific (Scientific)
Data/Attoparsec/Text/Buffer.hs+12−8
@@ -40,9 +40,8 @@ module Data.Attoparsec.Text.Buffer
40import Control.Exception (assert)
40import Control.Exception (assert)
41import Data.Bits (shiftR)
41import Data.Bits (shiftR)
42import Data.List (foldl1')
42import Data.List (foldl1')
43−#if !MIN_VERSION_base(4,8,0)
43+import Data.Monoid as Mon (Monoid(..))
44−import Data.Monoid (Monoid(..))
44+import Data.Semigroup (Semigroup(..))
45−#endif
46import Data.Text ()
45import Data.Text ()
47import Data.Text.Internal (Text(..))
46import Data.Text.Internal (Text(..))
48import Data.Text.Internal.Encoding.Utf16 (chr2)
47import Data.Text.Internal.Encoding.Utf16 (chr2)
@@ -80,15 +79,20 @@ unbufferAt s (Buf arr off len _ _) =
80 assert (s >= 0 && s <= len) $
79 assert (s >= 0 && s <= len) $
81 Text arr (off+s) (len-s)
80 Text arr (off+s) (len-s)
82
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+
83instance Monoid Buffer where
88instance Monoid Buffer where
84 mempty = Buf A.empty 0 0 0 0
89 mempty = Buf A.empty 0 0 0 0
90+ {-# INLINE mempty #-}
85
91
86− mappend (Buf _ _ _ 0 _) b = b
92+ mappend = (<>)
87− mappend a (Buf _ _ _ 0 _) = a
88− mappend buf (Buf arr off len _ _) = append buf arr off len
89
93
90− mconcat [] = mempty
94+ mconcat [] = Mon.mempty
91− mconcat xs = foldl1' mappend xs
95+ mconcat xs = foldl1' (<>) xs
92
96
93pappend :: Buffer -> Text -> Buffer
97pappend :: Buffer -> Text -> Buffer
94pappend (Buf _ _ _ 0 _) t = buffer t
98pappend (Buf _ _ _ 0 _) t = buffer t
Data/Attoparsec/Text/FastSet.hs+3−1
@@ -62,7 +62,9 @@ resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries)
62
62
63pad :: Int -> [Entry] -> [Entry]
63pad :: Int -> [Entry] -> [Entry]
64pad = go 0
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
65− where go !_ !m [] = replicate (max 1 m) empty
67+ go !_ !m [] = replicate (max 1 m + 1) empty
66 go k m (e:entries) = map (const empty) [k..i - 1] ++ e :
68 go k m (e:entries) = map (const empty) [k..i - 1] ++ e :
67 go (i + 1) (m + i - k - 1) entries
69 go (i + 1) (m + i - k - 1) entries
68 where i = index e
70 where i = index e
Data/Attoparsec/Text/Internal.hs+31−21
@@ -65,14 +65,14 @@ module Data.Attoparsec.Text.Internal
65 , atEnd
65 , atEnd
66 ) where
66 ) where
67
67
68−import Control.Applicative ((<|>), (<$>))
68+import Control.Applicative ((<|>), (<$>), pure, (*>))
69import Control.Monad (when)
69import Control.Monad (when)
70import Data.Attoparsec.Combinator ((<?>))
70import Data.Attoparsec.Combinator ((<?>))
71import Data.Attoparsec.Internal
71import Data.Attoparsec.Internal
72import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
72import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
73import qualified Data.Attoparsec.Text.Buffer as Buf
73import qualified Data.Attoparsec.Text.Buffer as Buf
74import Data.Attoparsec.Text.Buffer (Buffer, buffer)
74import Data.Attoparsec.Text.Buffer (Buffer, buffer)
75−import Data.Char (chr, ord)
75+import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)
76import Data.List (intercalate)
76import Data.List (intercalate)
77import Data.String (IsString(..))
77import Data.String (IsString(..))
78import Data.Text.Internal (Text(..))
78import Data.Text.Internal (Text(..))
@@ -222,15 +222,16 @@ stringCI s = go 0
222
222
223-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
223-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
224asciiCI :: Text -> Parser Text
224asciiCI :: Text -> Parser Text
225−asciiCI s = string_ (stringSuspended asciiToLower) asciiToLower s
225+asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s
226− where
227− asciiToLower = T.map f
228− where
229− offset = ord 'a' - ord 'A'
230− f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)
231− | otherwise = c
232{-# INLINE asciiCI #-}
226{-# INLINE asciiCI #-}
233
227
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+
234-- | Skip past input for as long as the predicate returns 'True'.
235-- | Skip past input for as long as the predicate returns 'True'.
235skipWhile :: (Char -> Bool) -> Parser ()
236skipWhile :: (Char -> Bool) -> Parser ()
236skipWhile p = go
237skipWhile p = go
@@ -266,14 +267,25 @@ takeTill p = takeWhile (not . p)
266-- parsers loop until a failure occurs. Careless use will thus result
267-- parsers loop until a failure occurs. Careless use will thus result
267-- in an infinite loop.
268-- in an infinite loop.
268takeWhile :: (Char -> Bool) -> Parser Text
269takeWhile :: (Char -> Bool) -> Parser Text
269−takeWhile p = (T.concat . reverse) `fmap` go []
270+takeWhile p = do
271+ h <- T.takeWhile p <$> get
272+ continue <- inputSpansChunks (size h)
273+ -- only use slow concat path if necessary
274+ if continue
275+ then takeWhileAcc p [h]
276+ else return h
277+{-# INLINE takeWhile #-}
278+
279+takeWhileAcc :: (Char -> Bool) -> [Text] -> Parser Text
280+takeWhileAcc p = go
270 where
281 where
271 go acc = do
282 go acc = do
272 h <- T.takeWhile p <$> get
283 h <- T.takeWhile p <$> get
273 continue <- inputSpansChunks (size h)
284 continue <- inputSpansChunks (size h)
274 if continue
285 if continue
275 then go (h:acc)
286 then go (h:acc)
276− else return (h:acc)
287+ else return $ concatReverse (h:acc)
288+{-# INLINE takeWhileAcc #-}
277
289
278takeRest :: Parser [Text]
290takeRest :: Parser [Text]
279takeRest = go []
291takeRest = go []
@@ -296,7 +308,7 @@ takeLazyText :: Parser L.Text
296takeLazyText = L.fromChunks `fmap` takeRest
308takeLazyText = L.fromChunks `fmap` takeRest
297
309
298data Scan s = Continue s
310data Scan s = Continue s
299− | Finished {-# UNPACK #-} !Int Text
311+ | Finished s {-# UNPACK #-} !Int Text
300
312
301scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
313scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
302scan_ f s0 p = go [] s0
314scan_ f s0 p = go [] s0
@@ -305,7 +317,7 @@ scan_ f s0 p = go [] s0
305 case T.uncons t of
317 case T.uncons t of
306 Just (c,t') -> case p s c of
318 Just (c,t') -> case p s c of
307 Just s' -> scanner s' (n+1) t'
319 Just s' -> scanner s' (n+1) t'
308− Nothing -> Finished n t
320+ Nothing -> Finished s n t
309 Nothing -> Continue s
321 Nothing -> Continue s
310 go acc s = do
322 go acc s = do
311 input <- get
323 input <- get
@@ -314,8 +326,8 @@ scan_ f s0 p = go [] s0
314 if continue
326 if continue
315 then go (input : acc) s'
327 then go (input : acc) s'
316 else f s' (input : acc)
328 else f s' (input : acc)
317− Finished n t -> do advance (size input - size t)
329+ Finished s' n t -> do advance (size input - size t)
318− f s (T.take n input : acc)
330+ f s' (T.take n input : acc)
319{-# INLINE scan_ #-}
331{-# INLINE scan_ #-}
320
332
321-- | A stateful scanner. The predicate consumes and transforms a
333-- | A stateful scanner. The predicate consumes and transforms a
@@ -331,16 +343,13 @@ scan_ f s0 p = go [] s0
331-- parsers loop until a failure occurs. Careless use will thus result
343-- parsers loop until a failure occurs. Careless use will thus result
332-- in an infinite loop.
344-- in an infinite loop.
333scan :: s -> (s -> Char -> Maybe s) -> Parser Text
345scan :: s -> (s -> Char -> Maybe s) -> Parser Text
334−scan = scan_ $ \_ chunks ->
346+scan = scan_ $ \_ chunks -> return $! concatReverse chunks
335− case chunks of
336− [x] -> return x
337− xs -> return . T.concat . reverse $ xs
338{-# INLINE scan #-}
347{-# INLINE scan #-}
339
348
340-- | Like 'scan', but generalized to return the final state of the
349-- | Like 'scan', but generalized to return the final state of the
341-- scanner.
350-- scanner.
342runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
351runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
343−runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)
352+runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
344{-# INLINE runScanner #-}
353{-# INLINE runScanner #-}
345
354
346-- | Consume input as long as the predicate returns 'True', and return
355-- | Consume input as long as the predicate returns 'True', and return
@@ -358,8 +367,9 @@ takeWhile1 p = do
358 advance size'
367 advance size'
359 eoc <- endOfChunk
368 eoc <- endOfChunk
360 if eoc
369 if eoc
361− then (h<>) `fmap` takeWhile p
370+ then takeWhileAcc p [h]
362 else return h
371 else return h
372+{-# INLINE takeWhile1 #-}
363
373
364-- | Match any character in a set.
374-- | Match any character in a set.
365--
375--
Data/Attoparsec/Zepto.hs+81−43
@@ -2,7 +2,7 @@
2#if __GLASGOW_HASKELL__ >= 702
2#if __GLASGOW_HASKELL__ >= 702
3{-# LANGUAGE Trustworthy #-} -- Data.ByteString.Unsafe
3{-# LANGUAGE Trustworthy #-} -- Data.ByteString.Unsafe
4#endif
4#endif
5−{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
5+{-# LANGUAGE BangPatterns #-}
6
6
7-- |
7-- |
8-- Module : Data.Attoparsec.Zepto
8-- Module : Data.Attoparsec.Zepto
@@ -27,101 +27,139 @@
27module Data.Attoparsec.Zepto
27module Data.Attoparsec.Zepto
28 (
28 (
29 Parser
29 Parser
30+ , ZeptoT
30 , parse
31 , parse
32+ , parseT
31 , atEnd
33 , atEnd
32 , string
34 , string
33 , take
35 , take
34 , takeWhile
36 , takeWhile
35 ) where
37 ) where
36
38
37−import Data.Word (Word8)
38import Control.Applicative
39import Control.Applicative
39−import Control.Monad
40+import Control.Monad (MonadPlus(..), ap)
40−import Data.Monoid
41−import qualified Data.ByteString as B
41+import qualified Control.Monad.Fail as Fail
42−import qualified Data.ByteString.Unsafe as B
42+import Control.Monad.IO.Class (MonadIO(..))
43import Data.ByteString (ByteString)
43import Data.ByteString (ByteString)
44+import Data.Functor.Identity (Identity(runIdentity))
45+import Data.Monoid as Mon (Monoid(..))
46+import Data.Semigroup (Semigroup(..))
47+import Data.Word (Word8)
44import Prelude hiding (take, takeWhile)
48import Prelude hiding (take, takeWhile)
49+import qualified Data.ByteString as B
50+import qualified Data.ByteString.Unsafe as B
45
51
46newtype S = S {
52newtype S = S {
47 input :: ByteString
53 input :: ByteString
48 }
54 }
49
55
50data Result a = Fail String
56data Result a = Fail String
51− | OK !a
57+ | OK !a S
52
58
53-- | A simple parser.
59-- | A simple parser.
54--
60--
55-- This monad is strict in its state, and the monadic bind operator
61-- This monad is strict in its state, and the monadic bind operator
56-- ('>>=') evaluates each result to weak head normal form before
62-- ('>>=') evaluates each result to weak head normal form before
57-- passing it along.
63-- passing it along.
58−newtype Parser a = Parser {
64+newtype ZeptoT m a = Parser {
59− runParser :: S -> (# Result a, S #)
65+ runParser :: S -> m (Result a)
60 }
66 }
61
67
68+type Parser a = ZeptoT Identity a
69+
62−instance Functor Parser where
70+instance Monad m => Functor (ZeptoT m) where
63− fmap f m = Parser $ \s -> case runParser m s of
71+ fmap f m = Parser $ \s -> do
72+ result <- runParser m s
73+ case result of
64− (# OK a, s' #) -> (# OK (f a), s' #)
74+ OK a s' -> return (OK (f a) s')
65− (# Fail err, s' #) -> (# Fail err, s' #)
75+ Fail err -> return (Fail err)
66 {-# INLINE fmap #-}
76 {-# INLINE fmap #-}
67
77
68−instance Monad Parser where
78+instance MonadIO m => MonadIO (ZeptoT m) where
69− return a = Parser $ \s -> (# OK a, s #)
79+ liftIO act = Parser $ \s -> do
80+ result <- liftIO act
81+ return (OK result s)
82+ {-# INLINE liftIO #-}
83+
84+instance Monad m => Monad (ZeptoT m) where
85+ return = pure
70 {-# INLINE return #-}
86 {-# INLINE return #-}
71
87
72− m >>= k = Parser $ \s -> case runParser m s of
88+ m >>= k = Parser $ \s -> do
89+ result <- runParser m s
90+ case result of
73− (# OK a, s' #) -> runParser (k a) s'
91+ OK a s' -> runParser (k a) s'
74− (# Fail err, s' #) -> (# Fail err, s' #)
92+ Fail err -> return (Fail err)
75 {-# INLINE (>>=) #-}
93 {-# INLINE (>>=) #-}
76
94
95+#if !(MIN_VERSION_base(4,13,0))
77− fail msg = Parser $ \s -> (# Fail msg, s #)
96+ fail = Fail.fail
97+ {-# INLINE fail #-}
98+#endif
78
99
79−instance MonadPlus Parser where
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
80 mzero = fail "mzero"
105 mzero = fail "mzero"
81 {-# INLINE mzero #-}
106 {-# INLINE mzero #-}
82
107
83− mplus a b = Parser $ \s ->
108+ mplus a b = Parser $ \s -> do
84− case runParser a s of
109+ result <- runParser a s
110+ case result of
85− (# ok@(OK _), s' #) -> (# ok, s' #)
111+ ok@(OK _ _) -> return ok
86− (# _, _ #) -> case runParser b s of
112+ _ -> runParser b s
87− (# ok@(OK _), s'' #) -> (# ok, s'' #)
88− (# err, s'' #) -> (# err, s'' #)
89 {-# INLINE mplus #-}
113 {-# INLINE mplus #-}
90
114
91−instance Applicative Parser where
115+instance (Monad m) => Applicative (ZeptoT m) where
92− pure = return
116+ pure a = Parser $ \s -> return (OK a s)
93 {-# INLINE pure #-}
117 {-# INLINE pure #-}
94 (<*>) = ap
118 (<*>) = ap
95 {-# INLINE (<*>) #-}
119 {-# INLINE (<*>) #-}
96
120
97−gets :: (S -> a) -> Parser a
121+gets :: Monad m => (S -> a) -> ZeptoT m a
98−gets f = Parser $ \s -> (# OK (f s), s #)
122+gets f = Parser $ \s -> return (OK (f s) s)
99{-# INLINE gets #-}
123{-# INLINE gets #-}
100
124
101−put :: S -> Parser ()
125+put :: Monad m => S -> ZeptoT m ()
102−put s = Parser $ \_ -> (# OK (), s #)
126+put s = Parser $ \_ -> return (OK () s)
103{-# INLINE put #-}
127{-# INLINE put #-}
104
128
105-- | Run a parser.
129-- | Run a parser.
106parse :: Parser a -> ByteString -> Either String a
130parse :: Parser a -> ByteString -> Either String a
107−parse p bs = case runParser p (S bs) of
131+parse p bs = case runIdentity (runParser p (S bs)) of
108− (# OK a, _ #) -> Right a
132+ (OK a _) -> Right a
109− (# Fail err, _ #) -> Left err
133+ (Fail err) -> Left err
110−
134+{-# INLINE parse #-}
111−instance Monoid (Parser a) where
135+
136+-- | Run a parser on top of the given base monad.
137+parseT :: Monad m => ZeptoT m a -> ByteString -> m (Either String a)
138+parseT p bs = do
139+ result <- runParser p (S bs)
140+ case result of
141+ OK a _ -> return (Right a)
142+ Fail err -> return (Left err)
143+{-# INLINE parseT #-}
144+
145+instance Monad m => Semigroup (ZeptoT m a) where
146+ (<>) = mplus
147+ {-# INLINE (<>) #-}
148+
149+instance Monad m => Mon.Monoid (ZeptoT m a) where
112 mempty = fail "mempty"
150 mempty = fail "mempty"
113 {-# INLINE mempty #-}
151 {-# INLINE mempty #-}
114− mappend = mplus
152+ mappend = (<>)
115 {-# INLINE mappend #-}
153 {-# INLINE mappend #-}
116
154
117−instance Alternative Parser where
155+instance Monad m => Alternative (ZeptoT m) where
118 empty = fail "empty"
156 empty = fail "empty"
119 {-# INLINE empty #-}
157 {-# INLINE empty #-}
120 (<|>) = mplus
158 (<|>) = mplus
121 {-# INLINE (<|>) #-}
159 {-# INLINE (<|>) #-}
122
160
123-- | Consume input while the predicate returns 'True'.
161-- | Consume input while the predicate returns 'True'.
124−takeWhile :: (Word8 -> Bool) -> Parser ByteString
162+takeWhile :: Monad m => (Word8 -> Bool) -> ZeptoT m ByteString
125takeWhile p = do
163takeWhile p = do
126 (h,t) <- gets (B.span p . input)
164 (h,t) <- gets (B.span p . input)
127 put (S t)
165 put (S t)
@@ -129,7 +167,7 @@ takeWhile p = do
129{-# INLINE takeWhile #-}
167{-# INLINE takeWhile #-}
130
168
131-- | Consume @n@ bytes of input.
169-- | Consume @n@ bytes of input.
132−take :: Int -> Parser ByteString
170+take :: Monad m => Int -> ZeptoT m ByteString
133take !n = do
171take !n = do
134 s <- gets input
172 s <- gets input
135 if B.length s >= n
173 if B.length s >= n
@@ -138,7 +176,7 @@ take !n = do
138{-# INLINE take #-}
176{-# INLINE take #-}
139
177
140-- | Match a string exactly.
178-- | Match a string exactly.
141−string :: ByteString -> Parser ()
179+string :: Monad m => ByteString -> ZeptoT m ()
142string s = do
180string s = do
143 i <- gets input
181 i <- gets input
144 if s `B.isPrefixOf` i
182 if s `B.isPrefixOf` i
@@ -147,7 +185,7 @@ string s = do
147{-# INLINE string #-}
185{-# INLINE string #-}
148
186
149-- | Indicate whether the end of the input has been reached.
187-- | Indicate whether the end of the input has been reached.
150−atEnd :: Parser Bool
188+atEnd :: Monad m => ZeptoT m Bool
151atEnd = do
189atEnd = do
152 i <- gets input
190 i <- gets input
153 return $! B.null i
191 return $! B.null i
README.markdown−6
@@ -16,12 +16,6 @@ Master [git repository](https://github.com/bos/attoparsec):
16
16
17* `git clone git://github.com/bos/attoparsec.git`
17* `git clone git://github.com/bos/attoparsec.git`
18
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−
25Authors
19Authors
26-------
20-------
27
21
attoparsec.cabal+53−11
@@ -1,12 +1,13 @@
1name: attoparsec
1name: attoparsec
2−version: 0.12.1.5
2+version: 0.13.2.2
3+x-revision: 3
3license: BSD3
4license: BSD3
4license-file: LICENSE
5license-file: LICENSE
5category: Text, Parsing
6category: Text, Parsing
6author: Bryan O'Sullivan <bos@serpentine.com>
7author: Bryan O'Sullivan <bos@serpentine.com>
7−maintainer: Bryan O'Sullivan <bos@serpentine.com>
8+maintainer: Bryan O'Sullivan <bos@serpentine.com>, Ben Gamari <ben@smart-cactus.org>
8stability: experimental
9stability: experimental
9−tested-with: GHC == 7.0, GHC == 7.2, GHC == 7.4, GHC == 7.6, GHC == 7.8, GHC == 7.10
10+tested-with: GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.2, GHC ==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1
10synopsis: Fast combinator parsing for bytestrings and text
11synopsis: Fast combinator parsing for bytestrings and text
11cabal-version: >= 1.8
12cabal-version: >= 1.8
12homepage: https://github.com/bos/attoparsec
13homepage: https://github.com/bos/attoparsec
@@ -21,6 +22,7 @@ extra-source-files:
21 benchmarks/*.cabal
22 benchmarks/*.cabal
22 benchmarks/*.hs
23 benchmarks/*.hs
23 benchmarks/*.txt
24 benchmarks/*.txt
25+ benchmarks/json-data/*.json
24 benchmarks/Makefile
26 benchmarks/Makefile
25 benchmarks/med.txt.bz2
27 benchmarks/med.txt.bz2
26 changelog.md
28 changelog.md
@@ -38,16 +40,22 @@ Flag developer
38
40
39library
41library
40 build-depends: array,
42 build-depends: array,
41− base >= 4.2 && < 5,
43+ base >= 4.3 && < 5,
42 bytestring,
44 bytestring,
43 containers,
45 containers,
44 deepseq,
46 deepseq,
45 scientific >= 0.3.1 && < 0.4,
47 scientific >= 0.3.1 && < 0.4,
48+ transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,
46 text >= 1.1.1.3
49 text >= 1.1.1.3
47 if impl(ghc < 7.4)
50 if impl(ghc < 7.4)
48 build-depends:
51 build-depends:
49 bytestring < 0.10.4.0
52 bytestring < 0.10.4.0
50
53
54+ if !impl(ghc >= 8.0)
55+ -- Data.Semigroup && Control.Monad.Fail are available in base-4.9+
56+ build-depends: fail == 4.9.*,
57+ semigroups >=0.16.1 && <0.20
58+
51 exposed-modules: Data.Attoparsec
59 exposed-modules: Data.Attoparsec
52 Data.Attoparsec.ByteString
60 Data.Attoparsec.ByteString
53 Data.Attoparsec.ByteString.Char8
61 Data.Attoparsec.ByteString.Char8
@@ -88,6 +96,26 @@ test-suite tests
88 QC.Rechunked
96 QC.Rechunked
89 QC.Simple
97 QC.Simple
90 QC.Text
98 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
91
119
92 ghc-options:
120 ghc-options:
93 -Wall -threaded -rtsopts
121 -Wall -threaded -rtsopts
@@ -97,17 +125,23 @@ test-suite tests
97
125
98 build-depends:
126 build-depends:
99 array,
127 array,
100− base >= 4 && < 5,
128+ base,
101 bytestring,
129 bytestring,
102 deepseq >= 1.1,
130 deepseq >= 1.1,
103− QuickCheck >= 2.7,
131+ QuickCheck >= 2.13.2 && < 2.14,
104 quickcheck-unicode,
132 quickcheck-unicode,
105 scientific,
133 scientific,
106− test-framework >= 0.8.0.2,
134+ tasty >= 0.11,
107− test-framework-quickcheck2 >= 0.3.0.3,
135+ tasty-quickcheck >= 0.8,
108 text,
136 text,
137+ transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,
109 vector
138 vector
110
139
140+ if !impl(ghc >= 8.0)
141+ -- Data.Semigroup && Control.Monad.Fail are available in base-4.9+
142+ build-depends: fail == 4.9.*,
143+ semigroups >=0.16.1 && <0.20
144+
111benchmark benchmarks
145benchmark benchmarks
112 type: exitcode-stdio-1.0
146 type: exitcode-stdio-1.0
113 hs-source-dirs: benchmarks benchmarks/warp-3.0.1.1 .
147 hs-source-dirs: benchmarks benchmarks/warp-3.0.1.1 .
@@ -119,7 +153,11 @@ benchmark benchmarks
119 HeadersByteString.Atto
153 HeadersByteString.Atto
120 HeadersText
154 HeadersText
121 Links
155 Links
156+ Network.Wai.Handler.Warp.ReadInt
157+ Network.Wai.Handler.Warp.RequestHeader
122 Numbers
158 Numbers
159+ Sets
160+ TextFastSet
123 Warp
161 Warp
124 ghc-options: -O2 -Wall
162 ghc-options: -O2 -Wall
125
163
@@ -131,6 +169,7 @@ benchmark benchmarks
131 base == 4.*,
169 base == 4.*,
132 bytestring >= 0.10.4.0,
170 bytestring >= 0.10.4.0,
133 case-insensitive,
171 case-insensitive,
172+ containers,
134 criterion >= 1.0,
173 criterion >= 1.0,
135 deepseq >= 1.1,
174 deepseq >= 1.1,
136 directory,
175 directory,
@@ -140,13 +179,16 @@ benchmark benchmarks
140 parsec >= 3.1.2,
179 parsec >= 3.1.2,
141 scientific,
180 scientific,
142 text >= 1.1.1.0,
181 text >= 1.1.1.0,
182+ transformers >= 0.2 && (< 0.4 || >= 0.4.1.0) && < 0.6,
143 unordered-containers,
183 unordered-containers,
144 vector
184 vector
145
185
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+
146source-repository head
191source-repository head
147 type: git
192 type: git
148 location: https://github.com/bos/attoparsec
193 location: https://github.com/bos/attoparsec
149
194
150−source-repository head
151− type: mercurial
152− location: https://bitbucket.org/bos/attoparsec
benchmarks/Aeson.hs+6−2
@@ -10,8 +10,13 @@ module Aeson
10import Data.ByteString.Builder
10import Data.ByteString.Builder
11 (Builder, byteString, toLazyByteString, charUtf8, word8)
11 (Builder, byteString, toLazyByteString, charUtf8, word8)
12
12
13+#if !MIN_VERSION_base(4,8,0)
14+import Control.Applicative ((*>), (<$>), (<*), pure)
15+import Data.Monoid (mappend, mempty)
16+#endif
17+
13import Common (pathTo)
18import Common (pathTo)
14−import Control.Applicative ((*>), (<$>), (<*), liftA2, pure)
19+import Control.Applicative (liftA2)
15import Control.DeepSeq (NFData(..))
20import Control.DeepSeq (NFData(..))
16import Control.Monad (forM)
21import Control.Monad (forM)
17import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,
22import Data.Attoparsec.ByteString.Char8 (Parser, char, endOfInput, scientific,
@@ -20,7 +25,6 @@ import Data.Bits ((.|.), shiftL)
20import Data.ByteString (ByteString)
25import Data.ByteString (ByteString)
21import Data.Char (chr)
26import Data.Char (chr)
22import Data.List (sort)
27import Data.List (sort)
23−import Data.Monoid (mappend, mempty)
24import Data.Scientific (Scientific)
28import Data.Scientific (Scientific)
25import Data.Text (Text)
29import Data.Text (Text)
26import Data.Text.Encoding (decodeUtf8')
30import Data.Text.Encoding (decodeUtf8')
benchmarks/Benchmarks.hs+6
@@ -28,6 +28,7 @@ import qualified HeadersByteString
28import qualified HeadersText
28import qualified HeadersText
29import qualified Links
29import qualified Links
30import qualified Text.Parsec as P
30import qualified Text.Parsec as P
31+import qualified Sets
31
32
32main :: IO ()
33main :: IO ()
33main = do
34main = do
@@ -70,10 +71,14 @@ main = do
70 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl
71 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl
71 , bench "isAlpha_iso8859_15" $
72 , bench "isAlpha_iso8859_15" $
72 nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl
73 nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl
74+ , bench "T isAlpha" $ nf (AT.parse (AT.takeWhile isAlpha)) t
75+ , bench "TL isAlpha" $ nf (ATL.parse (AT.takeWhile isAlpha)) tl
73 ]
76 ]
74 , bgroup "takeWhile1" [
77 , bgroup "takeWhile1" [
75 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl
78 bench "isAlpha" $ nf (ABL.parse (AC.takeWhile1 isAlpha)) bl
76 , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile1 AC.isAlpha_ascii)) bl
79 , 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
77 ]
82 ]
78 , bench "word32LE" $ nf (AB.parse word32LE) b
83 , bench "word32LE" $ nf (AB.parse word32LE) b
79 , bgroup "scan" [
84 , bgroup "scan" [
@@ -86,6 +91,7 @@ main = do
86 , headersT
91 , headersT
87 , Links.links
92 , Links.links
88 , numbers
93 , numbers
94+ , Sets.benchmarks
89 , Warp.benchmarks
95 , Warp.benchmarks
90 ]
96 ]
91
97
benchmarks/HeadersByteString.hs+10−1
@@ -9,6 +9,15 @@ import qualified Data.Attoparsec.ByteString.Char8 as B
9import qualified Data.Attoparsec.ByteString.Lazy as BL
9import qualified Data.Attoparsec.ByteString.Lazy as BL
10import qualified Data.ByteString.Char8 as B
10import qualified Data.ByteString.Char8 as B
11
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+
12headers :: IO Benchmark
21headers :: IO Benchmark
13headers = do
22headers = do
14 req <- B.readFile =<< pathTo "http-request.txt"
23 req <- B.readFile =<< pathTo "http-request.txt"
@@ -18,7 +27,7 @@ headers = do
18 return $ bgroup "headers" [
27 return $ bgroup "headers" [
19 bgroup "B" [
28 bgroup "B" [
20 bench "request" $ nf (B.parseOnly request) req
29 bench "request" $ nf (B.parseOnly request) req
21− , bench "warp" $ nfIO (parseHeaderLines [req])
30+ , bench "warp" $ nfIO (parseHeaderLines (B.split '\n' req))
22 , bench "response" $ nf (B.parseOnly response) resp
31 , bench "response" $ nf (B.parseOnly response) resp
23 ]
32 ]
24 , bgroup "BL" [
33 , bgroup "BL" [
benchmarks/HeadersByteString/Atto.hs+9−1
@@ -15,8 +15,16 @@ import qualified Data.ByteString.Char8 as B
15instance NFData HttpVersion where
15instance NFData HttpVersion where
16 rnf !_ = ()
16 rnf !_ = ()
17
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+
18header = do
26header = do
19− name <- B.takeWhile1 (B.inClass "a-zA-Z0-9_-") <* B.char ':' <* B.skipSpace
27+ name <- B.takeWhile1 isHeaderChar <* B.char ':' <* B.skipSpace
20 body <- bodyLine
28 body <- bodyLine
21 return (name, body)
29 return (name, body)
22
30
benchmarks/Links.hs+2−2
@@ -5,8 +5,8 @@ module Links (links) where
5import Control.Applicative
5import Control.Applicative
6import Control.DeepSeq (NFData(..))
6import Control.DeepSeq (NFData(..))
7import Criterion.Main (Benchmark, bench, nf)
7import Criterion.Main (Benchmark, bench, nf)
8−import Data.Attoparsec as A
8+import Data.Attoparsec.ByteString as A
9−import Data.Attoparsec.Char8 as A8
9+import Data.Attoparsec.ByteString.Char8 as A8
10import Data.ByteString.Char8 as B8
10import Data.ByteString.Char8 as B8
11
11
12data Link = Link {
12data Link = Link {
benchmarks/Numbers.hs+1
@@ -1,4 +1,5 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2+{-# OPTIONS_GHC -fno-warn-deprecations #-}
2
3
3module Numbers (numbers) where
4module Numbers (numbers) where
4
5
benchmarks/Sets.hsnew file+21
@@ -0,0 +1,21 @@
1+module Sets (benchmarks) where
2+
3+import Criterion
4+import Data.Char (ord)
5+import qualified Data.Attoparsec.Text.FastSet as FastSet
6+import qualified TextFastSet
7+import qualified Data.HashSet as HashSet
8+import qualified Data.IntSet as IntSet
9+
10+smallSet :: String
11+smallSet = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']
12+
13+benchmarks :: Benchmark
14+benchmarks = bgroup "sets" [
15+ bench "Fast" $ whnf (FastSet.member '*') (FastSet.fromList smallSet)
16+ , bench "Hash" $ whnf (HashSet.member '*') (HashSet.fromList smallSet)
17+ , bench "Int" $ whnf (IntSet.member (ord '*'))
18+ (IntSet.fromList (map ord smallSet))
19+ , bench "TextFast" $ whnf (TextFastSet.member '*')
20+ (TextFastSet.fromList smallSet)
21+ ]
benchmarks/TextFastSet.hsnew file+121
@@ -0,0 +1,121 @@
1+{-# LANGUAGE BangPatterns #-}
2+
3+------------------------------------------------------------------------------
4+-- |
5+-- Module : Data.Attoparsec.FastSet
6+-- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2015
7+-- License : BSD3
8+--
9+-- Maintainer : felipe.lessa@gmail.com
10+-- Stability : experimental
11+-- Portability : unknown
12+--
13+-- Fast set membership tests for 'Char' values. We test for
14+-- membership using a hashtable implemented with Robin Hood
15+-- collision resolution. The set representation is unboxed,
16+-- and the characters and hashes interleaved, for efficiency.
17+--
18+--
19+-----------------------------------------------------------------------------
20+module TextFastSet
21+ (
22+ -- * Data type
23+ FastSet
24+ -- * Construction
25+ , fromList
26+ , set
27+ -- * Lookup
28+ , member
29+ -- * Handy interface
30+ , charClass
31+ ) where
32+
33+import Data.Bits ((.|.), (.&.), shiftR)
34+import Data.Function (on)
35+import Data.List (sort, sortBy)
36+import qualified Data.Array.Base as AB
37+import qualified Data.Array.Unboxed as A
38+import qualified Data.Text as T
39+
40+data FastSet = FastSet {
41+ table :: {-# UNPACK #-} !(A.UArray Int Int)
42+ , mask :: {-# UNPACK #-} !Int
43+ }
44+
45+data Entry = Entry {
46+ key :: {-# UNPACK #-} !Char
47+ , initialIndex :: {-# UNPACK #-} !Int
48+ , index :: {-# UNPACK #-} !Int
49+ }
50+
51+offset :: Entry -> Int
52+offset e = index e - initialIndex e
53+
54+resolveCollisions :: [Entry] -> [Entry]
55+resolveCollisions [] = []
56+resolveCollisions [e] = [e]
57+resolveCollisions (a:b:entries) = a' : resolveCollisions (b' : entries)
58+ where (a', b')
59+ | index a < index b = (a, b)
60+ | offset a < offset b = (b { index=index a }, a { index=index a + 1 })
61+ | otherwise = (a, b { index=index a + 1 })
62+
63+pad :: Int -> [Entry] -> [Entry]
64+pad = go 0
65+ where -- ensure that we pad enough so that lookups beyond the
66+ -- last hash in the table fall within the array
67+ go !_ !m [] = replicate (max 1 m + 1) empty
68+ go k m (e:entries) = map (const empty) [k..i - 1] ++ e :
69+ go (i + 1) (m + i - k - 1) entries
70+ where i = index e
71+ empty = Entry '\0' maxBound 0
72+
73+nextPowerOf2 :: Int -> Int
74+nextPowerOf2 0 = 1
75+nextPowerOf2 x = go (x - 1) 1
76+ where go y 32 = y + 1
77+ go y k = go (y .|. (y `shiftR` k)) $ k * 2
78+
79+fastHash :: Char -> Int
80+fastHash = fromEnum
81+
82+fromList :: String -> FastSet
83+fromList s = FastSet (AB.listArray (0, length interleaved - 1) interleaved)
84+ mask'
85+ where s' = ordNub (sort s)
86+ l = length s'
87+ mask' = nextPowerOf2 ((5 * l) `div` 4) - 1
88+ entries = pad mask' .
89+ resolveCollisions .
90+ sortBy (compare `on` initialIndex) .
91+ zipWith (\c i -> Entry c i i) s' .
92+ map ((.&. mask') . fastHash) $ s'
93+ interleaved = concatMap (\e -> [fromEnum $ key e, initialIndex e])
94+ entries
95+
96+ordNub :: Eq a => [a] -> [a]
97+ordNub [] = []
98+ordNub (y:ys) = go y ys
99+ where go x (z:zs)
100+ | x == z = go x zs
101+ | otherwise = x : go z zs
102+ go x [] = [x]
103+
104+set :: T.Text -> FastSet
105+set = fromList . T.unpack
106+
107+-- | Check the set for membership.
108+member :: Char -> FastSet -> Bool
109+member c a = go (2 * i)
110+ where i = fastHash c .&. mask a
111+ lookupAt j b = (i' <= i) && (c == c' || b)
112+ where c' = toEnum $ AB.unsafeAt (table a) j
113+ i' = AB.unsafeAt (table a) $ j + 1
114+ go j = lookupAt j . lookupAt (j + 2) . lookupAt (j + 4) .
115+ lookupAt (j + 6) . go $ j + 8
116+
117+charClass :: String -> FastSet
118+charClass = fromList . go
119+ where go (a:'-':b:xs) = [a..b] ++ go xs
120+ go (x:xs) = x : go xs
121+ go _ = ""
benchmarks/attoparsec-benchmarks.cabal+4
@@ -16,6 +16,8 @@ executable attoparsec-benchmarks
16 Links
16 Links
17 Numbers
17 Numbers
18 Network.Wai.Handler.Warp.ReadInt
18 Network.Wai.Handler.Warp.ReadInt
19+ Sets
20+ TextFastSet
19 Warp
21 Warp
20 hs-source-dirs: .. . warp-3.0.1.1
22 hs-source-dirs: .. . warp-3.0.1.1
21 ghc-options: -O2 -Wall -rtsopts
23 ghc-options: -O2 -Wall -rtsopts
@@ -24,6 +26,7 @@ executable attoparsec-benchmarks
24 base == 4.*,
26 base == 4.*,
25 bytestring >= 0.10.4.0,
27 bytestring >= 0.10.4.0,
26 case-insensitive,
28 case-insensitive,
29+ containers,
27 criterion >= 1.0,
30 criterion >= 1.0,
28 deepseq >= 1.1,
31 deepseq >= 1.1,
29 directory,
32 directory,
@@ -33,5 +36,6 @@ executable attoparsec-benchmarks
33 parsec >= 3.1.2,
36 parsec >= 3.1.2,
34 scientific >= 0.3.1,
37 scientific >= 0.3.1,
35 text >= 1.1.1.0,
38 text >= 1.1.1.0,
39+ transformers,
36 unordered-containers,
40 unordered-containers,
37 vector
41 vector
benchmarks/http-request.txt+3−8
@@ -1,14 +1,9 @@
1GET / HTTP/1.1
1GET / HTTP/1.1
2Host: twitter.com
2Host: twitter.com
3−Accept: text/html, application/xhtml+xml, application/xml; q=0.9,
3+Accept: text/html, application/xhtml+xml, application/xml; q=0.9, image/webp, */*; q=0.8
4− image/webp, */*; q=0.8
5Accept-Encoding: gzip,deflate,sdch
4Accept-Encoding: gzip,deflate,sdch
6Accept-Language: en-GB,en-US;q=0.8,en;q=0.6
5Accept-Language: en-GB,en-US;q=0.8,en;q=0.6
7Cache-Control: max-age=0
6Cache-Control: max-age=0
8−Cookie: guest_id=v1%3A139; _twitter_sess=BAh7CSIKZmxhc2hJQz-e1e1;
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)
9− __utma=43838368.452555194.1399611824.1; __utmb=43838368;
10− __utmc=43838368; __utmz=1399611824.1.1.utmcsr=(direct)|utmcmd=(none)
11−User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10_8_5)
12− AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.86
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
13− Safari/537.36
14
9
benchmarks/http-response.txt+2−4
@@ -3,10 +3,8 @@ Date: Fri, 09 May 2014 04:24:57 GMT
3Expires: -1
3Expires: -1
4Cache-Control: private, max-age=0
4Cache-Control: private, max-age=0
5Content-Type: text/html; charset=ISO-8859-1
5Content-Type: text/html; charset=ISO-8859-1
6−Set-Cookie: PREF=ID=1a871afc4240db5e:FF:LM=1399609497:S=e5MZ0itEekjVwNcU;
6+Set-Cookie: PREF=ID=1a871afc4240db5e:FF:LM=1399609497:S=e5MZ0itEekjVwNcU; expires=Sun, 08-May-2016 04:24:57 GMT; path=/; domain=.google.com
7− expires=Sun, 08-May-2016 04:24:57 GMT; path=/; domain=.google.com
8−Set-Cookie: NID=67=-WlfaDG6VSEPk7abAjrK98HBSoCD2ID6JKkUR95tEumzDmg7Fc8pSQ8;
7+Set-Cookie: NID=67=-WlfaDG6VSEPk7abAjrK98HBSoCD2ID6JKkUR95tEumzDmg7Fc8pSQ8; expires=Sat, 08-Nov-2014 04:24:57 GMT; path=/; domain=.google.com; HttpOnly
9− expires=Sat, 08-Nov-2014 04:24:57 GMT; path=/; domain=.google.com; HttpOnly
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."
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."
11Server: gws
9Server: gws
12X-XSS-Protection: 1; mode=block
10X-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
139
140parseHeader :: ByteString -> H.Header
140parseHeader :: ByteString -> H.Header
141parseHeader s =
141parseHeader s =
142− let (k, rest) = S.breakByte 58 s -- ':'
142+ let (k, rest) = S.break (== 58) s -- ':'
143 rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest
143 rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest
144 in (CI.mk k, rest')
144 in (CI.mk k, rest')
145
145
changelog.md+35
@@ -1,3 +1,38 @@
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+
10.12.1.5
360.12.1.5
2
37
3* Fixed an indexing bug in the new Text implementation of string,
38* Fixed an indexing bug in the new Text implementation of string,
tests/QC.hs+2−2
@@ -6,11 +6,11 @@ import qualified QC.ByteString as ByteString
6import qualified QC.Combinator as Combinator
6import qualified QC.Combinator as Combinator
7import qualified QC.Simple as Simple
7import qualified QC.Simple as Simple
8import qualified QC.Text as Text
8import qualified QC.Text as Text
9−import Test.Framework (defaultMain, testGroup)
9+import Test.Tasty (defaultMain, testGroup)
10
10
11main = defaultMain tests
11main = defaultMain tests
12
12
13−tests = [
13+tests = testGroup "tests" [
14 testGroup "bs" ByteString.tests
14 testGroup "bs" ByteString.tests
15 , testGroup "buf" Buffer.tests
15 , testGroup "buf" Buffer.tests
16 , testGroup "combinator" Combinator.tests
16 , testGroup "combinator" Combinator.tests
tests/QC/Buffer.hs+4−4
@@ -3,13 +3,13 @@
3
3
4module QC.Buffer (tests) where
4module QC.Buffer (tests) where
5
5
6−import Control.Applicative ((<$>))
7#if !MIN_VERSION_base(4,8,0)
6#if !MIN_VERSION_base(4,8,0)
7+import Control.Applicative ((<$>))
8import Data.Monoid (Monoid(mconcat))
8import Data.Monoid (Monoid(mconcat))
9#endif
9#endif
10import QC.Common ()
10import QC.Common ()
11−import Test.Framework (Test)
11+import Test.Tasty (TestTree)
12−import Test.Framework.Providers.QuickCheck2 (testProperty)
12+import Test.Tasty.QuickCheck (testProperty)
13import Test.QuickCheck
13import Test.QuickCheck
14import qualified Data.Attoparsec.ByteString.Buffer as BB
14import qualified Data.Attoparsec.ByteString.Buffer as BB
15import qualified Data.Attoparsec.Text.Buffer as BT
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)
82 i <- choose (0, T.lengthWord16 t)
83 return $ T.dropWord16 i t === BT.dropWord16 i buf
83 return $ T.dropWord16 i t === BT.dropWord16 i buf
84
84
85−tests :: [Test]
85+tests :: [TestTree]
86tests = [
86tests = [
87 testProperty "b_unbuffer" b_unbuffer
87 testProperty "b_unbuffer" b_unbuffer
88 , testProperty "t_unbuffer" t_unbuffer
88 , testProperty "t_unbuffer" t_unbuffer
tests/QC/ByteString.hs+18−9
@@ -2,22 +2,22 @@
2module QC.ByteString (tests) where
2module QC.ByteString (tests) where
3
3
4#if !MIN_VERSION_base(4,8,0)
4#if !MIN_VERSION_base(4,8,0)
5−import Control.Applicative ((<*>))
5+import Control.Applicative ((<*>), (<$>))
6#endif
6#endif
7−import Control.Applicative ((<$>))
8−import Data.Char (chr, ord)
7+import Data.Char (chr, ord, toUpper)
9import Data.Int (Int64)
8import Data.Int (Int64)
10import Data.Word (Word8)
9import Data.Word (Word8)
11import Prelude hiding (take, takeWhile)
10import Prelude hiding (take, takeWhile)
12−import QC.Common (liftOp, parseBS, toStrictBS)
11+import QC.Common (ASCII(..), liftOp, parseBS, toStrictBS)
13−import Test.Framework (Test)
12+import Test.Tasty (TestTree)
14−import Test.Framework.Providers.QuickCheck2 (testProperty)
13+import Test.Tasty.QuickCheck (testProperty)
15import Test.QuickCheck
14import Test.QuickCheck
16import qualified Data.Attoparsec.ByteString as P
15import qualified Data.Attoparsec.ByteString as P
17import qualified Data.Attoparsec.ByteString.Char8 as P8
16import qualified Data.Attoparsec.ByteString.Char8 as P8
18import qualified Data.Attoparsec.ByteString.FastSet as S
17import qualified Data.Attoparsec.ByteString.FastSet as S
19import qualified Data.Attoparsec.ByteString.Lazy as PL
18import qualified Data.Attoparsec.ByteString.Lazy as PL
20import qualified Data.ByteString as B
19import qualified Data.ByteString as B
20+import qualified Data.ByteString.Char8 as B8
21import qualified Data.ByteString.Lazy as L
21import qualified Data.ByteString.Lazy as L
22import qualified Data.ByteString.Lazy.Char8 as L8
22import qualified Data.ByteString.Lazy.Char8 as L8
23
23
@@ -26,9 +26,11 @@ import qualified Data.ByteString.Lazy.Char8 as L8
26satisfy :: Word8 -> L.ByteString -> Property
26satisfy :: Word8 -> L.ByteString -> Property
27satisfy w s = parseBS (P.satisfy (<=w)) (L.cons w s) === Just w
27satisfy w s = parseBS (P.satisfy (<=w)) (L.cons w s) === Just w
28
28
29−satisfyWith :: Char -> L.ByteString -> Property
29+satisfyWith :: Word8 -> L.ByteString -> Property
30−satisfyWith c s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))
30+satisfyWith w s = parseBS (P.satisfyWith (chr . fromIntegral) (<=c))
31 (L.cons (fromIntegral (ord c)) s) === Just c
31 (L.cons (fromIntegral (ord c)) s) === Just c
32+ where
33+ c = chr (fromIntegral w)
32
34
33word8 :: Word8 -> L.ByteString -> Property
35word8 :: Word8 -> L.ByteString -> Property
34word8 w s = parseBS (P.word8 w) (L.cons w s) === Just w
36word8 w s = parseBS (P.word8 w) (L.cons w s) === Just w
@@ -66,6 +68,12 @@ string :: L.ByteString -> L.ByteString -> Property
66string s t = parseBS (P.string s') (s `L.append` t) === Just s'
68string s t = parseBS (P.string s') (s `L.append` t) === Just s'
67 where s' = toStrictBS s
69 where s' = toStrictBS s
68
70
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+
69strings :: L.ByteString -> L.ByteString -> L.ByteString -> Property
77strings :: L.ByteString -> L.ByteString -> L.ByteString -> Property
70strings s t u =
78strings s t u =
71 parseBS (P.string (toStrictBS s) >> P.string t') (L.concat [s,t,u])
79 parseBS (P.string (toStrictBS s) >> P.string t') (L.concat [s,t,u])
@@ -149,7 +157,7 @@ nonmembers :: [Word8] -> [Word8] -> Property
149nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s'
157nonmembers s s' = property . not . any (`S.memberWord8` set) $ filter (not . (`elem` s)) s'
150 where set = S.fromList s
158 where set = S.fromList s
151
159
152−tests :: [Test]
160+tests :: [TestTree]
153tests = [
161tests = [
154 testProperty "anyWord8" anyWord8
162 testProperty "anyWord8" anyWord8
155 , testProperty "endOfInput" endOfInput
163 , testProperty "endOfInput" endOfInput
@@ -163,6 +171,7 @@ tests = [
163 , testProperty "skip" skip
171 , testProperty "skip" skip
164 , testProperty "skipWhile" skipWhile
172 , testProperty "skipWhile" skipWhile
165 , testProperty "string" string
173 , testProperty "string" string
174+ , testProperty "stringCI" stringCI
166 , testProperty "strings" strings
175 , testProperty "strings" strings
167 , testProperty "take" take
176 , testProperty "take" take
168 , testProperty "takeByteString" takeByteString
177 , testProperty "takeByteString" takeByteString
tests/QC/Combinator.hs+7−5
@@ -1,13 +1,15 @@
1−{-# LANGUAGE OverloadedStrings #-}
1+{-# LANGUAGE CPP, OverloadedStrings #-}
2
2
3module QC.Combinator where
3module QC.Combinator where
4
4
5+#if !MIN_VERSION_base(4,8,0)
5−import Control.Applicative
6+import Control.Applicative ((<*>), (<$>), (<*), (*>))
7+#endif
6import Data.Maybe (fromJust, isJust)
8import Data.Maybe (fromJust, isJust)
7import Data.Word (Word8)
9import Data.Word (Word8)
8import QC.Common (Repack, parseBS, repackBS, toLazyBS)
10import QC.Common (Repack, parseBS, repackBS, toLazyBS)
9−import Test.Framework (Test)
11+import Test.Tasty (TestTree)
10−import Test.Framework.Providers.QuickCheck2 (testProperty)
12+import Test.Tasty.QuickCheck (testProperty)
11import Test.QuickCheck
13import Test.QuickCheck
12import qualified Data.Attoparsec.ByteString.Char8 as P
14import qualified Data.Attoparsec.ByteString.Char8 as P
13import qualified Data.Attoparsec.Combinator as C
15import qualified Data.Attoparsec.Combinator as C
@@ -41,7 +43,7 @@ match n (NonNegative x) (NonNegative y) rs =
41 B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'
43 B8.replicate x 'x', B8.pack (show n), B8.replicate y 'y'
42 ]
44 ]
43
45
44−tests :: [Test]
46+tests :: [TestTree]
45tests = [
47tests = [
46 testProperty "choice" choice
48 testProperty "choice" choice
47 , testProperty "count" count
49 , testProperty "count" count
tests/QC/Common.hs+27−4
@@ -1,8 +1,9 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP, FlexibleInstances #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
3module QC.Common
3module QC.Common
4 (
4 (
5+ ASCII(..)
5− parseBS
6+ , parseBS
6 , parseT
7 , parseT
7 , toLazyBS
8 , toLazyBS
8 , toStrictBS
9 , toStrictBS
@@ -15,9 +16,8 @@ module QC.Common
15 ) where
16 ) where
16
17
17#if !MIN_VERSION_base(4,8,0)
18#if !MIN_VERSION_base(4,8,0)
18−import Control.Applicative ((<*>))
19+import Control.Applicative ((<*>), (<$>))
19#endif
20#endif
20−import Control.Applicative ((<$>))
21import Data.Char (isAlpha)
21import Data.Char (isAlpha)
22import Test.QuickCheck
22import Test.QuickCheck
23import Test.QuickCheck.Unicode (shrinkChar, string)
23import Test.QuickCheck.Unicode (shrinkChar, string)
@@ -28,6 +28,16 @@ import qualified Data.Text.Lazy as TL
28import qualified Data.Attoparsec.ByteString.Lazy as BL
28import qualified Data.Attoparsec.ByteString.Lazy as BL
29import qualified Data.Attoparsec.Text.Lazy as TL
29import qualified Data.Attoparsec.Text.Lazy as TL
30
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+
31parseBS :: BL.Parser r -> BL.ByteString -> Maybe r
41parseBS :: BL.Parser r -> BL.ByteString -> Maybe r
32parseBS p = BL.maybeResult . BL.parse p
42parseBS p = BL.maybeResult . BL.parse p
33
43
@@ -42,9 +52,22 @@ toLazyBS = BL.fromChunks . (:[])
42
52
43instance Arbitrary B.ByteString where
53instance Arbitrary B.ByteString where
44 arbitrary = B.pack <$> arbitrary
54 arbitrary = B.pack <$> arbitrary
55+ shrink = map B.pack . shrink . B.unpack
45
56
46instance Arbitrary BL.ByteString where
57instance Arbitrary BL.ByteString where
47 arbitrary = repackBS <$> arbitrary <*> arbitrary
58 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
48
71
49type Repack = NonEmptyList (Positive (Small Int))
72type Repack = NonEmptyList (Positive (Small Int))
50
73
tests/QC/Simple.hs+3−3
@@ -10,8 +10,8 @@ import Data.ByteString (ByteString)
10import Data.List (foldl')
10import Data.List (foldl')
11import Data.Maybe (fromMaybe)
11import Data.Maybe (fromMaybe)
12import QC.Rechunked (rechunkBS)
12import QC.Rechunked (rechunkBS)
13−import Test.Framework (Test)
13+import Test.Tasty (TestTree)
14−import Test.Framework.Providers.QuickCheck2 (testProperty)
14+import Test.Tasty.QuickCheck (testProperty)
15import Test.QuickCheck (Property, counterexample, forAll)
15import Test.QuickCheck (Property, counterexample, forAll)
16import qualified Data.Attoparsec.ByteString.Char8 as A
16import qualified Data.Attoparsec.ByteString.Char8 as A
17
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
31parse p (x:xs) = foldl' A.feed (A.parse p x) xs
32parse p [] = A.parse p ""
32parse p [] = A.parse p ""
33
33
34−tests :: [Test]
34+tests :: [TestTree]
35tests = [
35tests = [
36 testProperty "issue75" t_issue75
36 testProperty "issue75" t_issue75
37 ]
37 ]
tests/QC/Text.hs+19−8
@@ -3,20 +3,24 @@
3module QC.Text (tests) where
3module QC.Text (tests) where
4
4
5#if !MIN_VERSION_base(4,8,0)
5#if !MIN_VERSION_base(4,8,0)
6−import Control.Applicative ((<*>))
6+import Control.Applicative ((<*>), (<$>))
7#endif
7#endif
8−import Control.Applicative ((<$>))
9import Data.Int (Int64)
8import Data.Int (Int64)
9+import Data.Word (Word8)
10import Prelude hiding (take, takeWhile)
10import Prelude hiding (take, takeWhile)
11import QC.Common (liftOp, parseT)
11import QC.Common (liftOp, parseT)
12−import Test.Framework (Test)
12+import qualified QC.Text.FastSet as FastSet
13+import qualified QC.Text.Regressions as Regressions
14+import Test.Tasty (TestTree, testGroup)
13−import Test.Framework.Providers.QuickCheck2 (testProperty)
15+import Test.Tasty.QuickCheck (testProperty)
14import Test.QuickCheck
16import Test.QuickCheck
15import qualified Data.Attoparsec.Text as P
17import qualified Data.Attoparsec.Text as P
16import qualified Data.Attoparsec.Text.Lazy as PL
18import qualified Data.Attoparsec.Text.Lazy as PL
17import qualified Data.Attoparsec.Text.FastSet as S
19import qualified Data.Attoparsec.Text.FastSet as S
20+import qualified Data.ByteString as BS
18import qualified Data.Char as Char
21import qualified Data.Char as Char
19import qualified Data.Text as T
22import qualified Data.Text as T
23+import qualified Data.Text.Encoding as TE
20import qualified Data.Text.Lazy as L
24import qualified Data.Text.Lazy as L
21
25
22-- Basic byte-level combinators.
26-- Basic byte-level combinators.
@@ -69,9 +73,12 @@ strings s t u =
69 === Just t'
73 === Just t'
70 where t' = toStrict t
74 where t' = toStrict t
71
75
76+-- | Note: "simple, and efficient" works for well formed input...
77+-- i.e. e.g. Latin1 texts
72−stringCI :: T.Text -> Property
78+stringCI :: [Word8] -> Property
73−stringCI s = P.parseOnly (P.stringCI fs) s === Right s
79+stringCI ws = P.parseOnly (P.stringCI fs) s === Right s
74 where fs = T.toCaseFold s
80 where fs = T.toCaseFold s
81+ s = TE.decodeLatin1 (BS.pack ws)
75
82
76asciiCI :: T.Text -> Gen Bool
83asciiCI :: T.Text -> Gen Bool
77asciiCI x =
84asciiCI x =
@@ -149,7 +156,9 @@ endOfLine s =
149 (c, fst <$> L.uncons s') === ('\r', Just '\n')
156 (c, fst <$> L.uncons s') === ('\r', Just '\n')
150
157
151scan :: L.Text -> Positive Int64 -> Property
158scan :: L.Text -> Positive Int64 -> Property
159+-- for some reason, if counterexample is removed, this test fails?
160+scan s (Positive k) = counterexample (show s)
152−scan s (Positive k) = parseT p s === Just (toStrict $ L.take k s)
161+ $ parseT p s === Just (toStrict $ L.take k s)
153 where p = P.scan k $ \ n _ ->
162 where p = P.scan k $ \ n _ ->
154 if n > 0 then let !n' = n - 1 in Just n' else Nothing
163 if n > 0 then let !n' = n - 1 in Just n' else Nothing
155
164
@@ -161,7 +170,7 @@ nonmembers :: String -> String -> Property
161nonmembers s s' = property . not . any (`S.member` set) $ filter (not . (`elem` s)) s'
170nonmembers s s' = property . not . any (`S.member` set) $ filter (not . (`elem` s)) s'
162 where set = S.fromList s
171 where set = S.fromList s
163
172
164−tests :: [Test]
173+tests :: [TestTree]
165tests = [
174tests = [
166 testProperty "anyChar" anyChar
175 testProperty "anyChar" anyChar
167 , testProperty "asciiCI" asciiCI
176 , testProperty "asciiCI" asciiCI
@@ -189,4 +198,6 @@ tests = [
189 , testProperty "takeWhile1_empty" takeWhile1_empty
198 , testProperty "takeWhile1_empty" takeWhile1_empty
190 , testProperty "members" members
199 , testProperty "members" members
191 , testProperty "nonmembers" nonmembers
200 , testProperty "nonmembers" nonmembers
201+ , testGroup "FastSet" FastSet.tests
202+ , testGroup "Regressions" Regressions.tests
192 ]
203 ]
tests/QC/Text/FastSet.hsnew file+15
@@ -0,0 +1,15 @@
1+module QC.Text.FastSet where
2+
3+import Test.Tasty (TestTree)
4+import Test.Tasty.QuickCheck (testProperty)
5+import Test.QuickCheck
6+import qualified Data.Attoparsec.Text.FastSet as FastSet
7+
8+membershipCorrect :: String -> String -> Property
9+membershipCorrect members others =
10+ let fs = FastSet.fromList members
11+ correct c = (c `FastSet.member` fs) == (c `elem` members)
12+ in property $ all correct (members ++ others)
13+
14+tests :: [TestTree]
15+tests = [ testProperty "membership is correct" membershipCorrect ]
tests/QC/Text/Regressions.hsnew file+54
@@ -0,0 +1,54 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module QC.Text.Regressions (
4+ tests
5+ ) where
6+
7+import Data.Text (Text)
8+import qualified Data.Text as T
9+import Data.List (foldl')
10+import Data.Maybe (fromMaybe)
11+import Data.Char (isLower)
12+import Data.Monoid ((<>))
13+import QC.Rechunked (rechunkT)
14+import Test.Tasty (TestTree)
15+import Test.Tasty.QuickCheck (testProperty)
16+import Test.QuickCheck (Property, counterexample, forAll)
17+import qualified Data.Attoparsec.Text as A
18+
19+
20+--------------------------------------------------------------------------------
21+-- 105 was about runScanner not always returning the final state. The result
22+-- did depend on how the data was fed to the parser.
23+
24+t_issue105 :: Property
25+t_issue105 = expect issue105 "lowER" (A.Done "ER" "low")
26+
27+issue105 :: A.Parser Text
28+issue105 = do
29+ (_, firstFourLowercaseLetters) <- A.runScanner "" f
30+ return $ firstFourLowercaseLetters
31+
32+ where
33+ f :: Text -> Char -> Maybe Text
34+ f acc c = if T.length acc < 4 && isLower c
35+ then Just $ acc <> T.singleton c
36+ else Nothing
37+
38+
39+expect :: (Show r, Eq r) => A.Parser r -> Text -> A.Result r -> Property
40+expect p input wanted =
41+ forAll (rechunkT input) $ \in' ->
42+ let result = parse p in'
43+ in counterexample (show result ++ " /= " ++ show wanted) $
44+ fromMaybe False (A.compareResults result wanted)
45+
46+parse :: A.Parser r -> [Text] -> A.Result r
47+parse p (x:xs) = foldl' A.feed (A.parse p x) xs
48+parse p [] = A.parse p ""
49+
50+
51+tests :: [TestTree]
52+tests = [
53+ testProperty "issue105" t_issue105
54+ ]