Commits

Bryan O'Sullivan committed 9a77e86

Switch numerics to use the Number type

This is very nearly as fast as Doubles for parsing, and more accurate
for dealing with integers.

  • Participants
  • Parent commits 0506c5e

Comments (0)

Files changed (3)

Data/Aeson/Generic.hs

 import Control.Monad.State.Strict
 import Data.Aeson.Functions (transformMap)
 import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON)
+import Data.Attoparsec.Number (Number)
 import Data.Generics
 import Data.Int (Int8, Int16, Int32, Int64)
 import Data.IntSet (IntSet)
          `extQ` (T.toJSON :: T Word32)
          `extQ` (T.toJSON :: T Word64)
          `extQ` (T.toJSON :: T Double)
+         `extQ` (T.toJSON :: T Number)
          `extQ` (T.toJSON :: T Float)
          `extQ` (T.toJSON :: T Rational)
          `extQ` (T.toJSON :: T Char)
              `extR` (value :: F Word32)
              `extR` (value :: F Word64)
              `extR` (value :: F Double)
+             `extR` (value :: F Number)
              `extR` (value :: F Float)
              `extR` (value :: F Rational)
              `extR` (value :: F Char)

Data/Aeson/Parser.hs

 -- | Parse any JSON value.  Use 'json' in preference to this function
 -- if you are parsing data from an untrusted source.
 value :: Parser Value
-value = most <|> (Number <$> double)
+value = most <|> (Number <$> number)
  where
   most = do
     c <- anyChar

Data/Aeson/Types.hs

 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
 import Data.Time.Clock (UTCTime)
 import Data.Time.Format (FormatTime, formatTime, parseTime)
+import Data.Attoparsec.Char8 (Number(..))
 import Data.Typeable (Typeable)
 import Data.Vector (Vector)
 import Data.Word (Word, Word8, Word16, Word32, Word64)
 data Value = Object Object
            | Array Array
            | String Text
-           | Number Double
+           | Number Number
            | Bool !Bool
            | Null
              deriving (Eq, Show, Typeable, Data)
     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) = rnf n
+    rnf (Number n) = case n of I i -> rnf i; D d -> rnf d
     rnf (Bool b)   = rnf b
     rnf Null       = ()
 
     {-# INLINE parseJSON #-}
 
 instance ToJSON Double where
+    toJSON = Number . D
+    {-# INLINE toJSON #-}
+
+instance FromJSON Double where
+    parseJSON (Number n) = case n of
+                             D d -> pure d
+                             I i -> pure (fromIntegral i)
+    parseJSON _              = empty
+    {-# INLINE parseJSON #-}
+
+instance ToJSON Number where
     toJSON = Number
     {-# INLINE toJSON #-}
 
-instance FromJSON Double where
+instance FromJSON Number where
     parseJSON (Number n) = pure n
     parseJSON _          = empty
     {-# INLINE parseJSON #-}
     {-# INLINE toJSON #-}
 
 instance FromJSON Float where
-    parseJSON (Number n) = pure . fromRational . toRational $ n
+    parseJSON (Number n) = case n of
+                             D d -> pure . fromRational . toRational $ d
+                             I i -> pure (fromIntegral i)
     parseJSON _          = empty
     {-# INLINE parseJSON #-}
 
     {-# INLINE toJSON #-}
 
 instance FromJSON (Ratio Integer) where
-    parseJSON (Number n) = pure . toRational $ n
+    parseJSON (Number n) = case n of
+                             D d -> pure . toRational $ d
+                             I i -> pure (fromIntegral i)
     parseJSON _          = empty
     {-# INLINE parseJSON #-}
 
     {-# INLINE toJSON #-}
 
 instance FromJSON Int where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
+parseIntegral :: Integral a => Value -> Parser a
+parseIntegral (Number n) = pure (floor n)
+parseIntegral _          = empty
+{-# INLINE parseIntegral #-}
+
 instance ToJSON Integer where
     toJSON = Number . fromIntegral
     {-# INLINE toJSON #-}
 
 instance FromJSON Integer where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Int8 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Int8 where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Int16 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Int16 where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Int32 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Int32 where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Int64 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Int64 where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word8 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word8 where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word16 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word16 where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word32 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word32 where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Word64 where
     {-# INLINE toJSON #-}
 
 instance FromJSON Word64 where
-    parseJSON (Number n) = pure (floor n)
-    parseJSON _          = empty
+    parseJSON = parseIntegral
     {-# INLINE parseJSON #-}
 
 instance ToJSON Text where