715931e · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Replace Number with Scientific

715931eBas van Dijk13 years ago

Data/Aeson/Encode.hs+8−8

compare with master

unifiedsplit

@@ -24,11 +24,10 @@ module Data.Aeson.Encode

24 ) where

26import Data.Aeson.Types (ToJSON(..), Value(..))

27−import Data.Attoparsec.Number (Number(..))

28import Data.Monoid (mappend)

27import Data.Monoid (mappend)

28+import Data.Scientific (Scientific, coefficient, base10Exponent, scientificBuilder)

29import Data.Text.Lazy.Builder

30import Data.Text.Lazy.Builder.Int (decimal)

31−import Data.Text.Lazy.Builder.RealFloat (realFloat)

32import Data.Text.Lazy.Encoding (encodeUtf8)

31import Data.Text.Lazy.Encoding (encodeUtf8)

33import Numeric (showHex)

32import Numeric (showHex)

34import qualified Data.ByteString.Lazy as L

33import qualified Data.ByteString.Lazy as L

@@ -43,7 +42,7 @@ fromValue :: Value -> Builder

43fromValue Null = {-# SCC "fromValue/Null" #-} "null"

42fromValue Null = {-# SCC "fromValue/Null" #-} "null"

44fromValue (Bool b) = {-# SCC "fromValue/Bool" #-}

43fromValue (Bool b) = {-# SCC "fromValue/Bool" #-}

45 if b then "true" else "false"

44 if b then "true" else "false"

46−fromValue (Number n) = {-# SCC "fromValue/Number" #-} fromNumber n

45+fromValue (Number s) = {-# SCC "fromValue/Number" #-} fromScientific s

47fromValue (String s) = {-# SCC "fromValue/String" #-} string s

46fromValue (String s) = {-# SCC "fromValue/String" #-} string s

48fromValue (Array v)

47fromValue (Array v)

49 | V.null v = {-# SCC "fromValue/Array" #-} "[]"

48 | V.null v = {-# SCC "fromValue/Array" #-} "[]"

@@ -87,11 +86,12 @@ string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'

87 | otherwise = singleton c

86 | otherwise = singleton c

88 where h = showHex (fromEnum c) ""

87 where h = showHex (fromEnum c) ""

90−fromNumber :: Number -> Builder

89+fromScientific :: Scientific -> Builder

91−fromNumber (I i) = decimal i

90+fromScientific s

92−fromNumber (D d)

91+ | e < 0 = scientificBuilder s

93− | isNaN d || isInfinite d = "null"

92+ | otherwise = decimal (coefficient s * 10 ^ e)

94− | otherwise = realFloat d

93+ where

94+ e = base10Exponent s

96-- | Efficiently serialize a JSON value as a lazy 'L.ByteString'.

97encode :: ToJSON a => a -> L.ByteString

Data/Aeson/Parser/Internal.hs+2−2

@@ -136,7 +136,7 @@ arrayValues val = do

136-- implementations in other languages conform to that same restriction

137-- to preserve interoperability and security.

138value :: Parser Value

139−value = most <|> (Number <$> number)

139+value = most <|> (Number <$> rational)

140 where

141 most = do

142 c <- satisfy (`B8.elem` "{[\"ftn")

@@ -166,7 +166,7 @@ value' = most <|> num

166 'n' -> string "ull" *> pure Null

167 _ -> error "attoparsec panic! the impossible happened!"

168 num = do

169− !n <- number

169+ !n <- rational

170 return (Number n)

171

172doubleQuote, backslash :: Word8

Data/Aeson/Types.hs+1

@@ -47,6 +47,7 @@ module Data.Aeson.Types

47 , withText

48 , withArray

49 , withNumber

50+ , withScientific

50 , withBool

51 , withBool

52 -- * Constructors and accessors

53 -- * Constructors and accessors

Data/Aeson/Types/Class.hs+37−20

@@ -39,6 +39,7 @@ module Data.Aeson.Types.Class

39 , withText

40 , withArray

41 , withNumber

42+ , withScientific

42 , withBool

43 , withBool

44 -- * Functions

45 -- * Functions

@@ -53,7 +54,8 @@ module Data.Aeson.Types.Class

53import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)

54import Control.Applicative ((<$>), (<*>), (<|>), pure, empty)

54import Data.Aeson.Functions

55import Data.Aeson.Functions

55import Data.Aeson.Types.Internal

56import Data.Aeson.Types.Internal

57+import Data.Scientific (Scientific, coefficient, base10Exponent)

56−import Data.Attoparsec.Char8 (Number(..))

58+import Data.Attoparsec.Number (Number(..))

57import Data.Fixed

59import Data.Fixed

58import Data.Hashable (Hashable(..))

60import Data.Hashable (Hashable(..))

59import Data.Int (Int8, Int16, Int32, Int64)

61import Data.Int (Int8, Int16, Int32, Int64)

@@ -311,23 +313,21 @@ instance FromJSON Char where

311 {-# INLINE parseJSON #-}

313 {-# INLINE parseJSON #-}

312

314

313instance ToJSON Double where

315instance ToJSON Double where

314− toJSON = Number . D

316+ toJSON = Number . realToFrac

315 {-# INLINE toJSON #-}

317 {-# INLINE toJSON #-}

316

318

317instance FromJSON Double where

319instance FromJSON Double where

318− parseJSON (Number n) = case n of

320+ parseJSON (Number s) = pure $ realToFrac s

319− D d -> pure d

320− I i -> pure (fromIntegral i)

321 parseJSON Null = pure (0/0)

322 parseJSON v = typeMismatch "Double" v

323 {-# INLINE parseJSON #-}

324

325instance ToJSON Number where

326− toJSON = Number

326+ toJSON = Number . numberToScientific

327 {-# INLINE toJSON #-}

328

329instance FromJSON Number where

330− parseJSON (Number n) = pure n

330+ parseJSON (Number s) = pure $ scientificToNumber s

331 parseJSON Null = pure (D (0/0))

332 parseJSON v = typeMismatch "Number" v

333 {-# INLINE parseJSON #-}

@@ -337,9 +337,7 @@ instance ToJSON Float where

337 {-# INLINE toJSON #-}

338

339instance FromJSON Float where

340− parseJSON (Number n) = pure $ case n of

340+ parseJSON (Number s) = pure $ realToFrac s

341− D d -> realToFrac d

342− I i -> fromIntegral i

343 parseJSON Null = pure (0/0)

341 parseJSON Null = pure (0/0)

344 parseJSON v = typeMismatch "Float" v

342 parseJSON v = typeMismatch "Float" v

345 {-# INLINE parseJSON #-}

343 {-# INLINE parseJSON #-}

@@ -360,9 +358,7 @@ instance HasResolution a => ToJSON (Fixed a) where

360 {-# INLINE toJSON #-}

358 {-# INLINE toJSON #-}

361

359

362instance HasResolution a => FromJSON (Fixed a) where

360instance HasResolution a => FromJSON (Fixed a) where

363− parseJSON (Number n) = pure $ case n of

361+ parseJSON (Number s) = pure $ realToFrac s

364− D d -> realToFrac d

365− I i -> fromIntegral i

366 parseJSON v = typeMismatch "Fixed" v

362 parseJSON v = typeMismatch "Fixed" v

367 {-# INLINE parseJSON #-}

363 {-# INLINE parseJSON #-}

368

364

@@ -375,7 +371,7 @@ instance FromJSON Int where

375 {-# INLINE parseJSON #-}

371 {-# INLINE parseJSON #-}

376

372

377parseIntegral :: Integral a => Value -> Parser a

373parseIntegral :: Integral a => Value -> Parser a

378−parseIntegral = withNumber "Integral" $ pure . floor

374+parseIntegral = withScientific "Integral" $ pure . floor

379{-# INLINE parseIntegral #-}

375{-# INLINE parseIntegral #-}

380

376

381instance ToJSON Integer where

377instance ToJSON Integer where

@@ -857,28 +853,35 @@ withObject _ f (Object obj) = f obj

857withObject expected _ v = typeMismatch expected v

853withObject expected _ v = typeMismatch expected v

858{-# INLINE withObject #-}

854{-# INLINE withObject #-}

859

855

860−-- | @withObject expected f value@ applies @f@ to the 'Text' when @value@ is a @String@

856+-- | @withText expected f value@ applies @f@ to the 'Text' when @value@ is a @String@

861-- and fails using @'typeMismatch' expected@ otherwise.

857-- and fails using @'typeMismatch' expected@ otherwise.

862withText :: String -> (Text -> Parser a) -> Value -> Parser a

858withText :: String -> (Text -> Parser a) -> Value -> Parser a

863withText _ f (String txt) = f txt

859withText _ f (String txt) = f txt

864withText expected _ v = typeMismatch expected v

860withText expected _ v = typeMismatch expected v

865{-# INLINE withText #-}

861{-# INLINE withText #-}

866

862

867−-- | @withObject expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@

863+-- | @withArray expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@

868-- and fails using @'typeMismatch' expected@ otherwise.

864-- and fails using @'typeMismatch' expected@ otherwise.

869withArray :: String -> (Array -> Parser a) -> Value -> Parser a

865withArray :: String -> (Array -> Parser a) -> Value -> Parser a

870withArray _ f (Array arr) = f arr

866withArray _ f (Array arr) = f arr

871withArray expected _ v = typeMismatch expected v

867withArray expected _ v = typeMismatch expected v

872{-# INLINE withArray #-}

868{-# INLINE withArray #-}

873

869

874−-- | @withObject expected f value@ applies @f@ to the 'Number' when @value@ is a @Number@

870+-- | @withNumber expected f value@ applies @f@ to the 'Number' when @value@ is a 'Number'.

875-- and fails using @'typeMismatch' expected@ otherwise.

871-- and fails using @'typeMismatch' expected@ otherwise.

876withNumber :: String -> (Number -> Parser a) -> Value -> Parser a

872withNumber :: String -> (Number -> Parser a) -> Value -> Parser a

877−withNumber _ f (Number num) = f num

873+withNumber expected f = withScientific expected (f . scientificToNumber)

878−withNumber expected _ v = typeMismatch expected v

879{-# INLINE withNumber #-}

874{-# INLINE withNumber #-}

875+{-# DEPRECATED withNumber "Use withScientific instead" #-}

876+

877+-- | @withScientific expected f value@ applies @f@ to the 'Scientific' number when @value@ is a 'Number'.

878+-- and fails using @'typeMismatch' expected@ otherwise.

879+withScientific :: String -> (Scientific -> Parser a) -> Value -> Parser a

880+withScientific _ f (Number scientific) = f scientific

881+withScientific expected _ v = typeMismatch expected v

882+{-# INLINE withScientific #-}

880

883

881−-- | @withObject expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@

884+-- | @withBool expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@

882-- and fails using @'typeMismatch' expected@ otherwise.

885-- and fails using @'typeMismatch' expected@ otherwise.

883withBool :: String -> (Bool -> Parser a) -> Value -> Parser a

886withBool :: String -> (Bool -> Parser a) -> Value -> Parser a

884withBool _ f (Bool arr) = f arr

887withBool _ f (Bool arr) = f arr

@@ -954,3 +957,17 @@ typeMismatch expected actual =

954 Number _ -> "Number"

957 Number _ -> "Number"

955 Bool _ -> "Boolean"

958 Bool _ -> "Boolean"

956 Null -> "Null"

959 Null -> "Null"

960+

961+scientificToNumber :: Scientific -> Number

962+scientificToNumber s

963+ | e < 0 = D $ fromInteger c / 10 ^ negate e

964+ | otherwise = I $ c * 10 ^ e

965+ where

966+ e = base10Exponent s

967+ c = coefficient s

968+{-# INLINE scientificToNumber #-}

969+

970+numberToScientific :: Number -> Scientific

971+numberToScientific (I i) = fromInteger i

972+numberToScientific (D d) = realToFrac d

973+{-# INLINE numberToScientific #-}

Data/Aeson/Types/Internal.hs+6−8

@@ -40,7 +40,7 @@ module Data.Aeson.Types.Internal

40import Control.Applicative

41import Control.Monad

42import Control.DeepSeq (NFData(..))

43−import Data.Attoparsec.Char8 (Number(..))

43+import Data.Scientific (Scientific)

44import Data.Hashable (Hashable(..))

45import Data.HashMap.Strict (HashMap)

46import Data.Monoid (Monoid(..))

@@ -166,7 +166,7 @@ type Array = Vector Value

166data Value = Object !Object

167 | Array !Array

168 | String !Text

169− | Number !Number

169+ | Number !Scientific

170 | Bool !Bool

171 | Null

172 deriving (Eq, Show, Typeable)

@@ -175,7 +175,7 @@ instance NFData Value where

175 rnf (Object o) = rnf o

176 rnf (Array a) = V.foldl' (\x y -> rnf y `seq` x) () a

177 rnf (String s) = rnf s

178− rnf (Number n) = case n of I i -> rnf i; D d -> rnf d

178+ rnf (Number n) = rnf n

179 rnf (Bool b) = rnf b

180 rnf Null = ()

181

@@ -189,11 +189,9 @@ instance Hashable Value where

189 hashWithSalt s (Array a) = V.foldl' hashWithSalt

190 (s `hashWithSalt` (1::Int)) a

191 hashWithSalt s (String str) = s `hashWithSalt` (2::Int) `hashWithSalt` str

192− hashWithSalt s (Number n) = 3 `hashWithSalt`

192+ hashWithSalt s (Number n) = s `hashWithSalt` (3::Int) `hashWithSalt` n

193− case n of I i -> hashWithSalt s i

194− D d -> hashWithSalt s d

195− hashWithSalt s (Bool b) = s `hashWithSalt` (4::Int) `hashWithSalt` b

193+ hashWithSalt s (Bool b) = s `hashWithSalt` (4::Int) `hashWithSalt` b

196− hashWithSalt s Null = s `hashWithSalt` (5::Int)

194+ hashWithSalt s Null = s `hashWithSalt` (5::Int)

197

195

198-- | The empty array.

196-- | The empty array.

199emptyArray :: Value

197emptyArray :: Value

aeson.cabal+2−1

@@ -130,7 +130,8 @@ library

130 text >= 0.11.1.0,

131 time,

132 unordered-containers >= 0.1.3.0,

133− vector >= 0.7.1

133+ vector >= 0.7.1,

134+ scientific >= 0.0 && < 0.1

134

135

135 if flag(blaze-builder)

136 if flag(blaze-builder)

136 build-depends: blaze-builder >= 0.2.1.4

137 build-depends: blaze-builder >= 0.2.1.4