summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBenGamari <>2016-09-15 16:26:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2016-09-15 16:26:00 (GMT)
commit8f663e70812cf69effb4512a737444e953c8c282 (patch)
tree2344657516482c67f30a65dabcc3ad1165ff0a36
parent170d4302598cb8e79e0716700ad7fb559f194b9d (diff)
version 0.13.1.00.13.1.0
-rw-r--r--Data/Attoparsec/ByteString/Buffer.hs18
-rw-r--r--Data/Attoparsec/Internal/Types.hs57
-rw-r--r--Data/Attoparsec/Text/Buffer.hs20
-rw-r--r--Data/Attoparsec/Text/Internal.hs8
-rw-r--r--Data/Attoparsec/Zepto.hs23
-rw-r--r--README.markdown6
-rw-r--r--attoparsec.cabal25
-rw-r--r--benchmarks/json-data/example.json88
-rw-r--r--benchmarks/json-data/geometry.json1
-rw-r--r--benchmarks/json-data/integers.json1
-rw-r--r--benchmarks/json-data/jp10.json1
-rw-r--r--benchmarks/json-data/jp100.json1
-rw-r--r--benchmarks/json-data/jp50.json1
-rw-r--r--benchmarks/json-data/numbers.json1
-rw-r--r--benchmarks/json-data/twitter1.json1
-rw-r--r--benchmarks/json-data/twitter10.json1
-rw-r--r--benchmarks/json-data/twitter100.json1
-rw-r--r--benchmarks/json-data/twitter20.json1
-rw-r--r--benchmarks/json-data/twitter50.json1
-rw-r--r--benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/ReadInt.hs67
-rw-r--r--benchmarks/warp-3.0.1.1/Network/Wai/Handler/Warp/RequestHeader.hs172
-rw-r--r--changelog.md7
-rw-r--r--tests/QC/Text.hs2
-rw-r--r--tests/QC/Text/Regressions.hs54
24 files changed, 494 insertions, 64 deletions
diff --git a/Data/Attoparsec/ByteString/Buffer.hs b/Data/Attoparsec/ByteString/Buffer.hs
index d9bb0d1..ac94dfc 100644
--- a/Data/Attoparsec/ByteString/Buffer.hs
+++ b/Data/Attoparsec/ByteString/Buffer.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP #-}
+{-# LANGUAGE BangPatterns #-}
-- |
-- Module : Data.Attoparsec.ByteString.Buffer
-- Copyright : Bryan O'Sullivan 2007-2015
@@ -57,9 +57,8 @@ import Control.Exception (assert)
import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)
import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
import Data.List (foldl1')
-#if !MIN_VERSION_base(4,8,0)
-import Data.Monoid (Monoid(..))
-#endif
+import Data.Monoid as Mon (Monoid(..))
+import Data.Semigroup (Semigroup(..))
import Data.Word (Word8)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Ptr (castPtr, plusPtr)
@@ -88,14 +87,17 @@ buffer (PS fp off len) = Buf fp off len len 0
unbuffer :: Buffer -> ByteString
unbuffer (Buf fp off len _ _) = PS fp off len
+instance Semigroup Buffer where
+ (Buf _ _ _ 0 _) <> b = b
+ a <> (Buf _ _ _ 0 _) = a
+ buf <> (Buf fp off len _ _) = append buf fp off len
+
instance Monoid Buffer where
mempty = Buf nullForeignPtr 0 0 0 0
- mappend (Buf _ _ _ 0 _) b = b
- mappend a (Buf _ _ _ 0 _) = a
- mappend buf (Buf fp off len _ _) = append buf fp off len
+ mappend = (<>)
- mconcat [] = mempty
+ mconcat [] = Mon.mempty
mconcat xs = foldl1' mappend xs
pappend :: Buffer -> ByteString -> Buffer
diff --git a/Data/Attoparsec/Internal/Types.hs b/Data/Attoparsec/Internal/Types.hs
index bd43c92..06d19ef 100644
--- a/Data/Attoparsec/Internal/Types.hs
+++ b/Data/Attoparsec/Internal/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, OverloadedStrings,
+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,
Rank2Types, RecordWildCards, TypeFamilies #-}
-- |
-- Module : Data.Attoparsec.Internal.Types
@@ -25,13 +25,13 @@ module Data.Attoparsec.Internal.Types
, Chunk(..)
) where
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative (Applicative(..), (<$>))
-import Data.Monoid (Monoid(..))
-#endif
+import Control.Applicative as App (Applicative(..), (<$>))
import Control.Applicative (Alternative(..))
import Control.DeepSeq (NFData(rnf))
import Control.Monad (MonadPlus(..))
+import qualified Control.Monad.Fail as Fail (MonadFail(..))
+import Data.Monoid as Mon (Monoid(..))
+import Data.Semigroup (Semigroup(..))
import Data.Word (Word8)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
@@ -127,17 +127,19 @@ type Success i t a r = t -> Pos -> More -> a -> IResult i r
data More = Complete | Incomplete
deriving (Eq, Show)
-instance Monoid More where
- mappend c@Complete _ = c
- mappend _ m = m
- mempty = Incomplete
+instance Semigroup More where
+ c@Complete <> _ = c
+ _ <> m = m
+
+instance Mon.Monoid More where
+ mappend = (<>)
+ mempty = Incomplete
instance Monad (Parser i) where
- fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg
- where msg = "Failed reading: " ++ err
+ fail = Fail.fail
{-# INLINE fail #-}
- return v = Parser $ \t pos more _lose succ -> succ t pos more v
+ return = App.pure
{-# INLINE return #-}
m >>= k = Parser $ \t !pos more lose succ ->
@@ -145,6 +147,15 @@ instance Monad (Parser i) where
in runParser m t pos more lose succ'
{-# INLINE (>>=) #-}
+ (>>) = (*>)
+ {-# INLINE (>>) #-}
+
+
+instance Fail.MonadFail (Parser i) where
+ fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg
+ where msg = "Failed reading: " ++ err
+ {-# INLINE fail #-}
+
plus :: Parser i a -> Parser i a -> Parser i a
plus f g = Parser $ \t pos more lose succ ->
let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ
@@ -169,23 +180,23 @@ apP d e = do
{-# INLINE apP #-}
instance Applicative (Parser i) where
- pure = return
+ pure v = Parser $ \t pos more _lose succ -> succ t pos more v
{-# INLINE pure #-}
(<*>) = apP
{-# INLINE (<*>) #-}
-
- -- These definitions are equal to the defaults, but this
- -- way the optimizer doesn't have to work so hard to figure
- -- that out.
- (*>) = (>>)
+ m *> k = m >>= \_ -> k
{-# INLINE (*>) #-}
- x <* y = x >>= \a -> y >> return a
+ x <* y = x >>= \a -> y >> pure a
{-# INLINE (<*) #-}
+instance Semigroup (Parser i a) where
+ (<>) = plus
+ {-# INLINE (<>) #-}
+
instance Monoid (Parser i a) where
mempty = fail "mempty"
{-# INLINE mempty #-}
- mappend = plus
+ mappend = (<>)
{-# INLINE mappend #-}
instance Alternative (Parser i) where
@@ -197,7 +208,7 @@ instance Alternative (Parser i) where
many v = many_v
where many_v = some_v <|> pure []
- some_v = (:) <$> v <*> many_v
+ some_v = (:) App.<$> v <*> many_v
{-# INLINE many #-}
some v = some_v
@@ -206,10 +217,6 @@ instance Alternative (Parser i) where
some_v = (:) <$> v <*> many_v
{-# INLINE some #-}
-(<>) :: (Monoid m) => m -> m -> m
-(<>) = mappend
-{-# INLINE (<>) #-}
-
-- | A common interface for input chunks.
class Monoid c => Chunk c where
type ChunkElem c
diff --git a/Data/Attoparsec/Text/Buffer.hs b/Data/Attoparsec/Text/Buffer.hs
index 810f685..9b2f65c 100644
--- a/Data/Attoparsec/Text/Buffer.hs
+++ b/Data/Attoparsec/Text/Buffer.hs
@@ -40,9 +40,8 @@ module Data.Attoparsec.Text.Buffer
import Control.Exception (assert)
import Data.Bits (shiftR)
import Data.List (foldl1')
-#if !MIN_VERSION_base(4,8,0)
-import Data.Monoid (Monoid(..))
-#endif
+import Data.Monoid as Mon (Monoid(..))
+import Data.Semigroup (Semigroup(..))
import Data.Text ()
import Data.Text.Internal (Text(..))
import Data.Text.Internal.Encoding.Utf16 (chr2)
@@ -80,17 +79,20 @@ unbufferAt s (Buf arr off len _ _) =
assert (s >= 0 && s <= len) $
Text arr (off+s) (len-s)
+instance Semigroup Buffer where
+ (Buf _ _ _ 0 _) <> b = b
+ a <> (Buf _ _ _ 0 _) = a
+ buf <> (Buf arr off len _ _) = append buf arr off len
+