@@ -39,6 +39,7 @@ module Data.Aeson.Types.Class
3939 , withText
4040 , withArray
4141 , withNumber
42+ , withScientific
4243 , withBool
4344
4445 -- * Functions
@@ -53,13 +54,14 @@ module Data.Aeson.Types.Class
5354import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)
5455import Data.Aeson.Functions
5556import Data.Aeson.Types.Internal
56−import Data.Attoparsec.Char8 (Number(..))
57+import Data.Scientific (Scientific, coefficient, base10Exponent)
58+import Data.Attoparsec.Number (Number(..))
5759import Data.Fixed
5860import Data.Hashable (Hashable(..))
5961import Data.Int (Int8, Int16, Int32, Int64)
6062import Data.Maybe (fromMaybe)
6163import Data.Monoid (Dual(..), First(..), Last(..), mappend)
62−import Data.Ratio (Ratio)
64+import Data.Ratio (Ratio, (%), numerator, denominator)
6365import Data.Text (Text, pack, unpack)
6466import Data.Time (UTCTime, ZonedTime(..), TimeZone(..))
6567import Data.Time.Format (FormatTime, formatTime, parseTime)
@@ -309,48 +311,52 @@ instance FromJSON Char where
309311 {-# INLINE parseJSON #-}
310312
311313instance ToJSON Double where
312− toJSON = Number . D
314+ toJSON = realFloatToJSON
313315 {-# INLINE toJSON #-}
314316
317+realFloatToJSON :: RealFloat a => a -> Value
318+realFloatToJSON d
319+ | isNaN d || isInfinite d = Null
320+ | otherwise = Number $ realToFrac d
321+{-# INLINE realFloatToJSON #-}
322+
315323instance FromJSON Double where
316− parseJSON (Number n) = case n of
317− D d -> pure d
318− I i -> pure (fromIntegral i)
324+ parseJSON (Number s) = pure $ realToFrac s
319325 parseJSON Null = pure (0/0)
320326 parseJSON v = typeMismatch "Double" v
321327 {-# INLINE parseJSON #-}
322328
323329instance ToJSON Number where
324− toJSON = Number
330+ toJSON (D d) = toJSON d
331+ toJSON (I i) = Number $ fromInteger i
325332 {-# INLINE toJSON #-}
326333
327334instance FromJSON Number where
328− parseJSON (Number n) = pure n
335+ parseJSON (Number s) = pure $ scientificToNumber s
329336 parseJSON Null = pure (D (0/0))
330337 parseJSON v = typeMismatch "Number" v
331338 {-# INLINE parseJSON #-}
332339
333340instance ToJSON Float where
334− toJSON = Number . realToFrac
341+ toJSON = realFloatToJSON
335342 {-# INLINE toJSON #-}
336343
337344instance FromJSON Float where
338− parseJSON (Number n) = pure $ case n of
339− D d -> realToFrac d
340− I i -> fromIntegral i
345+ parseJSON (Number s) = pure $ realToFrac s
341346 parseJSON Null = pure (0/0)
342347 parseJSON v = typeMismatch "Float" v
343348 {-# INLINE parseJSON #-}
344349
345350instance ToJSON (Ratio Integer) where
346− toJSON = Number . fromRational
351+ toJSON r = object [ "numerator" .= numerator r
352+ , "denominator" .= denominator r
353+ ]
347354 {-# INLINE toJSON #-}
348355
349356instance FromJSON (Ratio Integer) where
350− parseJSON = withNumber "Ration Integer" $ \n ->
351− pure $ case n of
352− D d -> toRational d
353− I i -> fromIntegral i
357+ parseJSON = withObject "Rational" $ \obj ->
358+ (%) <$> obj .: "numerator"
359+ <*> obj .: "denominator"
354360 {-# INLINE parseJSON #-}
355361
356362instance HasResolution a => ToJSON (Fixed a) where
@@ -358,10 +364,7 @@ instance HasResolution a => ToJSON (Fixed a) where
358364 {-# INLINE toJSON #-}
359365
360366instance HasResolution a => FromJSON (Fixed a) where
361− parseJSON (Number n) = pure $ case n of
362− D d -> realToFrac d
363− I i -> fromIntegral i
364− parseJSON v = typeMismatch "Fixed" v
367+ parseJSON = withScientific "Fixed" $ pure . realToFrac
365368 {-# INLINE parseJSON #-}
366369
367370instance ToJSON Int where
@@ -373,7 +376,7 @@ instance FromJSON Int where
373376 {-# INLINE parseJSON #-}
374377
375378parseIntegral :: Integral a => Value -> Parser a
376−parseIntegral = withNumber "Integral" $ pure . floor
379+parseIntegral = withScientific "Integral" $ pure . floor
377380{-# INLINE parseIntegral #-}
378381
379382instance ToJSON Integer where
@@ -837,28 +840,35 @@ withObject _ f (Object obj) = f obj
837840withObject expected _ v = typeMismatch expected v
838841{-# INLINE withObject #-}
839842
840−-- | @withObject expected f value@ applies @f@ to the 'Text' when @value@ is a @String@
843+-- | @withText expected f value@ applies @f@ to the 'Text' when @value@ is a @String@
841844-- and fails using @'typeMismatch' expected@ otherwise.
842845withText :: String -> (Text -> Parser a) -> Value -> Parser a
843846withText _ f (String txt) = f txt
844847withText expected _ v = typeMismatch expected v
845848{-# INLINE withText #-}
846849
847−-- | @withObject expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@
850+-- | @withArray expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@
848851-- and fails using @'typeMismatch' expected@ otherwise.
849852withArray :: String -> (Array -> Parser a) -> Value -> Parser a
850853withArray _ f (Array arr) = f arr
851854withArray expected _ v = typeMismatch expected v
852855{-# INLINE withArray #-}
853856
854−-- | @withObject expected f value@ applies @f@ to the 'Number' when @value@ is a @Number@
857+-- | @withNumber expected f value@ applies @f@ to the 'Number' when @value@ is a 'Number'.
855858-- and fails using @'typeMismatch' expected@ otherwise.
856859withNumber :: String -> (Number -> Parser a) -> Value -> Parser a
857−withNumber _ f (Number num) = f num
858−withNumber expected _ v = typeMismatch expected v
860+withNumber expected f = withScientific expected (f . scientificToNumber)
859861{-# INLINE withNumber #-}
862+{-# DEPRECATED withNumber "Use withScientific instead" #-}
863+
864+-- | @withScientific expected f value@ applies @f@ to the 'Scientific' number when @value@ is a 'Number'.
865+-- and fails using @'typeMismatch' expected@ otherwise.
866+withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
867+withScientific _ f (Number scientific) = f scientific
868+withScientific expected _ v = typeMismatch expected v
869+{-# INLINE withScientific #-}
860870
861−-- | @withObject expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@
871+-- | @withBool expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@
862872-- and fails using @'typeMismatch' expected@ otherwise.
863873withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
864874withBool _ f (Bool arr) = f arr
@@ -934,3 +944,12 @@ typeMismatch expected actual =
934944 Number _ -> "Number"
935945 Bool _ -> "Boolean"
936946 Null -> "Null"
947+
948+scientificToNumber :: Scientific -> Number
949+scientificToNumber s
950+ | e < 0 = D $ fromInteger c / 10 ^ negate e
951+ | otherwise = I $ c * 10 ^ e
952+ where
953+ e = base10Exponent s
954+ c = coefficient s
955+{-# INLINE scientificToNumber #-}