git.iko.soy/typeable/aeson
on acc-errors help sign in
typeable/aeson/tests/UnitTests.hs
542 lines 21 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.Framework (Test, testGroup)
47import Test.Framework.Providers.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 :: Test
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 ]
104roundTripCamel :: String -> Assertion
105roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name)
107roundTripCamel2 :: String -> Assertion
108roundTripCamel2 name = assertEqual "" name (camelFrom '_' $ camelTo2 '_' name)
110camelFrom :: Char -> String -> String
111camelFrom c s = let (p:ps) = split c s
112 in concat $ p : map capitalize ps
113 where
114 split c' s' = map L.unpack $ L.split c' $ L.pack s'
115 capitalize t = toUpper (head t) : tail t
118data Wibble = Wibble {
119 wibbleString :: String
120 , wibbleInt :: Int
121 } deriving (Generic, Show, Eq)
123instance FromJSON Wibble
125instance ToJSON Wibble where
126 toJSON = genericToJSON defaultOptions
127 toEncoding = genericToEncoding defaultOptions
129-- Test that if we put a bomb in a data structure, but only demand
130-- part of it via lazy encoding, we do not unexpectedly fail.
131goodProducer :: Assertion
132goodProducer = assertEqual "partial encoding should not explode on undefined"
133 '{' (L.head (encode wibble))
134 where
135 wibble = Wibble {
136 wibbleString = replicate k 'a'
137 , wibbleInt = 1
138 }
139 k | arch32bit = 4047
140 | otherwise = 4030
141 arch32bit = (maxBound :: Int) == 2147483647
143-- Test decoding various UTC time formats
144--
145-- Note: the incomplete pattern matches for UTCTimes are completely
146-- intentional. The test expects these parses to succeed. If the
147-- pattern matches fails, there's a bug in either the test or in aeson
148-- and needs to be investigated.
149utcTimeGood :: Assertion
150utcTimeGood = do
151 let ts1 = "2015-01-01T12:13:00.00Z" :: LT.Text
152 let ts2 = "2015-01-01T12:13:00Z" :: LT.Text
153 -- 'T' between date and time is not required, can be space
154 let ts3 = "2015-01-03 12:13:00.00Z" :: LT.Text
155 let ts4 = "2015-01-03 12:13:00.125Z" :: LT.Text
156 let (Just (t1 :: UTCTime)) = parseWithAeson ts1
157 let (Just (t2 :: UTCTime)) = parseWithAeson ts2
158 let (Just (t3 :: UTCTime)) = parseWithAeson ts3
159 let (Just (t4 :: UTCTime)) = parseWithAeson ts4
160 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts1) t1
161 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts2) t2
162 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts3) t3
163 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts4) t4
164 -- Time zones. Both +HHMM and +HH:MM are allowed for timezone
165 -- offset, and MM may be omitted.
166 let ts5 = "2015-01-01T12:30:00.00+00" :: LT.Text
167 let ts6 = "2015-01-01T12:30:00.00+01:15" :: LT.Text
168 let ts7 = "2015-01-01T12:30:00.00-02" :: LT.Text
169 let ts8 = "2015-01-01T22:00:00.00-03" :: LT.Text
170 let ts9 = "2015-01-01T22:00:00.00-04:30" :: LT.Text
171 let (Just (t5 :: UTCTime)) = parseWithAeson ts5
172 let (Just (t6 :: UTCTime)) = parseWithAeson ts6
173 let (Just (t7 :: UTCTime)) = parseWithAeson ts7
174 let (Just (t8 :: UTCTime)) = parseWithAeson ts8
175 let (Just (t9 :: UTCTime)) = parseWithAeson ts9
176 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T12:30:00.00Z") t5
177 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T11:15:00.00Z") t6
178 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t7
179 -- ts8 wraps around to the next day in UTC
180 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T01:00:00Z") t8
181 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T02:30:00Z") t9
183 -- Seconds in Time can be omitted
184 let ts10 = "2015-01-03T12:13Z" :: LT.Text
185 let ts11 = "2015-01-03 12:13Z" :: LT.Text
186 let ts12 = "2015-01-01T12:30-02" :: LT.Text
187 let (Just (t10 :: UTCTime)) = parseWithAeson ts10
188 let (Just (t11 :: UTCTime)) = parseWithAeson ts11
189 let (Just (t12 :: UTCTime)) = parseWithAeson ts12
190 assertEqual "utctime" (parseWithRead "%FT%H:%MZ" ts10) t10
191 assertEqual "utctime" (parseWithRead "%F %H:%MZ" ts11) t11
192 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t12
194 where
195 parseWithRead :: String -> LT.Text -> UTCTime
196 parseWithRead f s =
197 fromMaybe (error "parseTime input malformed") . parseTime defaultTimeLocale f . LT.unpack $ s
198 parseWithAeson :: LT.Text -> Maybe UTCTime
199 parseWithAeson s = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""]
201-- Test that a few non-timezone qualified timestamp formats get
202-- rejected if decoding to UTCTime.
203utcTimeBad :: Assertion
204utcTimeBad = do
205 verifyFailParse "2000-01-01T12:13:00" -- missing Zulu time not allowed (some TZ required)
206 verifyFailParse "2000-01-01 12:13:00" -- missing Zulu time not allowed (some TZ required)
207 verifyFailParse "2000-01-01" -- date only not OK
208 verifyFailParse "2000-01-01Z" -- date only not OK
209 verifyFailParse "2015-01-01T12:30:00.00+00Z" -- no Zulu if offset given
210 verifyFailParse "2015-01-01T12:30:00.00+00:00Z" -- no Zulu if offset given
211 verifyFailParse "2015-01-03 12:13:00.Z" -- decimal at the end but no digits
212 verifyFailParse "2015-01-03 12:13.000Z" -- decimal at the end, but no seconds
213 where
214 verifyFailParse (s :: LT.Text) =
215 let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ LT.concat ["\"", s, "\""] in
216 assertEqual "verify failure" Nothing dec
218-- Non identifier keys should be escaped & enclosed in brackets
219formatErrorExample :: Assertion
220formatErrorExample =
221 let rhs = formatError [Index 0, Key "foo", Key "bar", Key "a.b.c", Key "", Key "'\\", Key "end"] "error msg"
222 lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
223 in assertEqual "formatError example" lhs rhs
225------------------------------------------------------------------------------
226-- Comparison (.:?) and (.:!)
227------------------------------------------------------------------------------
229newtype T1 = T1 (Maybe Int) deriving (Eq, Show)
230newtype T2 = T2 (Maybe Int) deriving (Eq, Show)
231newtype T3 = T3 (Maybe Int) deriving (Eq, Show)
233instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")
234instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")
235instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")
237dotColonMark :: [Assertion]
238dotColonMark = [
239 assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1)
240 , assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)
241 , assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1)
243 , assertEqual ".:? not-present" (Just (T2 Nothing)) (decode ex1 :: Maybe T2)
244 , assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2)
245 , assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2)
247 , assertEqual ".:! not-present" (Just (T3 Nothing)) (decode ex1 :: Maybe T3)
248 , assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3)
249 , assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3)
250 ]
251 where ex1 = "{}"
252 ex2 = "{\"value\": 42 }"
253 ex3 = "{\"value\": null }"
255------------------------------------------------------------------------------
256-- These tests check that JSONPath is tracked correctly
257-----------------------------------------------------------------------------
259jsonPath :: [Assertion]
260jsonPath = [
261 -- issue #356
262 assertEqual "Either"
263 (Left "Error in $[1].Left[1]: expected Bool, encountered Number")
264 (eitherDecode "[1,{\"Left\":[2,3]}]"
265 :: Either String (Int, Either (Int, Bool) ()))
266 -- issue #358
267 , assertEqual "Seq a"
268 (Left "Error in $[2]: expected Int, encountered Boolean")
269 (eitherDecode "[0,1,true]" :: Either String (Seq Int))
270 , assertEqual "Wibble"
271 (Left "Error in $.wibbleInt: expected Int, encountered Boolean")
272 (eitherDecode "{\"wibbleString\":\"\",\"wibbleInt\":true}"
273 :: Either String Wibble)
274 ]
276------------------------------------------------------------------------------
277-- Check that the hashes of two equal Value are the same
278------------------------------------------------------------------------------
280hashableLaws :: [Assertion]
281hashableLaws = [
282 assertEqual "Hashable Object" (hash a) (hash b)
283 ]
284 where
285 a = object ["223" .= False, "807882556" .= True]
286 b = object ["807882556" .= True, "223" .= False]
288-------------------------------------------------------------------------------
289-- ToJSONKey
290-------------------------------------------------------------------------------
292newtype MyText = MyText Text
293 deriving (FromJSONKey)
295newtype MyText' = MyText' Text
297instance FromJSONKey MyText' where
298 fromJSONKey = fmap MyText' fromJSONKey
299 fromJSONKeyList = error "not used"
301fromJSONKeyAssertions :: [Assertion]
302fromJSONKeyAssertions =
303 [ assertIsCoerce "Text" (fromJSONKey :: FromJSONKeyFunction Text)
304 , assertIsCoerce "Tagged Int Text" (fromJSONKey :: FromJSONKeyFunction (Tagged Int Text))
305 , assertIsCoerce "MyText" (fromJSONKey :: FromJSONKeyFunction MyText)
307#if __GLASGOW_HASKELL__ >= 710
308 , assertIsCoerce' "MyText'" (fromJSONKey :: FromJSONKeyFunction MyText')
309#endif
310 ]
311 where
312 assertIsCoerce _ (FromJSONKeyCoerce _) = pure ()
313 assertIsCoerce n _ = assertFailure n
315#if __GLASGOW_HASKELL__ >= 710
316 assertIsCoerce' _ (FromJSONKeyCoerce _) = pure ()
317 assertIsCoerce' n _ = pickWithRules (assertFailure n) (pure ())
319-- | Pick the first when RULES are enabled, e.g. optimisations are on
320pickWithRules
321 :: a -- ^ Pick this when RULES are on
322 -> a -- ^ use this otherwise
323 -> a
324pickWithRules _ = id
325{-# NOINLINE pickWithRules #-}
326{-# RULES "pickWithRules/rule" [0] forall x. pickWithRules x = const x #-}
327#endif
329------------------------------------------------------------------------------
330-- Regressions
331------------------------------------------------------------------------------
333-- A regression test for: https://github.com/bos/aeson/issues/351
334overlappingRegression :: FromJSON a => L.ByteString -> [a]
335overlappingRegression bs = fromMaybe [] $ decode bs
337issue351 :: [Assertion]
338issue351 = [
339 assertEqual "Int" ([1, 2, 3] :: [Int]) $ overlappingRegression "[1, 2, 3]"
340 , assertEqual "Char" ("abc" :: String) $ overlappingRegression "\"abc\""
341 , assertEqual "Char" ("" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"
342 ]
344------------------------------------------------------------------------------
345-- Comparison between bytestring and text encoders
346------------------------------------------------------------------------------
348ioTests :: IO [Test]
349ioTests = do
350 enc <- encoderComparisonTests
351 js <- jsonTestSuite
352 return [enc, js]
354encoderComparisonTests :: IO Test
355encoderComparisonTests = do
356 encoderTests <- forM testFiles $ \file0 -> do
357 let file = "benchmarks/json-data/" ++ file0
358 return $ testCase file $ do
359 inp <- L.readFile file
360 case eitherDecode inp of
361 Left err -> assertFailure $ "Decoding failure: " ++ err
362 Right val -> assertEqual "" (encode val) (encodeViaText val)
363 return $ testGroup "encoders" encoderTests
364 where
365 encodeViaText :: Value -> L.ByteString
366 encodeViaText =
367 TLE.encodeUtf8 . TLB.toLazyText . encodeToTextBuilder . toJSON
369 testFiles =
370 [ "example.json"
371 , "integers.json"
372 , "jp100.json"
373 , "numbers.json"
374 , "twitter10.json"
375 , "twitter20.json"
376 , "geometry.json"
377 , "jp10.json"
378 , "jp50.json"
379 , "twitter1.json"
380 , "twitter100.json"
381 , "twitter50.json"
382 ]
384-- A regression test for: https://github.com/bos/aeson/issues/293
385data MyRecord = MyRecord {_field1 :: Maybe Int, _field2 :: Maybe Bool}
387data MyRecord2 = MyRecord2 {_field3 :: Maybe Int, _field4 :: Maybe Bool}
388 deriving Generic
390instance ToJSON MyRecord2
391instance FromJSON MyRecord2
393-- A regression test for: https://github.com/bos/aeson/pull/477
394unescapeString :: Assertion
395unescapeString = do
396 assertEqual "Basic escaping"
397 (Right ("\" / \\ \b \f \n \r \t" :: String))
398 (eitherDecode "\"\\\" \\/ \\\\ \\b \\f \\n \\r \\t\"")
400 forM_ [minBound .. maxBound :: Char] $ \ c ->
401 let s = LT.pack [c] in
402 assertEqual (printf "UTF-16 encoded '\\x%X'" c)
403 (Right s) (eitherDecode $ utf16Char s)
404 where
405 utf16Char = formatString . LBase16.encode . LT.encodeUtf16BE
406 formatString s
407 | L.length s == 4 = L.concat ["\"\\u", s, "\""]
408 | L.length s == 8 =
409 L.concat ["\"\\u", L.take 4 s, "\\u", L.drop 4 s, "\""]
410 | otherwise = error "unescapeString: can't happen"
412-- JSONTestSuite
414jsonTestSuiteTest :: FilePath -> Test
415jsonTestSuiteTest path = testCase fileName $ do
416 payload <- L.readFile path
417 let result = eitherDecode payload :: Either String Value
418 assertBool fileName $ case take 2 fileName of
419 "i_" -> isRight result
420 "n_" -> isLeft result
421 "y_" -> isRight result
422 _ -> isRight result -- test_transform tests have inconsistent names
423 where
424 fileName = takeFileName path
426-- Build a collection of tests based on the current contents of the
427-- JSONTestSuite test directories.
429jsonTestSuite :: IO Test
430jsonTestSuite = do
431 let suitePath = "tests/JSONTestSuite"
432 let suites = ["test_parsing", "test_transform"]
433 testPaths <- fmap (sort . concat) . forM suites $ \suite -> do
434 let dir = suitePath </> suite
435 entries <- getDirectoryContents dir
436 let ok name = takeExtension name == ".json" &&
437 not (name `HashSet.member` blacklist)
438 return . map (dir </>) . filter ok $ entries
439 return $ testGroup "JSONTestSuite" $ map jsonTestSuiteTest testPaths
441-- The set expected-to-be-failing JSONTestSuite tests.
442-- Not all of these failures are genuine bugs.
443-- Of those that are bugs, not all are worth fixing.
445blacklist :: HashSet.HashSet String
446-- blacklist = HashSet.empty
447blacklist = _blacklist
449_blacklist :: HashSet.HashSet String
450_blacklist = HashSet.fromList [
451 "i_object_key_lone_2nd_surrogate.json"
452 , "i_string_1st_surrogate_but_2nd_missing.json"
453 , "i_string_1st_valid_surrogate_2nd_invalid.json"
454 , "i_string_UTF-16LE_with_BOM.json"
455 , "i_string_UTF-16_invalid_lonely_surrogate.json"
456 , "i_string_UTF-16_invalid_surrogate.json"
457 , "i_string_UTF-8_invalid_sequence.json"
458 , "i_string_incomplete_surrogate_and_escape_valid.json"
459 , "i_string_incomplete_surrogate_pair.json"
460 , "i_string_incomplete_surrogates_escape_valid.json"
461 , "i_string_invalid_lonely_surrogate.json"
462 , "i_string_invalid_surrogate.json"
463 , "i_string_inverted_surrogates_U+1D11E.json"
464 , "i_string_lone_second_surrogate.json"
465 , "i_string_not_in_unicode_range.json"
466 , "i_string_truncated-utf-8.json"
467 , "i_structure_UTF-8_BOM_empty_object.json"
468 , "n_string_unescaped_crtl_char.json"
469 , "n_string_unescaped_newline.json"
470 , "n_string_unescaped_tab.json"
471 , "string_1_escaped_invalid_codepoint.json"
472 , "string_1_invalid_codepoint.json"
473 , "string_1_invalid_codepoints.json"
474 , "string_2_escaped_invalid_codepoints.json"
475 , "string_2_invalid_codepoints.json"
476 , "string_3_escaped_invalid_codepoints.json"
477 , "string_3_invalid_codepoints.json"
478 , "y_string_utf16BE_no_BOM.json"
479 , "y_string_utf16LE_no_BOM.json"
480 ]
482-- A regression test for: https://github.com/bos/aeson/pull/455
483data Foo a = FooNil | FooCons (Foo Int)
485pr455 :: Assertion
486pr455 = assertEqual "FooCons FooNil"
487 (toJSON foo) (liftToJSON undefined undefined foo)
488 where
489 foo :: Foo Int
490 foo = FooCons FooNil
492showOptions :: Assertion
493showOptions =
494 assertEqual
495 "Show Options"
496 ( "Options {"
497 ++ "fieldLabelModifier =~ \"exampleField\""
498 ++ ", constructorTagModifier =~ \"ExampleConstructor\""
499 ++ ", allNullaryToStringTag = True"
500 ++ ", omitNothingFields = False"
501 ++ ", sumEncoding = TaggedObject {tagFieldName = \"tag\", contentsFieldName = \"contents\"}"
502 ++ ", unwrapUnaryRecords = False"
503 ++ ", tagSingleConstructors = False"
504 ++ "}")
505 (show defaultOptions)
507newtype SingleMaybeField = SingleMaybeField { smf :: Maybe Int }
508 deriving (Eq, Show, Generic)
510singleMaybeField :: [Test]
511singleMaybeField = do
512 (gName, gToJSON, gToEncoding, gFromJSON) <-
513 [ ("generic", genericToJSON opts, genericToEncoding opts, parse (genericParseJSON opts))
514 , ("th", toJSON, toEncoding, fromJSON) ]
515 return $
516 testCase gName $ do
517 assertEqual "toJSON" Null (gToJSON v)
518 assertEqual "toEncoding" (toEncoding (gToJSON v)) (gToEncoding v)
519 assertEqual "fromJSON" (Success v) (gFromJSON Null)
520 where
521 v = SingleMaybeField Nothing
522 opts = defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True}
525newtype EmbeddedJSONTest = EmbeddedJSONTest Int
526 deriving (Eq, Show)
528instance FromJSON EmbeddedJSONTest where
529 parseJSON =
530 withObject "Object" $ \o ->
531 EmbeddedJSONTest <$> (o .: "prop" >>= withEmbeddedJSON "Quoted Int" parseJSON)
533withEmbeddedJSONTest :: Assertion
534withEmbeddedJSONTest =
535 assertEqual "Unquote embedded JSON" (Right $ EmbeddedJSONTest 1) (eitherDecode "{\"prop\":\"1\"}")
537deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord
539deriveToJSON defaultOptions ''Foo
540deriveToJSON1 defaultOptions ''Foo
542deriveJSON defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True} ''SingleMaybeField