@@ -1,4 +1,5 @@
1−{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
1+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards,
2+ ScopedTypeVariables #-}
23{-# OPTIONS_GHC -fno-warn-orphans #-}
34
45import Control.Applicative
@@ -6,10 +7,12 @@ import Data.Aeson.Encode
67import Data.Aeson.Parser (value)
78import Data.Aeson.Types
89import Data.Attoparsec.Number
10+import Data.Data (Typeable, Data)
911import Data.Text (Text)
1012import Test.Framework (Test, defaultMain, testGroup)
1113import Test.Framework.Providers.QuickCheck2 (testProperty)
1214import Test.QuickCheck (Arbitrary(..))
15+import qualified Data.Aeson.Generic as G
1316import qualified Data.Attoparsec.Lazy as L
1417import qualified Data.ByteString.Lazy.Char8 as L
1518import qualified Data.Text as T
@@ -23,20 +26,17 @@ encodeDouble num denom
2326encodeInteger :: Integer -> Bool
2427encodeInteger i = encode (Number (I i)) == L.pack (show i)
2528
26−roundTrip :: (FromJSON a, ToJSON a) => (a -> a -> Bool) -> a -> Bool
27−roundTrip eq i =
29+roundTrip :: (FromJSON a, ToJSON a) => (a -> a -> Bool) -> a -> a -> Bool
30+roundTrip eq _ i =
2831 case fmap fromJSON . L.parse value . encode . toJSON $ i of
2932 L.Done _ (Success v) -> v `eq` i
3033 _ -> False
3134
32−roundTripBool :: Bool -> Bool
33−roundTripBool = roundTrip (==)
34−roundTripDouble :: Double -> Bool
35−roundTripDouble = roundTrip approxEq
36−roundTripInteger :: Integer -> Bool
37−roundTripInteger = roundTrip (==)
38−roundTripFoo :: Foo -> Bool
39−roundTripFoo = roundTrip (==)
35+roundTripEq :: (Eq a, FromJSON a, ToJSON a) => a -> a -> Bool
36+roundTripEq x y = roundTrip (==) x y
37+
38+genericTo :: (Data a, ToJSON a) => a -> a -> Bool
39+genericTo _ v = G.toJSON v == toJSON v
4040
4141approxEq :: Double -> Double -> Bool
4242approxEq a b = a == b ||
@@ -50,7 +50,7 @@ data Foo = Foo {
5050 fooInt :: Int
5151 , fooDouble :: Double
5252 , fooTuple :: (String, Text)
53− } deriving (Show)
53+ } deriving (Show, Typeable, Data)
5454
5555instance Eq Foo where
5656 a == b = fooInt a == fooInt b &&
@@ -58,16 +58,16 @@ instance Eq Foo where
5858 fooTuple a == fooTuple b
5959
6060instance ToJSON Foo where
61− toJSON Foo{..} = object [ "int" .= fooInt
62− , "double" .= fooDouble
63− , "tuple" .= fooTuple
61+ toJSON Foo{..} = object [ "fooInt" .= fooInt
62+ , "fooDouble" .= fooDouble
63+ , "fooTuple" .= fooTuple
6464 ]
6565
6666instance FromJSON Foo where
6767 parseJSON (Object v) = Foo <$>
68− v .: "int" <*>
69− v .: "double" <*>
70− v .: "tuple"
68+ v .: "fooInt" <*>
69+ v .: "fooDouble" <*>
70+ v .: "fooTuple"
7171 parseJSON _ = empty
7272
7373instance Arbitrary Text where
@@ -85,10 +85,19 @@ tests = [
8585 testProperty "encodeDouble" encodeDouble
8686 , testProperty "encodeInteger" encodeInteger
8787 ],
88+ testGroup "generic" [
89+ testProperty "Bool" $ genericTo True
90+ , testProperty "Double" $ genericTo (1::Double)
91+ , testProperty "Int" $ genericTo (1::Int)
92+ , testProperty "Foo" $ genericTo (undefined::Foo)
93+ ],
8894 testGroup "roundTrip" [
89− testProperty "roundTripBool" roundTripBool
90− , testProperty "roundTripDouble" roundTripDouble
91− , testProperty "roundTripInteger" roundTripInteger
92− , testProperty "roundTripFoo" roundTripFoo
95+ testProperty "Bool" $ roundTripEq True
96+ , testProperty "Double" $ roundTrip approxEq (1::Double)
97+ , testProperty "Int" $ roundTripEq (1::Int)
98+ , testProperty "Integer" $ roundTripEq (1::Integer)
99+ , testProperty "String" $ roundTripEq (""::String)
100+ , testProperty "Text" $ roundTripEq T.empty
101+ , testProperty "Foo" $ roundTripEq (undefined::Foo)
93102 ]
94103 ]