git.iko.soy/typeable/aeson
on master help sign in
Resolved conflict
commitd367d5886f8e7e700e693e7bfbe40f2897639b2b authorBas van Dijk <v.dijk.bas@gmail.com> dateSun 7 Apr 2013, 18:21 (14 years ago) parent5e6c32cbe09b9f
6 files changed+74−35
compare with master
unifiedsplit
Data/Aeson/Parser/Internal.hs+11−6 Data/Aeson/Types/Internal.hs+1−1 benchmarks/AesonEncode.hs+13−12 benchmarks/AesonParse.hs+3−2 benchmarks/CompareWithJSON.hs+9−5 tests/Properties.hs+37−9
Data/Aeson/Parser/Internal.hs+11−6
@@ -37,7 +37,7 @@ import Data.ByteString as B
3737import Data.Char (chr)
3838import Data.Monoid (mappend, mempty)
3939import Data.Text as T
40−import Data.Text.Encoding (decodeUtf8)
40+import Data.Text.Encoding (decodeUtf8')
4141import Data.Vector as Vector hiding ((++))
4242import Data.Word (Word8)
4343import qualified Data.Attoparsec as A
@@ -175,11 +175,16 @@ jstring_ = {-# SCC "jstring_" #-} do
175175 then Nothing
176176 else Just (c == backslash)
177177 _ <- A.word8 doubleQuote
178− if backslash `B.elem` s
179− then case Z.parse unescape s of
180− Right r -> return (decodeUtf8 r)
181− Left err -> fail err
182− else return (decodeUtf8 s)
178+ s' <- if backslash `B.elem` s
179+ then case Z.parse unescape s of
180+ Right r -> return r
181+ Left err -> fail err
182+ else return s
183+
184+ case decodeUtf8' s' of
185+ Right r -> return r
186+ Left err -> fail $ show err
187+
183188{-# INLINE jstring_ #-}
184189
185190unescape :: Z.Parser ByteString
Data/Aeson/Types/Internal.hs+1−1
@@ -222,11 +222,11 @@ parseMaybe m v = runParser (m v) (const Nothing) Just
222222-- | Run a 'Parser' with an 'Either' result type.
223223parseEither :: (a -> Parser b) -> a -> Either String b
224224parseEither m v = runParser (m v) Left Right
225+{-# INLINE parseEither #-}
225226
226227-- | A key\/value pair for an 'Object'.
227228type Pair = (Text, Value)
228229
229−{-# INLINE parseEither #-}
230230-- | Create a 'Value' from a list of name\/value 'Pair's. If duplicate
231231-- keys arise, earlier keys and their associated values win.
232232object :: [Pair] -> Value
benchmarks/AesonEncode.hs+13−12
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, OverloadedStrings #-}
1+{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}
22
33import Control.Exception
44import Control.Monad
@@ -8,35 +8,36 @@ import Data.Time.Clock
88import System.Environment (getArgs)
99import System.IO
1010import qualified Data.ByteString as B
11−import qualified Data.ByteString.Lazy as L
12−import qualified Data.ByteString.Lazy.Internal as L
1311import Control.DeepSeq
1412
13+#if !MIN_VERSION_bytestring(0,10,0)
14+import qualified Data.ByteString.Lazy.Internal as L
15+
1516instance NFData L.ByteString where
1617 rnf = go
1718 where go (L.Chunk _ cs) = go cs
1819 go L.Empty = ()
1920 {-# INLINE rnf #-}
21+#endif
2022
23+main :: IO ()
2124main = do
2225 (cnt:args) <- getArgs
2326 let count = read cnt :: Int
2427 forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
2528 putStrLn $ arg ++ ":"
2629 let refill = B.hGet h 16384
27− result <- parseWith refill json =<< refill
28− r <- case result of
29− Done _ r -> return r
30− _ -> fail $ "failed to read " ++ show arg
30+ result0 <- parseWith refill json =<< refill
31+ r0 <- case result0 of
32+ Done _ r -> return r
33+ _ -> fail $ "failed to read " ++ show arg
3134 start <- getCurrentTime
3235 let loop !n r
3336 | n >= count = return ()
3437 | otherwise = {-# SCC "loop" #-} do
35− case result of
36− Done _ r -> rnf (encode r) `seq` loop (n+1) r
37− _ -> error $ "failed to read " ++ show arg
38− loop 0 r
38+ rnf (encode r) `seq` loop (n+1) r
39+ loop 0 r0
3940 delta <- flip diffUTCTime start `fmap` getCurrentTime
4041 let rate = fromIntegral count / realToFrac delta :: Double
4142 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
1010import qualified Data.ByteString as B
1111
1212main = do
13− (cnt:args) <- getArgs
13+ (bs:cnt:args) <- getArgs
1414 let count = read cnt :: Int
15+ blkSize = read bs
1516 forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
1617 putStrLn $ arg ++ ":"
1718 start <- getCurrentTime
@@ -19,7 +20,7 @@ main = do
1920 | good+bad >= count = return (good, bad)
2021 | otherwise = do
2122 hSeek h AbsoluteSeek 0
22− let refill = B.hGet h 16384
23+ let refill = B.hGet h blkSize
2324 result <- parseWith refill json =<< refill
2425 case result of
2526 Done _ r -> loop (good+1) bad
benchmarks/CompareWithJSON.hs+9−5
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# OPTIONS_GHC -fno-warn-orphans #-}
23
34import Blaze.ByteString.Builder (toLazyByteString)
@@ -6,9 +7,16 @@ import Control.DeepSeq (NFData(rnf))
67import Criterion.Main
78import qualified Data.Aeson as A
89import qualified Data.ByteString.Lazy as BL
9−import qualified Data.ByteString.Lazy.Internal as BL
1010import qualified Text.JSON as J
1111
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+
1220instance (NFData v) => NFData (J.JSObject v) where
1321 rnf o = rnf (J.fromJSObject o)
1422
@@ -20,10 +28,6 @@ instance NFData J.JSValue where
2028 rnf (J.JSArray lst) = rnf lst
2129 rnf (J.JSObject o) = rnf o
2230
23−instance NFData BL.ByteString where
24− rnf (BL.Chunk _ bs) = rnf bs
25− rnf BL.Empty = ()
26−
2731decodeJ :: String -> J.JSValue
2832decodeJ s =
2933 case J.decodeStrict s of
tests/Properties.hs+37−9
@@ -14,6 +14,7 @@ import Data.Aeson.Types
1414import Data.Aeson.TH
1515import Data.Attoparsec.Number
1616import Data.Data (Typeable, Data)
17+import Data.Function (on)
1718import Data.Text (Text)
1819import Test.Framework (Test, defaultMain, testGroup)
1920import Test.Framework.Providers.QuickCheck2 (testProperty)
@@ -25,8 +26,10 @@ import qualified Data.ByteString.Lazy.Char8 as L
2526import qualified Data.Text as T
2627import qualified Data.Map as Map
2728import qualified Data.HashMap.Strict as H
28−import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), hoursToTimeZone, Day(..), TimeOfDay(..))
29−
29+import Data.Time.Calendar (Day)
30+import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)
31+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),
32+ hoursToTimeZone, Day(..), TimeOfDay(..))
3033import Options
3134
3235#ifdef GENERICS
@@ -57,13 +60,24 @@ genericTo _ v = G.toJSON v == toJSON v
5760genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool
5861genericFrom _ v = G.fromJSON (toJSON v) == Success v
5962
60−approxEq :: Double -> Double -> Bool
61−approxEq a b = a == b ||
62− d < maxAbsoluteError ||
63− d / max (abs b) (abs a) <= maxRelativeError
64− where d = abs (a - b)
65− maxAbsoluteError = 1e-15
66− maxRelativeError = 1e-15
63+approxEq :: (Fractional a, Ord a) => a -> a -> Bool
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 =
68+ a == b || d < maxAbsoluteError ||
69+ d / max (abs b) (abs a) <= maxRelativeError
70+ where d = abs (a - b)
71+
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
6781
6882toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a) => a -> Bool
6983toFromJSON x = case fromJSON . toJSON $ x of
@@ -297,6 +311,18 @@ instance Arbitrary TimeZone where
297311 offset <- choose (0,2) :: Gen Int
298312 return $ hoursToTimeZone offset
299313
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+
300326instance Arbitrary ZonedTime where
301327 arbitrary = liftM2 ZonedTime arbitrary arbitrary
302328
@@ -345,6 +371,8 @@ tests = [
345371 , testProperty "String" $ roundTripEq (""::String)
346372 , testProperty "Text" $ roundTripEq T.empty
347373 , testProperty "Foo" $ roundTripEq (undefined::Foo)
374+ , testProperty "DotNetTime" $ roundTrip approxEqNet undefined
375+ , testProperty "UTCTime" $ roundTrip approxEqUTC undefined
348376 , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)
349377 ],
350378 testGroup "toFromJSON" [