abhin4v/hs-json-parser
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Changes tests to add whitespaces in generated JSON string

Browse Source
This commit is contained in:
Abhinav Sarkar 2018-03-03 10:46:35 +05:30
parent 39381d2996
commit 41d40f2366
1 changed files with 41 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
test/Spec.hs
View File

@ -1,7 +1,8 @@
module Main where module Main where
import Control.Monad (unless) import Control.Monad (unless, forM)
import Data.Char (isControl) import Data.Char (isControl)
import Data.List (intercalate)
import System.Exit import System.Exit
import Test.QuickCheck import Test.QuickCheck
import Test.QuickCheck.Test (isSuccess) import Test.QuickCheck.Test (isSuccess)
@ -10,33 +11,56 @@ import JSONParser
main :: IO () main :: IO ()
main = do main = do
result <- quickCheckResult $ \j -> parseJSON (show j) == Just j result <- quickCheckResult checkJSON
unless (isSuccess result) exitFailure unless (isSuccess result) exitFailure
checkJSON :: JValue -> Gen Property
checkJSON value = do
json <- stringify value
return . counterexample (show json) . (== Just value) . parseJSON $ json
stringify :: JValue -> Gen String
stringify = pad . go
where
surround l r j = l ++ j ++ r
pad gen = surround <$> jsonWhitespaceGen <*> jsonWhitespaceGen <*> gen
commaSeparated = pad . pure . intercalate ","
go value = case value of
JArray elements ->
mapM (pad . stringify) elements >>= fmap (surround "[" "]") . commaSeparated
JObject kvs ->
mapM stringifyKV kvs >>= fmap (surround "{" "}") . commaSeparated
_ -> return $ show value
stringifyKV (k, v) = surround <$> pad (pure $ show k) <*> stringify v <*> pure ":"
instance Arbitrary JValue where instance Arbitrary JValue where
shrink = genericShrink shrink = genericShrink
arbitrary = sized go arbitrary = sized go
where where
go 0 = oneof scalarGens go n | n < 5 = frequency [(4, oneof scalarGens), (1, oneof (compositeGens n))]
go n = frequency [(2, oneof scalarGens), (3, oneof (compositeGens n))] go n = frequency [(1, oneof scalarGens), (4, oneof (compositeGens n))]
scalarGens = [ pure JNull scalarGens = [ pure JNull
, JBool <$> arbitrary , JBool <$> arbitrary
, JString <$> arbitraryJSONString , JString <$> jsonStringGen
, JNumber <$> arbitrary <*> oneof [choose (-5, 0), arbitrary] , JNumber <$> arbitrary <*> listOf digits <*> arbitrary
] ]
compositeGens n = [ fmap JArray . scaledListOf . go $ n `div` 2 compositeGens n = [ fmap JArray . scaledListOf . go $ n `div` 2
, fmap JObject . scaledListOf . objKV $ n `div` 2 , fmap JObject . scaledListOf . objKV $ n `div` 2
] ]
objKV n = (,) <$> arbitraryJSONString <*> go n objKV n = (,) <$> jsonStringGen <*> go n
scaledListOf = scale (\n -> n * 2 `div` 3) . listOf scaledListOf = scale (`div` 2) . listOf
arbitraryJSONString :: Gen String digits = choose (0, 9)
arbitraryJSONString = listOf arbitraryJSONChar
jsonStringGen :: Gen String
jsonStringGen = listOf arbitraryJSONChar
where where
arbitraryJSONChar' = arbitraryJSONChar' =
frequency [(9, arbitraryASCIIChar), (0, choose ('\128', '\65535'))] frequency [(9, arbitraryASCIIChar), (0, choose ('\128', '\65535'))]
@ -46,3 +70,10 @@ arbitraryJSONString = listOf arbitraryJSONChar
(99, arbitraryJSONChar') (99, arbitraryJSONChar')
, (1, elements ['"' , '\\' , '\b' , '\f' , '\n' , '\r' , '\t']) , (1, elements ['"' , '\\' , '\b' , '\f' , '\n' , '\r' , '\t'])
] ]
jsonWhitespaceGen :: Gen String
jsonWhitespaceGen =
scale (round . sqrt . fromIntegral)
. listOf
. elements
$ [' ' , '\n' , '\r' , '\t']