git.iko.soy/typeable/aeson
on master help sign in
Test round-tripping of compound types.
fe90687Bryan O'Sullivan
aeson.cabal+3−1
compare with master
unifiedsplit
@@ -144,12 +144,14 @@ test-suite tests
144 -Wall -threaded -rtsopts
144 -Wall -threaded -rtsopts
145
145
146 build-depends:
146 build-depends:
147+ QuickCheck,
147 aeson,
148 aeson,
148 attoparsec,
149 attoparsec,
149 base,
150 base,
150 bytestring,
151 bytestring,
151 test-framework,
152 test-framework,
152− test-framework-quickcheck2
153+ test-framework-quickcheck2,
154+ text
153
155
154source-repository head
156source-repository head
155 type: git
157 type: git
tests/Properties.hs+40−2
@@ -1,13 +1,18 @@
1−{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
1+{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
2
3
4+import Control.Applicative
3import Data.Aeson.Encode
5import Data.Aeson.Encode
4import Data.Aeson.Parser (value)
6import Data.Aeson.Parser (value)
5import Data.Aeson.Types
7import Data.Aeson.Types
6import Data.Attoparsec.Number
8import Data.Attoparsec.Number
9+import Data.Text (Text)
7import Test.Framework (Test, defaultMain, testGroup)
10import Test.Framework (Test, defaultMain, testGroup)
8import Test.Framework.Providers.QuickCheck2 (testProperty)
11import Test.Framework.Providers.QuickCheck2 (testProperty)
9−import qualified Data.ByteString.Lazy.Char8 as L
12+import Test.QuickCheck (Arbitrary(..))
10import qualified Data.Attoparsec.Lazy as L
13import qualified Data.Attoparsec.Lazy as L
14+import qualified Data.ByteString.Lazy.Char8 as L
15+import qualified Data.Text as T
11
16
12encodeDouble :: Double -> Double -> Bool
17encodeDouble :: Double -> Double -> Bool
13encodeDouble num denom
18encodeDouble num denom
@@ -30,6 +35,8 @@ roundTripDouble :: Double -> Bool
30roundTripDouble = roundTrip approxEq
35roundTripDouble = roundTrip approxEq
31roundTripInteger :: Integer -> Bool
36roundTripInteger :: Integer -> Bool
32roundTripInteger = roundTrip (==)
37roundTripInteger = roundTrip (==)
38+roundTripFoo :: Foo -> Bool
39+roundTripFoo = roundTrip (==)
33
40
34approxEq :: Double -> Double -> Bool
41approxEq :: Double -> Double -> Bool
35approxEq a b = a == b ||
42approxEq a b = a == b ||
@@ -39,6 +46,36 @@ approxEq a b = a == b ||
39 maxAbsoluteError = 1e-15
46 maxAbsoluteError = 1e-15
40 maxRelativeError = 1e-15
47 maxRelativeError = 1e-15
41
48
49+data Foo = Foo {
50+ fooInt :: Int
51+ , fooDouble :: Double
52+ , fooTuple :: (String, Text)
53+ } deriving (Show)
54+
55+instance Eq Foo where
56+ a == b = fooInt a == fooInt b &&
57+ fooDouble a `approxEq` fooDouble b &&
58+ fooTuple a == fooTuple b
59+
60+instance ToJSON Foo where
61+ toJSON Foo{..} = object [ "int" .= fooInt
62+ , "double" .= fooDouble
63+ , "tuple" .= fooTuple
64+ ]
65+
66+instance FromJSON Foo where
67+ parseJSON (Object v) = Foo <$>
68+ v .: "int" <*>
69+ v .: "double" <*>
70+ v .: "tuple"
71+ parseJSON _ = empty
72+
73+instance Arbitrary Text where
74+ arbitrary = T.pack <$> arbitrary
75+
76+instance Arbitrary Foo where
77+ arbitrary = liftA3 Foo arbitrary arbitrary arbitrary
78+
42main :: IO ()
79main :: IO ()
43main = defaultMain tests
80main = defaultMain tests
44
81
@@ -52,5 +89,6 @@ tests = [
52 testProperty "roundTripBool" roundTripBool
89 testProperty "roundTripBool" roundTripBool
53 , testProperty "roundTripDouble" roundTripDouble
90 , testProperty "roundTripDouble" roundTripDouble
54 , testProperty "roundTripInteger" roundTripInteger
91 , testProperty "roundTripInteger" roundTripInteger
92+ , testProperty "roundTripFoo" roundTripFoo
55 ]
93 ]
56 ]
94 ]