packages feed

aeson (empty) → 0.1.0.0

raw patch · 12 files changed

+824/−0 lines, 12 filesdep +attoparsecdep +basedep +blaze-buildersetup-changed

Dependencies added: attoparsec, base, blaze-builder, bytestring, containers, deepseq, old-locale, text, time, vector

Files

+ Data/Aeson.hs view
@@ -0,0 +1,33 @@+-- Module:      Data.Aeson+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Types and functions for working efficiently with JSON data.+--+-- (A note on naming: in Greek mythology, Aeson was the father of Jason.)++module Data.Aeson+    (+    -- * Core JSON types+      Value(..)+    , Array+    , Object+    -- * Type conversion+    , FromJSON(..)+    , ToJSON(..)+    -- * Constructors and accessors+    , (.=)+    , (.:)+    , (.:?)+    , object+    -- * Encoding and parsing+    , encode+    , json+    ) where++import Data.Aeson.Encode+import Data.Aeson.Parser+import Data.Aeson.Types
+ Data/Aeson/Encode.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}++-- Module:      Data.Aeson.Encode+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Efficiently serialize a JSON value as a lazy 'L.ByteString'.++module Data.Aeson.Encode+    (+      fromValue+    , encode+    ) where++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char.Utf8+import Data.Aeson.Types (ToJSON(..), Value(..))+import Data.Monoid (mappend)+import Numeric (showHex)+import qualified Data.ByteString.Char8 as B+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++-- | 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 n) = fromByteString (B.pack (show n))+fromValue (String s) = string s+fromValue (Array v)+    | V.null v = fromByteString "[]"+    | otherwise = fromChar '[' `mappend`+                  fromValue (V.unsafeHead v) `mappend`+                  V.foldr f (fromChar ']') (V.unsafeTail v)+  where f a z = fromChar ',' `mappend` fromValue a `mappend` z+fromValue (Object m) =+    case M.toList m of+      (x:xs) -> fromChar '{' `mappend`+                one x `mappend`+                foldr f (fromChar '}') xs+      _ -> fromByteString "{}"+  where f a z     = fromChar ',' `mappend` one a `mappend` z+        one (k,v) = string k `mappend` fromChar ':' `mappend` fromValue v++string :: T.Text -> Builder+string s = fromChar '"' `mappend` quote s `mappend` fromChar '"'+  where+    quote q = case T.uncons t of+                Just (c,t') -> fromText h `mappend` escape c `mappend` quote t'+                Nothing -> fromText h+        where (h,t) = T.break isEscape q+    isEscape c = c == '\"' || c == '\\' || c < '\x20'+    escape '\"' = fromByteString "\\\""+    escape '\\' = fromByteString "\\\\"+    escape '\n' = fromByteString "\\n"+    escape '\r' = fromByteString "\\r"+    escape '\t' = fromByteString "\\t"+    escape c+        | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h+        | otherwise  = fromChar c+        where h = showHex (fromEnum c) ""++-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.+encode :: ToJSON a => a -> L.ByteString+encode = toLazyByteString . fromValue . toJSON+{-# INLINE encode #-}
+ Data/Aeson/Parser.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE OverloadedStrings #-}++-- Module:      Data.Aeson.Parser+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Efficiently and correctly parse a JSON string.++module Data.Aeson.Parser+    (+      json+    , value+    ) where++import Blaze.ByteString.Builder (fromByteString, toByteString)+import Blaze.ByteString.Builder.Char.Utf8 (fromChar)+import Blaze.ByteString.Builder.Word (fromWord8)+import Control.Applicative as A+import Control.Monad (when)+import Data.Aeson.Types (Value(..))+import Data.Attoparsec.Char8+import Data.Bits ((.|.), shiftL)+import Data.ByteString as B+import Data.Char (chr)+import Data.Map as Map+import Data.Monoid (mappend, mempty)+import Data.Text as T+import Data.Text.Encoding (decodeUtf8)+import Data.Vector as Vector hiding ((++))+import Data.Word (Word8)+import qualified Data.Attoparsec as A+import qualified Data.ByteString.Unsafe as B++-- | Parse a top-level JSON value.  This must be either an object or+-- an array.+json :: Parser Value+json = do+  c <- skipSpace *> anyChar+  case c of+    '{' -> object_+    '[' -> array_+    _   -> fail "root value is not an object or array"++object_ :: Parser Value+object_ = do+  skipSpace+  let pair = do+        a <- jstring <* skipSpace+        b <- char ':' *> skipSpace *> value+        return (a,b)+  vals <- ((pair <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char '}'+  return . Object $ Map.fromList vals++array_ :: Parser Value+array_ = do+  skipSpace+  vals <- ((value <* skipSpace) `sepBy` (char ',' *> skipSpace)) <* char ']'+  return . Array $ Vector.fromList vals++-- | Parse any JSON value.  Use 'json' in preference to this function+-- if you are parsing data from an untrusted source.+value :: Parser Value+value = most <|> (Number <$> double)+ where+  most = do+    c <- anyChar+    case c of+      '{' -> object_+      '[' -> array_+      '"' -> String <$> jstring_+      'f' -> string "alse" *> pure (Bool False)+      't' -> string "rue" *> pure (Bool True)+      'n' -> string "ull" *> pure Null+      _   -> fail "not a valid JSON value"++doubleQuote, backslash :: Word8+doubleQuote = 34+backslash = 92++jstring :: Parser Text+jstring = A.word8 doubleQuote *> jstring_++-- | Parse a string without a leading quote.+jstring_ :: Parser Text+jstring_ = do+  s <- A.scan False $ \s c -> if s then Just False+                                   else if c == doubleQuote+                                        then Nothing+                                        else Just (c == backslash)+  _ <- A.word8 doubleQuote+  if backslash `B.elem` s+    then decodeUtf8 <$> reparse unescape s+    else return (decodeUtf8 s)++reparse :: Parser a -> ByteString -> Parser a+reparse p s = case (case parse p s of {Partial k -> k ""; r -> r}) of+                Done "" r    -> return r+                Fail _ _ msg -> fail msg+                _            -> fail "unexpected failure"++unescape :: Parser ByteString+unescape = toByteString <$> go mempty where+  go acc = do+    h <- A.takeWhile (/=backslash)+    let rest = do+          start <- A.take 2+          let !slash = B.unsafeHead start+              !t = B.unsafeIndex start 1+              escape = case B.findIndex (==t) "\"\\/ntbrfu" of+                         Just i -> i+                         _      -> 255+          when (slash /= backslash || escape == 255) $+            fail "invalid JSON escape sequence"+          let continue m = go (acc `mappend` fromByteString h `mappend` m)+              {-# INLINE continue #-}+          if t /= 117 -- 'u'+            then continue (fromWord8 (B.unsafeIndex mapping escape))+            else do+                 a <- hexQuad+                 if a < 0xd800 || a > 0xdfff+                   then continue (fromChar (chr a))+                   else do+                     b <- string "\\u" *> hexQuad+                     if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff+                       then let !c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) ++                                     0x10000+                            in continue (fromChar (chr c))+                       else fail "invalid UTF-16 surrogates"+    rest <|> return (acc `mappend` fromByteString h)+  mapping = "\"\\/\n\t\b\r\f"++hexQuad :: Parser Int+hexQuad = do+  s <- A.take 4+  let hex n | w >= 48 && w <= 57  = w - 48+            | w >= 97 && w <= 122 = w - 87+            | w >= 65 && w <= 90  = w - 55+            | otherwise           = 255+        where w = fromIntegral $ B.unsafeIndex s n+      a = hex 0; b = hex 1; c = hex 2; d = hex 3+  if (a .|. b .|. c .|. d) /= 255+    then return $! d .|. (c `shiftL` 4) .|. (b `shiftL` 8) .|. (a `shiftL` 12)+    else fail "invalid hex escape"
+ Data/Aeson/Types.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- Module:      Data.Aeson.Types+-- Copyright:   (c) 2011 MailRank, Inc.+-- License:     Apache+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>+-- Stability:   experimental+-- Portability: portable+--+-- Types for working with JSON data.++module Data.Aeson.Types+    (+    -- * Core JSON types+      Value(..)+    , Array+    , Object+    -- * Type conversion+    , FromJSON(..)+    , ToJSON(..)+    -- * Constructors and accessors+    , (.=)+    , (.:)+    , (.:?)+    , object+    ) where++import Control.Applicative+import Control.DeepSeq (NFData(..))+import Data.Map (Map)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Data.Text (Text, pack, unpack)+import qualified Data.Text.Lazy as LT+import Data.Time.Clock (UTCTime)+import Data.Time.Format (formatTime, parseTime)+import Data.Typeable (Typeable)+import Data.Vector (Vector)+import System.Locale (defaultTimeLocale)+import qualified Data.Map as M+import qualified Data.Vector as V++type Object = Map Text Value+type Array = Vector Value++-- | A JSON value represented as a Haskell value.+data Value = Object Object+           | Array Array+           | String Text+           | Number Double+           | Bool !Bool+           | Null+             deriving (Eq, Show, Typeable)++instance NFData Value where+    rnf (Object o) = rnf o+    rnf (Array a)  = V.foldl' (\x y -> rnf y `seq` x) () a+    rnf (String s) = rnf s+    rnf (Number n) = rnf n+    rnf (Bool b)   = rnf b+    rnf Null       = ()++-- | Construct an 'Object' from a key and a value.+(.=) :: ToJSON a => Text -> a -> Object+name .= value = M.singleton name (toJSON value)+{-# INLINE (.=) #-}++-- | Retrieve the value associated with the given key of an 'Object'.+-- The result is 'empty' if the key is not present or the value cannot+-- be converted to the desired type.+--+-- This accessor is appropriate if the key and value /must/ be present+-- in an object for it to be valid.  If the key and value are+-- optional, use '(.:?)' instead.+(.:) :: (Alternative f, FromJSON a) => Object -> Text -> f a+obj .: key = case M.lookup key obj of+               Nothing -> empty+               Just v  -> fromJSON v+{-# INLINE (.:) #-}++-- | Retrieve the value associated with the given key of an 'Object'.+-- The result is 'Nothing' if the key is not present, or 'empty' if+-- the value cannot be converted to the desired type.+--+-- This accessor is most useful if the key and value can be absent+-- from an object without affecting its validity.  If the key and+-- value are mandatory, use '(.:?)' instead.+(.:?) :: (Alternative f, FromJSON a) => Object -> Text -> f (Maybe a)+obj .:? key = case M.lookup key obj of+               Nothing -> pure Nothing+               Just v  -> fromJSON v+{-# INLINE (.:?) #-}++-- | Create a 'Value' from a list of 'Object's.  If duplicate+-- keys arise, earlier keys and their associated values win.+object :: [Object] -> Value+object = Object . M.unions+{-# INLINE object #-}++-- | A type that can be converted to JSON.+--+-- An example type and instance:+--+-- @data Coord { x :: Double, y :: Double }+--+-- instance ToJSON Coord where+--   toJSON (Coord x y) = 'object' [\"x\" '.=' x, \"y\" '.=' y]+-- @+class ToJSON a where+    toJSON   :: a -> Value++-- | A type that can be converted from JSON, with the possibility of+-- failure.+--+-- When writing an instance, use 'empty' to make a conversion fail,+-- e.g. if an 'Object' is missing a required key, or the value is of+-- the wrong type.+--+-- An example type and instance:+--+-- @data Coord { x :: Double, y :: Double }+-- +-- instance FromJSON Coord where+--   fromJSON ('Object' v) = Coord '<$>'+--                         v '.:' \"x\" '<*>'+--                         v '.:' \"y\"+--+--   \-- A non-'Object' value is of the wrong type, so use 'empty' to fail.+--   fromJSON _          = 'empty'+-- @+class FromJSON a where+    fromJSON :: Alternative f => Value -> f a++instance (ToJSON a) => ToJSON (Maybe a) where+    toJSON (Just a) = toJSON a+    toJSON Nothing  = Null+    {-# INLINE toJSON #-}+    +instance (FromJSON a) => FromJSON (Maybe a) where+    fromJSON Null   = pure Nothing+    fromJSON a      = Just <$> fromJSON a+    {-# INLINE fromJSON #-}++instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where+    toJSON (Left a)  = toJSON a+    toJSON (Right b) = toJSON b+    {-# INLINE toJSON #-}+    +instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where+    fromJSON a = Left <$> fromJSON a <|> Right <$> fromJSON a+    {-# INLINE fromJSON #-}++instance ToJSON Bool where+    toJSON = Bool+    {-# INLINE toJSON #-}++instance FromJSON Bool where+    fromJSON (Bool b) = pure b+    fromJSON _        = empty+    {-# INLINE fromJSON #-}++instance ToJSON Double where+    toJSON = Number+    {-# INLINE toJSON #-}++instance FromJSON Double where+    fromJSON (Number n) = pure n+    fromJSON _          = empty+    {-# INLINE fromJSON #-}++instance ToJSON Int where+    toJSON = Number . fromIntegral+    {-# INLINE toJSON #-}++instance FromJSON Int where+    fromJSON (Number n) = pure (floor n)+    fromJSON _          = empty+    {-# INLINE fromJSON #-}++instance ToJSON Integer where+    toJSON = Number . fromIntegral+    {-# INLINE toJSON #-}++instance FromJSON Integer where+    fromJSON (Number n) = pure (floor n)+    fromJSON _          = empty+    {-# INLINE fromJSON #-}++instance ToJSON Text where+    toJSON = String+    {-# INLINE toJSON #-}++instance FromJSON Text where+    fromJSON (String t) = pure t+    fromJSON _          = empty+    {-# INLINE fromJSON #-}++instance ToJSON LT.Text where+    toJSON = String . LT.toStrict+    {-# INLINE toJSON #-}++instance FromJSON LT.Text where+    fromJSON (String t) = pure (LT.fromStrict t)+    fromJSON _          = empty+    {-# INLINE fromJSON #-}++instance ToJSON B.ByteString where+    toJSON = String . decodeUtf8+    {-# INLINE toJSON #-}++instance FromJSON B.ByteString where+    fromJSON (String t) = pure . encodeUtf8 $ t+    fromJSON _          = empty+    {-# INLINE fromJSON #-}++instance ToJSON LB.ByteString where+    toJSON = toJSON . B.concat . LB.toChunks+    {-# INLINE toJSON #-}++instance FromJSON LB.ByteString where+    fromJSON (String t) = pure . LB.fromChunks . (:[]) . encodeUtf8 $ t+    fromJSON _          = empty+    {-# INLINE fromJSON #-}++mapA :: (Applicative f) => (t -> f a) -> [t] -> f [a]+mapA f = go+  where+    go (a:as) = (:) <$> f a <*> go as+    go []     = pure []++instance (ToJSON a) => ToJSON [a] where+    toJSON = Array . V.fromList . map toJSON+    {-# INLINE toJSON #-}+    +instance (FromJSON a) => FromJSON [a] where+    fromJSON (Array a) = mapA fromJSON (V.toList a)+    fromJSON _         = empty+    {-# INLINE fromJSON #-}++instance (ToJSON a) => ToJSON (Vector a) where+    toJSON = Array . V.map toJSON+    {-# INLINE toJSON #-}+    +instance (FromJSON a) => FromJSON (Vector a) where+    fromJSON (Array a) = V.fromList <$> mapA fromJSON (V.toList a)+    fromJSON _         = empty+    {-# INLINE fromJSON #-}++instance ToJSON Value where+    toJSON a = a+    {-# INLINE toJSON #-}++instance FromJSON Value where+    fromJSON a = pure a+    {-# INLINE fromJSON #-}++-- We happen to use the same JSON formatting for a UTCTime as .NET+-- does for a DateTime. How handy!+instance ToJSON UTCTime where+    toJSON t = String (pack (formatTime defaultTimeLocale "/Date(%s)/" t))+    {-# INLINE toJSON #-}++instance FromJSON UTCTime where+    fromJSON (String t) =+        case parseTime defaultTimeLocale "/Date(%s)/" (unpack t) of+          Just d -> pure d+          _      -> empty+    fromJSON _          = empty+    {-# INLINE fromJSON #-}++instance (ToJSON a, ToJSON b) => ToJSON (a,b) where+    toJSON (a,b) = toJSON [toJSON a, toJSON b]+    {-# INLINE toJSON #-}++instance (FromJSON a, FromJSON b) => FromJSON (a,b) where+    fromJSON (Array ab) = case V.toList ab of+                            [a,b] -> (,) <$> fromJSON a <*> fromJSON b+                            _     -> empty+    fromJSON _          = empty+    {-# INLINE fromJSON #-}++++++++++
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2011, MailRank, Inc.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ README.markdown view
@@ -0,0 +1,27 @@+# Welcome to aeson++aeson is a fast Haskell library for working with JSON data.++# Join in!++We are happy to receive bug reports, fixes, documentation enhancements,+and other improvements.++Please report bugs via the+[github issue tracker](http://github.com/mailrank/aeson/issues).++Master [git repository](http://github.com/mailrank/aeson):++* `git clone git://github.com/mailrank/aeson.git`++There's also a [Mercurial mirror](http://bitbucket.org/bos/aeson):++* `hg clone http://bitbucket.org/bos/aeson`++(You can create and contribute changes using either git or Mercurial.)++Authors+-------++This library is written and maintained by Bryan O'Sullivan,+<bos@mailrank.com>.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ aeson.cabal view
@@ -0,0 +1,94 @@+name:            aeson+version:         0.1.0.0+license:         BSD3+license-file:    LICENSE+category:        Text, Web, JSON+copyright:       Copyright 2011 MailRank, Inc.+author:          Bryan O'Sullivan <bos@mailrank.com>+maintainer:      Bryan O'Sullivan <bos@mailrank.com>+stability:       experimental+tested-with:     GHC == 6.12.3+synopsis:        Fast JSON parsing and generation+cabal-version:   >= 1.8+homepage:        http://github.com/mailrank/aeson+bug-reports:     http://github.com/mailrank/aeson/issues+build-type:      Simple+description:+    A JSON parsing and generation library optimized for ease of use+    and high performance.+    .+    Parsing performance with GHC 6.12.3 on a late 2010 MacBook Pro+    (2.66GHz Core i7), for mostly-English tweets from Twitter's JSON+    search API:+    .+    * 854 bytes: 21054 msg\/sec (17.1 MB/sec)+    .+    * 6.4 KB: 4545 msg\/sec (28.6 MB/sec)+    .+    * 31.2 KB: 856 msg\/sec (26.1 MB/sec)+    .+    * 61.5 KB: 403 msg\/sec (24.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)+    .+    * 44.1 KB: 363 msg\/sec (15.6 MB/sec)+    .+    Encoding performance on the same machine and data:+    .+    * 854 bytes: 10647 msg\/sec (8.7 MB/sec)+    .+    * 6.4 KB: 2098 msg\/sec (13.2 MB/sec)+    .+    * 31.2 KB: 422 msg\/sec (12.9 MB/sec)+    .+    * 61.5 KB: 219 msg\/sec (13.2 MB/sec)+    .+    (A note on naming: in Greek mythology, Aeson was the father of Jason.)++extra-source-files:+    README.markdown+    benchmarks/AesonParse.hs+    benchmarks/EncodeFile.hs+    benchmarks/JsonParse.hs+    benchmarks/ReadFile.hs++flag developer+  description: operate in developer mode+  default: False++library+  exposed-modules:+    Data.Aeson+    Data.Aeson.Encode+    Data.Aeson.Parser+    Data.Aeson.Types++  build-depends:+    attoparsec >= 0.8.4.0,+    base == 4.*,+    blaze-builder >= 0.2.1.4,+    bytestring,+    containers,+    deepseq,+    old-locale,+    text >= 0.11.0.2,+    time,+    vector >= 0.7++  if flag(developer)+    ghc-options: -Werror+    ghc-prof-options: -auto-all++  ghc-options:      -Wall++source-repository head+  type:     git+  location: http://github.com/mailrank/aeson++source-repository head+  type:     mercurial+  location: http://bitbucket.org/bos/aeson
+ benchmarks/AesonParse.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}++import Control.DeepSeq+import Control.Exception+import Control.Monad+import Data.Aeson+import Data.Aeson.Parser+import Data.Attoparsec+import Data.Time.Clock+import System.Environment (getArgs)+import System.IO+import qualified Data.ByteString as B++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 !good !bad+            | good+bad >= count = return (good, bad)+            | otherwise = do+          hSeek h AbsoluteSeek 0+          let refill = B.hGet h 16384+          result <- parseWith refill json =<< refill+          case result of+            Done _ r -> loop (good+1) bad+            _        -> loop good (bad+1)+    (good, _) <- loop 0 0+    end <- getCurrentTime+    putStrLn $ "  " ++ show good ++ " good, " ++ show (diffUTCTime end start)
+ benchmarks/EncodeFile.hs view
@@ -0,0 +1,32 @@+{-# 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/JsonParse.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}++import Control.DeepSeq+import Control.Exception+import Control.Monad+import Text.JSON+import Data.Time.Clock+import System.Environment (getArgs)+import System.IO+import qualified Data.ByteString as B++instance NFData JSValue where+    rnf JSNull = ()+    rnf (JSBool b) = rnf b+    rnf (JSRational b r) = rnf b `seq` rnf r `seq` ()+    rnf (JSString s) = rnf (fromJSString s)+    rnf (JSArray vs) = rnf vs+    rnf (JSObject kvs) = rnf (fromJSObject kvs)++main = do+  (cnt:args) <- getArgs+  let count = read cnt :: Int+  forM_ args $ \arg -> do+    putStrLn $ arg ++ ":"+    start <- getCurrentTime+    let loop !good !bad+            | good+bad >= count = return (good, bad)+            | otherwise = do+          s <- readFile arg+          case decodeStrict s of+            Ok (v::JSValue) -> loop (good+1) 0+            _ -> loop 0 (bad+1)+    (good, _) <- loop 0 0+    end <- getCurrentTime+    putStrLn $ "  " ++ show good ++ " good, " ++ show (diffUTCTime end start)
+ benchmarks/ReadFile.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}++import Control.DeepSeq+import Control.Exception+import Control.Monad+import Data.Aeson+import Data.Aeson.Parser+import Data.Attoparsec+import Data.Time.Clock+import System.Environment (getArgs)+import System.IO+import qualified Data.ByteString as B++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 = do+          let go = do+                s <- B.hGet h 16384+                if B.null s+                  then loop (n+1)+                  else go+          go+    loop 0+    end <- getCurrentTime+    putStrLn $ "  " ++ show (diffUTCTime end start)