basvandijk avatar basvandijk committed 7e7fb93 Merge

Merged master

Comments (0)

Files changed (7)

 -- $pitfalls
 -- #pitfalls#
 --
--- Note that the JSON standard only allows arrays or objects of things
--- at the top-level. Since this library follows the standard, calling
--- 'decode' on an unsupported result type will typecheck, but will
--- always \"fail\":
+-- Note that the JSON standard requires that the top-level value be
+-- either an array or an object. If you try to use 'decode' with a
+-- result type that is /not/ represented in JSON as an array or
+-- object, your code will typecheck, but it will always \"fail\" at
+-- runtime:
 --
 -- > >>> decode "1" :: Maybe Int
 -- > Nothing
 --   converted to an AST, then the 'FromJSON' class is used to convert
 --   to the desired type.
 --
--- For convenience, the 'encode' and
--- 'decode' functions combine both steps for convenience.
+-- For convenience, the 'encode' and 'decode' functions combine both
+-- steps.
     benchmarks/json-data/*.json
     examples/*.hs
     release-notes.markdown
-    tests/Properties.hs
 
 flag developer
   description: operate in developer mode
   type:           exitcode-stdio-1.0
   hs-source-dirs: tests
   main-is:        Properties.hs
-  other-modules:  Options
+  other-modules:  Functions
+                  Instances
+                  Types
+                  Options
+                  Encoders
 
   ghc-options:
     -Wall -threaded -rtsopts
 
-  if impl(ghc >= 7.2.1)
-    cpp-options: -DGENERICS
-    build-depends: ghc-prim >= 0.2
-
   build-depends:
     QuickCheck,
     aeson,
     text,
     time,
     unordered-containers,
-    vector
+    vector,
+    ghc-prim >= 0.2
 
 source-repository head
   type:     git

tests/Functions.hs

+module Functions where
+
+approxEq :: (Fractional a, Ord a) => a -> a -> Bool
+approxEq = approxEqWith 1e-15 1e-15
+
+approxEqWith :: (Fractional a, Ord a) => a -> a -> a -> a -> Bool
+approxEqWith maxAbsoluteError maxRelativeError a b =
+    a == b || d < maxAbsoluteError ||
+    d / max (abs b) (abs a) <= maxRelativeError
+  where d = abs (a - b)

tests/Instances.hs

+{-# Language OverloadedStrings, RecordWildCards, StandaloneDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Instances where
+
+import Types
+import Data.Function (on)
+import Control.Monad
+import Test.QuickCheck (Arbitrary(..), Gen, choose, oneof, elements)
+import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)
+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),
+                  hoursToTimeZone, Day(..), TimeOfDay(..))
+import qualified Data.Text as T
+import qualified Data.Map as Map
+import Data.Text (Text)
+import Data.Aeson.Types
+import Control.Applicative
+import Functions
+
+-- "System" types.
+
+instance Arbitrary Text where
+    arbitrary = T.pack <$> arbitrary
+
+instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
+    arbitrary = Map.fromList <$> arbitrary
+
+instance Arbitrary LocalTime where
+    arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
+
+instance Arbitrary TimeZone where
+    arbitrary = do
+      offset <- choose (0,2) :: Gen Int
+      return $ hoursToTimeZone offset
+
+instance Arbitrary Day where
+    arbitrary = ModifiedJulianDay `liftM` arbitrary
+
+instance Arbitrary DiffTime where
+    arbitrary = picosecondsToDiffTime `liftM` choose (0, 86400000000000000)
+
+instance Arbitrary UTCTime where
+    arbitrary = liftM2 UTCTime arbitrary arbitrary
+
+instance Arbitrary DotNetTime where
+    arbitrary = DotNetTime `liftM` arbitrary
+
+instance Arbitrary ZonedTime where
+    arbitrary = liftM2 ZonedTime arbitrary arbitrary
+
+deriving instance Eq ZonedTime
+
+-- Compare equality to within a millisecond, allowing for rounding
+-- error (ECMA 262 requires milliseconds to rounded to zero, not
+-- rounded to nearest).
+instance ApproxEq UTCTime where
+    a =~ b = ((==) `on` utctDay) a b &&
+             (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
+
+instance ApproxEq DotNetTime
+
+instance ApproxEq Double where
+    (=~) = approxEq
+
+-- Test-related types.
+
+instance Arbitrary Foo where
+    arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
+
+instance Eq Foo where
+    a == b = fooInt a == fooInt b &&
+             fooDouble a `approxEq` fooDouble b &&
+             fooTuple a == fooTuple b
+
+instance ToJSON Foo where
+    toJSON Foo{..} = object [ "fooInt" .= fooInt
+                            , "fooDouble" .= fooDouble
+                            , "fooTuple" .= fooTuple
+                            , "fooMap" .= fooMap
+                            ]
+
+instance FromJSON Foo where
+    parseJSON (Object v) = Foo <$>
+                           v .: "fooInt" <*>
+                           v .: "fooDouble" <*>
+                           v .: "fooTuple" <*>
+                           v .: "fooMap"
+    parseJSON _ = empty
+
+instance Arbitrary UFoo where
+    arbitrary = UFoo <$> arbitrary <*> arbitrary
+        where _ = uFooInt
+
+instance Arbitrary OneConstructor where
+    arbitrary = return OneConstructor
+
+instance FromJSON OneConstructor
+instance ToJSON OneConstructor
+
+instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
+    arbitrary = liftM2 Product2 arbitrary arbitrary
+
+instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
+instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
+          Arbitrary f) => Arbitrary (Product6 a b c d e f) where
+    arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
+                             arbitrary <*> arbitrary <*> arbitrary
+
+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
+          FromJSON f) => FromJSON (Product6 a b c d e f)
+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
+          ToJSON f) => ToJSON (Product6 a b c d e f)
+
+instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
+    => Arbitrary (Sum4 a b c d) where
+    arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
+                       Alt3 <$> arbitrary, Alt4 <$> arbitrary]
+
+instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
+    => FromJSON (Sum4 a b c d)
+instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
+
+instance (Arbitrary a) => Arbitrary (Approx a) where
+    arbitrary = Approx <$> arbitrary
+
+instance (FromJSON a) => FromJSON (Approx a) where
+    parseJSON a = Approx <$> parseJSON a
+
+instance (ToJSON a) => ToJSON (Approx a) where
+    toJSON = toJSON . fromApprox
+
+instance Arbitrary Nullary where
+    arbitrary = elements [C1, C2, C3]
+
+instance Arbitrary a => Arbitrary (SomeType a) where
+    arbitrary = oneof [ pure Nullary
+                      , Unary   <$> arbitrary
+                      , Product <$> arbitrary <*> arbitrary <*> arbitrary
+                      , Record  <$> arbitrary <*> arbitrary <*> arbitrary
+                      ]
 import Data.Char
 
 optsDefault :: Options
-optsDefault = defaultOptions{ fieldNameModifier       = map toLower
-                            , constructorNameModifier = map toLower
-                            , sumEncoding             = TwoElemArray
-                            }
+optsDefault = defaultOptions
+              { fieldNameModifier       = map toLower
+              , constructorNameModifier = map toLower
+              }
 
 opts2ElemArray :: Options
-opts2ElemArray = optsDefault{ nullaryToString = False }
+opts2ElemArray = optsDefault
+                 { nullaryToString = False
+                 , sumEncoding     = TwoElemArray
+                 }
 
 optsObjectWithType :: Options
 optsObjectWithType = optsDefault
-                     { nullaryToString = False
-                     , sumEncoding     = defaultObjectWithType
-                     }
+                     { nullaryToString = False }
 
 optsObjectWithSingleField :: Options
 optsObjectWithSingleField = optsDefault

tests/Properties.hs

-{-# LANGUAGE CPP, DeriveDataTypeable, OverloadedStrings, RecordWildCards,
-    ScopedTypeVariables, StandaloneDeriving, TemplateHaskell #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
 
-#ifdef GENERICS
-{-# LANGUAGE DeriveGeneric, StandaloneDeriving #-}
-#endif
-
-import Control.Monad
-import Control.Applicative
 import Data.Aeson.Encode
 import Data.Aeson.Parser (value)
 import Data.Aeson.Types
-import Data.Aeson.TH
 import Data.Attoparsec.Number
-import Data.Data (Typeable, Data)
-import Data.Function (on)
-import Data.Text (Text)
+import Data.Data (Data)
+import Data.Int
 import Test.Framework (Test, defaultMain, testGroup)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.QuickCheck (Arbitrary(..), choose, oneof, elements, Gen)
+import Test.QuickCheck (Arbitrary(..))
 import qualified Data.Vector as V
 import qualified Data.Aeson.Generic as G
 import qualified Data.Attoparsec.Lazy as L
 import qualified Data.Text as T
 import qualified Data.Map as Map
 import qualified Data.HashMap.Strict as H
-import Data.Time.Calendar (Day)
-import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)
-import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),
-                  hoursToTimeZone, Day(..), TimeOfDay(..))
-import Options
+import Data.Time.Clock (UTCTime(..))
+import Data.Time (ZonedTime(..))
+import Types (Foo(..), UFoo(..))
+import Instances ()
+import Types (Approx(..), OneConstructor(..), Product2, Product6, Sum4)
+import Encoders
 
-#ifdef GENERICS
-import GHC.Generics
-#endif
 
 encodeDouble :: Double -> Double -> Bool
 encodeDouble num denom
 encodeInteger :: Integer -> Bool
 encodeInteger i = encode (Number (I i)) == L.pack (show i)
 
+toParseJSON :: (Arbitrary a, Eq a) => (Value -> Parser a) -> (a -> Value) -> a -> Bool
+toParseJSON parsejson tojson x =
+    case parse parsejson . tojson $ x of
+      Error _ -> False
+      Success x' -> x == x'
+
 roundTrip :: (FromJSON a, ToJSON a) => (a -> a -> Bool) -> a -> a -> Bool
 roundTrip eq _ i =
     case fmap fromJSON . L.parse value . encode . toJSON $ i of
 genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool
 genericFrom _ v = G.fromJSON (toJSON v) == Success v
 
-approxEq :: (Fractional a, Ord a) => a -> a -> Bool
-approxEq = approxEqWith 1e-15 1e-15
-
-approxEqWith :: (Fractional a, Ord a) => a -> a -> a -> a -> Bool
-approxEqWith maxAbsoluteError maxRelativeError a b =
-    a == b || d < maxAbsoluteError ||
-    d / max (abs b) (abs a) <= maxRelativeError
-  where d = abs (a - b)
-
--- Compare equality to within a millisecond, allowing for rounding
--- error (ECMA 262 requires milliseconds to rounded to zero, not
--- rounded to nearest).
-approxEqUTC :: UTCTime -> UTCTime -> Bool
-approxEqUTC a b = ((==) `on` utctDay) a b &&
-                  (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
-
-approxEqNet :: DotNetTime -> DotNetTime -> Bool
-approxEqNet (DotNetTime a) (DotNetTime b) = approxEqUTC a b
-
 toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a) => a -> Bool
 toFromJSON x = case fromJSON . toJSON $ x of
                 Error _ -> False
                 Error _ -> False
                 Success x' -> x == x'
 
-toParseJSON :: (Arbitrary a, Eq a) => (Value -> Parser a) -> (a -> Value) -> a -> Bool
-toParseJSON parsejson tojson x = case parse parsejson . tojson $ x of
-                Error _ -> False
-                Success x' -> x == x'
-
 regress_gh72 :: [(String, Maybe String)] -> Bool
 regress_gh72 ys = G.decode (G.encode m) == Just m
     where m = Map.fromList ys
     result :: Result ()
     result = parse parser ()
 
-data Foo = Foo {
-      fooInt :: Int
-    , fooDouble :: Double
-    , fooTuple :: (String, Text, Int)
-    -- This definition causes an infinite loop in genericTo and genericFrom!
-    -- , fooMap :: Map.Map String Foo
-    , fooMap :: Map.Map String (Text,Int)
-    } deriving (Show, Typeable, Data)
+main :: IO ()
+main = defaultMain tests
 
---------------------------------------------------------------------------------
--- Nullary
---------------------------------------------------------------------------------
-
-data Nullary = C1 | C2 | C3 deriving (Eq, Show)
-
-instance Arbitrary Nullary where
-    arbitrary = elements [C1, C2, C3]
-
-thNullaryToJSONString :: Nullary -> Value
-thNullaryToJSONString = $(mkToJSON optsDefault ''Nullary)
-
-thNullaryParseJSONString :: Value -> Parser Nullary
-thNullaryParseJSONString = $(mkParseJSON optsDefault ''Nullary)
-
-
-thNullaryToJSON2ElemArray :: Nullary -> Value
-thNullaryToJSON2ElemArray = $(mkToJSON opts2ElemArray ''Nullary)
-
-thNullaryParseJSON2ElemArray :: Value -> Parser Nullary
-thNullaryParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''Nullary)
-
-
-thNullaryToJSONObjectWithType :: Nullary -> Value
-thNullaryToJSONObjectWithType = $(mkToJSON optsObjectWithType ''Nullary)
-
-thNullaryParseJSONObjectWithType :: Value -> Parser Nullary
-thNullaryParseJSONObjectWithType = $(mkParseJSON optsObjectWithType ''Nullary)
-
-
-thNullaryToJSONObjectWithSingleField :: Nullary -> Value
-thNullaryToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''Nullary)
-
-thNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
-thNullaryParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''Nullary)
-
-#ifdef GENERICS
-deriving instance Generic Nullary
-
-gNullaryToJSONString :: Nullary -> Value
-gNullaryToJSONString = gToJSON optsDefault . from
-
-gNullaryParseJSONString :: Value -> Parser Nullary
-gNullaryParseJSONString = fmap to . gParseJSON optsDefault
-
-
-gNullaryToJSON2ElemArray :: Nullary -> Value
-gNullaryToJSON2ElemArray = gToJSON opts2ElemArray . from
-
-gNullaryParseJSON2ElemArray :: Value -> Parser Nullary
-gNullaryParseJSON2ElemArray = fmap to . gParseJSON opts2ElemArray
-
-
-gNullaryToJSONObjectWithType :: Nullary -> Value
-gNullaryToJSONObjectWithType = gToJSON optsObjectWithType . from
-
-gNullaryParseJSONObjectWithType :: Value -> Parser Nullary
-gNullaryParseJSONObjectWithType = fmap to . gParseJSON optsObjectWithType
-
-
-gNullaryToJSONObjectWithSingleField :: Nullary -> Value
-gNullaryToJSONObjectWithSingleField = gToJSON optsObjectWithSingleField . from
-
-gNullaryParseJSONObjectWithSingleField :: Value -> Parser Nullary
-gNullaryParseJSONObjectWithSingleField = fmap to . gParseJSON optsObjectWithSingleField
-#endif
-
---------------------------------------------------------------------------------
--- SomeType
---------------------------------------------------------------------------------
-
-data SomeType a = Nullary
-                | Unary Int
-                | Product String (Maybe Char) a
-                | Record { testOne   :: Double
-                         , testTwo   :: Maybe Bool
-                         , testThree :: Maybe a
-                         } deriving (Eq, Show)
-
-instance Arbitrary a => Arbitrary (SomeType a) where
-    arbitrary = oneof [ pure Nullary
-                      , Unary   <$> arbitrary
-                      , Product <$> arbitrary <*> arbitrary <*> arbitrary
-                      , Record  <$> arbitrary <*> arbitrary <*> arbitrary
-                      ]
-
-type SomeTypeToJSON = SomeType Int -> Value
-
-thSomeTypeToJSON2ElemArray :: ToJSON a => SomeType a -> Value
-thSomeTypeToJSON2ElemArray = $(mkToJSON opts2ElemArray ''SomeType)
-
-thSomeTypeParseJSON2ElemArray :: FromJSON a => Value -> Parser (SomeType a)
-thSomeTypeParseJSON2ElemArray = $(mkParseJSON opts2ElemArray ''SomeType)
-
-
-thSomeTypeToJSONObjectWithType :: ToJSON a => SomeType a -> Value
-thSomeTypeToJSONObjectWithType = $(mkToJSON optsObjectWithType ''SomeType)
-
-thSomeTypeParseJSONObjectWithType :: FromJSON a => Value -> Parser (SomeType a)
-thSomeTypeParseJSONObjectWithType = $(mkParseJSON optsObjectWithType ''SomeType)
-
-
-thSomeTypeToJSONObjectWithSingleField :: ToJSON a => SomeType a -> Value
-thSomeTypeToJSONObjectWithSingleField = $(mkToJSON optsObjectWithSingleField ''SomeType)
-
-thSomeTypeParseJSONObjectWithSingleField :: FromJSON a => Value -> Parser (SomeType a)
-thSomeTypeParseJSONObjectWithSingleField = $(mkParseJSON optsObjectWithSingleField ''SomeType)
-
-#ifdef GENERICS
-deriving instance Generic (SomeType a)
-
-gSomeTypeToJSON2ElemArray :: ToJSON a => SomeType a -> Value
-gSomeTypeToJSON2ElemArray = gToJSON opts2ElemArray . from
-
-gSomeTypeParseJSON2ElemArray :: FromJSON a => Value -> Parser (SomeType a)
-gSomeTypeParseJSON2ElemArray = fmap to . gParseJSON opts2ElemArray
-
-
-gSomeTypeToJSONObjectWithType :: ToJSON a => SomeType a -> Value
-gSomeTypeToJSONObjectWithType = gToJSON optsObjectWithType . from
-
-gSomeTypeParseJSONObjectWithType :: FromJSON a => Value -> Parser (SomeType a)
-gSomeTypeParseJSONObjectWithType = fmap to . gParseJSON optsObjectWithType
-
-
-gSomeTypeToJSONObjectWithSingleField :: ToJSON a => SomeType a -> Value
-gSomeTypeToJSONObjectWithSingleField = gToJSON optsObjectWithSingleField . from
-
-gSomeTypeParseJSONObjectWithSingleField :: FromJSON a => Value -> Parser (SomeType a)
-gSomeTypeParseJSONObjectWithSingleField = fmap to . gParseJSON optsObjectWithSingleField
-#endif
+type P6 = Product6 Int Bool String (Approx Double) (Int, Approx Double) ()
+type S4 = Sum4 Int8 ZonedTime T.Text (Map.Map String Int)
 
 --------------------------------------------------------------------------------
 -- Value properties
 isObjectWithTypeValue _            = False
 
 isObjectWithType :: Value -> Bool
-isObjectWithType (Object obj) = "type"  `H.member` obj
+isObjectWithType (Object obj) = "type" `H.member` obj
 isObjectWithType _            = False
 
 isObjectWithSingleField :: Value -> Bool
 
 --------------------------------------------------------------------------------
 
-instance Eq Foo where
-    a == b = fooInt a == fooInt b &&
-             fooDouble a `approxEq` fooDouble b &&
-             fooTuple a == fooTuple b
-
-instance ToJSON Foo where
-    toJSON Foo{..} = object [ "fooInt" .= fooInt
-                            , "fooDouble" .= fooDouble
-                            , "fooTuple" .= fooTuple
-                            , "fooMap" .= fooMap
-                            ]
-
-instance FromJSON Foo where
-    parseJSON (Object v) = Foo <$>
-                           v .: "fooInt" <*>
-                           v .: "fooDouble" <*>
-                           v .: "fooTuple" <*>
-                           v .: "fooMap"
-    parseJSON _ = empty
-
-instance Arbitrary Text where
-    arbitrary = T.pack <$> arbitrary
-
-instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
-    arbitrary = Map.fromList <$> arbitrary
-
-instance Arbitrary Foo where
-    arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
-
-instance Arbitrary LocalTime where
-    arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
-
-instance Arbitrary TimeZone where
-    arbitrary = do
-      offset <- choose (0,2) :: Gen Int
-      return $ hoursToTimeZone offset
-
-instance Arbitrary Day where
-    arbitrary = ModifiedJulianDay `liftM` arbitrary
-
-instance Arbitrary DiffTime where
-    arbitrary = picosecondsToDiffTime `liftM` choose (0, 86400000000000000)
-
-instance Arbitrary UTCTime where
-    arbitrary = liftM2 UTCTime arbitrary arbitrary
-
-instance Arbitrary DotNetTime where
-    arbitrary = DotNetTime `liftM` arbitrary
-
-instance Arbitrary ZonedTime where
-    arbitrary = liftM2 ZonedTime arbitrary arbitrary
-
-data UFoo = UFoo {
-      _UFooInt :: Int
-    , uFooInt :: Int
-    } deriving (Show, Eq, Data, Typeable)
-
-instance Arbitrary UFoo where
-    arbitrary = UFoo <$> arbitrary <*> arbitrary
-        where _ = uFooInt
-
-main :: IO ()
-main = defaultMain tests
-
-deriving instance Eq ZonedTime
-
 tests :: [Test]
 tests = [
   testGroup "regression" [
     ],
   testGroup "roundTrip" [
       testProperty "Bool" $ roundTripEq True
-    , testProperty "Double" $ roundTrip approxEq (1::Double)
+    , testProperty "Double" $ roundTripEq (1 :: Approx 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)
-    , testProperty "DotNetTime" $ roundTrip approxEqNet undefined
-    , testProperty "UTCTime" $ roundTrip approxEqUTC undefined
+    , testProperty "DotNetTime" $ roundTripEq (undefined :: Approx DotNetTime)
+    , testProperty "UTCTime" $ roundTripEq (undefined :: Approx UTCTime)
     , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)
+    , testGroup "ghcGenerics" [
+        testProperty "OneConstructor" $ roundTripEq OneConstructor
+      , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)
+      , testProperty "Product6" $ roundTripEq (undefined :: P6)
+      , testProperty "Sum4" $ roundTripEq (undefined :: S4)
+      ]
     ],
   testGroup "toFromJSON" [
       testProperty "Integer" (toFromJSON :: Integer -> Bool)
       testProperty "modify failure" modifyFailureProp
     ],
   testGroup "template-haskell" [
-    testGroup "Nullary" [
-        testProperty "string"                (isString                . thNullaryToJSONString)
-      , testProperty "2ElemArray"            (is2ElemArray            . thNullaryToJSON2ElemArray)
-      , testProperty "ObjectWithType"        (isObjectWithTypeValue   . thNullaryToJSONObjectWithType)
-      , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField)
+      testGroup "Nullary" [
+          testProperty "string"                (isString                . thNullaryToJSONString)
+        , testProperty "2ElemArray"            (is2ElemArray            . thNullaryToJSON2ElemArray)
+        , testProperty "ObjectWithType"        (isObjectWithTypeValue   . thNullaryToJSONObjectWithType)
+        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . thNullaryToJSONObjectWithSingleField)
 
-      , testGroup "roundTrip" [
-            testProperty "string"                (toParseJSON thNullaryParseJSONString                thNullaryToJSONString)
-          , testProperty "2ElemArray"            (toParseJSON thNullaryParseJSON2ElemArray            thNullaryToJSON2ElemArray)
-          , testProperty "ObjectWithType"        (toParseJSON thNullaryParseJSONObjectWithType        thNullaryToJSONObjectWithType)
-          , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField)
-        ]
-      ]
-   , testGroup "SomeType" [
-        testProperty "2ElemArray"            (is2ElemArray            . (thSomeTypeToJSON2ElemArray            :: SomeTypeToJSON))
-      , testProperty "ObjectWithType"        (isObjectWithType        . (thSomeTypeToJSONObjectWithType        :: SomeTypeToJSON))
-      , testProperty "ObjectWithSingleField" (isObjectWithSingleField . (thSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
-
-      , testGroup "roundTrip" [
-            testProperty "2ElemArray"            (toParseJSON thSomeTypeParseJSON2ElemArray            (thSomeTypeToJSON2ElemArray            :: SomeTypeToJSON))
-          , testProperty "ObjectWithType"        (toParseJSON thSomeTypeParseJSONObjectWithType        (thSomeTypeToJSONObjectWithType        :: SomeTypeToJSON))
-          , testProperty "ObjectWithSingleField" (toParseJSON thSomeTypeParseJSONObjectWithSingleField (thSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
-        ]
-    ]
-    ]
-#ifdef GENERICS
-  , testGroup "GHC-generics" [
-      testGroup "Nullary" [
-          testProperty "string"                (isString                . gNullaryToJSONString)
-        , testProperty "2ElemArray"            (is2ElemArray            . gNullaryToJSON2ElemArray)
-        , testProperty "ObjectWithType"        (isObjectWithTypeValue   . gNullaryToJSONObjectWithType)
-        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gNullaryToJSONObjectWithSingleField)
-
-        , testGroup "eq" [
-              testProperty "string"                (\n -> gNullaryToJSONString                n == thNullaryToJSONString                n)
-            , testProperty "2ElemArray"            (\n -> gNullaryToJSON2ElemArray            n == thNullaryToJSON2ElemArray            n)
-            , testProperty "ObjectWithType"        (\n -> gNullaryToJSONObjectWithType        n == thNullaryToJSONObjectWithType        n)
-            , testProperty "ObjectWithSingleField" (\n -> gNullaryToJSONObjectWithSingleField n == thNullaryToJSONObjectWithSingleField n)
-          ]
         , testGroup "roundTrip" [
-            testProperty "string"                (toParseJSON gNullaryParseJSONString                gNullaryToJSONString)
-          , testProperty "2ElemArray"            (toParseJSON gNullaryParseJSON2ElemArray            gNullaryToJSON2ElemArray)
-          , testProperty "ObjectWithType"        (toParseJSON gNullaryParseJSONObjectWithType        gNullaryToJSONObjectWithType)
-          , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField)
+              testProperty "string"                (toParseJSON thNullaryParseJSONString                thNullaryToJSONString)
+            , testProperty "2ElemArray"            (toParseJSON thNullaryParseJSON2ElemArray            thNullaryToJSON2ElemArray)
+            , testProperty "ObjectWithType"        (toParseJSON thNullaryParseJSONObjectWithType        thNullaryToJSONObjectWithType)
+            , testProperty "ObjectWithSingleField" (toParseJSON thNullaryParseJSONObjectWithSingleField thNullaryToJSONObjectWithSingleField)
           ]
         ]
     , testGroup "SomeType" [
+          testProperty "2ElemArray"            (is2ElemArray            . (thSomeTypeToJSON2ElemArray            :: SomeTypeToJSON))
+        , testProperty "ObjectWithType"        (isObjectWithType        . (thSomeTypeToJSONObjectWithType        :: SomeTypeToJSON))
+        , testProperty "ObjectWithSingleField" (isObjectWithSingleField . (thSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
+
+        , testGroup "roundTrip" [
+              testProperty "2ElemArray"            (toParseJSON thSomeTypeParseJSON2ElemArray            (thSomeTypeToJSON2ElemArray            :: SomeTypeToJSON))
+            , testProperty "ObjectWithType"        (toParseJSON thSomeTypeParseJSONObjectWithType        (thSomeTypeToJSONObjectWithType        :: SomeTypeToJSON))
+            , testProperty "ObjectWithSingleField" (toParseJSON thSomeTypeParseJSONObjectWithSingleField (thSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
+          ]
+      ]
+    ]
+  , testGroup "GHC-generics" [
+        testGroup "Nullary" [
+            testProperty "string"                (isString                . gNullaryToJSONString)
+          , testProperty "2ElemArray"            (is2ElemArray            . gNullaryToJSON2ElemArray)
+          , testProperty "ObjectWithType"        (isObjectWithTypeValue   . gNullaryToJSONObjectWithType)
+          , testProperty "ObjectWithSingleField" (isObjectWithSingleField . gNullaryToJSONObjectWithSingleField)
+          , testGroup "eq" [
+                testProperty "string"                (\n -> gNullaryToJSONString                n == thNullaryToJSONString                n)
+              , testProperty "2ElemArray"            (\n -> gNullaryToJSON2ElemArray            n == thNullaryToJSON2ElemArray            n)
+              , testProperty "ObjectWithType"        (\n -> gNullaryToJSONObjectWithType        n == thNullaryToJSONObjectWithType        n)
+              , testProperty "ObjectWithSingleField" (\n -> gNullaryToJSONObjectWithSingleField n == thNullaryToJSONObjectWithSingleField n)
+            ]
+          , testGroup "roundTrip" [
+              testProperty "string"                (toParseJSON gNullaryParseJSONString                gNullaryToJSONString)
+            , testProperty "2ElemArray"            (toParseJSON gNullaryParseJSON2ElemArray            gNullaryToJSON2ElemArray)
+            , testProperty "ObjectWithType"        (toParseJSON gNullaryParseJSONObjectWithType        gNullaryToJSONObjectWithType)
+            , testProperty "ObjectWithSingleField" (toParseJSON gNullaryParseJSONObjectWithSingleField gNullaryToJSONObjectWithSingleField)
+            ]
+          ]
+    , testGroup "SomeType" [
           testProperty "2ElemArray"            (is2ElemArray            . (gSomeTypeToJSON2ElemArray            :: SomeTypeToJSON))
         , testProperty "ObjectWithType"        (isObjectWithType        . (gSomeTypeToJSONObjectWithType        :: SomeTypeToJSON))
         , testProperty "ObjectWithSingleField" (isObjectWithSingleField . (gSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
           , testProperty "ObjectWithType"        (toParseJSON gSomeTypeParseJSONObjectWithType        (gSomeTypeToJSONObjectWithType        :: SomeTypeToJSON))
           , testProperty "ObjectWithSingleField" (toParseJSON gSomeTypeParseJSONObjectWithSingleField (gSomeTypeToJSONObjectWithSingleField :: SomeTypeToJSON))
           ]
-        ]
+      ]
     ]
-#endif
   ]
+{-# LANGUAGE DefaultSignatures, DeriveDataTypeable, DeriveGeneric,
+    GeneralizedNewtypeDeriving #-}
+
+module Types where
+
+import qualified Data.Map as Map
+import Data.Data
+import Data.Text
+import GHC.Generics
+
+data Foo = Foo {
+      fooInt :: Int
+    , fooDouble :: Double
+    , fooTuple :: (String, Text, Int)
+    -- This definition causes an infinite loop in genericTo and genericFrom!
+    -- , fooMap :: Map.Map String Foo
+    , fooMap :: Map.Map String (Text,Int)
+    } deriving (Show, Typeable, Data, Generic)
+
+data UFoo = UFoo {
+      _UFooInt :: Int
+    , uFooInt :: Int
+    } deriving (Show, Eq, Data, Typeable, Generic)
+
+data OneConstructor = OneConstructor
+                      deriving (Show, Eq, Typeable, Data, Generic)
+
+data Product2 a b = Product2 a b
+                    deriving (Show, Eq, Typeable, Data, Generic)
+
+data Product6 a b c d e f = Product6 a b c d e f
+                    deriving (Show, Eq, Typeable, Data, Generic)
+
+data Sum4 a b c d = Alt1 a | Alt2 b | Alt3 c | Alt4 d
+                    deriving (Show, Eq, Typeable, Data, Generic)
+
+class ApproxEq a where
+    (=~) :: a -> a -> Bool
+
+    default (=~) :: (Eq a) => a -> a -> Bool
+    (=~) = (==)
+
+newtype Approx a = Approx { fromApprox :: a }
+    deriving (Show, Data, Typeable, Generic, ApproxEq, Num)
+
+instance (ApproxEq a) => Eq (Approx a) where
+    Approx a == Approx b = a =~ b
+
+data Nullary = C1 | C2 | C3 deriving (Eq, Show, Generic)
+
+data SomeType a = Nullary
+                | Unary Int
+                | Product String (Maybe Char) a
+                | Record { testOne   :: Double
+                         , testTwo   :: Maybe Bool
+                         , testThree :: Maybe a
+                         } deriving (Eq, Show, Generic)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.