on master help sign in
* Fix naming errors in some test cases

* Add unit tests to specify the format of nullary constructors * Make sure the old format `"contents" : []` is still allowed when deriving tagged objects for nullary constructors

commit29d300ffa0da5305bb3666ddc051620aebe42602 authorAdam Bergmark <adam@bergmark.nl> dateFri 6 May 2016, 20:06 (10 years ago) parent0ee8f79
4 files changed+63−3
aeson.cabal+1 tests/Properties.hs+3−3 tests/UnitTests.hs+2 tests/UnitTests/NullaryConstructors.hs+57
aeson.cabal+1
@@ -145,6 +145,7 @@ test-suite tests
145145 Properties
146146 Types
147147 UnitTests
148+ UnitTests.NullaryConstructors
148149
149150 ghc-options: -Wall -threaded -rtsopts
150151
tests/Properties.hs+3−3
@@ -209,11 +209,11 @@ tests = testGroup "properties" [
209209 , testProperty "ApproxDefault" $
210210 gApproxToJSONDefault `sameAs` gApproxToEncodingDefault
211211 , testProperty "SomeType2ElemArray" $
212− gSomeTypeToJSON2ElemArray `sameAsV` gSomeTypeToEncoding2ElemArray
212+ gSomeTypeToJSON2ElemArray `sameAs` gSomeTypeToEncoding2ElemArray
213213 , testProperty "SomeTypeTaggedObject" $
214− gSomeTypeToJSONTaggedObject `sameAsV` gSomeTypeToEncodingTaggedObject
214+ gSomeTypeToJSONTaggedObject `sameAs` gSomeTypeToEncodingTaggedObject
215215 , testProperty "SomeTypeObjectWithSingleField" $
216− gSomeTypeToJSONObjectWithSingleField `sameAsV`
216+ gSomeTypeToJSONObjectWithSingleField `sameAs`
217217 gSomeTypeToEncodingObjectWithSingleField
218218 ]
219219 ]
tests/UnitTests.hs+2
@@ -24,6 +24,7 @@ import GHC.Generics (Generic)
2424import Test.Framework (Test, testGroup)
2525import Test.Framework.Providers.HUnit (testCase)
2626import Test.HUnit (Assertion, assertFailure, assertEqual)
27+import UnitTests.NullaryConstructors (nullaryConstructors)
2728import qualified Data.ByteString.Lazy.Char8 as L
2829import qualified Data.Text.Lazy.Builder as TLB
2930import qualified Data.Text.Lazy.Encoding as TLE
@@ -66,6 +67,7 @@ tests = testGroup "unit" [
6667 , testGroup "JSONPath" $ fmap (testCase "-") jsonPath
6768 , testGroup "Hashable laws" $ fmap (testCase "-") hashableLaws
6869 , testGroup "Issue #351" $ fmap (testCase "-") issue351
70+ , testGroup "Nullary constructors" $ fmap (testCase "-") nullaryConstructors
6971 ]
7072
7173roundTripCamel :: String -> Assertion
tests/UnitTests/NullaryConstructors.hsnew file+57
@@ -0,0 +1,57 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+{-# OPTIONS_GHC -fno-warn-deprecations #-}
4+
5+module UnitTests.NullaryConstructors (nullaryConstructors) where
6+
7+import Data.Aeson (decode, eitherDecode, fromEncoding, Value)
8+import Data.Aeson.Internal (IResult (..), iparse)
9+import Data.Aeson.Types (Parser)
10+import Data.ByteString.Builder (toLazyByteString)
11+import Data.Maybe (fromJust)
12+import Encoders
13+import Test.HUnit (Assertion, (@=?))
14+import Types
15+import qualified Data.ByteString.Lazy.Char8 as L
16+
17+nullaryConstructors :: [Assertion]
18+nullaryConstructors =
19+ [ dec "\"C1\"" @=? thNullaryToJSONString C1
20+ , dec "\"C1\"" @=? gNullaryToJSONString C1
21+ , dec "{\"c1\":[]}" @=? thNullaryToJSONObjectWithSingleField C1
22+ , dec "{\"c1\":[]}" @=? gNullaryToJSONObjectWithSingleField C1
23+ , dec "[\"c1\",[]]" @=? gNullaryToJSON2ElemArray C1
24+ , dec "[\"c1\",[]]" @=? thNullaryToJSON2ElemArray C1
25+ , dec "{\"tag\":\"c1\"}" @=? thNullaryToJSONTaggedObject C1
26+ , dec "{\"tag\":\"c1\"}" @=? gNullaryToJSONTaggedObject C1
27+
28+ , decE "\"C1\"" @=? enc (gNullaryToEncodingString C1)
29+ , decE "\"C1\"" @=? enc (thNullaryToEncodingString C1)
30+ , decE "[\"c1\",[]]" @=? enc (gNullaryToEncoding2ElemArray C1)
31+ , decE "[\"c1\",[]]" @=? enc (thNullaryToEncoding2ElemArray C1)
32+ , decE "{\"c1\":[]}" @=? enc (thNullaryToEncodingObjectWithSingleField C1)
33+ , decE "{\"c1\":[]}" @=? enc (gNullaryToEncodingObjectWithSingleField C1)
34+ , decE "{\"tag\":\"c1\"}" @=? enc (thNullaryToEncodingTaggedObject C1)
35+ , decE "{\"tag\":\"c1\"}" @=? enc (gNullaryToEncodingTaggedObject C1)
36+
37+ , ISuccess C1 @=? parse thNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\"}")
38+ , ISuccess C1 @=? parse gNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\"}")
39+
40+ , ISuccess C1 @=? parse thNullaryParseJSONString (dec "\"C1\"")
41+ , ISuccess C1 @=? parse gNullaryParseJSONString (dec "\"C1\"")
42+ , ISuccess C1 @=? parse thNullaryParseJSON2ElemArray (dec "[\"c1\",[]]")
43+ , ISuccess C1 @=? parse gNullaryParseJSON2ElemArray (dec "[\"c1\",[]]")
44+ , ISuccess C1 @=? parse thNullaryParseJSONObjectWithSingleField (dec "{\"c1\":[]}")
45+ , ISuccess C1 @=? parse gNullaryParseJSONObjectWithSingleField (dec "{\"c1\":[]}")
46+ -- Make sure that the old `"contents" : []' is still allowed
47+ , ISuccess C1 @=? parse thNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\",\"contents\":[]}")
48+ , ISuccess C1 @=? parse gNullaryParseJSONTaggedObject (dec "{\"tag\":\"c1\",\"contents\":[]}")
49+ ]
50+ where
51+ enc = eitherDecode . toLazyByteString . fromEncoding
52+ dec :: L.ByteString -> Value
53+ dec = fromJust . decode
54+ decE :: L.ByteString -> Either String Value
55+ decE = eitherDecode
56+ parse :: (a -> Parser b) -> a -> IResult b
57+ parse parsejson v = iparse parsejson v