Commits

Bryan O'Sullivan  committed cd1f9ff

See if generic JSON conversion is behaving.

  • Participants
  • Parent commits 54119c8

Comments (0)

Files changed (1)

File tests/Properties.hs

-{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards,
+    ScopedTypeVariables #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 import Control.Applicative
 import Data.Aeson.Parser (value)
 import Data.Aeson.Types
 import Data.Attoparsec.Number
+import Data.Data (Typeable, Data)
 import Data.Text (Text)
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck (Arbitrary(..))
+import qualified Data.Aeson.Generic as G
 import qualified Data.Attoparsec.Lazy as L
 import qualified Data.ByteString.Lazy.Char8 as L
 import qualified Data.Text as T
 encodeInteger :: Integer -> Bool
 encodeInteger i = encode (Number (I i)) == L.pack (show i)
 
-roundTrip :: (FromJSON a, ToJSON a) => (a -> a -> Bool) -> a -> Bool
-roundTrip eq i =
+roundTrip :: (FromJSON a, ToJSON a) => (a -> a -> Bool) -> a -> a -> Bool
+roundTrip eq _ i =
     case fmap fromJSON . L.parse value . encode . toJSON $ i of
       L.Done _ (Success v) -> v `eq` i
       _                    -> False
 
-roundTripBool :: Bool -> Bool
-roundTripBool = roundTrip (==)
-roundTripDouble :: Double -> Bool
-roundTripDouble = roundTrip approxEq
-roundTripInteger :: Integer -> Bool
-roundTripInteger = roundTrip (==)
-roundTripFoo :: Foo -> Bool
-roundTripFoo = roundTrip (==)
+roundTripEq :: (Eq a, FromJSON a, ToJSON a) => a -> a -> Bool
+roundTripEq x y = roundTrip (==) x y
+
+genericTo :: (Data a, ToJSON a) => a -> a -> Bool
+genericTo _ v = G.toJSON v == toJSON v
 
 approxEq :: Double -> Double -> Bool
 approxEq a b = a == b ||
       fooInt :: Int
     , fooDouble :: Double
     , fooTuple :: (String, Text)
-    } deriving (Show)
+    } deriving (Show, Typeable, Data)
 
 instance Eq Foo where
     a == b = fooInt a == fooInt b &&
              fooTuple a == fooTuple b
 
 instance ToJSON Foo where
-    toJSON Foo{..} = object [ "int" .= fooInt
-                            , "double" .= fooDouble
-                            , "tuple" .= fooTuple
+    toJSON Foo{..} = object [ "fooInt" .= fooInt
+                            , "fooDouble" .= fooDouble
+                            , "fooTuple" .= fooTuple
                             ]
 
 instance FromJSON Foo where
     parseJSON (Object v) = Foo <$>
-                           v .: "int" <*>
-                           v .: "double" <*>
-                           v .: "tuple"
+                           v .: "fooInt" <*>
+                           v .: "fooDouble" <*>
+                           v .: "fooTuple"
     parseJSON _ = empty
 
 instance Arbitrary Text where
       testProperty "encodeDouble" encodeDouble
     , testProperty "encodeInteger" encodeInteger
     ],
+  testGroup "generic" [
+      testProperty "Bool" $ genericTo True
+    , testProperty "Double" $ genericTo (1::Double)
+    , testProperty "Int" $ genericTo (1::Int)
+    , testProperty "Foo" $ genericTo (undefined::Foo)
+    ],
   testGroup "roundTrip" [
-      testProperty "roundTripBool" roundTripBool
-    , testProperty "roundTripDouble" roundTripDouble
-    , testProperty "roundTripInteger" roundTripInteger
-    , testProperty "roundTripFoo" roundTripFoo
+      testProperty "Bool" $ roundTripEq True
+    , testProperty "Double" $ roundTrip approxEq (1::Double)
+    , testProperty "Int" $ roundTripEq (1::Int)
+    , testProperty "Integer" $ roundTripEq (1::Integer)
+    , testProperty "String" $ roundTripEq (""::String)
+    , testProperty "Text" $ roundTripEq T.empty
+    , testProperty "Foo" $ roundTripEq (undefined::Foo)
     ]
   ]