git.iko.soy/typeable/aeson
on 1.0.0.0 help sign in
typeable/aeson/tests/UnitTests.hs
576 lines 25 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE GADTs #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE TemplateHaskell #-}
8#if __GLASGOW_HASKELL__ >= 708
9{-# LANGUAGE DataKinds #-}
10#endif
12{-# OPTIONS_GHC -fno-warn-deprecations #-}
14module UnitTests
15 (
16 ioTests
17 , tests
18 ) where
20import Prelude ()
21import Prelude.Compat
23import Control.Applicative (Const(..))
24import Control.Monad (forM)
25import Data.Aeson ((.=), (.:), (.:?), (.:!), FromJSON(..), FromJSONKeyFunction(..), FromJSONKey(..), ToJSON1(..), decode, eitherDecode, encode, genericParseJSON, genericToEncoding, genericToJSON, object, withObject)
26import Data.Aeson.Internal (JSONPathElement(..), formatError)
27import Data.Aeson.TH (deriveJSON, deriveToJSON, deriveToJSON1)
28import Data.Aeson.Text (encodeToTextBuilder)
29import Data.Aeson.Types (Options(..), SumEncoding(..), ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)
30import Data.Char (toUpper)
31import Data.Fixed (Pico)
32import Data.Functor.Compose (Compose(..))
33import Data.Functor.Identity (Identity(..))
34import Data.Functor.Product (Product(..))
35import Data.Functor.Sum (Sum(..))
36import Data.Hashable (hash)
37import Data.List.NonEmpty (NonEmpty(..))
38import Data.Maybe (fromMaybe)
39import Data.Proxy (Proxy(..))
40import Data.Scientific (Scientific)
41import Data.Sequence (Seq)
42import Data.Tagged (Tagged(..))
43import Data.Text (Text)
44import Data.Time (UTCTime)
45import Data.Time.Format (parseTime)
46import Data.Time.Locale.Compat (defaultTimeLocale)
47import Data.Word (Word8)
48import GHC.Generics (Generic)
49import Instances ()
50import Test.Framework (Test, testGroup)
51import Test.Framework.Providers.HUnit (testCase)
52import Test.HUnit (Assertion, assertFailure, assertEqual)
53import Types (Approx(..), Compose3, Compose3', I)
54import UnitTests.NullaryConstructors (nullaryConstructors)
55import qualified Data.ByteString.Lazy.Char8 as L
56import qualified Data.DList as DList
57import qualified Data.HashMap.Strict as HM
58import qualified Data.HashSet as HashSet
59import qualified Data.IntMap as IntMap
60import qualified Data.IntSet as IntSet
61import qualified Data.Map as M
62import qualified Data.Sequence as Seq
63import qualified Data.Set as Set
64import qualified Data.Text.Lazy as LT
65import qualified Data.Text.Lazy.Builder as TLB
66import qualified Data.Text.Lazy.Encoding as LT
67import qualified Data.Text.Lazy.Encoding as TLE
68import qualified Data.Tree as Tree
69import qualified Data.Vector as Vector
71tests :: Test
72tests = testGroup "unit" [
73 testGroup "camelCase" [
74 testCase "camelTo" $ roundTripCamel "aName"
75 , testCase "camelTo" $ roundTripCamel "another"
76 , testCase "camelTo" $ roundTripCamel "someOtherName"
77 , testCase "camelTo" $
78 assertEqual "" "camel_apicase" (camelTo '_' "CamelAPICase")
79 , testCase "camelTo2" $ roundTripCamel2 "aName"
80 , testCase "camelTo2" $ roundTripCamel2 "another"
81 , testCase "camelTo2" $ roundTripCamel2 "someOtherName"
82 , testCase "camelTo2" $
83 assertEqual "" "camel_api_case" (camelTo2 '_' "CamelAPICase")
84 ]
85 , testGroup "encoding" [
86 testCase "goodProducer" $ goodProducer
87 ]
88 , testGroup "utctime" [
89 testCase "good" $ utcTimeGood
90 , testCase "bad" $ utcTimeBad
91 ]
92 , testGroup "formatError" [
93 testCase "example 1" $ formatErrorExample
94 ]
95 , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
96 , testGroup "To JSON representation" $ fmap assertJsonEncodingExample jsonEncodingExamples
97 , testGroup "From JSON representation" $ fmap assertJsonExample jsonDecodingExamples
98 , testGroup "To/From JSON representation" $ fmap assertJsonExample jsonExamples
99 , testGroup "JSONPath" $ fmap (testCase "-") jsonPath
100 , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws
101 , testGroup "Issue #351" $ fmap (testCase "-") issue351
102 , testGroup "Nullary constructors" $ fmap (testCase "-") nullaryConstructors
103 , testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions
104 , testCase "PR #455" pr455
105 ]
107roundTripCamel :: String -> Assertion
108roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name)
110roundTripCamel2 :: String -> Assertion
111roundTripCamel2 name = assertEqual "" name (camelFrom '_' $ camelTo2 '_' name)
113camelFrom :: Char -> String -> String
114camelFrom c s = let (p:ps) = split c s
115 in concat $ p : map capitalize ps
116 where
117 split c' s' = map L.unpack $ L.split c' $ L.pack s'
118 capitalize t = toUpper (head t) : tail t
121data MyEither a b = MyLeft a | MyRight b
122 deriving (Generic, Show, Eq)
124instance (ToJSON a, ToJSON b) => ToJSON (MyEither a b) where
125 toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }
126 toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue }
128instance (FromJSON a, FromJSON b) => FromJSON (MyEither a b) where
129 parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }
132data Wibble = Wibble {
133 wibbleString :: String
134 , wibbleInt :: Int
135 } deriving (Generic, Show, Eq)
137instance FromJSON Wibble
139instance ToJSON Wibble where
140 toJSON = genericToJSON defaultOptions
141 toEncoding = genericToEncoding defaultOptions
143-- Test that if we put a bomb in a data structure, but only demand
144-- part of it via lazy encoding, we do not unexpectedly fail.
145goodProducer :: Assertion
146goodProducer = assertEqual "partial encoding should not explode on undefined"
147 '{' (L.head (encode wibble))
148 where
149 wibble = Wibble {
150 wibbleString = replicate k 'a'
151 , wibbleInt = 1
152 }
153 k | arch32bit = 4047
154 | otherwise = 4030
155 arch32bit = (maxBound :: Int) == 2147483647
157-- Test decoding various UTC time formats
158--
159-- Note: the incomplete pattern matches for UTCTimes are completely
160-- intentional. The test expects these parses to succeed. If the
161-- pattern matches fails, there's a bug in either the test or in aeson
162-- and needs to be investigated.
163utcTimeGood :: Assertion
164utcTimeGood = do
165 let ts1 = "2015-01-01T12:13:00.00Z" :: LT.Text
166 let ts2 = "2015-01-01T12:13:00Z" :: LT.Text
167 -- 'T' between date and time is not required, can be space
168 let ts3 = "2015-01-03 12:13:00.00Z" :: LT.Text
169 let ts4 = "2015-01-03 12:13:00.125Z" :: LT.Text
170 let (Just (t1 :: UTCTime)) = parseWithAeson ts1
171 let (Just (t2 :: UTCTime)) = parseWithAeson ts2
172 let (Just (t3 :: UTCTime)) = parseWithAeson ts3
173 let (Just (t4 :: UTCTime)) = parseWithAeson ts4
174 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts1) t1
175 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts2) t2
176 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts3) t3
177 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts4) t4
178 -- Time zones. Both +HHMM and +HH:MM are allowed for timezone
179 -- offset, and MM may be omitted.
180 let ts5 = "2015-01-01T12:30:00.00+00" :: LT.Text
181 let ts6 = "2015-01-01T12:30:00.00+01:15" :: LT.Text
182 let ts7 = "2015-01-01T12:30:00.00-02" :: LT.Text
183 let ts8 = "2015-01-01T22:00:00.00-03" :: LT.Text
184 let ts9 = "2015-01-01T22:00:00.00-04:30" :: LT.Text
185 let (Just (t5 :: UTCTime)) = parseWithAeson ts5
186 let (Just (t6 :: UTCTime)) = parseWithAeson ts6
187 let (Just (t7 :: UTCTime)) = parseWithAeson ts7
188 let (Just (t8 :: UTCTime)) = parseWithAeson ts8
189 let (Just (t9 :: UTCTime)) = parseWithAeson ts9
190 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T12:30:00.00Z") t5
191 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T11:15:00.00Z") t6
192 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t7
193 -- ts8 wraps around to the next day in UTC
194 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T01:00:00Z") t8
195 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T02:30:00Z") t9
197 -- Seconds in Time can be omitted
198 let ts10 = "2015-01-03T12:13Z" :: LT.Text
199 let ts11 = "2015-01-03 12:13Z" :: LT.Text
200 let ts12 = "2015-01-01T12:30-02" :: LT.Text
201 let (Just (t10 :: UTCTime)) = parseWithAeson ts10
202 let (Just (t11 :: UTCTime)) = parseWithAeson ts11
203 let (Just (t12 :: UTCTime)) = parseWithAeson ts12
204 assertEqual "utctime" (parseWithRead "%FT%H:%MZ" ts10) t10
205 assertEqual "utctime" (parseWithRead "%F %H:%MZ" ts11) t11
206 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t12
208 where
209 parseWithRead :: String -> LT.Text -> UTCTime
210 parseWithRead f s =
211 case parseTime defaultTimeLocale f . LT.unpack $ s of
212 Nothing -> error "parseTime input malformed"
213 Just t -> t
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 where
230 verifyFailParse (s :: LT.Text) =
231 let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""]) in
232 assertEqual "verify failure" Nothing dec
234-- Non identifier keys should be escaped & enclosed in brackets
235formatErrorExample :: Assertion
236formatErrorExample =
237 let rhs = formatError [Index 0, Key "foo", Key "bar", Key "a.b.c", Key "", Key "'\\", Key "end"] "error msg"
238 lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
239 in assertEqual "formatError example" lhs rhs
241------------------------------------------------------------------------------
242-- Comparison (.:?) and (.:!)
243------------------------------------------------------------------------------
245newtype T1 = T1 (Maybe Int) deriving (Eq, Show)
246newtype T2 = T2 (Maybe Int) deriving (Eq, Show)
247newtype T3 = T3 (Maybe Int) deriving (Eq, Show)
249instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")
250instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")
251instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")
253dotColonMark :: [Assertion]
254dotColonMark = [
255 assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1)
256 , assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)
257 , assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1)
259 , assertEqual ".:? not-present" (Just (T2 (Nothing))) (decode ex1 :: Maybe T2)
260 , assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2)
261 , assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2)
263 , assertEqual ".:! not-present" (Just (T3 (Nothing))) (decode ex1 :: Maybe T3)
264 , assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3)
265 , assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3)
266 ]
267 where ex1 = "{}"
268 ex2 = "{\"value\": 42 }"
269 ex3 = "{\"value\": null }"
271------------------------------------------------------------------------------
272-- These tests assert that the JSON serialization doesn't change by accident.
273-----------------------------------------------------------------------------
275data Example where
276 Example
277 :: (Eq a, Show a, ToJSON a, FromJSON a)
278 => String -> L.ByteString -> a -> Example
279 MaybeExample
280 :: (Eq a, Show a, FromJSON a)
281 => String -> L.ByteString -> Maybe a -> Example
283assertJsonExample :: Example -> Test
284assertJsonExample (Example name bs val) = testCase name $ do
285 assertEqual "encode" bs (encode val)
286 assertEqual "encode/via value" bs (encode $ toJSON val)
287 assertEqual "decode" (Just val) (decode bs)
288assertJsonExample (MaybeExample name bs mval) = testCase name $
289 assertEqual "decode" mval (decode bs)
291assertJsonEncodingExample :: Example -> Test
292assertJsonEncodingExample (Example name bs val) = testCase name $ do
293 assertEqual "encode" bs (encode val)
294 assertEqual "encode/via value" bs (encode $ toJSON val)
295assertJsonEncodingExample (MaybeExample name _ _) = testCase name $
296 assertFailure "cannot encode MaybeExample"
298jsonEncodingExamples :: [Example]
299jsonEncodingExamples =
300 [
301 -- Maybe serialising is lossy
302 -- https://github.com/bos/aeson/issues/376
303 Example "Just Nothing" "null" (Just Nothing :: Maybe (Maybe Int))
304 -- infinities cannot be recovered, null is decoded as NaN
305 , Example "inf :: Double" "null" (Approx $ 1/0 :: Approx Double)
306 ]
308jsonDecodingExamples :: [Example]
309jsonDecodingExamples = [
310 -- Maybe serialising is lossy
311 -- https://github.com/bos/aeson/issues/376
312 MaybeExample "Nothing" "null" (Just $ Nothing :: Maybe (Maybe Int))
313 , MaybeExample "Just" "1" (Just $ Just 1 :: Maybe (Maybe Int))
314 , MaybeExample "Just Nothing" "null" (Just $ Nothing :: Maybe (Maybe (Maybe Int)))
315 -- Integral values are truncated, and overflowed
316 -- https://github.com/bos/aeson/issues/317
317 , MaybeExample "Word8 3" "3" (Just 3 :: Maybe Word8)
318 , MaybeExample "Word8 3.00" "3.00" (Just 3 :: Maybe Word8)
319 , MaybeExample "Word8 3.14" "3.14" (Nothing :: Maybe Word8)
320 , MaybeExample "Word8 -1" "-1" (Nothing :: Maybe Word8)
321 , MaybeExample "Word8 300" "300" (Nothing :: Maybe Word8)
322 ]
324jsonExamples :: [Example]
325jsonExamples =
326 [
327 Example "Either Left" "{\"Left\":1}" (Left 1 :: Either Int Int)
328 , Example "Either Right" "{\"Right\":1}" (Right 1 :: Either Int Int)
329 , Example "Nothing" "null" (Nothing :: Maybe Int)
330 , Example "Just" "1" (Just 1 :: Maybe Int)
331 , Example "Proxy Int" "null" (Proxy :: Proxy Int)
332 , Example "Tagged Char Int" "1" (Tagged 1 :: Tagged Char Int)
333#if __GLASGOW_HASKELL__ >= 708
334 -- Test Tagged instance is polykinded
335 , Example "Tagged 123 Int" "1" (Tagged 1 :: Tagged 123 Int)
336#endif
337 , Example "Const Char Int" "\"c\"" (Const 'c' :: Const Char Int)
338 , Example "Tuple" "[1,2]" ((1, 2) :: (Int, Int))
339 , Example "NonEmpty" "[1,2,3]" (1 :| [2, 3] :: NonEmpty Int)
340 , Example "Seq" "[1,2,3]" (Seq.fromList [1, 2, 3] :: Seq.Seq Int)
341 , Example "DList" "[1,2,3]" (DList.fromList [1, 2, 3] :: DList.DList Int)
342 , Example "()" "[]" ()
344 , Example "HashMap Int Int" "{\"0\":1,\"2\":3}" (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)
345 , Example "Map Int Int" "{\"0\":1,\"2\":3}" (M.fromList [(0,1),(2,3)] :: M.Map Int Int)
346 , Example "Map (Tagged Int Int) Int" "{\"0\":1,\"2\":3}" (M.fromList [(Tagged 0,1),(Tagged 2,3)] :: M.Map (Tagged Int Int) Int)
347 , Example "Map [Int] Int" "[[[0],1],[[2],3]]" (M.fromList [([0],1),([2],3)] :: M.Map [Int] Int)
348 , Example "Map [Char] Int" "{\"ab\":1,\"cd\":3}" (M.fromList [("ab",1),("cd",3)] :: M.Map [Char] Int)
349 , Example "Map [I Char] Int" "{\"ab\":1,\"cd\":3}" (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)
351 , Example "nan :: Double" "null" (Approx $ 0/0 :: Approx Double)
353 , Example "Ordering LT" "\"LT\"" LT
354 , Example "Ordering EQ" "\"EQ\"" EQ
355 , Example "Ordering GT" "\"GT\"" GT
357 , Example "Float" "3.14" (3.14 :: Float)
358 , Example "Pico" "3.14" (3.14 :: Pico)
359 , Example "Scientific" "3.14" (3.14 :: Scientific)
361 , Example "Set Int" "[1,2,3]" (Set.fromList [3, 2, 1] :: Set.Set Int)
362 , Example "IntSet" "[1,2,3]" (IntSet.fromList [3, 2, 1])
363 , Example "IntMap" "[[1,2],[3,4]]" (IntMap.fromList [(3,4), (1,2)] :: IntMap.IntMap Int)
364 , Example "Vector" "[1,2,3]" (Vector.fromList [1, 2, 3] :: Vector.Vector Int)
365 , Example "HashSet Int" "[1,2,3]" (HashSet.fromList [3, 2, 1] :: HashSet.HashSet Int)
366 , Example "Tree Int" "[1,[[2,[[3,[]],[4,[]]]],[5,[]]]]" (let n = Tree.Node in n 1 [n 2 [n 3 [], n 4 []], n 5 []] :: Tree.Tree Int)
368 -- Three separate cases, as ordering in HashMap is not defined
369 , Example "HashMap Float Int, NaN" "{\"NaN\":1}" (Approx $ HM.singleton (0/0) 1 :: Approx (HM.HashMap Float Int))
370 , Example "HashMap Float Int, Infinity" "{\"Infinity\":1}" (HM.singleton (1/0) 1 :: HM.HashMap Float Int)
371 , Example "HashMap Float Int, +Infinity" "{\"-Infinity\":1}" (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)
373 -- Functors
374 , Example "Identity Int" "1" (pure 1 :: Identity Int)
376 , Example "Identity Char" "\"x\"" (pure 'x' :: Identity Char)
377 , Example "Identity String" "\"foo\"" (pure "foo" :: Identity String)
378 , Example "[Identity Char]" "\"xy\"" ([pure 'x', pure 'y'] :: [Identity Char])
380 , Example "Maybe Char" "\"x\"" (pure 'x' :: Maybe Char)
381 , Example "Maybe String" "\"foo\"" (pure "foo" :: Maybe String)
382 , Example "Maybe [Identity Char]" "\"xy\"" (pure [pure 'x', pure 'y'] :: Maybe [Identity Char])
384 , Example "Product I Maybe Int" "[1,2]" (Pair (pure 1) (pure 2) :: Product I Maybe Int)
385 , Example "Product I Maybe Int" "[1,null]" (Pair (pure 1) Nothing :: Product I Maybe Int)
386 , Example "Product I [] Char" "[\"a\",\"foo\"]" (Pair (pure 'a') "foo" :: Product I [] Char)
388 , Example "Sum I [] Int: InL" "{\"InL\":1}" (InL (pure 1) :: Sum I [] Int)
389 , Example "Sum I [] Int: InR" "{\"InR\":[1,2]}" (InR [1, 2] :: Sum I [] Int)
390 , Example "Sum I [] Char: InR" "{\"InR\":\"foo\"}" (InR "foo" :: Sum I [] Char)
392 , Example "Compose I I Int" "1" (pure 1 :: Compose I I Int)
393 , Example "Compose I [] Int" "[1]" (pure 1 :: Compose I [] Int)
394 , Example "Compose [] I Int" "[1]" (pure 1 :: Compose [] I Int)
395 , Example "Compose [] [] Int" "[[1]]" (pure 1 :: Compose [] [] Int)
397 , Example "Compose I I Char" "\"x\"" (pure 'x' :: Compose I I Char)
398 , Example "Compose I [] Char" "\"x\"" (pure 'x' :: Compose I [] Char)
399 , Example "Compose [] I Char" "\"x\"" (pure 'x' :: Compose [] I Char)
400 , Example "Compose [] [] Char" "[\"x\"]" (pure 'x' :: Compose [] [] Char)
402 , Example "Compose3 I I I Char" "\"x\"" (pure 'x' :: Compose3 I I I Char)
403 , Example "Compose3 I I [] Char" "\"x\"" (pure 'x' :: Compose3 I I [] Char)
404 , Example "Compose3 I [] I Char" "\"x\"" (pure 'x' :: Compose3 I [] I Char)
405 , Example "Compose3 I [] [] Char" "[\"x\"]" (pure 'x' :: Compose3 I [] [] Char)
406 , Example "Compose3 [] I I Char" "\"x\"" (pure 'x' :: Compose3 [] I I Char)
407 , Example "Compose3 [] I [] Char" "[\"x\"]" (pure 'x' :: Compose3 [] I [] Char)
408 , Example "Compose3 [] [] I Char" "[\"x\"]" (pure 'x' :: Compose3 [] [] I Char)
409 , Example "Compose3 [] [] [] Char" "[[\"x\"]]" (pure 'x' :: Compose3 [] [] [] Char)
411 , Example "Compose3' I I I Char" "\"x\"" (pure 'x' :: Compose3' I I I Char)
412 , Example "Compose3' I I [] Char" "\"x\"" (pure 'x' :: Compose3' I I [] Char)
413 , Example "Compose3' I [] I Char" "\"x\"" (pure 'x' :: Compose3' I [] I Char)
414 , Example "Compose3' I [] [] Char" "[\"x\"]" (pure 'x' :: Compose3' I [] [] Char)
415 , Example "Compose3' [] I I Char" "\"x\"" (pure 'x' :: Compose3' [] I I Char)
416 , Example "Compose3' [] I [] Char" "[\"x\"]" (pure 'x' :: Compose3' [] I [] Char)
417 , Example "Compose3' [] [] I Char" "[\"x\"]" (pure 'x' :: Compose3' [] [] I Char)
418 , Example "Compose3' [] [] [] Char" "[[\"x\"]]" (pure 'x' :: Compose3' [] [] [] Char)
420 , Example "MyEither Int String: Left" "42" (MyLeft 42 :: MyEither Int String)
421 , Example "MyEither Int String: Right" "\"foo\"" (MyRight "foo" :: MyEither Int String)
422 ]
426------------------------------------------------------------------------------
427-- These tests check that JSONPath is tracked correctly
428-----------------------------------------------------------------------------
430jsonPath :: [Assertion]
431jsonPath = [
432 -- issue #356
433 assertEqual "Either"
434 (Left "Error in $[1].Left[1]: expected Bool, encountered Number")
435 (eitherDecode "[1,{\"Left\":[2,3]}]"
436 :: Either String (Int, Either (Int, Bool) ()))
437 -- issue #358
438 , assertEqual "Seq a"
439 (Left "Error in $[2]: expected Int, encountered Boolean")
440 (eitherDecode "[0,1,true]" :: Either String (Seq Int))
441 , assertEqual "Wibble"
442 (Left "Error in $.wibbleInt: expected Int, encountered Boolean")
443 (eitherDecode "{\"wibbleString\":\"\",\"wibbleInt\":true}"
444 :: Either String Wibble)
445 ]
447------------------------------------------------------------------------------
448-- Check that the hashes of two equal Value are the same
449------------------------------------------------------------------------------
451hashableLaws :: [Assertion]
452hashableLaws = [
453 assertEqual "Hashable Object" (hash a) (hash b)
454 ]
455 where
456 a = object ["223" .= False, "807882556" .= True]
457 b = object ["807882556" .= True, "223" .= False]
459-------------------------------------------------------------------------------
460-- ToJSONKey
461-------------------------------------------------------------------------------
463newtype MyText = MyText Text
464 deriving (FromJSONKey)
466newtype MyText' = MyText' Text
468instance FromJSONKey MyText' where
469 fromJSONKey = fmap MyText' fromJSONKey
470 fromJSONKeyList = error "not used"
472fromJSONKeyAssertions :: [Assertion]
473fromJSONKeyAssertions =
474 [ assertIsCoerce "Text" (fromJSONKey :: FromJSONKeyFunction Text)
475 , assertIsCoerce "Tagged Int Text" (fromJSONKey :: FromJSONKeyFunction (Tagged Int Text))
476 , assertIsCoerce "MyText" (fromJSONKey :: FromJSONKeyFunction MyText)
478#if __GLASGOW_HASKELL__ >= 710
479 , assertIsCoerce' "MyText'" (fromJSONKey :: FromJSONKeyFunction MyText')
480#endif
481 ]
482 where
483 assertIsCoerce _ (FromJSONKeyCoerce _) = pure ()
484 assertIsCoerce n _ = assertFailure n
486#if __GLASGOW_HASKELL__ >= 710
487 assertIsCoerce' _ (FromJSONKeyCoerce _) = pure ()
488 assertIsCoerce' n _ = pickWithRules (assertFailure n) (pure ())
490-- | Pick the first when RULES are enabled, e.g. optimisations are on
491pickWithRules
492 :: a -- ^ Pick this when RULES are on
493 -> a -- ^ use this otherwise
494 -> a
495pickWithRules _ = id
496{-# NOINLINE pickWithRules #-}
497{-# RULES "pickWithRules/rule" [0] forall x. pickWithRules x = const x #-}
498#endif
500------------------------------------------------------------------------------
501-- Regressions
502------------------------------------------------------------------------------
504-- A regression test for: https://github.com/bos/aeson/issues/351
505overlappingRegression :: FromJSON a => L.ByteString -> [a]
506overlappingRegression bs = fromMaybe [] $ decode bs
508issue351 :: [Assertion]
509issue351 = [
510 assertEqual "Int" ([1, 2, 3] :: [Int]) $ overlappingRegression "[1, 2, 3]"
511 , assertEqual "Char" ("abc" :: String) $ overlappingRegression "\"abc\""
512 , assertEqual "Char" ("" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"
513 ]
515------------------------------------------------------------------------------
516-- Comparison between bytestring and text encoders
517------------------------------------------------------------------------------
519ioTests :: IO [Test]
520ioTests = do
521 enc <- encoderComparisonTests
522 return [enc]
524encoderComparisonTests :: IO Test
525encoderComparisonTests = do
526 encoderTests <- forM testFiles $ \file0 -> do
527 let file = "benchmarks/json-data/" ++ file0
528 return $ testCase file $ do
529 inp <- L.readFile file
530 case eitherDecode inp of
531 Left err -> assertFailure $ "Decoding failure: " ++ err
532 Right val -> assertEqual "" (encode val) (encodeViaText val)
533 return $ testGroup "encoders" encoderTests
534 where
535 encodeViaText :: Value -> L.ByteString
536 encodeViaText =
537 TLE.encodeUtf8 . TLB.toLazyText . encodeToTextBuilder . toJSON
539 testFiles =
540 [ "example.json"
541 , "integers.json"
542 , "jp100.json"
543 , "numbers.json"
544 , "twitter10.json"
545 , "twitter20.json"
546 , "geometry.json"
547 , "jp10.json"
548 , "jp50.json"
549 , "twitter1.json"
550 , "twitter100.json"
551 , "twitter50.json"
552 ]
554-- A regression test for: https://github.com/bos/aeson/issues/293
555data MyRecord = MyRecord {_field1 :: Maybe Int, _field2 :: Maybe Bool}
557data MyRecord2 = MyRecord2 {_field3 :: Maybe Int, _field4 :: Maybe Bool}
558 deriving Generic
560instance ToJSON MyRecord2
561instance FromJSON MyRecord2
563-- A regression test for: https://github.com/bos/aeson/pull/455
564data Foo a = FooNil | FooCons (Foo Int)
566pr455 :: Assertion
567pr455 = assertEqual "FooCons FooNil"
568 (toJSON foo) (liftToJSON undefined undefined foo)
569 where
570 foo :: Foo Int
571 foo = FooCons FooNil
573deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord
575deriveToJSON defaultOptions ''Foo
576deriveToJSON1 defaultOptions ''Foo