git.iko.soy/typeable/aeson
on 1.0.2.0 help sign in
typeable/aeson/tests/UnitTests.hs
590 lines 26 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.Monoid as Monoid
63import qualified Data.Semigroup as Semigroup
64import qualified Data.Sequence as Seq
65import qualified Data.Set as Set
66import qualified Data.Text.Lazy as LT
67import qualified Data.Text.Lazy.Builder as TLB
68import qualified Data.Text.Lazy.Encoding as LT
69import qualified Data.Text.Lazy.Encoding as TLE
70import qualified Data.Tree as Tree
71import qualified Data.Vector as Vector
73tests :: Test
74tests = testGroup "unit" [
75 testGroup "camelCase" [
76 testCase "camelTo" $ roundTripCamel "aName"
77 , testCase "camelTo" $ roundTripCamel "another"
78 , testCase "camelTo" $ roundTripCamel "someOtherName"
79 , testCase "camelTo" $
80 assertEqual "" "camel_apicase" (camelTo '_' "CamelAPICase")
81 , testCase "camelTo2" $ roundTripCamel2 "aName"
82 , testCase "camelTo2" $ roundTripCamel2 "another"
83 , testCase "camelTo2" $ roundTripCamel2 "someOtherName"
84 , testCase "camelTo2" $
85 assertEqual "" "camel_api_case" (camelTo2 '_' "CamelAPICase")
86 ]
87 , testGroup "encoding" [
88 testCase "goodProducer" $ goodProducer
89 ]
90 , testGroup "utctime" [
91 testCase "good" $ utcTimeGood
92 , testCase "bad" $ utcTimeBad
93 ]
94 , testGroup "formatError" [
95 testCase "example 1" $ formatErrorExample
96 ]
97 , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
98 , testGroup "To JSON representation" $ fmap assertJsonEncodingExample jsonEncodingExamples
99 , testGroup "From JSON representation" $ fmap assertJsonExample jsonDecodingExamples
100 , testGroup "To/From JSON representation" $ fmap assertJsonExample jsonExamples
101 , testGroup "JSONPath" $ fmap (testCase "-") jsonPath
102 , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws
103 , testGroup "Issue #351" $ fmap (testCase "-") issue351
104 , testGroup "Nullary constructors" $ fmap (testCase "-") nullaryConstructors
105 , testGroup "FromJSONKey" $ fmap (testCase "-") fromJSONKeyAssertions
106 , testCase "PR #455" pr455
107 ]
109roundTripCamel :: String -> Assertion
110roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name)
112roundTripCamel2 :: String -> Assertion
113roundTripCamel2 name = assertEqual "" name (camelFrom '_' $ camelTo2 '_' name)
115camelFrom :: Char -> String -> String
116camelFrom c s = let (p:ps) = split c s
117 in concat $ p : map capitalize ps
118 where
119 split c' s' = map L.unpack $ L.split c' $ L.pack s'
120 capitalize t = toUpper (head t) : tail t
123data MyEither a b = MyLeft a | MyRight b
124 deriving (Generic, Show, Eq)
126instance (ToJSON a, ToJSON b) => ToJSON (MyEither a b) where
127 toJSON = genericToJSON defaultOptions { sumEncoding = UntaggedValue }
128 toEncoding = genericToEncoding defaultOptions { sumEncoding = UntaggedValue }
130instance (FromJSON a, FromJSON b) => FromJSON (MyEither a b) where
131 parseJSON = genericParseJSON defaultOptions { sumEncoding = UntaggedValue }
134data Wibble = Wibble {
135 wibbleString :: String
136 , wibbleInt :: Int
137 } deriving (Generic, Show, Eq)
139instance FromJSON Wibble
141instance ToJSON Wibble where
142 toJSON = genericToJSON defaultOptions
143 toEncoding = genericToEncoding defaultOptions
145-- Test that if we put a bomb in a data structure, but only demand
146-- part of it via lazy encoding, we do not unexpectedly fail.
147goodProducer :: Assertion
148goodProducer = assertEqual "partial encoding should not explode on undefined"
149 '{' (L.head (encode wibble))
150 where
151 wibble = Wibble {
152 wibbleString = replicate k 'a'
153 , wibbleInt = 1
154 }
155 k | arch32bit = 4047
156 | otherwise = 4030
157 arch32bit = (maxBound :: Int) == 2147483647
159-- Test decoding various UTC time formats
160--
161-- Note: the incomplete pattern matches for UTCTimes are completely
162-- intentional. The test expects these parses to succeed. If the
163-- pattern matches fails, there's a bug in either the test or in aeson
164-- and needs to be investigated.
165utcTimeGood :: Assertion
166utcTimeGood = do
167 let ts1 = "2015-01-01T12:13:00.00Z" :: LT.Text
168 let ts2 = "2015-01-01T12:13:00Z" :: LT.Text
169 -- 'T' between date and time is not required, can be space
170 let ts3 = "2015-01-03 12:13:00.00Z" :: LT.Text
171 let ts4 = "2015-01-03 12:13:00.125Z" :: LT.Text
172 let (Just (t1 :: UTCTime)) = parseWithAeson ts1
173 let (Just (t2 :: UTCTime)) = parseWithAeson ts2
174 let (Just (t3 :: UTCTime)) = parseWithAeson ts3
175 let (Just (t4 :: UTCTime)) = parseWithAeson ts4
176 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts1) t1
177 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts2) t2
178 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts3) t3
179 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts4) t4
180 -- Time zones. Both +HHMM and +HH:MM are allowed for timezone
181 -- offset, and MM may be omitted.
182 let ts5 = "2015-01-01T12:30:00.00+00" :: LT.Text
183 let ts6 = "2015-01-01T12:30:00.00+01:15" :: LT.Text
184 let ts7 = "2015-01-01T12:30:00.00-02" :: LT.Text
185 let ts8 = "2015-01-01T22:00:00.00-03" :: LT.Text
186 let ts9 = "2015-01-01T22:00:00.00-04:30" :: LT.Text
187 let (Just (t5 :: UTCTime)) = parseWithAeson ts5
188 let (Just (t6 :: UTCTime)) = parseWithAeson ts6
189 let (Just (t7 :: UTCTime)) = parseWithAeson ts7
190 let (Just (t8 :: UTCTime)) = parseWithAeson ts8
191 let (Just (t9 :: UTCTime)) = parseWithAeson ts9
192 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T12:30:00.00Z") t5
193 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T11:15:00.00Z") t6
194 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t7
195 -- ts8 wraps around to the next day in UTC
196 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T01:00:00Z") t8
197 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T02:30:00Z") t9
199 -- Seconds in Time can be omitted
200 let ts10 = "2015-01-03T12:13Z" :: LT.Text
201 let ts11 = "2015-01-03 12:13Z" :: LT.Text
202 let ts12 = "2015-01-01T12:30-02" :: LT.Text
203 let (Just (t10 :: UTCTime)) = parseWithAeson ts10
204 let (Just (t11 :: UTCTime)) = parseWithAeson ts11
205 let (Just (t12 :: UTCTime)) = parseWithAeson ts12
206 assertEqual "utctime" (parseWithRead "%FT%H:%MZ" ts10) t10
207 assertEqual "utctime" (parseWithRead "%F %H:%MZ" ts11) t11
208 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t12
210 where
211 parseWithRead :: String -> LT.Text -> UTCTime
212 parseWithRead f s =
213 case parseTime defaultTimeLocale f . LT.unpack $ s of
214 Nothing -> error "parseTime input malformed"
215 Just t -> t
216 parseWithAeson :: LT.Text -> Maybe UTCTime
217 parseWithAeson s = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""])
219-- Test that a few non-timezone qualified timestamp formats get
220-- rejected if decoding to UTCTime.
221utcTimeBad :: Assertion
222utcTimeBad = do
223 verifyFailParse "2000-01-01T12:13:00" -- missing Zulu time not allowed (some TZ required)
224 verifyFailParse "2000-01-01 12:13:00" -- missing Zulu time not allowed (some TZ required)
225 verifyFailParse "2000-01-01" -- date only not OK
226 verifyFailParse "2000-01-01Z" -- date only not OK
227 verifyFailParse "2015-01-01T12:30:00.00+00Z" -- no Zulu if offset given
228 verifyFailParse "2015-01-01T12:30:00.00+00:00Z" -- no Zulu if offset given
229 verifyFailParse "2015-01-03 12:13:00.Z" -- decimal at the end but no digits
230 verifyFailParse "2015-01-03 12:13.000Z" -- decimal at the end, but no seconds
231 where
232 verifyFailParse (s :: LT.Text) =
233 let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""]) in
234 assertEqual "verify failure" Nothing dec
236-- Non identifier keys should be escaped & enclosed in brackets
237formatErrorExample :: Assertion
238formatErrorExample =
239 let rhs = formatError [Index 0, Key "foo", Key "bar", Key "a.b.c", Key "", Key "'\\", Key "end"] "error msg"
240 lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
241 in assertEqual "formatError example" lhs rhs
243------------------------------------------------------------------------------
244-- Comparison (.:?) and (.:!)
245------------------------------------------------------------------------------
247newtype T1 = T1 (Maybe Int) deriving (Eq, Show)
248newtype T2 = T2 (Maybe Int) deriving (Eq, Show)
249newtype T3 = T3 (Maybe Int) deriving (Eq, Show)
251instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")
252instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")
253instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")
255dotColonMark :: [Assertion]
256dotColonMark = [
257 assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1)
258 , assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)
259 , assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1)
261 , assertEqual ".:? not-present" (Just (T2 (Nothing))) (decode ex1 :: Maybe T2)
262 , assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2)
263 , assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2)
265 , assertEqual ".:! not-present" (Just (T3 (Nothing))) (decode ex1 :: Maybe T3)
266 , assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3)
267 , assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3)
268 ]
269 where ex1 = "{}"
270 ex2 = "{\"value\": 42 }"
271 ex3 = "{\"value\": null }"
273------------------------------------------------------------------------------
274-- These tests assert that the JSON serialization doesn't change by accident.
275-----------------------------------------------------------------------------
277data Example where
278 Example
279 :: (Eq a, Show a, ToJSON a, FromJSON a)
280 => String -> L.ByteString -> a -> Example
281 MaybeExample
282 :: (Eq a, Show a, FromJSON a)
283 => String -> L.ByteString -> Maybe a -> Example
285assertJsonExample :: Example -> Test
286assertJsonExample (Example name bs val) = testCase name $ do
287 assertEqual "encode" bs (encode val)
288 assertEqual "encode/via value" bs (encode $ toJSON val)
289 assertEqual "decode" (Just val) (decode bs)
290assertJsonExample (MaybeExample name bs mval) = testCase name $
291 assertEqual "decode" mval (decode bs)
293assertJsonEncodingExample :: Example -> Test
294assertJsonEncodingExample (Example name bs val) = testCase name $ do
295 assertEqual "encode" bs (encode val)
296 assertEqual "encode/via value" bs (encode $ toJSON val)
297assertJsonEncodingExample (MaybeExample name _ _) = testCase name $
298 assertFailure "cannot encode MaybeExample"
300jsonEncodingExamples :: [Example]
301jsonEncodingExamples =
302 [
303 -- Maybe serialising is lossy
304 -- https://github.com/bos/aeson/issues/376
305 Example "Just Nothing" "null" (Just Nothing :: Maybe (Maybe Int))
306 -- infinities cannot be recovered, null is decoded as NaN
307 , Example "inf :: Double" "null" (Approx $ 1/0 :: Approx Double)
308 ]
310jsonDecodingExamples :: [Example]
311jsonDecodingExamples = [
312 -- Maybe serialising is lossy
313 -- https://github.com/bos/aeson/issues/376
314 MaybeExample "Nothing" "null" (Just $ Nothing :: Maybe (Maybe Int))
315 , MaybeExample "Just" "1" (Just $ Just 1 :: Maybe (Maybe Int))
316 , MaybeExample "Just Nothing" "null" (Just $ Nothing :: Maybe (Maybe (Maybe Int)))
317 -- Integral values are truncated, and overflowed
318 -- https://github.com/bos/aeson/issues/317
319 , MaybeExample "Word8 3" "3" (Just 3 :: Maybe Word8)
320 , MaybeExample "Word8 3.00" "3.00" (Just 3 :: Maybe Word8)
321 , MaybeExample "Word8 3.14" "3.14" (Nothing :: Maybe Word8)
322 , MaybeExample "Word8 -1" "-1" (Nothing :: Maybe Word8)
323 , MaybeExample "Word8 300" "300" (Nothing :: Maybe Word8)
324 ]
326jsonExamples :: [Example]
327jsonExamples =
328 [
329 Example "Either Left" "{\"Left\":1}" (Left 1 :: Either Int Int)
330 , Example "Either Right" "{\"Right\":1}" (Right 1 :: Either Int Int)
331 , Example "Nothing" "null" (Nothing :: Maybe Int)
332 , Example "Just" "1" (Just 1 :: Maybe Int)
333 , Example "Proxy Int" "null" (Proxy :: Proxy Int)
334 , Example "Tagged Char Int" "1" (Tagged 1 :: Tagged Char Int)
335#if __GLASGOW_HASKELL__ >= 708
336 -- Test Tagged instance is polykinded
337 , Example "Tagged 123 Int" "1" (Tagged 1 :: Tagged 123 Int)
338#endif
339 , Example "Const Char Int" "\"c\"" (Const 'c' :: Const Char Int)
340 , Example "Tuple" "[1,2]" ((1, 2) :: (Int, Int))
341 , Example "NonEmpty" "[1,2,3]" (1 :| [2, 3] :: NonEmpty Int)
342 , Example "Seq" "[1,2,3]" (Seq.fromList [1, 2, 3] :: Seq.Seq Int)
343 , Example "DList" "[1,2,3]" (DList.fromList [1, 2, 3] :: DList.DList Int)
344 , Example "()" "[]" ()
346 , Example "HashMap Int Int" "{\"0\":1,\"2\":3}" (HM.fromList [(0,1),(2,3)] :: HM.HashMap Int Int)
347 , Example "Map Int Int" "{\"0\":1,\"2\":3}" (M.fromList [(0,1),(2,3)] :: M.Map Int Int)
348 , Example "Map (Tagged Int Int) Int" "{\"0\":1,\"2\":3}" (M.fromList [(Tagged 0,1),(Tagged 2,3)] :: M.Map (Tagged Int Int) Int)
349 , Example "Map [Int] Int" "[[[0],1],[[2],3]]" (M.fromList [([0],1),([2],3)] :: M.Map [Int] Int)
350 , Example "Map [Char] Int" "{\"ab\":1,\"cd\":3}" (M.fromList [("ab",1),("cd",3)] :: M.Map [Char] Int)
351 , Example "Map [I Char] Int" "{\"ab\":1,\"cd\":3}" (M.fromList [(map pure "ab",1),(map pure "cd",3)] :: M.Map [I Char] Int)
353 , Example "nan :: Double" "null" (Approx $ 0/0 :: Approx Double)
355 , Example "Ordering LT" "\"LT\"" LT
356 , Example "Ordering EQ" "\"EQ\"" EQ
357 , Example "Ordering GT" "\"GT\"" GT
359 , Example "Float" "3.14" (3.14 :: Float)
360 , Example "Pico" "3.14" (3.14 :: Pico)
361 , Example "Scientific" "3.14" (3.14 :: Scientific)
363 , Example "Set Int" "[1,2,3]" (Set.fromList [3, 2, 1] :: Set.Set Int)
364 , Example "IntSet" "[1,2,3]" (IntSet.fromList [3, 2, 1])
365 , Example "IntMap" "[[1,2],[3,4]]" (IntMap.fromList [(3,4), (1,2)] :: IntMap.IntMap Int)
366 , Example "Vector" "[1,2,3]" (Vector.fromList [1, 2, 3] :: Vector.Vector Int)
367 , Example "HashSet Int" "[1,2,3]" (HashSet.fromList [3, 2, 1] :: HashSet.HashSet Int)
368 , 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)
370 -- Three separate cases, as ordering in HashMap is not defined
371 , Example "HashMap Float Int, NaN" "{\"NaN\":1}" (Approx $ HM.singleton (0/0) 1 :: Approx (HM.HashMap Float Int))
372 , Example "HashMap Float Int, Infinity" "{\"Infinity\":1}" (HM.singleton (1/0) 1 :: HM.HashMap Float Int)
373 , Example "HashMap Float Int, +Infinity" "{\"-Infinity\":1}" (HM.singleton (negate 1/0) 1 :: HM.HashMap Float Int)
375 -- Functors
376 , Example "Identity Int" "1" (pure 1 :: Identity Int)
378 , Example "Identity Char" "\"x\"" (pure 'x' :: Identity Char)
379 , Example "Identity String" "\"foo\"" (pure "foo" :: Identity String)
380 , Example "[Identity Char]" "\"xy\"" ([pure 'x', pure 'y'] :: [Identity Char])
382 , Example "Maybe Char" "\"x\"" (pure 'x' :: Maybe Char)
383 , Example "Maybe String" "\"foo\"" (pure "foo" :: Maybe String)
384 , Example "Maybe [Identity Char]" "\"xy\"" (pure [pure 'x', pure 'y'] :: Maybe [Identity Char])
386 , Example "Product I Maybe Int" "[1,2]" (Pair (pure 1) (pure 2) :: Product I Maybe Int)
387 , Example "Product I Maybe Int" "[1,null]" (Pair (pure 1) Nothing :: Product I Maybe Int)
388 , Example "Product I [] Char" "[\"a\",\"foo\"]" (Pair (pure 'a') "foo" :: Product I [] Char)
390 , Example "Sum I [] Int: InL" "{\"InL\":1}" (InL (pure 1) :: Sum I [] Int)
391 , Example "Sum I [] Int: InR" "{\"InR\":[1,2]}" (InR [1, 2] :: Sum I [] Int)
392 , Example "Sum I [] Char: InR" "{\"InR\":\"foo\"}" (InR "foo" :: Sum I [] Char)
394 , Example "Compose I I Int" "1" (pure 1 :: Compose I I Int)
395 , Example "Compose I [] Int" "[1]" (pure 1 :: Compose I [] Int)
396 , Example "Compose [] I Int" "[1]" (pure 1 :: Compose [] I Int)
397 , Example "Compose [] [] Int" "[[1]]" (pure 1 :: Compose [] [] Int)
399 , Example "Compose I I Char" "\"x\"" (pure 'x' :: Compose I I Char)
400 , Example "Compose I [] Char" "\"x\"" (pure 'x' :: Compose I [] Char)
401 , Example "Compose [] I Char" "\"x\"" (pure 'x' :: Compose [] I Char)
402 , Example "Compose [] [] Char" "[\"x\"]" (pure 'x' :: Compose [] [] Char)
404 , Example "Compose3 I I I Char" "\"x\"" (pure 'x' :: Compose3 I I I Char)
405 , Example "Compose3 I I [] Char" "\"x\"" (pure 'x' :: Compose3 I 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 I Char" "\"x\"" (pure 'x' :: Compose3 [] I I Char)
409 , Example "Compose3 [] I [] Char" "[\"x\"]" (pure 'x' :: Compose3 [] I [] Char)
410 , Example "Compose3 [] [] I Char" "[\"x\"]" (pure 'x' :: Compose3 [] [] I Char)
411 , Example "Compose3 [] [] [] Char" "[[\"x\"]]" (pure 'x' :: Compose3 [] [] [] Char)
413 , Example "Compose3' I I I Char" "\"x\"" (pure 'x' :: Compose3' I I I Char)
414 , Example "Compose3' I I [] Char" "\"x\"" (pure 'x' :: Compose3' I 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 I Char" "\"x\"" (pure 'x' :: Compose3' [] I I Char)
418 , Example "Compose3' [] I [] Char" "[\"x\"]" (pure 'x' :: Compose3' [] I [] Char)
419 , Example "Compose3' [] [] I Char" "[\"x\"]" (pure 'x' :: Compose3' [] [] I Char)
420 , Example "Compose3' [] [] [] Char" "[[\"x\"]]" (pure 'x' :: Compose3' [] [] [] Char)
422 , Example "MyEither Int String: Left" "42" (MyLeft 42 :: MyEither Int String)
423 , Example "MyEither Int String: Right" "\"foo\"" (MyRight "foo" :: MyEither Int String)
425 -- newtypes from Monoid/Semigroup
426 , Example "Monoid.Dual Int" "2" (pure 2 :: Monoid.Dual Int)
427 , Example "Monoid.First Int" "2" (pure 2 :: Monoid.First Int)
428 , Example "Monoid.Last Int" "2" (pure 2 :: Monoid.Last Int)
429 , Example "Semigroup.Min Int" "2" (pure 2 :: Semigroup.Min Int)
430 , Example "Semigroup.Max Int" "2" (pure 2 :: Semigroup.Max Int)
431 , Example "Semigroup.First Int" "2" (pure 2 :: Semigroup.First Int)
432 , Example "Semigroup.Last Int" "2" (pure 2 :: Semigroup.Last Int)
433 , Example "Semigroup.WrappedMonoid Int" "2" (Semigroup.WrapMonoid 2 :: Semigroup.WrappedMonoid Int)
434 , Example "Semigroup.Option Just" "2" (pure 2 :: Semigroup.Option Int)
435 , Example "Semigroup.Option Nothing" "null" (Semigroup.Option (Nothing :: Maybe Bool))
436 ]
440------------------------------------------------------------------------------
441-- These tests check that JSONPath is tracked correctly
442-----------------------------------------------------------------------------
444jsonPath :: [Assertion]
445jsonPath = [
446 -- issue #356
447 assertEqual "Either"
448 (Left "Error in $[1].Left[1]: expected Bool, encountered Number")
449 (eitherDecode "[1,{\"Left\":[2,3]}]"
450 :: Either String (Int, Either (Int, Bool) ()))
451 -- issue #358
452 , assertEqual "Seq a"
453 (Left "Error in $[2]: expected Int, encountered Boolean")
454 (eitherDecode "[0,1,true]" :: Either String (Seq Int))
455 , assertEqual "Wibble"
456 (Left "Error in $.wibbleInt: expected Int, encountered Boolean")
457 (eitherDecode "{\"wibbleString\":\"\",\"wibbleInt\":true}"
458 :: Either String Wibble)
459 ]
461------------------------------------------------------------------------------
462-- Check that the hashes of two equal Value are the same
463------------------------------------------------------------------------------
465hashableLaws :: [Assertion]
466hashableLaws = [
467 assertEqual "Hashable Object" (hash a) (hash b)
468 ]
469 where
470 a = object ["223" .= False, "807882556" .= True]
471 b = object ["807882556" .= True, "223" .= False]
473-------------------------------------------------------------------------------
474-- ToJSONKey
475-------------------------------------------------------------------------------
477newtype MyText = MyText Text
478 deriving (FromJSONKey)
480newtype MyText' = MyText' Text
482instance FromJSONKey MyText' where
483 fromJSONKey = fmap MyText' fromJSONKey
484 fromJSONKeyList = error "not used"
486fromJSONKeyAssertions :: [Assertion]
487fromJSONKeyAssertions =
488 [ assertIsCoerce "Text" (fromJSONKey :: FromJSONKeyFunction Text)
489 , assertIsCoerce "Tagged Int Text" (fromJSONKey :: FromJSONKeyFunction (Tagged Int Text))
490 , assertIsCoerce "MyText" (fromJSONKey :: FromJSONKeyFunction MyText)
492#if __GLASGOW_HASKELL__ >= 710
493 , assertIsCoerce' "MyText'" (fromJSONKey :: FromJSONKeyFunction MyText')
494#endif
495 ]
496 where
497 assertIsCoerce _ (FromJSONKeyCoerce _) = pure ()
498 assertIsCoerce n _ = assertFailure n
500#if __GLASGOW_HASKELL__ >= 710
501 assertIsCoerce' _ (FromJSONKeyCoerce _) = pure ()
502 assertIsCoerce' n _ = pickWithRules (assertFailure n) (pure ())
504-- | Pick the first when RULES are enabled, e.g. optimisations are on
505pickWithRules
506 :: a -- ^ Pick this when RULES are on
507 -> a -- ^ use this otherwise
508 -> a
509pickWithRules _ = id
510{-# NOINLINE pickWithRules #-}
511{-# RULES "pickWithRules/rule" [0] forall x. pickWithRules x = const x #-}
512#endif
514------------------------------------------------------------------------------
515-- Regressions
516------------------------------------------------------------------------------
518-- A regression test for: https://github.com/bos/aeson/issues/351
519overlappingRegression :: FromJSON a => L.ByteString -> [a]
520overlappingRegression bs = fromMaybe [] $ decode bs
522issue351 :: [Assertion]
523issue351 = [
524 assertEqual "Int" ([1, 2, 3] :: [Int]) $ overlappingRegression "[1, 2, 3]"
525 , assertEqual "Char" ("abc" :: String) $ overlappingRegression "\"abc\""
526 , assertEqual "Char" ("" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"
527 ]
529------------------------------------------------------------------------------
530-- Comparison between bytestring and text encoders
531------------------------------------------------------------------------------
533ioTests :: IO [Test]
534ioTests = do
535 enc <- encoderComparisonTests
536 return [enc]
538encoderComparisonTests :: IO Test
539encoderComparisonTests = do
540 encoderTests <- forM testFiles $ \file0 -> do
541 let file = "benchmarks/json-data/" ++ file0
542 return $ testCase file $ do
543 inp <- L.readFile file
544 case eitherDecode inp of
545 Left err -> assertFailure $ "Decoding failure: " ++ err
546 Right val -> assertEqual "" (encode val) (encodeViaText val)
547 return $ testGroup "encoders" encoderTests
548 where
549 encodeViaText :: Value -> L.ByteString
550 encodeViaText =
551 TLE.encodeUtf8 . TLB.toLazyText . encodeToTextBuilder . toJSON
553 testFiles =
554 [ "example.json"
555 , "integers.json"
556 , "jp100.json"
557 , "numbers.json"
558 , "twitter10.json"
559 , "twitter20.json"
560 , "geometry.json"
561 , "jp10.json"
562 , "jp50.json"
563 , "twitter1.json"
564 , "twitter100.json"
565 , "twitter50.json"
566 ]
568-- A regression test for: https://github.com/bos/aeson/issues/293
569data MyRecord = MyRecord {_field1 :: Maybe Int, _field2 :: Maybe Bool}
571data MyRecord2 = MyRecord2 {_field3 :: Maybe Int, _field4 :: Maybe Bool}
572 deriving Generic
574instance ToJSON MyRecord2
575instance FromJSON MyRecord2
577-- A regression test for: https://github.com/bos/aeson/pull/455
578data Foo a = FooNil | FooCons (Foo Int)
580pr455 :: Assertion
581pr455 = assertEqual "FooCons FooNil"
582 (toJSON foo) (liftToJSON undefined undefined foo)
583 where
584 foo :: Foo Int
585 foo = FooCons FooNil
587deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord
589deriveToJSON defaultOptions ''Foo
590deriveToJSON1 defaultOptions ''Foo