json 0.10 → 0.11
raw patch · 6 files changed
+40/−59 lines, 6 filesnew-uploader
Files
- CHANGES +4/−0
- Text/JSON.hs +2/−2
- Text/JSON/Parsec.hs +5/−3
- Text/JSON/ReadP.hs +11/−1
- Text/JSON/String.hs +10/−47
- json.cabal +8/−6
CHANGES view
@@ -1,3 +1,7 @@+Version 0.11+ * Limit floating-point range to that of Double to avoid allocation+ overflows when constructing Rationals+ Version 0.10 * Use MonadFail, so that it works with GHC 8.8
Text/JSON.hs view
@@ -45,7 +45,7 @@ import Data.Int import Data.Word-import qualified Control.Monad.Fail as Fail+import Control.Monad.Fail (MonadFail (..)) import Control.Monad(liftM,ap,MonadPlus(..)) import Control.Applicative @@ -141,7 +141,7 @@ Ok a >>= f = f a Error x >>= _ = Error x -instance Fail.MonadFail Result where+instance MonadFail Result where fail x = Error x -- | Convenient error generation
Text/JSON/Parsec.hs view
@@ -78,9 +78,11 @@ p_number :: CharParser () Rational p_number = tok $ do s <- getInput- case readSigned readFloat s of- [(n,s1)] -> n <$$ setInput s1- _ -> mzero+ case (reads s, readSigned readFloat s) of+ ([(x,_)], _)+ | isInfinite (x :: Double) -> fail "number out of range"+ (_, [(y,s')]) -> y <$$ setInput s'+ _ -> mzero <?> "number" p_js_string :: CharParser () JSString p_js_string = toJSString <$$> p_string
Text/JSON/ReadP.hs view
@@ -70,7 +70,17 @@ where p_field = (,) <$$> (p_string <** token (char ':')) <**> p_value p_number :: ReadP Rational-p_number = readS_to_P (readSigned readFloat)+p_number = readS_to_P safeRationalReads++-- reading into a Double with reads is safe for huge floating-point literals+-- this will allow all floating-point literals that are small enough to fit+-- into a Double (and are thus compatible with most other json implementations)+-- to be parsed here without opening us to oversized Rational allocations+safeRationalReads :: ReadS Rational+safeRationalReads str =+ case reads str of+ [(d,_)] | not (isInfinite (d :: Double)) -> readSigned readFloat str+ _ -> [] p_js_string :: ReadP JSString p_js_string = toJSString <$$> p_string
Text/JSON/String.hs view
@@ -30,17 +30,18 @@ , showJSTopType ) where +import Prelude hiding (fail) import Text.JSON.Types (JSValue(..), JSString, toJSString, fromJSString, JSObject, toJSObject, fromJSObject) import Control.Monad (liftM, ap)-import qualified Control.Monad.Fail as Fail+import Control.Monad.Fail (MonadFail (..)) import Control.Applicative((<$>)) import qualified Control.Applicative as A import Data.Char (isSpace, isDigit, digitToInt) import Data.Ratio (numerator, denominator, (%))-import Numeric (readHex, readDec, showHex)+import Numeric (readHex, readDec, showHex, readSigned, readFloat) -- ----------------------------------------------------------------- -- | Parsing JSON@@ -59,7 +60,7 @@ Left err -> Left err Right (a,s1) -> un (f a) s1) -instance Fail.MonadFail GetJSON where+instance MonadFail GetJSON where fail x = GetJSON (\_ -> Left x) -- | Run a JSON reader on an input String, returning some Haskell value.@@ -152,50 +153,12 @@ readJSRational :: GetJSON Rational readJSRational = do cs <- getInput- case cs of- '-' : ds -> negate <$> pos ds- _ -> pos cs-- where - pos [] = fail $ "Unable to parse JSON Rational: " ++ context []- pos (c:cs) =- case c of- '0' -> frac 0 cs- _ - | not (isDigit c) -> fail $ "Unable to parse JSON Rational: " ++ context cs- | otherwise -> readDigits (digitToIntI c) cs-- readDigits acc [] = frac (fromInteger acc) []- readDigits acc (x:xs)- | isDigit x = let acc' = 10*acc + digitToIntI x in - acc' `seq` readDigits acc' xs- | otherwise = frac (fromInteger acc) (x:xs)-- frac n ('.' : ds) = - case span isDigit ds of- ([],_) -> setInput ds >> return n- (as,bs) -> let x = read as :: Integer- y = 10 ^ (fromIntegral (length as) :: Integer)- in exponent' (n + (x % y)) bs- frac n cs = exponent' n cs-- exponent' n (c:cs)- | c == 'e' || c == 'E' = (n*) <$> exp_num cs- exponent' n cs = setInput cs >> return n-- exp_num :: String -> GetJSON Rational- exp_num ('+':cs) = exp_digs cs- exp_num ('-':cs) = recip <$> exp_digs cs- exp_num cs = exp_digs cs-- exp_digs :: String -> GetJSON Rational- exp_digs cs = case readDec cs of- [(a,ds)] -> do setInput ds- return (fromIntegral ((10::Integer) ^ (a::Integer)))- _ -> fail $ "Unable to parse JSON exponential: " ++ context cs-- digitToIntI :: Char -> Integer- digitToIntI ch = fromIntegral (digitToInt ch)+ case (reads cs, readSigned readFloat cs) of+ ([(x,_)], _)+ | isInfinite (x :: Double) ->+ fail ("JSON Rational out of range: " ++ context cs)+ (_, [(y,cs')]) -> setInput cs' >> return y+ _ -> fail ("Unable to parse JSON Rational: " ++ context cs) -- | Read a list in JSON format
json.cabal view
@@ -1,5 +1,6 @@+cabal-version: 2.4 name: json-version: 0.10+version: 0.11 synopsis: Support for serialising Haskell to and from JSON description: JSON (JavaScript Object Notation) is a lightweight data-interchange@@ -11,15 +12,15 @@ This library provides a parser and pretty printer for converting between Haskell values and JSON. category: Web-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Galois Inc. maintainer: Iavor S. Diatchki (iavor.diatchki@gmail.com) Copyright: (c) 2007-2018 Galois Inc.-cabal-version: >= 1.6 build-type: Simple-extra-source-files:+extra-doc-files: CHANGES+extra-source-files: tests/GenericTest.hs tests/HUnit.hs tests/Makefile@@ -86,6 +87,7 @@ description: Encode Haskell maps as JSON dicts library+ default-language: Haskell2010 exposed-modules: Text.JSON, Text.JSON.Types, Text.JSON.String,@@ -94,12 +96,12 @@ if flag(split-base) if flag(generic)- build-depends: base >=4 && <5, syb >= 0.3.3+ build-depends: base >=4.9 && <5, syb >= 0.3.3 exposed-modules: Text.JSON.Generic Cpp-Options: -DBASE_4 else- build-depends: base >= 3+ build-depends: base >= 3 && <4 build-depends: array, containers, bytestring, mtl, text