packages feed

aeson 0.3.1.1 → 0.3.2.0

raw patch · 10 files changed

+343/−57 lines, 10 filesdep +ghc-primdep +integerdep +integer-gmpdep ~basedep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim, integer, integer-gmp

Dependency ranges changed: base, time

API changes (from Hackage documentation)

Files

Data/Aeson/Encode.hs view
@@ -17,22 +17,20 @@  import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Char.Utf8+import Data.Aeson.Encode.Number (fromNumber) import Data.Aeson.Types (ToJSON(..), Value(..))-import Data.Attoparsec.Number (Number(..)) import Data.Monoid (mappend) import Numeric (showHex) import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Vector as V-import qualified Text.Show.ByteString as S  -- | Encode a JSON value to a 'Builder'. fromValue :: Value -> Builder fromValue Null = fromByteString "null" fromValue (Bool b) = fromByteString $ if b then "true" else "false"-fromValue (Number (I n)) = fromLazyByteString (S.show n)-fromValue (Number (D n)) = fromLazyByteString (S.show n)+fromValue (Number n) = fromNumber n fromValue (String s) = string s fromValue (Array v)     | V.null v = fromByteString "[]"
+ Data/Aeson/Encode/Double.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, OverloadedStrings, UnboxedTuples #-}++-- Module:      Data.Aeson.Encode.Number+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Efficiently serialize a Double as a lazy 'L.ByteString'.++module Data.Aeson.Encode.Double+    (+      double+    ) where++import Blaze.ByteString.Builder (Builder, fromByteString)+import Blaze.ByteString.Builder.Char8 (fromChar)+import Data.Aeson.Encode.Int (digit, int, minus)+import Data.ByteString.Char8 ()+import Data.Monoid (mappend, mconcat, mempty)+import qualified Data.Vector as V++-- The code below is originally from GHC.Float, but has been optimised+-- in quite a few ways.++data T = T [Int] {-# UNPACK #-} !Int++double :: Double -> Builder+double f+    | isNaN f                   = fromByteString "NaN"+    | isInfinite f              = fromByteString $+                                  if f < 0 then "-Infinity" else "Infinity"+    | f < 0 || isNegativeZero f = minus `mappend` goGeneric (floatToDigits (-f))+    | otherwise                 = goGeneric (floatToDigits f)+  where+   goGeneric p@(T _ e)+     | e < 0 || e > 7 = goExponent p+     | otherwise      = goFixed    p+   goExponent (T is e) =+       case is of+         []     -> error "putFormattedFloat"+         [0]    -> fromByteString "0.0e0"+         [d]    -> digit d `mappend` fromByteString ".0e" `mappend` int (e-1)+         (d:ds) -> digit d `mappend` fromChar '.' `mappend` digits ds `mappend`+                   fromChar 'e' `mappend` int (e-1)+   goFixed (T is e)+       | e <= 0    = fromChar '0' `mappend` fromChar '.' `mappend`+                     mconcat (replicate (-e) (fromChar '0')) `mappend`+                     digits is+       | otherwise = let g 0 rs     = fromChar '.' `mappend` mk0 rs+                         g n []     = fromChar '0' `mappend` g (n-1) []+                         g n (r:rs) = digit r `mappend` g (n-1) rs+                     in g e is+   mk0 [] = fromChar '0'+   mk0 rs = digits rs++digits :: [Int] -> Builder+digits (d:ds) = digit d `mappend` digits ds+digits _      = mempty+{-# INLINE digits #-}++floatToDigits :: Double -> T+floatToDigits 0 = T [0] 0+floatToDigits x = T (reverse rds) k+ where+  (f0, e0)     = decodeFloat x+  (minExp0, _) = floatRange (undefined::Double)+  p = floatDigits x+  b = floatRadix x+  minExp = minExp0 - p -- the real minimum exponent+  -- Haskell requires that f be adjusted so denormalized numbers+  -- will have an impossibly low exponent.  Adjust for this.+  (# f, e #) =+   let n = minExp - e0 in+   if n > 0 then (# f0 `div` (b^n), e0+n #) else (# f0, e0 #)+  (# r, s, mUp, mDn #) =+   if e >= 0+   then let be = b^ e+        in if f == b^(p-1)+           then (# f*be*b*2, 2*b, be*b, b #)+           else (# f*be*2, 2, be, be #)+   else if e > minExp && f == b^(p-1)+        then (# f*b*2, b^(-e+1)*2, b, 1 #)+        else (# f*2, b^(-e)*2, 1, 1 #)+  k = fixup k0+   where+    k0 | b == 2 = (p - 1 + e0) * 3 `div` 10+        -- logBase 10 2 is slightly bigger than 3/10 so the following+        -- will err on the low side.  Ignoring the fraction will make+        -- it err even more.  Haskell promises that p-1 <= logBase b f+        -- < p.+       | otherwise = ceiling ((log (fromInteger (f+1) :: Double) ++                               fromIntegral e * log (fromInteger b)) / log 10)+    fixup n+      | n >= 0    = if r + mUp <= exp10 n * s then n else fixup (n+1)+      | otherwise = if exp10 (-n) * (r + mUp) <= s then n else fixup (n+1)++  gen ds !rn !sN !mUpN !mDnN =+   let (dn0, rn') = (rn * 10) `divMod` sN+       mUpN' = mUpN * 10+       mDnN' = mDnN * 10+       !dn   = fromInteger dn0+       !dn'  = dn + 1+   in case (# rn' < mDnN', rn' + mUpN' > sN #) of+        (# True,  False #) -> dn : ds+        (# False, True #)  -> dn' : ds+        (# True,  True #)  -> if rn' * 2 < sN then dn : ds else dn' : ds+        (# False, False #) -> gen (dn:ds) rn' sN mUpN' mDnN'++  rds | k >= 0    = gen [] r (s * exp10 k) mUp mDn+      | otherwise = gen [] (r * bk) s (mUp * bk) (mDn * bk)+      where bk = exp10 (-k)+                    +exp10 :: Int -> Integer+exp10 n+    | n >= 0 && n < maxExpt = V.unsafeIndex expts n+    | otherwise             = 10 ^ n+  where expts = V.generate maxExpt (10^)+        {-# NOINLINE expts #-}+        maxExpt = 17+{-# INLINE exp10 #-}
+ Data/Aeson/Encode/Int.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}++-- Module:      Data.Aeson.Encode.Int+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Efficiently serialize an integral JSON value as a lazy 'L.ByteString'.++module Data.Aeson.Encode.Int+    (+      digit+    , int+    , minus+    ) where++import Blaze.ByteString.Builder (Builder, fromWord8)+import Data.Monoid (mappend)++int :: Int -> Builder+int i+    | i < 0     = minus `mappend` go (-i)+    | otherwise = go i+  where+    go n | n < 10    = digit n+         | otherwise = go (n `rem` 10) `mappend` digit (n `quot` 10)++digit :: Int -> Builder+digit n = fromWord8 $! fromIntegral n + 48++minus :: Builder+minus = fromWord8 45
+ Data/Aeson/Encode/Number.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}++-- Module:      Data.Aeson.Encode.Number+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Efficiently serialize a numeric JSON value as a lazy 'L.ByteString'.++module Data.Aeson.Encode.Number+    (+      fromNumber+    ) where++import Data.Monoid (mappend, mempty)+import Data.Attoparsec.Number (Number(..))+import Data.Aeson.Encode.Double+import Data.Aeson.Encode.Int+import Blaze.ByteString.Builder+import GHC.Base (quotInt, remInt)+import GHC.Num (quotRemInteger)+import GHC.Types (Int(..))++#ifdef  __GLASGOW_HASKELL__+# if __GLASGOW_HASKELL__ < 611+import GHC.Integer.Internals+# else+import GHC.Integer.GMP.Internals+# endif+#endif++#ifdef INTEGER_GMP+# define PAIR(a,b) (# a,b #)+#else+# define PAIR(a,b) (a,b)+#endif++fromNumber :: Number -> Builder+fromNumber (I i) = integer i+fromNumber (D d) = double d++integer :: Integer -> Builder+integer (S# i#) = int (I# i#)+integer i+    | i < 0     = minus `mappend` go (-i)+    | otherwise = go i+  where+    go n | n < maxInt = int (fromInteger n)+         | otherwise  = putH (splitf (maxInt * maxInt) n)++    splitf p n+      | p > n       = [n]+      | otherwise   = splith p (splitf (p*p) n)++    splith p (n:ns) = case n `quotRemInteger` p of+                        PAIR(q,r) | q > 0     -> q : r : splitb p ns+                                  | otherwise -> r : splitb p ns+    splith _ _      = error "splith: the impossible happened."++    splitb p (n:ns) = case n `quotRemInteger` p of+                        PAIR(q,r) -> q : r : splitb p ns+    splitb _ _      = []++data T = T !Integer !Int++fstT :: T -> Integer+fstT (T a _) = a++maxInt :: Integer+maxDigits :: Int+T maxInt maxDigits =+    until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)+  where mi = fromIntegral (maxBound :: Int)++putH :: [Integer] -> Builder+putH (n:ns) = case n `quotRemInteger` maxInt of+                PAIR(x,y)+                    | q > 0     -> int q `mappend` pblock r `mappend` putB ns+                    | otherwise -> int r `mappend` putB ns+                    where q = fromInteger x+                          r = fromInteger y+putH _ = error "putH: the impossible happened"++putB :: [Integer] -> Builder+putB (n:ns) = case n `quotRemInteger` maxInt of+                PAIR(x,y) -> pblock q `mappend` pblock r `mappend` putB ns+                    where q = fromInteger x+                          r = fromInteger y+putB _ = mempty++pblock :: Int -> Builder+pblock = go maxDigits+  where+    go !d !n+        | d == 1    = digit n+        | otherwise = go (d-1) q `mappend` digit r+        where q = n `quotInt` 10+              r = n `remInt` 10
Data/Aeson/Parser.hs view
@@ -79,6 +79,8 @@ doubleQuote, backslash :: Word8 doubleQuote = 34 backslash = 92+{-# INLINE backslash #-}+{-# INLINE doubleQuote #-}  jstring :: Parser Text jstring = A.word8 doubleQuote *> jstring_@@ -92,14 +94,11 @@                                         else Just (c == backslash)   _ <- A.word8 doubleQuote   if backslash `B.elem` s-    then decodeUtf8 <$> reparse unescape s+    then case Z.parse unescape s of+           Right r  -> return (decodeUtf8 r)+           Left err -> fail err     else return (decodeUtf8 s) {-# INLINE jstring_ #-}--reparse :: Z.Parser a -> ByteString -> Parser a-reparse p s = case Z.parse p s of-                Right r  -> return r-                Left err -> fail err  unescape :: Z.Parser ByteString unescape = toByteString <$> go mempty where
aeson.cabal view
@@ -1,5 +1,5 @@ name:            aeson-version:         0.3.1.1+version:         0.3.2.0 license:         BSD3 license-file:    LICENSE category:        Text, Web, JSON@@ -21,38 +21,44 @@     (2.66GHz Core i7), for mostly-English tweets from Twitter's JSON     search API:     .-    * 854 bytes: 21054 msg\/sec (17.1 MB/sec)+    * English, 854 bytes: 29029 msg\/sec (23.6 MB/sec)     .-    * 6.4 KB: 4545 msg\/sec (28.6 MB/sec)+    * English, 6.4 KB: 6407 msg\/sec (40.3 MB/sec)     .-    * 31.2 KB: 856 msg\/sec (26.1 MB/sec)+    * English, 31.2 KB: 1265 msg\/sec (38.8 MB/sec)     .-    * 61.5 KB: 403 msg\/sec (24.2 MB/sec) +    * English, 61.5 KB: 585 msg\/sec (35.2 MB/sec)      .     Handling heavily-escaped text is a little more work.  Here is     parsing performance with Japanese tweets, where much of the text     is entirely Unicode-escaped:     .-    * 14.6 KB: 1250 msg\/sec (17.9 MB/sec)+    * Japanese, 14.6 KB: 2227 msg\/sec (31.9 MB/sec)     .-    * 44.1 KB: 363 msg\/sec (15.6 MB/sec)+    * Japanese, 44.1 KB: 671 msg\/sec (29.6 MB/sec)     .     Encoding performance on the same machine and data:     .-    * 854 bytes: 10647 msg\/sec (8.7 MB/sec)+    * English, 854 bytes: 43439 msg\/sec (35.4 MB/sec)     .-    * 6.4 KB: 2098 msg\/sec (13.2 MB/sec)+    * English, 6.4 KB: 7127 msg\/sec (44.8 MB/sec)     .-    * 31.2 KB: 422 msg\/sec (12.9 MB/sec)+    * Engish, 61.5 KB: 765 msg\/sec (46.0 MB/sec)     .-    * 61.5 KB: 219 msg\/sec (13.2 MB/sec)+    * Japanese, 14.6 KB: 4727 msg\/sec (67.5 MB/sec)     .+    * Japanese, 44.1 KB: 1505 msg\/sec (64.8 MB/sec)+    .+    With GHC 7.0.2, the story is mixed: parsing is 20-40% slower than+    GHC 6.12.3, while encoding performance ranges from about the same+    to twice as fast (on numeric data).+    .     (A note on naming: in Greek mythology, Aeson was the father of Jason.)  extra-source-files:     README.markdown+    benchmarks/AesonEncode.hs     benchmarks/AesonParse.hs-    benchmarks/EncodeFile.hs     benchmarks/JsonParse.hs     benchmarks/Makefile     benchmarks/ReadFile.hs@@ -83,6 +89,9 @@     Data.Aeson.Types    other-modules:+    Data.Aeson.Encode.Double+    Data.Aeson.Encode.Int+    Data.Aeson.Encode.Number     Data.Aeson.Functions    build-depends:@@ -93,7 +102,9 @@     bytestring-show,     containers,     deepseq,+    ghc-prim,     hashable,+    integer-gmp,     monads-fd,     old-locale,     syb,@@ -107,6 +118,14 @@     ghc-prof-options: -auto-all    ghc-options:      -Wall++  if impl(ghc >= 6.11)+    cpp-options: -DINTEGER_GMP+    build-depends: integer-gmp >= 0.2 && < 0.3++  if impl(ghc >= 6.9) && impl(ghc < 6.11)+    cpp-options: -DINTEGER_GMP+    build-depends: integer >= 0.1 && < 0.2  source-repository head   type:     git
+ benchmarks/AesonEncode.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}++import Control.Exception+import Control.Monad+import Data.Aeson+import Data.Aeson.Encode+import Data.Aeson.Parser+import Data.Attoparsec+import Data.Time.Clock+import System.Environment (getArgs)+import System.IO+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as L+import Control.DeepSeq++instance NFData L.ByteString where+    rnf = go+      where go (L.Chunk _ cs) = go cs+            go L.Empty        = ()+    {-# INLINE rnf #-}++main = do+  (cnt:args) <- getArgs+  let count = read cnt :: Int+  forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do+    putStrLn $ arg ++ ":"+    let refill = B.hGet h 16384+    result <- parseWith refill json =<< refill+    r <- case result of+           Done _ r -> return r+           _        -> fail $ "failed to read " ++ show arg+    start <- getCurrentTime+    let loop !n r+            | n >= count = return ()+            | otherwise = {-# SCC "loop" #-} do+          case result of+            Done _ r -> rnf (encode r) `seq` loop (n+1) r+            _        -> error $ "failed to read " ++ show arg+    loop 0 r+    delta <- flip diffUTCTime start `fmap` getCurrentTime+    let rate = fromIntegral count / (fromRational . toRational) delta :: Double+    putStrLn $ "  " ++ show delta+    putStrLn $ "  " ++ show (round rate) ++ " per second"
benchmarks/AesonParse.hs view
@@ -27,5 +27,7 @@             Done _ r -> loop (good+1) bad             _        -> loop good (bad+1)     (good, _) <- loop 0 0-    end <- getCurrentTime-    putStrLn $ "  " ++ show good ++ " good, " ++ show (diffUTCTime end start)+    delta <- flip diffUTCTime start `fmap` getCurrentTime+    putStrLn $ "  " ++ show good ++ " good, " ++ show delta+    let rate = fromIntegral count / (fromRational . toRational) delta :: Double+    putStrLn $ "  " ++ show (round rate) ++ " per second"
− benchmarks/EncodeFile.hs 
@@ -1,32 +0,0 @@-{-# LANGUAGE BangPatterns, OverloadedStrings #-}--import Control.Exception-import Control.Monad-import Data.Aeson-import Data.Aeson.Encode-import Data.Aeson.Parser-import Data.Attoparsec-import Data.Time.Clock-import System.Environment (getArgs)-import System.IO-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L--main = do-  (cnt:args) <- getArgs-  let count = read cnt :: Int-  forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do-    putStrLn $ arg ++ ":"-    start <- getCurrentTime-    let loop !n-            | n >= count = return ()-            | otherwise = {-# SCC "loop" #-} do-          hSeek h AbsoluteSeek 0-          let refill = B.hGet h 16384-          result <- parseWith refill json =<< refill-          case result of-            Done _ r -> L.length (encode r) `seq` loop (n+1)-            _        -> error $ "failed to read " ++ show arg-    loop 0-    end <- getCurrentTime-    putStrLn $ "  " ++ show (diffUTCTime end start)
benchmarks/Makefile view
@@ -1,7 +1,7 @@ ghc := ghc ghcflags := -O -binaries := AesonParse EncodeFile JsonParse+binaries := AesonParse AesonEncode JsonParse  all: $(binaries) $(binaries:%=%_p)