basvandijk avatar basvandijk committed ff433c1 Merge

Resolved conflict

Comments (0)

Files changed (6)

Data/Aeson/Parser/Internal.hs

 import Data.Char (chr)
 import Data.Monoid (mappend, mempty)
 import Data.Text as T
-import Data.Text.Encoding (decodeUtf8)
+import Data.Text.Encoding (decodeUtf8')
 import Data.Vector as Vector hiding ((++))
 import Data.Word (Word8)
 import qualified Data.Attoparsec as A
                                         then Nothing
                                         else Just (c == backslash)
   _ <- A.word8 doubleQuote
-  if backslash `B.elem` s
-    then case Z.parse unescape s of
-           Right r  -> return (decodeUtf8 r)
-           Left err -> fail err
-    else return (decodeUtf8 s)
+  s' <- if backslash `B.elem` s
+        then case Z.parse unescape s of
+            Right r  -> return r
+            Left err -> fail err
+         else return s
+
+  case decodeUtf8' s' of
+      Right r  -> return r
+      Left err -> fail $ show err
+
 {-# INLINE jstring_ #-}
 
 unescape :: Z.Parser ByteString

Data/Aeson/Types/Internal.hs

 -- | Run a 'Parser' with an 'Either' result type.
 parseEither :: (a -> Parser b) -> a -> Either String b
 parseEither m v = runParser (m v) Left Right
+{-# INLINE parseEither #-}
 
 -- | A key\/value pair for an 'Object'.
 type Pair = (Text, Value)
 
-{-# INLINE parseEither #-}
 -- | Create a 'Value' from a list of name\/value 'Pair's.  If duplicate
 -- keys arise, earlier keys and their associated values win.
 object :: [Pair] -> Value

benchmarks/AesonEncode.hs

-{-# LANGUAGE BangPatterns, OverloadedStrings #-}
+{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}
 
 import Control.Exception
 import Control.Monad
 import System.Environment (getArgs)
 import System.IO
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
+import Control.DeepSeq
+
+#if !MIN_VERSION_bytestring(0,10,0)
 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 #-}
+#endif
 
+main :: IO ()
 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
+    result0 <- parseWith refill json =<< refill
+    r0 <- case result0 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
+          rnf (encode r) `seq` loop (n+1) r
+    loop 0 r0
     delta <- flip diffUTCTime start `fmap` getCurrentTime
     let rate = fromIntegral count / realToFrac delta :: Double
     putStrLn $ "  " ++ show delta
-    putStrLn $ "  " ++ show (round rate) ++ " per second"
+    putStrLn $ "  " ++ show (round rate :: Int) ++ " per second"

benchmarks/AesonParse.hs

 import qualified Data.ByteString as B
 
 main = do
-  (cnt:args) <- getArgs
+  (bs:cnt:args) <- getArgs
   let count = read cnt :: Int
+      blkSize = read bs
   forM_ args $ \arg -> bracket (openFile arg ReadMode) hClose $ \h -> do
     putStrLn $ arg ++ ":"
     start <- getCurrentTime
             | good+bad >= count = return (good, bad)
             | otherwise = do
           hSeek h AbsoluteSeek 0
-          let refill = B.hGet h 16384
+          let refill = B.hGet h blkSize
           result <- parseWith refill json =<< refill
           case result of
             Done _ r -> loop (good+1) bad

benchmarks/CompareWithJSON.hs

+{-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 import Blaze.ByteString.Builder (toLazyByteString)
 import Criterion.Main
 import qualified Data.Aeson as A
 import qualified Data.ByteString.Lazy as BL
+import qualified Text.JSON as J
+
+#if !MIN_VERSION_bytestring(0,10,0)
 import qualified Data.ByteString.Lazy.Internal as BL
-import qualified Text.JSON as J
+
+instance NFData BL.ByteString where
+  rnf (BL.Chunk _ bs) = rnf bs
+  rnf BL.Empty        = ()
+#endif
 
 instance (NFData v) => NFData (J.JSObject v) where
   rnf o = rnf (J.fromJSObject o)
   rnf (J.JSArray lst) = rnf lst
   rnf (J.JSObject o) = rnf o
 
-instance NFData BL.ByteString where
-  rnf (BL.Chunk _ bs) = rnf bs
-  rnf BL.Empty        = ()
-
 decodeJ :: String -> J.JSValue
 decodeJ s =
   case J.decodeStrict s of

tests/Properties.hs

 import Data.Aeson.TH
 import Data.Attoparsec.Number
 import Data.Data (Typeable, Data)
+import Data.Function (on)
 import Data.Text (Text)
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import qualified Data.Text as T
 import qualified Data.Map as Map
 import qualified Data.HashMap.Strict as H
-import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), hoursToTimeZone, Day(..), TimeOfDay(..))
-
+import Data.Time.Calendar (Day)
+import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)
+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),
+                  hoursToTimeZone, Day(..), TimeOfDay(..))
 import Options
 
 #ifdef GENERICS
 genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool
 genericFrom _ v = G.fromJSON (toJSON v) == Success v
 
-approxEq :: Double -> Double -> Bool
-approxEq a b = a == b ||
-               d < maxAbsoluteError ||
-                 d / max (abs b) (abs a) <= maxRelativeError
-    where d = abs (a - b)
-          maxAbsoluteError = 1e-15
-          maxRelativeError = 1e-15
+approxEq :: (Fractional a, Ord a) => a -> a -> Bool
+approxEq = approxEqWith 1e-15 1e-15
+
+approxEqWith :: (Fractional a, Ord a) => a -> a -> a -> a -> Bool
+approxEqWith maxAbsoluteError maxRelativeError a b =
+    a == b || d < maxAbsoluteError ||
+    d / max (abs b) (abs a) <= maxRelativeError
+  where d = abs (a - b)
+
+-- Compare equality to within a millisecond, allowing for rounding
+-- error (ECMA 262 requires milliseconds to rounded to zero, not
+-- rounded to nearest).
+approxEqUTC :: UTCTime -> UTCTime -> Bool
+approxEqUTC a b = ((==) `on` utctDay) a b &&
+                  (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
+
+approxEqNet :: DotNetTime -> DotNetTime -> Bool
+approxEqNet (DotNetTime a) (DotNetTime b) = approxEqUTC a b
 
 toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a) => a -> Bool
 toFromJSON x = case fromJSON . toJSON $ x of
       offset <- choose (0,2) :: Gen Int
       return $ hoursToTimeZone offset
 
+instance Arbitrary Day where
+    arbitrary = ModifiedJulianDay `liftM` arbitrary
+
+instance Arbitrary DiffTime where
+    arbitrary = picosecondsToDiffTime `liftM` choose (0, 86400000000000000)
+
+instance Arbitrary UTCTime where
+    arbitrary = liftM2 UTCTime arbitrary arbitrary
+
+instance Arbitrary DotNetTime where
+    arbitrary = DotNetTime `liftM` arbitrary
+
 instance Arbitrary ZonedTime where
     arbitrary = liftM2 ZonedTime arbitrary arbitrary
 
     , testProperty "String" $ roundTripEq (""::String)
     , testProperty "Text" $ roundTripEq T.empty
     , testProperty "Foo" $ roundTripEq (undefined::Foo)
+    , testProperty "DotNetTime" $ roundTrip approxEqNet undefined
+    , testProperty "UTCTime" $ roundTrip approxEqUTC undefined
     , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)
     ],
   testGroup "toFromJSON" [
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.