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