Commits

basvandijk  committed 45ce68d

Replace Number with Scientific

Scientific numbers are floating-point numbers with arbitrary precision
that are fast to parse and can be efficiently converted to/from
Fractional numbers like Doubles.

  • Participants
  • Parent commits 28eaad9

Comments (0)

Files changed (6)

File Data/Aeson/Encode.hs

     ) where
 
 import Data.Aeson.Types (ToJSON(..), Value(..))
-import Data.Attoparsec.Number (Number(..))
 import Data.Monoid (mappend)
+import Data.Scientific (Scientific, coefficient, base10Exponent, scientificBuilder)
 import Data.Text.Lazy.Builder
 import Data.Text.Lazy.Builder.Int (decimal)
-import Data.Text.Lazy.Builder.RealFloat (realFloat)
 import Data.Text.Lazy.Encoding (encodeUtf8)
 import Numeric (showHex)
 import qualified Data.ByteString.Lazy as L
 fromValue Null = {-# SCC "fromValue/Null" #-} "null"
 fromValue (Bool b) = {-# SCC "fromValue/Bool" #-}
                      if b then "true" else "false"
-fromValue (Number n) = {-# SCC "fromValue/Number" #-} fromNumber n
+fromValue (Number s) = {-# SCC "fromValue/Number" #-} fromScientific s
 fromValue (String s) = {-# SCC "fromValue/String" #-} string s
 fromValue (Array v)
     | V.null v = {-# SCC "fromValue/Array" #-} "[]"
         | otherwise  = singleton c
         where h = showHex (fromEnum c) ""
 
-fromNumber :: Number -> Builder
-fromNumber (I i) = decimal i
-fromNumber (D d)
-    | isNaN d || isInfinite d = "null"
-    | otherwise               = realFloat d
+fromScientific :: Scientific -> Builder
+fromScientific s
+    | e < 0     = scientificBuilder s
+    | otherwise = decimal (coefficient s * 10 ^ e)
+  where
+    e = base10Exponent s
 
 -- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.
 encode :: ToJSON a => a -> L.ByteString

File Data/Aeson/Parser/Internal.hs

 -- implementations in other languages conform to that same restriction
 -- to preserve interoperability and security.
 value :: Parser Value
-value = most <|> (Number <$> number)
+value = most <|> (Number <$> rational)
  where
   most = do
     c <- satisfy (`B8.elem` "{[\"ftn")
       'n' -> string "ull" *> pure Null
       _   -> error "attoparsec panic! the impossible happened!"
   num = do
-    !n <- number
+    !n <- rational
     return (Number n)
 
 doubleQuote, backslash :: Word8

File Data/Aeson/Types.hs

     , withText
     , withArray
     , withNumber
+    , withScientific
     , withBool
 
     -- * Constructors and accessors

File Data/Aeson/Types/Class.hs

     , withText
     , withArray
     , withNumber
+    , withScientific
     , withBool
 
     -- * Functions
 import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)
 import Data.Aeson.Functions
 import Data.Aeson.Types.Internal
-import Data.Attoparsec.Char8 (Number(..))
+import Data.Scientific (Scientific, coefficient, base10Exponent)
+import Data.Attoparsec.Number (Number(..))
 import Data.Fixed
 import Data.Hashable (Hashable(..))
 import Data.Int (Int8, Int16, Int32, Int64)
     {-# INLINE parseJSON #-}
 
 instance ToJSON Double where
-    toJSON = Number . D
+    toJSON = Number . realToFrac
     {-# INLINE toJSON #-}
 
 instance FromJSON Double where
-    parseJSON (Number n) = case n of
-                             D d -> pure d
-                             I i -> pure (fromIntegral i)
+    parseJSON (Number s) = pure $ realToFrac s
     parseJSON Null       = pure (0/0)
     parseJSON v          = typeMismatch "Double" v
     {-# INLINE parseJSON #-}
 
 instance ToJSON Number where
-    toJSON = Number
+    toJSON = Number . numberToScientific
     {-# INLINE toJSON #-}
 
 instance FromJSON Number where
-    parseJSON (Number n) = pure n
+    parseJSON (Number s) = pure $ scientificToNumber s
     parseJSON Null       = pure (D (0/0))
     parseJSON v          = typeMismatch "Number" v
     {-# INLINE parseJSON #-}
     {-# INLINE toJSON #-}
 
 instance FromJSON Float where
-    parseJSON (Number n) = pure $ case n of
-                                    D d -> realToFrac d
-                                    I i -> fromIntegral i
+    parseJSON (Number s) = pure $ realToFrac s
     parseJSON Null       = pure (0/0)
     parseJSON v          = typeMismatch "Float" v
     {-# INLINE parseJSON #-}
     {-# INLINE toJSON #-}
 
 instance HasResolution a => FromJSON (Fixed a) where
-    parseJSON (Number n) = pure $ case n of
-                                    D d -> realToFrac d
-                                    I i -> fromIntegral i
+    parseJSON (Number s) = pure $ realToFrac s
     parseJSON v          = typeMismatch "Fixed" v
     {-# INLINE parseJSON #-}
 
     {-# INLINE parseJSON #-}
 
 parseIntegral :: Integral a => Value -> Parser a
-parseIntegral = withNumber "Integral" $ pure . floor
+parseIntegral = withScientific "Integral" $ pure . floor
 {-# INLINE parseIntegral #-}
 
 instance ToJSON Integer where
 withObject expected _ v            = typeMismatch expected v
 {-# INLINE withObject #-}
 
--- | @withObject expected f value@ applies @f@ to the 'Text' when @value@ is a @String@
+-- | @withText expected f value@ applies @f@ to the 'Text' when @value@ is a @String@
 --   and fails using @'typeMismatch' expected@ otherwise.
 withText :: String -> (Text -> Parser a) -> Value -> Parser a
 withText _        f (String txt) = f txt
 withText expected _ v            = typeMismatch expected v
 {-# INLINE withText #-}
 
--- | @withObject expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@
+-- | @withArray expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@
 --   and fails using @'typeMismatch' expected@ otherwise.
 withArray :: String -> (Array -> Parser a) -> Value -> Parser a
 withArray _        f (Array arr) = f arr
 withArray expected _ v           = typeMismatch expected v
 {-# INLINE withArray #-}
 
--- | @withObject expected f value@ applies @f@ to the 'Number' when @value@ is a @Number@
+-- | @withNumber expected f value@ applies @f@ to the 'Number' when @value@ is a 'Number'.
 --   and fails using @'typeMismatch' expected@ otherwise.
 withNumber :: String -> (Number -> Parser a) -> Value -> Parser a
-withNumber _        f (Number num) = f num
-withNumber expected _ v            = typeMismatch expected v
+withNumber expected f = withScientific expected (f . scientificToNumber)
 {-# INLINE withNumber #-}
+{-# DEPRECATED withNumber "Use withScientific instead" #-}
 
--- | @withObject expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@
+-- | @withScientific expected f value@ applies @f@ to the 'Scientific' number when @value@ is a 'Number'.
+--   and fails using @'typeMismatch' expected@ otherwise.
+withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a
+withScientific _        f (Number scientific) = f scientific
+withScientific expected _ v                   = typeMismatch expected v
+{-# INLINE withScientific #-}
+
+-- | @withBool expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@
 --   and fails using @'typeMismatch' expected@ otherwise.
 withBool :: String -> (Bool -> Parser a) -> Value -> Parser a
 withBool _        f (Bool arr) = f arr
              Number _ -> "Number"
              Bool _   -> "Boolean"
              Null     -> "Null"
+
+scientificToNumber :: Scientific -> Number
+scientificToNumber s
+    | e < 0     = D $ fromInteger c / 10 ^ negate e
+    | otherwise = I $ c * 10 ^ e
+  where
+    e = base10Exponent s
+    c = coefficient s
+{-# INLINE scientificToNumber #-}
+
+numberToScientific :: Number -> Scientific
+numberToScientific (I i) = fromInteger i
+numberToScientific (D d) = realToFrac d
+{-# INLINE numberToScientific #-}

File Data/Aeson/Types/Internal.hs

 import Control.Applicative
 import Control.Monad
 import Control.DeepSeq (NFData(..))
-import Data.Attoparsec.Char8 (Number(..))
+import Data.Scientific (Scientific)
 import Data.Hashable (Hashable(..))
 import Data.HashMap.Strict (HashMap)
 import Data.Monoid (Monoid(..))
 data Value = Object !Object
            | Array !Array
            | String !Text
-           | Number !Number
+           | Number !Scientific
            | Bool !Bool
            | Null
              deriving (Eq, Show, Typeable)
     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) = case n of I i -> rnf i; D d -> rnf d
+    rnf (Number n) = rnf n
     rnf (Bool b)   = rnf b
     rnf Null       = ()
 
     hashWithSalt s (Array a)    = V.foldl' hashWithSalt
                                   (s `hashWithSalt` (1::Int)) a
     hashWithSalt s (String str) = s `hashWithSalt` (2::Int) `hashWithSalt` str
-    hashWithSalt s (Number n)   = 3 `hashWithSalt`
-                                  case n of I i -> hashWithSalt s i
-                                            D d -> hashWithSalt s d
-    hashWithSalt s (Bool b)   = s `hashWithSalt` (4::Int) `hashWithSalt` b
-    hashWithSalt s Null       = s `hashWithSalt` (5::Int)
+    hashWithSalt s (Number n)   = s `hashWithSalt` (3::Int) `hashWithSalt` n
+    hashWithSalt s (Bool b)     = s `hashWithSalt` (4::Int) `hashWithSalt` b
+    hashWithSalt s Null         = s `hashWithSalt` (5::Int)
 
 -- | The empty array.
 emptyArray :: Value
     text >= 0.11.1.0,
     time,
     unordered-containers >= 0.1.3.0,
-    vector >= 0.7.1
+    vector >= 0.7.1,
+    scientific >= 0.0 && < 0.1
 
   if flag(blaze-builder)
     build-depends: blaze-builder >= 0.2.1.4