git.iko.soy/typeable/aeson
on 1.4.1.0 help sign in
typeable/aeson/tests/UnitTests.hs
606 lines 24 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE NoImplicitPrelude #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE TemplateHaskell #-}
9-- For Data.Aeson.Types.camelTo
10{-# OPTIONS_GHC -fno-warn-deprecations #-}
12#if MIN_VERSION_base(4,9,0)
13{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
14#endif
16module UnitTests
17 (
18 ioTests
19 , tests
20 , withEmbeddedJSONTest
21 ) where
23import Prelude.Compat
25import Control.Monad (forM, forM_)
26import Data.Aeson ((.=), (.:), (.:?), (.:!), FromJSON(..), FromJSONKeyFunction(..), FromJSONKey(..), ToJSON1(..), decode, eitherDecode, encode, fromJSON, genericParseJSON, genericToEncoding, genericToJSON, object, withObject, withEmbeddedJSON)
27import Data.Aeson.Internal (JSONPathElement(..), formatError)
28import Data.Aeson.TH (deriveJSON, deriveToJSON, deriveToJSON1)
29import Data.Aeson.Text (encodeToTextBuilder)
30import Data.Aeson.Types (Options(..), Result(Success), ToJSON(..), Value(Null), camelTo, camelTo2, defaultOptions, omitNothingFields, parse)
31import Data.Char (toUpper)
32import Data.Either.Compat (isLeft, isRight)
33import Data.Hashable (hash)
34import Data.HashMap.Strict (HashMap)
35import Data.List (sort)
36import Data.Maybe (fromMaybe)
37import Data.Sequence (Seq)
38import Data.Scientific (Scientific, scientific)
39import Data.Tagged (Tagged(..))
40import Data.Text (Text)
41import Data.Time (UTCTime)
42import Data.Time.Format (parseTime)
43import Data.Time.Locale.Compat (defaultTimeLocale)
44import GHC.Generics (Generic)
45import Instances ()
46import Numeric.Natural (Natural)
47import System.Directory (getDirectoryContents)
48import System.FilePath ((</>), takeExtension, takeFileName)
49import Test.Tasty (TestTree, testGroup)
50import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, assertEqual, testCase)
51import Text.Printf (printf)
52import UnitTests.NullaryConstructors (nullaryConstructors)
53import qualified Data.ByteString.Base16.Lazy as LBase16
54import qualified Data.ByteString.Lazy.Char8 as L
55import qualified Data.HashSet as HashSet
56import qualified Data.Text.Lazy as LT
57import qualified Data.Text.Lazy.Builder as TLB
58import qualified Data.Text.Lazy.Encoding as LT
59import qualified Data.Text.Lazy.Encoding as TLE
60import qualified ErrorMessages
61import qualified SerializationFormatSpec
63-- Asserts that we can use both modules at once in the test suite.
64import Data.Aeson.Parser.UnescapeFFI ()
65import Data.Aeson.Parser.UnescapePure ()
67tests :: TestTree
68tests = testGroup "unit" [
69 testGroup "SerializationFormatSpec" SerializationFormatSpec.tests
70 , testGroup "ErrorMessages" ErrorMessages.tests
71 , testGroup "camelCase" [
72 testCase "camelTo" $ roundTripCamel "aName"
73 , testCase "camelTo" $ roundTripCamel "another"
74 , testCase "camelTo" $ roundTripCamel "someOtherName"
75 , testCase "camelTo" $
76 assertEqual "" "camel_apicase" (camelTo '_' "CamelAPICase")
77 , testCase "camelTo2" $ roundTripCamel2 "aName"
78 , testCase "camelTo2" $ roundTripCamel2 "another"
79 , testCase "camelTo2" $ roundTripCamel2 "someOtherName"
80 , testCase "camelTo2" $
81 assertEqual "" "camel_api_case" (camelTo2 '_' "CamelAPICase")
82 ]
83 , testGroup "encoding" [
84 testCase "goodProducer" goodProducer
85 ]
86 , testGroup "utctime" [
87 testCase "good" utcTimeGood
88 , testCase "bad" utcTimeBad
89 ]
90 , testGroup "formatError" [
91 testCase "example 1" formatErrorExample
92 ]
93 , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
94 , testGroup "JSONPath" $ fmap (testCase "-") jsonPath
95 , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws
96 , testGroup "Issue #351" $ fmap (testCase "-") issue351
97 , testGroup "Nullary constructors" $ fmap (testCase "-") nullaryConstructors
98 , testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions
99 , testCase "PR #455" pr455
100 , testCase "Unescape string (PR #477)" unescapeString
101 , testCase "Show Options" showOptions
102 , testGroup "SingleMaybeField" singleMaybeField
103 , testCase "withEmbeddedJSON" withEmbeddedJSONTest
104 , testCase "SingleFieldCon" singleFieldCon
105 , testCase "Ratio with denominator 0" ratioDenominator0
106 , testCase "Big scientific exponent" bigScientificExponent
107 , testCase "Big integer decoding" bigIntegerDecoding
108 , testCase "Big natural decading" bigNaturalDecoding
109 , testCase "Big integer key decoding" bigIntegerKeyDecoding
110 ]
112roundTripCamel :: String -> Assertion
113roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name)
115roundTripCamel2 :: String -> Assertion
116roundTripCamel2 name = assertEqual "" name (camelFrom '_' $ camelTo2 '_' name)
118camelFrom :: Char -> String -> String
119camelFrom c s = let (p:ps) = split c s
120 in concat $ p : map capitalize ps
121 where
122 split c' s' = map L.unpack $ L.split c' $ L.pack s'
123 capitalize t = toUpper (head t) : tail t
126data Wibble = Wibble {
127 wibbleString :: String
128 , wibbleInt :: Int
129 } deriving (Generic, Show, Eq)
131instance FromJSON Wibble
133instance ToJSON Wibble where
134 toJSON = genericToJSON defaultOptions
135 toEncoding = genericToEncoding defaultOptions
137-- Test that if we put a bomb in a data structure, but only demand
138-- part of it via lazy encoding, we do not unexpectedly fail.
139goodProducer :: Assertion
140goodProducer = assertEqual "partial encoding should not explode on undefined"
141 '{' (L.head (encode wibble))
142 where
143 wibble = Wibble {
144 wibbleString = replicate k 'a'
145 , wibbleInt = 1
146 }
147 k | arch32bit = 4047
148 | otherwise = 4030
149 arch32bit = (maxBound :: Int) == 2147483647
151-- Test decoding various UTC time formats
152--
153-- Note: the incomplete pattern matches for UTCTimes are completely
154-- intentional. The test expects these parses to succeed. If the
155-- pattern matches fails, there's a bug in either the test or in aeson
156-- and needs to be investigated.
157utcTimeGood :: Assertion
158utcTimeGood = do
159 let ts1 = "2015-01-01T12:13:00.00Z" :: LT.Text
160 let ts2 = "2015-01-01T12:13:00Z" :: LT.Text
161 -- 'T' between date and time is not required, can be space
162 let ts3 = "2015-01-03 12:13:00.00Z" :: LT.Text
163 let ts4 = "2015-01-03 12:13:00.125Z" :: LT.Text
164 let (Just (t1 :: UTCTime)) = parseWithAeson ts1
165 let (Just (t2 :: UTCTime)) = parseWithAeson ts2
166 let (Just (t3 :: UTCTime)) = parseWithAeson ts3
167 let (Just (t4 :: UTCTime)) = parseWithAeson ts4
168 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts1) t1
169 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts2) t2
170 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts3) t3
171 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts4) t4
172 -- Time zones. Both +HHMM and +HH:MM are allowed for timezone
173 -- offset, and MM may be omitted.
174 let ts5 = "2015-01-01T12:30:00.00+00" :: LT.Text
175 let ts6 = "2015-01-01T12:30:00.00+01:15" :: LT.Text
176 let ts7 = "2015-01-01T12:30:00.00-02" :: LT.Text
177 let ts8 = "2015-01-01T22:00:00.00-03" :: LT.Text
178 let ts9 = "2015-01-01T22:00:00.00-04:30" :: LT.Text
179 let (Just (t5 :: UTCTime)) = parseWithAeson ts5
180 let (Just (t6 :: UTCTime)) = parseWithAeson ts6
181 let (Just (t7 :: UTCTime)) = parseWithAeson ts7
182 let (Just (t8 :: UTCTime)) = parseWithAeson ts8
183 let (Just (t9 :: UTCTime)) = parseWithAeson ts9
184 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T12:30:00.00Z") t5
185 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T11:15:00.00Z") t6
186 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t7
187 -- ts8 wraps around to the next day in UTC
188 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T01:00:00Z") t8
189 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T02:30:00Z") t9
191 -- Seconds in Time can be omitted
192 let ts10 = "2015-01-03T12:13Z" :: LT.Text
193 let ts11 = "2015-01-03 12:13Z" :: LT.Text
194 let ts12 = "2015-01-01T12:30-02" :: LT.Text
195 let (Just (t10 :: UTCTime)) = parseWithAeson ts10
196 let (Just (t11 :: UTCTime)) = parseWithAeson ts11
197 let (Just (t12 :: UTCTime)) = parseWithAeson ts12
198 assertEqual "utctime" (parseWithRead "%FT%H:%MZ" ts10) t10
199 assertEqual "utctime" (parseWithRead "%F %H:%MZ" ts11) t11
200 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t12
202 -- leap seconds are included correctly
203 let ts13 = "2015-08-23T23:59:60.128+00" :: LT.Text
204 let (Just (t13 :: UTCTime)) = parseWithAeson ts13
205 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-08-23T23:59:60.128Z") t13
206 let ts14 = "2015-08-23T23:59:60.999999999999+00" :: LT.Text
207 let (Just (t14 :: UTCTime)) = parseWithAeson ts14
208 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-08-23T23:59:60.999999999999Z") t14
210 where
211 parseWithRead :: String -> LT.Text -> UTCTime
212 parseWithRead f s =
213 fromMaybe (error "parseTime input malformed") . parseTime defaultTimeLocale f . LT.unpack $ s
214 parseWithAeson :: LT.Text -> Maybe UTCTime
215 parseWithAeson s = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""]
217-- Test that a few non-timezone qualified timestamp formats get
218-- rejected if decoding to UTCTime.
219utcTimeBad :: Assertion
220utcTimeBad = do
221 verifyFailParse "2000-01-01T12:13:00" -- missing Zulu time not allowed (some TZ required)
222 verifyFailParse "2000-01-01 12:13:00" -- missing Zulu time not allowed (some TZ required)
223 verifyFailParse "2000-01-01" -- date only not OK
224 verifyFailParse "2000-01-01Z" -- date only not OK
225 verifyFailParse "2015-01-01T12:30:00.00+00Z" -- no Zulu if offset given
226 verifyFailParse "2015-01-01T12:30:00.00+00:00Z" -- no Zulu if offset given
227 verifyFailParse "2015-01-03 12:13:00.Z" -- decimal at the end but no digits
228 verifyFailParse "2015-01-03 12:13.000Z" -- decimal at the end, but no seconds
229 verifyFailParse "2015-01-03 23:59:61Z" -- exceeds allowed seconds per day
230 where
231 verifyFailParse (s :: LT.Text) =
232 let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""] in
233 assertEqual "verify failure" Nothing dec
235-- Non identifier keys should be escaped & enclosed in brackets
236formatErrorExample :: Assertion
237formatErrorExample =
238 let rhs = formatError [Index 0, Key "foo", Key "bar", Key "a.b.c", Key "", Key "'\\", Key "end"] "error msg"
239 lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
240 in assertEqual "formatError example" lhs rhs
242------------------------------------------------------------------------------
243-- Comparison (.:?) and (.:!)
244------------------------------------------------------------------------------
246newtype T1 = T1 (Maybe Int) deriving (Eq, Show)
247newtype T2 = T2 (Maybe Int) deriving (Eq, Show)
248newtype T3 = T3 (Maybe Int) deriving (Eq, Show)
250instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")
251instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")
252instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")
254dotColonMark :: [Assertion]
255dotColonMark = [
256 assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1)
257 , assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)
258 , assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1)
260 , assertEqual ".:? not-present" (Just (T2 Nothing)) (decode ex1 :: Maybe T2)
261 , assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2)
262 , assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2)
264 , assertEqual ".:! not-present" (Just (T3 Nothing)) (decode ex1 :: Maybe T3)
265 , assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3)
266 , assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3)
267 ]
268 where ex1 = "{}"
269 ex2 = "{\"value\": 42 }"
270 ex3 = "{\"value\": null }"
272------------------------------------------------------------------------------
273-- These tests check that JSONPath is tracked correctly
274-----------------------------------------------------------------------------
276jsonPath :: [Assertion]
277jsonPath = [
278 -- issue #356
279 assertEqual "Either"
280 (Left "Error in $[1].Left[1]: expected Bool, encountered Number")
281 (eitherDecode "[1,{\"Left\":[2,3]}]"
282 :: Either String (Int, Either (Int, Bool) ()))
283 -- issue #358
284 , assertEqual "Seq a"
285 (Left "Error in $[2]: expected Int, encountered Boolean")
286 (eitherDecode "[0,1,true]" :: Either String (Seq Int))
287 , assertEqual "Wibble"
288 (Left "Error in $.wibbleInt: expected Int, encountered Boolean")
289 (eitherDecode "{\"wibbleString\":\"\",\"wibbleInt\":true}"
290 :: Either String Wibble)
291 ]
293------------------------------------------------------------------------------
294-- Check that the hashes of two equal Value are the same
295------------------------------------------------------------------------------
297hashableLaws :: [Assertion]
298hashableLaws = [
299 assertEqual "Hashable Object" (hash a) (hash b)
300 ]
301 where
302 a = object ["223" .= False, "807882556" .= True]
303 b = object ["807882556" .= True, "223" .= False]
305-------------------------------------------------------------------------------
306-- ToJSONKey
307-------------------------------------------------------------------------------
309newtype MyText = MyText Text
310 deriving (FromJSONKey)
312newtype MyText' = MyText' Text
314instance FromJSONKey MyText' where
315 fromJSONKey = fmap MyText' fromJSONKey
316 fromJSONKeyList = error "not used"
318fromJSONKeyAssertions :: [Assertion]
319fromJSONKeyAssertions =
320 [ assertIsCoerce "Text" (fromJSONKey :: FromJSONKeyFunction Text)
321 , assertIsCoerce "Tagged Int Text" (fromJSONKey :: FromJSONKeyFunction (Tagged Int Text))
322 , assertIsCoerce "MyText" (fromJSONKey :: FromJSONKeyFunction MyText)
324#if __GLASGOW_HASKELL__ >= 710
325 , assertIsCoerce' "MyText'" (fromJSONKey :: FromJSONKeyFunction MyText')
326#endif
327 ]
328 where
329 assertIsCoerce _ (FromJSONKeyCoerce _) = pure ()
330 assertIsCoerce n _ = assertFailure n
332#if __GLASGOW_HASKELL__ >= 710
333 assertIsCoerce' _ (FromJSONKeyCoerce _) = pure ()
334 assertIsCoerce' n _ = pickWithRules (assertFailure n) (pure ())
336-- | Pick the first when RULES are enabled, e.g. optimisations are on
337pickWithRules
338 :: a -- ^ Pick this when RULES are on
339 -> a -- ^ use this otherwise
340 -> a
341pickWithRules _ = id
342{-# NOINLINE pickWithRules #-}
343{-# RULES "pickWithRules/rule" [0] forall x. pickWithRules x = const x #-}
344#endif
346------------------------------------------------------------------------------
347-- Regressions
348------------------------------------------------------------------------------
350-- A regression test for: https://github.com/bos/aeson/issues/351
351overlappingRegression :: FromJSON a => L.ByteString -> [a]
352overlappingRegression bs = fromMaybe [] $ decode bs
354issue351 :: [Assertion]
355issue351 = [
356 assertEqual "Int" ([1, 2, 3] :: [Int]) $ overlappingRegression "[1, 2, 3]"
357 , assertEqual "Char" ("abc" :: String) $ overlappingRegression "\"abc\""
358 , assertEqual "Char" ("" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"
359 ]
361------------------------------------------------------------------------------
362-- Comparison between bytestring and text encoders
363------------------------------------------------------------------------------
365ioTests :: IO [TestTree]
366ioTests = do
367 enc <- encoderComparisonTests
368 js <- jsonTestSuite
369 return [enc, js]
371encoderComparisonTests :: IO TestTree
372encoderComparisonTests = do
373 encoderTests <- forM testFiles $ \file0 -> do
374 let file = "benchmarks/json-data/" ++ file0
375 return $ testCase file $ do
376 inp <- L.readFile file
377 case eitherDecode inp of
378 Left err -> assertFailure $ "Decoding failure: " ++ err
379 Right val -> assertEqual "" (encode val) (encodeViaText val)
380 return $ testGroup "encoders" encoderTests
381 where
382 encodeViaText :: Value -> L.ByteString
383 encodeViaText =
384 TLE.encodeUtf8 . TLB.toLazyText . encodeToTextBuilder . toJSON
386 testFiles =
387 [ "example.json"
388 , "integers.json"
389 , "jp100.json"
390 , "numbers.json"
391 , "twitter10.json"
392 , "twitter20.json"
393 , "geometry.json"
394 , "jp10.json"
395 , "jp50.json"
396 , "twitter1.json"
397 , "twitter100.json"
398 , "twitter50.json"
399 ]
401-- A regression test for: https://github.com/bos/aeson/issues/293
402data MyRecord = MyRecord {_field1 :: Maybe Int, _field2 :: Maybe Bool}
404data MyRecord2 = MyRecord2 {_field3 :: Maybe Int, _field4 :: Maybe Bool}
405 deriving Generic
407instance ToJSON MyRecord2
408instance FromJSON MyRecord2
410-- A regression test for: https://github.com/bos/aeson/pull/477
411unescapeString :: Assertion
412unescapeString = do
413 assertEqual "Basic escaping"
414 (Right ("\" / \\ \b \f \n \r \t" :: String))
415 (eitherDecode "\"\\\" \\/ \\\\ \\b \\f \\n \\r \\t\"")
417 forM_ [minBound .. maxBound :: Char] $ \ c ->
418 let s = LT.pack [c] in
419 assertEqual (printf "UTF-16 encoded '\\x%X'" c)
420 (Right s) (eitherDecode $ utf16Char s)
421 where
422 utf16Char = formatString . LBase16.encode . LT.encodeUtf16BE
423 formatString s
424 | L.length s == 4 = L.concat ["\"\\u", s, "\""]
425 | L.length s == 8 =
426 L.concat ["\"\\u", L.take 4 s, "\\u", L.drop 4 s, "\""]
427 | otherwise = error "unescapeString: can't happen"
429-- JSONTestSuite
431jsonTestSuiteTest :: FilePath -> TestTree
432jsonTestSuiteTest path = testCase fileName $ do
433 payload <- L.readFile path
434 let result = eitherDecode payload :: Either String Value
435 assertBool fileName $ case take 2 fileName of
436 "i_" -> isRight result
437 "n_" -> isLeft result
438 "y_" -> isRight result
439 _ -> isRight result -- test_transform tests have inconsistent names
440 where
441 fileName = takeFileName path
443-- Build a collection of tests based on the current contents of the
444-- JSONTestSuite test directories.
446jsonTestSuite :: IO TestTree
447jsonTestSuite = do
448 let suitePath = "tests/JSONTestSuite"
449 let suites = ["test_parsing", "test_transform"]
450 testPaths <- fmap (sort . concat) . forM suites $ \suite -> do
451 let dir = suitePath </> suite
452 entries <- getDirectoryContents dir
453 let ok name = takeExtension name == ".json" &&
454 not (name `HashSet.member` blacklist)
455 return . map (dir </>) . filter ok $ entries
456 return $ testGroup "JSONTestSuite" $ map jsonTestSuiteTest testPaths
458-- The set expected-to-be-failing JSONTestSuite tests.
459-- Not all of these failures are genuine bugs.
460-- Of those that are bugs, not all are worth fixing.
462blacklist :: HashSet.HashSet String
463-- blacklist = HashSet.empty
464blacklist = _blacklist
466_blacklist :: HashSet.HashSet String
467_blacklist = HashSet.fromList [
468 "i_object_key_lone_2nd_surrogate.json"
469 , "i_string_1st_surrogate_but_2nd_missing.json"
470 , "i_string_1st_valid_surrogate_2nd_invalid.json"
471 , "i_string_UTF-16LE_with_BOM.json"
472 , "i_string_UTF-16_invalid_lonely_surrogate.json"
473 , "i_string_UTF-16_invalid_surrogate.json"
474 , "i_string_UTF-8_invalid_sequence.json"
475 , "i_string_incomplete_surrogate_and_escape_valid.json"
476 , "i_string_incomplete_surrogate_pair.json"
477 , "i_string_incomplete_surrogates_escape_valid.json"
478 , "i_string_invalid_lonely_surrogate.json"
479 , "i_string_invalid_surrogate.json"
480 , "i_string_inverted_surrogates_U+1D11E.json"
481 , "i_string_lone_second_surrogate.json"
482 , "i_string_not_in_unicode_range.json"
483 , "i_string_truncated-utf-8.json"
484 , "i_structure_UTF-8_BOM_empty_object.json"
485 , "n_string_unescaped_crtl_char.json"
486 , "n_string_unescaped_newline.json"
487 , "n_string_unescaped_tab.json"
488 , "string_1_escaped_invalid_codepoint.json"
489 , "string_1_invalid_codepoint.json"
490 , "string_1_invalid_codepoints.json"
491 , "string_2_escaped_invalid_codepoints.json"
492 , "string_2_invalid_codepoints.json"
493 , "string_3_escaped_invalid_codepoints.json"
494 , "string_3_invalid_codepoints.json"
495 , "y_string_utf16BE_no_BOM.json"
496 , "y_string_utf16LE_no_BOM.json"
497 ]
499-- A regression test for: https://github.com/bos/aeson/pull/455
500data Foo a = FooNil | FooCons (Foo Int)
502pr455 :: Assertion
503pr455 = assertEqual "FooCons FooNil"
504 (toJSON foo) (liftToJSON undefined undefined foo)
505 where
506 foo :: Foo Int
507 foo = FooCons FooNil
509showOptions :: Assertion
510showOptions =
511 assertEqual
512 "Show Options"
513 ( "Options {"
514 ++ "fieldLabelModifier =~ \"exampleField\""
515 ++ ", constructorTagModifier =~ \"ExampleConstructor\""
516 ++ ", allNullaryToStringTag = True"
517 ++ ", omitNothingFields = False"
518 ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"
519 ++ ", unwrapUnaryRecords = False"
520 ++ ", tagSingleConstructors = False"
521 ++ "}")
522 (show defaultOptions)
524newtype SingleMaybeField = SingleMaybeField { smf :: Maybe Int }
525 deriving (Eq, Show, Generic)
527singleMaybeField :: [TestTree]
528singleMaybeField = do
529 (gName, gToJSON, gToEncoding, gFromJSON) <-
530 [ ("generic", genericToJSON opts, genericToEncoding opts, parse (genericParseJSON opts))
531 , ("th", toJSON, toEncoding, fromJSON) ]
532 return $
533 testCase gName $ do
534 assertEqual "toJSON" Null (gToJSON v)
535 assertEqual "toEncoding" (toEncoding (gToJSON v)) (gToEncoding v)
536 assertEqual "fromJSON" (Success v) (gFromJSON Null)
537 where
538 v = SingleMaybeField Nothing
539 opts = defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True}
542newtype EmbeddedJSONTest = EmbeddedJSONTest Int
543 deriving (Eq, Show)
545instance FromJSON EmbeddedJSONTest where
546 parseJSON =
547 withObject "Object" $ \o ->
548 EmbeddedJSONTest <$> (o .: "prop" >>= withEmbeddedJSON "Quoted Int" parseJSON)
550withEmbeddedJSONTest :: Assertion
551withEmbeddedJSONTest =
552 assertEqual "Unquote embedded JSON" (Right $ EmbeddedJSONTest 1) (eitherDecode "{\"prop\":\"1\"}")
554-- Regression test for https://github.com/bos/aeson/issues/627
555newtype SingleFieldCon = SingleFieldCon Int deriving (Eq, Show, Generic)
557instance FromJSON SingleFieldCon where
558 parseJSON = genericParseJSON defaultOptions{unwrapUnaryRecords=True}
559 -- This option should have no effect on this type
561singleFieldCon :: Assertion
562singleFieldCon =
563 assertEqual "fromJSON" (Right (SingleFieldCon 0)) (eitherDecode "0")
565ratioDenominator0 :: Assertion
566ratioDenominator0 =
567 assertEqual "Ratio with denominator 0"
568 (Left "Error in $: Ratio denominator was 0")
569 (eitherDecode "{ \"numerator\": 1, \"denominator\": 0 }" :: Either String Rational)
571bigScientificExponent :: Assertion
572bigScientificExponent =
573 assertEqual "Encoding an integral scientific with a large exponent should normalize it"
574 "1.0e2000"
575 (encode (scientific 1 2000 :: Scientific))
577bigIntegerDecoding :: Assertion
578bigIntegerDecoding =
579 assertEqual "Decoding an Integer with a large exponent should fail"
580 (Left "Error in $: expected a number with exponent <= 1024, encountered Number")
581 ((eitherDecode :: L.ByteString -> Either String Integer) "1e2000")
583bigNaturalDecoding :: Assertion
584bigNaturalDecoding =
585 assertEqual "Decoding a Natural with a large exponent should fail"
586 (Left "Error in $: expected a number with exponent <= 1024, encountered Number")
587 ((eitherDecode :: L.ByteString -> Either String Integer) "1e2000")
589bigIntegerKeyDecoding :: Assertion
590bigIntegerKeyDecoding =
591 assertEqual "Decoding an Integer key with a large exponent should fail"
592 (Left "Error in $['1e2000']: expected a number with exponent <= 1024, encountered Number")
593 ((eitherDecode :: L.ByteString -> Either String (HashMap Integer Value)) "{ \"1e2000\": null }")
595bigNaturalKeyDecoding :: Assertion
596bigNaturalKeyDecoding =
597 assertEqual "Decoding an Integer key with a large exponent should fail"
598 (Left "Error in $['1e2000']: expected a number with exponent <= 1024, encountered Number")
599 ((eitherDecode :: L.ByteString -> Either String (HashMap Natural Value)) "{ \"1e2000\": null }")
601deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord
603deriveToJSON defaultOptions ''Foo
604deriveToJSON1 defaultOptions ''Foo
606deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField