diff --git a/package.yaml b/package.yaml index 78d6c8b..78cad64 100644 --- a/package.yaml +++ b/package.yaml @@ -33,7 +33,7 @@ executables: ppj: main: Main.hs source-dirs: app - ghc-options: [] + ghc-options: -O2 dependencies: - json-parser - pretty-simple @@ -42,9 +42,7 @@ tests: json-parser-test: main: Spec.hs source-dirs: test - ghc-options: - - -threaded - - -rtsopts - - -with-rtsopts=-N + ghc-options: -O2 dependencies: - json-parser + - QuickCheck diff --git a/src/jsonparser.hs b/src/jsonparser.hs index 00df910..ebfd268 100644 --- a/src/jsonparser.hs +++ b/src/jsonparser.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} module JSONParser where import Control.Applicative (Alternative(..), optional) @@ -5,6 +6,7 @@ import Control.Monad (replicateM) import Data.Char (isDigit, isHexDigit, isSpace, isControl, chr, digitToInt) import Data.Functor (($>)) import Data.List (intercalate) +import GHC.Generics (Generic) newtype Parser i o = Parser { runParser :: i -> Maybe (i, o) } @@ -60,7 +62,7 @@ data JValue = JNull | JNumber { significand :: Integer, exponent :: Integer} | JArray [JValue] | JObject [(String, JValue)] - deriving (Eq) + deriving (Eq, Generic) instance Show JValue where show value = case value of @@ -68,9 +70,15 @@ instance Show JValue where JBool True -> "true" JBool False -> "false" JString s -> "\"" ++ s ++ "\"" - JNumber s e -> if e == 0 then show s else show s ++ "e" ++ show e + JNumber s e -> case e of + 0 -> show s + _ | e >= (-5) && e < 0 -> printf ("%." ++ show (abs e) ++ "f") (toDouble s e) + _ -> show s ++ "e" ++ show e JArray a -> "[" ++ intercalate ", " (map show a) ++ "]" JObject o -> "{" ++ intercalate ", " (map (\(k, v) -> show k ++ ": " ++ show v) o) ++ "}" + where + toDouble :: Integer -> Integer -> Double + toDouble s e = fromInteger s * 10 ^^ e jNull :: Parser String JValue jNull = string "null" $> JNull diff --git a/test/Spec.hs b/test/Spec.hs index cd4753f..6b89b4b 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,2 +1,43 @@ +module Main where + +import Control.Monad (unless) +import Data.Char (isControl, isAscii, isPrint) +import System.Exit +import Test.QuickCheck +import Test.QuickCheck.Test (isSuccess) + +import JSONParser + main :: IO () -main = putStrLn "Test suite not yet implemented" +main = do + result <- verboseCheckWithResult (stdArgs { maxSize = 40 }) $ \j -> parseJSON (show j) == Just j + unless (isSuccess result) exitFailure + +instance Arbitrary JValue where + arbitrary = sized go + where + scalarGens = [ pure JNull + , JBool <$> arbitrary + , JString <$> arbitraryJSONString + , JNumber <$> arbitrary <*> oneof [choose (-5, 0), arbitrary] + ] + compositeGens n = [ fmap JArray . scale scaleComp . listOf . go $ n `div` 2 + , fmap JObject . scale scaleComp . listOf $ ((,) <$> arbitraryJSONString <*> go (n `div` 2)) + ] + + scaleComp n = n * 2 `div` 3 + + go 0 = oneof scalarGens + go n = frequency [(2, oneof scalarGens), (3, oneof (compositeGens n))] + + arbitraryJSONString = listOf arbitraryJSONChar' + + arbitraryJSONChar' = + arbitraryUnicodeChar `suchThat` (\c -> isAscii c && isPrint c && not (c == '\"' || c == '\\' || isControl c)) + + arbitraryJSONChar = frequency [ + (99, arbitraryJSONChar') + , (1, elements ['"' , '\\' , '\b' , '\f' , '\n' , '\r' , '\t']) + ] + + shrink = genericShrink