d367d58 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Resolved conflict

d367d58Bas van Dijk14 years ago

Data/Aeson/Parser/Internal.hs+11−6

compare with master

unifiedsplit

@@ -37,7 +37,7 @@ import Data.ByteString as B

37import Data.Char (chr)

38import Data.Monoid (mappend, mempty)

39import Data.Text as T

40−import Data.Text.Encoding (decodeUtf8)

40+import Data.Text.Encoding (decodeUtf8')

41import Data.Vector as Vector hiding ((++))

42import Data.Word (Word8)

43import qualified Data.Attoparsec as A

@@ -175,11 +175,16 @@ jstring_ = {-# SCC "jstring_" #-} do

175 then Nothing

176 else Just (c == backslash)

177 _ <- A.word8 doubleQuote

178− if backslash `B.elem` s

178+ s' <- if backslash `B.elem` s

179− then case Z.parse unescape s of

179+ then case Z.parse unescape s of

180− Right r -> return (decodeUtf8 r)

180+ Right r -> return r

181− Left err -> fail err

181+ Left err -> fail err

182− else return (decodeUtf8 s)

182+ else return s

183+

184+ case decodeUtf8' s' of

185+ Right r -> return r

186+ Left err -> fail $ show err

187+

183{-# INLINE jstring_ #-}

188{-# INLINE jstring_ #-}

184

189

185unescape :: Z.Parser ByteString

190unescape :: Z.Parser ByteString

Data/Aeson/Types/Internal.hs+1−1

@@ -222,11 +222,11 @@ parseMaybe m v = runParser (m v) (const Nothing) Just

222-- | Run a 'Parser' with an 'Either' result type.

223parseEither :: (a -> Parser b) -> a -> Either String b

224parseEither m v = runParser (m v) Left Right

225+{-# INLINE parseEither #-}

225

226

226-- | A key\/value pair for an 'Object'.

227-- | A key\/value pair for an 'Object'.

227type Pair = (Text, Value)

228type Pair = (Text, Value)

228

229

229−{-# INLINE parseEither #-}

230-- | Create a 'Value' from a list of name\/value 'Pair's. If duplicate

231-- keys arise, earlier keys and their associated values win.

232object :: [Pair] -> Value

benchmarks/AesonEncode.hs+13−12

@@ -1,4 +1,4 @@

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

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

3import Control.Exception

4import Control.Monad

@@ -8,35 +8,36 @@ import Data.Time.Clock

8import System.Environment (getArgs)

9import System.IO

10import qualified Data.ByteString as B

11−import qualified Data.ByteString.Lazy as L

12−import qualified Data.ByteString.Lazy.Internal as L

13import Control.DeepSeq

11import Control.DeepSeq

13+#if !MIN_VERSION_bytestring(0,10,0)

14+import qualified Data.ByteString.Lazy.Internal as L

15+

15instance NFData L.ByteString where

16instance NFData L.ByteString where

16 rnf = go

17 rnf = go

17 where go (L.Chunk _ cs) = go cs

18 where go (L.Chunk _ cs) = go cs

18 go L.Empty = ()

19 go L.Empty = ()

19 {-# INLINE rnf #-}

20 {-# INLINE rnf #-}

21+#endif

23+main :: IO ()

21main = do

24main = do

22 (cnt:args) <- getArgs

25 (cnt:args) <- getArgs

23 let count = read cnt :: Int

26 let count = read cnt :: Int

24 forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do

27 forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do

25 putStrLn $ arg ++ ":"

28 putStrLn $ arg ++ ":"

26 let refill = B.hGet h 16384

29 let refill = B.hGet h 16384

27− result <- parseWith refill json =<< refill

30+ result0 <- parseWith refill json =<< refill

28− r <- case result of

31+ r0 <- case result0 of

29− Done _ r -> return r

32+ Done _ r -> return r

30− _ -> fail $ "failed to read " ++ show arg

33+ _ -> fail $ "failed to read " ++ show arg

31 start <- getCurrentTime

34 start <- getCurrentTime

32 let loop !n r

35 let loop !n r

33 | n >= count = return ()

36 | n >= count = return ()

34 | otherwise = {-# SCC "loop" #-} do

37 | otherwise = {-# SCC "loop" #-} do

35− case result of

36− Done _ r -> rnf (encode r) `seq` loop (n+1) r

38+ rnf (encode r) `seq` loop (n+1) r

37− _ -> error $ "failed to read " ++ show arg

38− loop 0 r

39+ loop 0 r0

39 delta <- flip diffUTCTime start `fmap` getCurrentTime

40 delta <- flip diffUTCTime start `fmap` getCurrentTime

40 let rate = fromIntegral count / realToFrac delta :: Double

41 let rate = fromIntegral count / realToFrac delta :: Double

41 putStrLn $ " " ++ show delta

42 putStrLn $ " " ++ show delta

42− putStrLn $ " " ++ show (round rate) ++ " per second"

43+ putStrLn $ " " ++ show (round rate :: Int) ++ " per second"

benchmarks/AesonParse.hs+3−2

@@ -10,8 +10,9 @@ import System.IO

10import qualified Data.ByteString as B

12main = do

13− (cnt:args) <- getArgs

13+ (bs:cnt:args) <- getArgs

14 let count = read cnt :: Int

15+ blkSize = read bs

15 forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do

16 forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do

16 putStrLn $ arg ++ ":"

17 putStrLn $ arg ++ ":"

17 start <- getCurrentTime

18 start <- getCurrentTime

@@ -19,7 +20,7 @@ main = do

19 | good+bad >= count = return (good, bad)

20 | good+bad >= count = return (good, bad)

20 | otherwise = do

21 | otherwise = do

21 hSeek h AbsoluteSeek 0

22 hSeek h AbsoluteSeek 0

22− let refill = B.hGet h 16384

23+ let refill = B.hGet h blkSize

23 result <- parseWith refill json =<< refill

24 result <- parseWith refill json =<< refill

24 case result of

25 case result of

25 Done _ r -> loop (good+1) bad

26 Done _ r -> loop (good+1) bad

benchmarks/CompareWithJSON.hs+9−5

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

1+{-# LANGUAGE CPP #-}

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

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

3import Blaze.ByteString.Builder (toLazyByteString)

4import Blaze.ByteString.Builder (toLazyByteString)

@@ -6,9 +7,16 @@ import Control.DeepSeq (NFData(rnf))

6import Criterion.Main

7import Criterion.Main

7import qualified Data.Aeson as A

8import qualified Data.Aeson as A

8import qualified Data.ByteString.Lazy as BL

9import qualified Data.ByteString.Lazy as BL

9−import qualified Data.ByteString.Lazy.Internal as BL

10import qualified Text.JSON as J

12+#if !MIN_VERSION_bytestring(0,10,0)

13+import qualified Data.ByteString.Lazy.Internal as BL

14+

15+instance NFData BL.ByteString where

16+ rnf (BL.Chunk _ bs) = rnf bs

17+ rnf BL.Empty = ()

18+#endif

19+

12instance (NFData v) => NFData (J.JSObject v) where

20instance (NFData v) => NFData (J.JSObject v) where

13 rnf o = rnf (J.fromJSObject o)

21 rnf o = rnf (J.fromJSObject o)

@@ -20,10 +28,6 @@ instance NFData J.JSValue where

20 rnf (J.JSArray lst) = rnf lst

28 rnf (J.JSArray lst) = rnf lst

21 rnf (J.JSObject o) = rnf o

29 rnf (J.JSObject o) = rnf o

23−instance NFData BL.ByteString where

24− rnf (BL.Chunk _ bs) = rnf bs

25− rnf BL.Empty = ()

26−

27decodeJ :: String -> J.JSValue

31decodeJ :: String -> J.JSValue

28decodeJ s =

32decodeJ s =

29 case J.decodeStrict s of

33 case J.decodeStrict s of

tests/Properties.hs+37−9

@@ -14,6 +14,7 @@ import Data.Aeson.Types

14import Data.Aeson.TH

15import Data.Attoparsec.Number

16import Data.Data (Typeable, Data)

17+import Data.Function (on)

17import Data.Text (Text)

18import Data.Text (Text)

18import Test.Framework (Test, defaultMain, testGroup)

19import Test.Framework (Test, defaultMain, testGroup)

19import Test.Framework.Providers.QuickCheck2 (testProperty)

20import Test.Framework.Providers.QuickCheck2 (testProperty)

@@ -25,8 +26,10 @@ import qualified Data.ByteString.Lazy.Char8 as L

25import qualified Data.Text as T

26import qualified Data.Text as T

26import qualified Data.Map as Map

27import qualified Data.Map as Map

27import qualified Data.HashMap.Strict as H

28import qualified Data.HashMap.Strict as H

29+import Data.Time.Calendar (Day)

30+import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)

31+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),

28−import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), hoursToTimeZone, Day(..), TimeOfDay(..))

32+ hoursToTimeZone, Day(..), TimeOfDay(..))

29−

30import Options

33import Options

32#ifdef GENERICS

35#ifdef GENERICS

@@ -57,13 +60,24 @@ genericTo _ v = G.toJSON v == toJSON v

57genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool

60genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool

58genericFrom _ v = G.fromJSON (toJSON v) == Success v

61genericFrom _ v = G.fromJSON (toJSON v) == Success v

60−approxEq :: Double -> Double -> Bool

63+approxEq :: (Fractional a, Ord a) => a -> a -> Bool

61−approxEq a b = a == b ||

64+approxEq = approxEqWith 1e-15 1e-15

65+

66+approxEqWith :: (Fractional a, Ord a) => a -> a -> a -> a -> Bool

67+approxEqWith maxAbsoluteError maxRelativeError a b =

62− d < maxAbsoluteError ||

68+ a == b || d < maxAbsoluteError ||

63− d / max (abs b) (abs a) <= maxRelativeError

69+ d / max (abs b) (abs a) <= maxRelativeError

64− where d = abs (a - b)

70+ where d = abs (a - b)

65− maxAbsoluteError = 1e-15

71+

66− maxRelativeError = 1e-15

72+-- Compare equality to within a millisecond, allowing for rounding

73+-- error (ECMA 262 requires milliseconds to rounded to zero, not

74+-- rounded to nearest).

75+approxEqUTC :: UTCTime -> UTCTime -> Bool

76+approxEqUTC a b = ((==) `on` utctDay) a b &&

77+ (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b

78+

79+approxEqNet :: DotNetTime -> DotNetTime -> Bool

80+approxEqNet (DotNetTime a) (DotNetTime b) = approxEqUTC a b

68toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a) => a -> Bool

82toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a) => a -> Bool

69toFromJSON x = case fromJSON . toJSON $ x of

83toFromJSON x = case fromJSON . toJSON $ x of

@@ -297,6 +311,18 @@ instance Arbitrary TimeZone where

297 offset <- choose (0,2) :: Gen Int

311 offset <- choose (0,2) :: Gen Int

298 return $ hoursToTimeZone offset

312 return $ hoursToTimeZone offset

299

313

314+instance Arbitrary Day where

315+ arbitrary = ModifiedJulianDay `liftM` arbitrary

316+

317+instance Arbitrary DiffTime where

318+ arbitrary = picosecondsToDiffTime `liftM` choose (0, 86400000000000000)

319+

320+instance Arbitrary UTCTime where

321+ arbitrary = liftM2 UTCTime arbitrary arbitrary

322+

323+instance Arbitrary DotNetTime where

324+ arbitrary = DotNetTime `liftM` arbitrary

325+

300instance Arbitrary ZonedTime where

326instance Arbitrary ZonedTime where

301 arbitrary = liftM2 ZonedTime arbitrary arbitrary

327 arbitrary = liftM2 ZonedTime arbitrary arbitrary

302

328

@@ -345,6 +371,8 @@ tests = [

345 , testProperty "String" $ roundTripEq (""::String)

371 , testProperty "String" $ roundTripEq (""::String)

346 , testProperty "Text" $ roundTripEq T.empty

372 , testProperty "Text" $ roundTripEq T.empty

347 , testProperty "Foo" $ roundTripEq (undefined::Foo)

373 , testProperty "Foo" $ roundTripEq (undefined::Foo)

374+ , testProperty "DotNetTime" $ roundTrip approxEqNet undefined

375+ , testProperty "UTCTime" $ roundTrip approxEqUTC undefined

348 , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)

376 , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)

349 ],

377 ],

350 testGroup "toFromJSON" [

378 testGroup "toFromJSON" [