git.iko.soy/typeable/aeson
on 0.11.2.1 help sign in
typeable/aeson/tests/UnitTests.hs
340 lines 14 kB history raw
1{-# LANGUAGE CPP, DeriveGeneric, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}
3{-# OPTIONS_GHC -fno-warn-deprecations #-}
5module UnitTests (ioTests, tests) where
7import Control.Applicative (Const(..))
8import Control.Monad (forM)
9import Data.Aeson (decode, eitherDecode, encode, genericToJSON, genericToEncoding, object, FromJSON(..), withObject, (.=), (.:), (.:?), (.:!))
10import Data.Aeson.Encode (encodeToTextBuilder)
11import Data.Aeson.Internal (JSONPathElement(..), formatError)
12import Data.Aeson.TH (deriveJSON)
13import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)
14import Data.Char (toUpper)
15import Data.Hashable (hash)
16import Data.List.NonEmpty (NonEmpty(..))
17import Data.Maybe (fromMaybe)
18import Data.Proxy (Proxy(..))
19import Data.Sequence (Seq)
20import Data.Tagged (Tagged(..))
21import Data.Time (UTCTime)
22import Data.Time.Format (parseTime)
23import GHC.Generics (Generic)
24import Test.Framework (Test, testGroup)
25import Test.Framework.Providers.HUnit (testCase)
26import Test.HUnit (Assertion, assertFailure, assertEqual)
27import qualified Data.ByteString.Lazy.Char8 as L
28import qualified Data.Text.Lazy.Builder as TLB
29import qualified Data.Text.Lazy.Encoding as TLE
30import qualified Data.Text.Lazy as LT
31import qualified Data.Text.Lazy.Encoding as LT
33#if MIN_VERSION_time(1,5,0)
34import Data.Time.Format (defaultTimeLocale)
35#else
36import System.Locale (defaultTimeLocale)
37#endif
39tests :: Test
40tests = testGroup "unit" [
41 testGroup "camelCase" [
42 testCase "camelTo" $ roundTripCamel "aName"
43 , testCase "camelTo" $ roundTripCamel "another"
44 , testCase "camelTo" $ roundTripCamel "someOtherName"
45 , testCase "camelTo" $
46 assertEqual "" "camel_apicase" (camelTo '_' "CamelAPICase")
47 , testCase "camelTo2" $ roundTripCamel2 "aName"
48 , testCase "camelTo2" $ roundTripCamel2 "another"
49 , testCase "camelTo2" $ roundTripCamel2 "someOtherName"
50 , testCase "camelTo2" $
51 assertEqual "" "camel_api_case" (camelTo2 '_' "CamelAPICase")
52 ]
53 , testGroup "encoding" [
54 testCase "goodProducer" $ goodProducer
55 ]
56 , testGroup "utctime" [
57 testCase "good" $ utcTimeGood
58 , testCase "bad" $ utcTimeBad
59 ]
60 , testGroup "formatError" [
61 testCase "example 1" $ formatErrorExample
62 ]
63 , testGroup ".:, .:?, .:!" $ fmap (testCase "-") dotColonMark
64 , testGroup "To JSON representation" $ fmap (testCase "-") jsonEncoding
65 , testGroup "From JSON representation" $ fmap (testCase "-") jsonDecoding
66 , testGroup "JSONPath" $ fmap (testCase "-") jsonPath
67 , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws
68 , testGroup "Issue #351" $ fmap (testCase "-") issue351
69 ]
71roundTripCamel :: String -> Assertion
72roundTripCamel name = assertEqual "" name (camelFrom '_' $ camelTo '_' name)
74roundTripCamel2 :: String -> Assertion
75roundTripCamel2 name = assertEqual "" name (camelFrom '_' $ camelTo2 '_' name)
77camelFrom :: Char -> String -> String
78camelFrom c s = let (p:ps) = split c s
79 in concat $ p : map capitalize ps
80 where
81 split c' s' = map L.unpack $ L.split c' $ L.pack s'
82 capitalize t = toUpper (head t) : tail t
84data Wibble = Wibble {
85 wibbleString :: String
86 , wibbleInt :: Int
87 } deriving (Generic, Show)
89instance ToJSON Wibble where
90 toJSON = genericToJSON defaultOptions
91 toEncoding = genericToEncoding defaultOptions
93-- Test that if we put a bomb in a data structure, but only demand
94-- part of it via lazy encoding, we do not unexpectedly fail.
95goodProducer :: Assertion
96goodProducer = assertEqual "partial encoding should not explode on undefined"
97 '{' (L.head (encode wibble))
98 where
99 wibble = Wibble {
100 wibbleString = replicate k 'a'
101 , wibbleInt = 1
102 }
103 k | arch32bit = 4047
104 | otherwise = 4030
105 arch32bit = (maxBound :: Int) == 2147483647
107-- Test decoding various UTC time formats
108--
109-- Note: the incomplete pattern matches for UTCTimes are completely
110-- intentional. The test expects these parses to succeed. If the
111-- pattern matches fails, there's a bug in either the test or in aeson
112-- and needs to be investigated.
113utcTimeGood :: Assertion
114utcTimeGood = do
115 let ts1 = "2015-01-01T12:13:00.00Z" :: LT.Text
116 let ts2 = "2015-01-01T12:13:00Z" :: LT.Text
117 -- 'T' between date and time is not required, can be space
118 let ts3 = "2015-01-03 12:13:00.00Z" :: LT.Text
119 let ts4 = "2015-01-03 12:13:00.125Z" :: LT.Text
120 let (Just (t1 :: UTCTime)) = parseWithAeson ts1
121 let (Just (t2 :: UTCTime)) = parseWithAeson ts2
122 let (Just (t3 :: UTCTime)) = parseWithAeson ts3
123 let (Just (t4 :: UTCTime)) = parseWithAeson ts4
124 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts1) t1
125 assertEqual "utctime" (parseWithRead "%FT%T%QZ" ts2) t2
126 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts3) t3
127 assertEqual "utctime" (parseWithRead "%F %T%QZ" ts4) t4
128 -- Time zones. Both +HHMM and +HH:MM are allowed for timezone
129 -- offset, and MM may be omitted.
130 let ts5 = "2015-01-01T12:30:00.00+00" :: LT.Text
131 let ts6 = "2015-01-01T12:30:00.00+01:15" :: LT.Text
132 let ts7 = "2015-01-01T12:30:00.00-02" :: LT.Text
133 let ts8 = "2015-01-01T22:00:00.00-03" :: LT.Text
134 let ts9 = "2015-01-01T22:00:00.00-04:30" :: LT.Text
135 let (Just (t5 :: UTCTime)) = parseWithAeson ts5
136 let (Just (t6 :: UTCTime)) = parseWithAeson ts6
137 let (Just (t7 :: UTCTime)) = parseWithAeson ts7
138 let (Just (t8 :: UTCTime)) = parseWithAeson ts8
139 let (Just (t9 :: UTCTime)) = parseWithAeson ts9
140 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T12:30:00.00Z") t5
141 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T11:15:00.00Z") t6
142 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t7
143 -- ts8 wraps around to the next day in UTC
144 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T01:00:00Z") t8
145 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-02T02:30:00Z") t9
147 -- Seconds in Time can be omitted
148 let ts10 = "2015-01-03T12:13Z" :: LT.Text
149 let ts11 = "2015-01-03 12:13Z" :: LT.Text
150 let ts12 = "2015-01-01T12:30-02" :: LT.Text
151 let (Just (t10 :: UTCTime)) = parseWithAeson ts10
152 let (Just (t11 :: UTCTime)) = parseWithAeson ts11
153 let (Just (t12 :: UTCTime)) = parseWithAeson ts12
154 assertEqual "utctime" (parseWithRead "%FT%H:%MZ" ts10) t10
155 assertEqual "utctime" (parseWithRead "%F %H:%MZ" ts11) t11
156 assertEqual "utctime" (parseWithRead "%FT%T%QZ" "2015-01-01T14:30:00Z") t12
158 where
159 parseWithRead :: String -> LT.Text -> UTCTime
160 parseWithRead f s =
161 case parseTime defaultTimeLocale f . LT.unpack $ s of
162 Nothing -> error "parseTime input malformed"
163 Just t -> t
164 parseWithAeson :: LT.Text -> Maybe UTCTime
165 parseWithAeson s = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""])
167-- Test that a few non-timezone qualified timestamp formats get
168-- rejected if decoding to UTCTime.
169utcTimeBad :: Assertion
170utcTimeBad = do
171 verifyFailParse "2000-01-01T12:13:00" -- missing Zulu time not allowed (some TZ required)
172 verifyFailParse "2000-01-01 12:13:00" -- missing Zulu time not allowed (some TZ required)
173 verifyFailParse "2000-01-01" -- date only not OK
174 verifyFailParse "2000-01-01Z" -- date only not OK
175 verifyFailParse "2015-01-01T12:30:00.00+00Z" -- no Zulu if offset given
176 verifyFailParse "2015-01-01T12:30:00.00+00:00Z" -- no Zulu if offset given
177 verifyFailParse "2015-01-03 12:13:00.Z" -- decimal at the end but no digits
178 verifyFailParse "2015-01-03 12:13.000Z" -- decimal at the end, but no seconds
179 where
180 verifyFailParse (s :: LT.Text) =
181 let (dec :: Maybe UTCTime) = decode . LT.encodeUtf8 $ (LT.concat ["\"", s, "\""]) in
182 assertEqual "verify failure" Nothing dec
184-- Non identifier keys should be escaped & enclosed in brackets
185formatErrorExample :: Assertion
186formatErrorExample =
187 let rhs = formatError [Index 0, Key "foo", Key "bar", Key "a.b.c", Key "", Key "'\\", Key "end"] "error msg"
188 lhs = "Error in $[0].foo.bar['a.b.c']['']['\\'\\\\'].end: error msg"
189 in assertEqual "formatError example" lhs rhs
191------------------------------------------------------------------------------
192-- Comparison (.:?) and (.:!)
193------------------------------------------------------------------------------
195newtype T1 = T1 (Maybe Int) deriving (Eq, Show)
196newtype T2 = T2 (Maybe Int) deriving (Eq, Show)
197newtype T3 = T3 (Maybe Int) deriving (Eq, Show)
199instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")
200instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")
201instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")
203dotColonMark :: [Assertion]
204dotColonMark = [
205 assertEqual ".: not-present" Nothing (decode ex1 :: Maybe T1)
206 , assertEqual ".: 42" (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)
207 , assertEqual ".: null" (Just (T1 Nothing)) (decode ex3 :: Maybe T1)
209 , assertEqual ".:? not-present" (Just (T2 (Nothing))) (decode ex1 :: Maybe T2)
210 , assertEqual ".:? 42" (Just (T2 (Just 42))) (decode ex2 :: Maybe T2)
211 , assertEqual ".:? null" (Just (T2 Nothing)) (decode ex3 :: Maybe T2)
213 , assertEqual ".:! not-present" (Just (T3 (Nothing))) (decode ex1 :: Maybe T3)
214 , assertEqual ".:! 42" (Just (T3 (Just 42))) (decode ex2 :: Maybe T3)
215 , assertEqual ".:! null" Nothing (decode ex3 :: Maybe T3)
216 ]
217 where ex1 = "{}"
218 ex2 = "{\"value\": 42 }"
219 ex3 = "{\"value\": null }"
221------------------------------------------------------------------------------
222-- These tests assert that the JSON serialization doesn't change by accident.
223-----------------------------------------------------------------------------
225jsonEncoding :: [Assertion]
226jsonEncoding = [
227 assertEqual "Either Left" "{\"Left\":1}" $ encode (Left 1 :: Either Int Int)
228 , assertEqual "Either Right" "{\"Right\":1}" $ encode (Right 1 :: Either Int Int)
229 , assertEqual "Nothing" "null" $ encode (Nothing :: Maybe Int)
230 , assertEqual "Just" "1" $ encode (Just 1 :: Maybe Int)
231 , assertEqual "Just Nothing" "null" $ encode (Just Nothing :: Maybe (Maybe Int))
232 , assertEqual "Proxy Int" "null" $ encode (Proxy :: Proxy Int)
233 , assertEqual "Tagged Char Int" "1" $ encode (Tagged 1 :: Tagged Char Int)
234 , assertEqual "Const Char Int" "\"c\"" $ encode (Const 'c' :: Const Char Int)
235 , assertEqual "Tuple" "[1,2]" $ encode ((1, 2) :: (Int, Int))
236 , assertEqual "NonEmpty" "[1,2,3]" $ encode (1 :| [2, 3] :: NonEmpty Int)
237 , assertEqual "()" "[]" $ encode ()
238 ]
240jsonDecoding :: [Assertion]
241jsonDecoding = [
242 assertEqual "Nothing" (Nothing :: Maybe Int) (decode "null")
243 , assertEqual "Just" (Just 1 :: Maybe Int) (decode "1")
244 , assertEqual "Just Nothing" (Just Nothing :: Maybe (Maybe Int)) (decode "null")
245 , assertEqual "NonEmpty" (Just (1 :| [2, 3]) :: Maybe (NonEmpty Int)) (decode "[1,2,3]")
246 , assertEqual "()" (Just ()) (decode "[]")
247 ]
249------------------------------------------------------------------------------
250-- These tests check that JSONPath is tracked correctly
251-----------------------------------------------------------------------------
253jsonPath :: [Assertion]
254jsonPath = [
255 -- issue #356
256 assertEqual "Either"
257 (Left "Error in $[1].Left[1]: expected Bool, encountered Number")
258 (eitherDecode "[1,{\"Left\":[2,3]}]"
259 :: Either String (Int, Either (Int, Bool) ()))
260 -- issue #358
261 , assertEqual "Seq a"
262 (Left "Error in $[2]: expected Int, encountered Boolean")
263 (eitherDecode "[0,1,true]" :: Either String (Seq Int))
264 ]
266------------------------------------------------------------------------------
267-- Check that the hashes of two equal Value are the same
268------------------------------------------------------------------------------
270hashableLaws :: [Assertion]
271hashableLaws = [
272 assertEqual "Hashable Object" (hash a) (hash b)
273 ]
274 where
275 a = object ["223" .= False, "807882556" .= True]
276 b = object ["807882556" .= True, "223" .= False]
278------------------------------------------------------------------------------
279-- Regressions
280------------------------------------------------------------------------------
282-- A regression test for: https://github.com/bos/aeson/issues/351
283overlappingRegression :: FromJSON a => L.ByteString -> [a]
284overlappingRegression bs = fromMaybe [] $ decode bs
286issue351 :: [Assertion]
287issue351 = [
288 assertEqual "Int" ([1, 2, 3] :: [Int]) $ overlappingRegression "[1, 2, 3]"
289 , assertEqual "Char" ("" :: String) $ overlappingRegression "\"abc\""
290 , assertEqual "Char" ("abc" :: String) $ overlappingRegression "[\"a\", \"b\", \"c\"]"
291 ]
293------------------------------------------------------------------------------
294-- Comparison between bytestring and text encoders
295------------------------------------------------------------------------------
297ioTests :: IO [Test]
298ioTests = do
299 enc <- encoderComparisonTests
300 return [enc]
302encoderComparisonTests :: IO Test
303encoderComparisonTests = do
304 encoderTests <- forM testFiles $ \file0 -> do
305 let file = "benchmarks/json-data/" ++ file0
306 return $ testCase file $ do
307 inp <- L.readFile file
308 case eitherDecode inp of
309 Left err -> assertFailure $ "Decoding failure: " ++ err
310 Right val -> assertEqual "" (encode val) (encodeViaText val)
311 return $ testGroup "encoders" encoderTests
312 where
313 encodeViaText :: Value -> L.ByteString
314 encodeViaText =
315 TLE.encodeUtf8 . TLB.toLazyText . encodeToTextBuilder . toJSON
317 testFiles =
318 [ "example.json"
319 , "integers.json"
320 , "jp100.json"
321 , "numbers.json"
322 , "twitter10.json"
323 , "twitter20.json"
324 , "geometry.json"
325 , "jp10.json"
326 , "jp50.json"
327 , "twitter1.json"
328 , "twitter100.json"
329 , "twitter50.json"
330 ]
332-- A regression test for: https://github.com/bos/aeson/issues/293
333data MyRecord = MyRecord {_field1 :: Maybe Int, _field2 :: Maybe Bool}
334deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord
336data MyRecord2 = MyRecord2 {_field3 :: Maybe Int, _field4 :: Maybe Bool}
337 deriving Generic
339instance ToJSON MyRecord2
340instance FromJSON MyRecord2