@@ -1,28 +1,24 @@
1−{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards,
2− ScopedTypeVariables, StandaloneDeriving #-}
3−{-# OPTIONS_GHC -fno-warn-orphans #-}
1+{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-}
42
5−import Control.Monad
6−import Control.Applicative
73import Data.Aeson.Encode
84import Data.Aeson.Parser (value)
95import Data.Aeson.Types
106import Data.Attoparsec.Number
11−import Data.Data (Typeable, Data)
7+import Data.Data (Data)
128import Data.Function (on)
13−import Data.Text (Text)
149import Test.Framework (Test, defaultMain, testGroup)
1510import Test.Framework.Providers.QuickCheck2 (testProperty)
16−import Test.QuickCheck (Arbitrary(..), choose, Gen)
11+import Test.QuickCheck (Arbitrary(..))
1712import qualified Data.Aeson.Generic as G
1813import qualified Data.Attoparsec.Lazy as L
1914import qualified Data.ByteString.Lazy.Char8 as L
2015import qualified Data.Text as T
2116import qualified Data.Map as Map
22−import Data.Time.Calendar (Day)
23−import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)
24−import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),
25− hoursToTimeZone, Day(..), TimeOfDay(..))
17+import Data.Time.Clock (UTCTime(..))
18+import Data.Time (ZonedTime(..))
19+import Types (Foo(..), UFoo(..))
20+import Functions
21+import Instances ()
2622
2723encodeDouble :: Double -> Double -> Bool
2824encodeDouble num denom
@@ -48,15 +44,6 @@ genericTo _ v = G.toJSON v == toJSON v
4844genericFrom :: (Eq a, Data a, ToJSON a) => a -> a -> Bool
4945genericFrom _ v = G.fromJSON (toJSON v) == Success v
5046
51−approxEq :: (Fractional a, Ord a) => a -> a -> Bool
52−approxEq = approxEqWith 1e-15 1e-15
53−
54−approxEqWith :: (Fractional a, Ord a) => a -> a -> a -> a -> Bool
55−approxEqWith maxAbsoluteError maxRelativeError a b =
56− a == b || d < maxAbsoluteError ||
57− d / max (abs b) (abs a) <= maxRelativeError
58− where d = abs (a - b)
59−
6047-- Compare equality to within a millisecond, allowing for rounding
6148-- error (ECMA 262 requires milliseconds to rounded to zero, not
6249-- rounded to nearest).
@@ -89,81 +76,9 @@ modifyFailureProp orig added =
8976 result :: Result ()
9077 result = parse parser ()
9178
92−data Foo = Foo {
93− fooInt :: Int
94− , fooDouble :: Double
95− , fooTuple :: (String, Text, Int)
96− -- This definition causes an infinite loop in genericTo and genericFrom!
97− -- , fooMap :: Map.Map String Foo
98− , fooMap :: Map.Map String (Text,Int)
99− } deriving (Show, Typeable, Data)
100−
101−instance Eq Foo where
102− a == b = fooInt a == fooInt b &&
103− fooDouble a `approxEq` fooDouble b &&
104− fooTuple a == fooTuple b
105−
106−instance ToJSON Foo where
107− toJSON Foo{..} = object [ "fooInt" .= fooInt
108− , "fooDouble" .= fooDouble
109− , "fooTuple" .= fooTuple
110− , "fooMap" .= fooMap
111− ]
112−
113−instance FromJSON Foo where
114− parseJSON (Object v) = Foo <$>
115− v .: "fooInt" <*>
116− v .: "fooDouble" <*>
117− v .: "fooTuple" <*>
118− v .: "fooMap"
119− parseJSON _ = empty
120−
121−instance Arbitrary Text where
122− arbitrary = T.pack <$> arbitrary
123−
124−instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where
125− arbitrary = Map.fromList <$> arbitrary
126−
127−instance Arbitrary Foo where
128− arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
129−
130−instance Arbitrary LocalTime where
131− arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)
132−
133−instance Arbitrary TimeZone where
134− arbitrary = do
135− offset <- choose (0,2) :: Gen Int
136− return $ hoursToTimeZone offset
137−
138−instance Arbitrary Day where
139− arbitrary = ModifiedJulianDay `liftM` arbitrary
140−
141−instance Arbitrary DiffTime where
142− arbitrary = picosecondsToDiffTime `liftM` choose (0, 86400000000000000)
143−
144−instance Arbitrary UTCTime where
145− arbitrary = liftM2 UTCTime arbitrary arbitrary
146−
147−instance Arbitrary DotNetTime where
148− arbitrary = DotNetTime `liftM` arbitrary
149−
150−instance Arbitrary ZonedTime where
151− arbitrary = liftM2 ZonedTime arbitrary arbitrary
152−
153−data UFoo = UFoo {
154− _UFooInt :: Int
155− , uFooInt :: Int
156− } deriving (Show, Eq, Data, Typeable)
157−
158−instance Arbitrary UFoo where
159− arbitrary = UFoo <$> arbitrary <*> arbitrary
160− where _ = uFooInt
161−
16279main :: IO ()
16380main = defaultMain tests
16481
165−deriving instance Eq ZonedTime
166−
16782tests :: [Test]
16883tests = [
16984 testGroup "regression" [