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