89aefad · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Merge pull request #342 from phadej/qc-instances

89aefadBryan O'Sullivan11 years ago

aeson.cabal+2−1

compare with master

unifiedsplit

@@ -159,7 +159,8 @@ test-suite tests

159 text,

160 time,

161 unordered-containers,

162− vector

162+ vector,

163+ quickcheck-instances >=0.3.12

163

164

164 if flag(old-locale)

165 if flag(old-locale)

165 build-depends: time < 1.5, old-locale

166 build-depends: time < 1.5, old-locale

tests/Instances.hs+9−49

@@ -10,67 +10,27 @@ module Instances where

10import Types

11import Data.Function (on)

12import Control.Monad

13−import Test.QuickCheck (Arbitrary(..), Gen, choose, getNonNegative, elements,

13+import Test.QuickCheck (Arbitrary(..), getNonNegative, elements,

14 listOf1, oneof, resize)

15−import Data.Time.Clock (DiffTime, UTCTime(..), picosecondsToDiffTime)

15+import Data.Time.Clock (UTCTime(..))

16−import Data.Fixed (Pico)

17−import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..),

16+import Data.Time (ZonedTime(..), TimeZone(..))

18− hoursToTimeZone, Day(..), TimeOfDay(..),

19− NominalDiffTime)

20import Data.Version

17import Data.Version

21−import qualified Data.Text as T

22−import Data.Text (Text)

23import Data.Aeson.Types

18import Data.Aeson.Types

24import Control.Applicative

19import Control.Applicative

25import Functions

20import Functions

27−#if !MIN_VERSION_QuickCheck(2,8,2)

22+import Test.QuickCheck.Instances ()

28−import qualified Data.Map as Map

29−

30−instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where

31− arbitrary = Map.fromList <$> arbitrary

32−#endif

34-- "System" types.

24-- "System" types.

36−instance Arbitrary Text where

37− arbitrary = T.pack <$> arbitrary

38−

39−instance Arbitrary TimeOfDay where

40− arbitrary = do

41− h <- choose (0, 23)

42− m <- choose (0, 59)

43− s <- fromRational . toRational <$> choose (0, 59 :: Double)

44− return $ TimeOfDay h m s

45−

46−instance Arbitrary LocalTime where

47− arbitrary = LocalTime <$> arbitrary <*> arbitrary

48−

49−instance Arbitrary TimeZone where

50− arbitrary = do

51− offset <- choose (0,2) :: Gen Int

52− return $ hoursToTimeZone offset

53−

54−instance Arbitrary Day where

55− arbitrary = ModifiedJulianDay `liftM` arbitrary

56−

57−instance Arbitrary DiffTime where

58− arbitrary = (picosecondsToDiffTime . (* 1000000000)) <$>

59− choose (0, 86400000)

60−

61−instance Arbitrary UTCTime where

62− arbitrary = liftM2 UTCTime arbitrary arbitrary

63−

64instance Arbitrary DotNetTime where

26instance Arbitrary DotNetTime where

65 arbitrary = DotNetTime `liftM` arbitrary

27 arbitrary = DotNetTime `liftM` arbitrary

28+ shrink = map DotNetTime . shrink . fromDotNetTime

67−instance Arbitrary ZonedTime where

30+-- | Compare timezone part only on 'timeZoneMinutes'

68− arbitrary = liftM2 ZonedTime arbitrary arbitrary

69−

70−instance Arbitrary NominalDiffTime where

71− arbitrary = realToFrac <$> (arbitrary :: Gen Pico)

72−

73−deriving instance Eq ZonedTime

31+instance Eq ZonedTime where

32+ ZonedTime a (TimeZone a' _ _) == ZonedTime b (TimeZone b' _ _) =

33+ a == b && a' == b'

75-- Compare equality to within a millisecond, allowing for rounding

35-- Compare equality to within a millisecond, allowing for rounding

76-- error (ECMA 262 requires milliseconds to rounded to zero, not

36-- error (ECMA 262 requires milliseconds to rounded to zero, not

tests/Properties.hs+10−2

@@ -16,7 +16,7 @@ import Encoders

16import Instances ()

17import Test.Framework (Test, testGroup)

18import Test.Framework.Providers.QuickCheck2 (testProperty)

19−import Test.QuickCheck (Arbitrary(..), Property, (===), (.&&.))

19+import Test.QuickCheck (Arbitrary(..), Property, (===), (.&&.), counterexample)

20import Types

21import qualified Data.Attoparsec.Lazy as L

22import qualified Data.ByteString.Lazy.Char8 as L

@@ -59,6 +59,14 @@ roundTripNoEnc eq _ i =

59roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property

60roundTripEq x y = roundTripEnc (===) x y .&&. roundTripNoEnc (===) x y

62+infix 4 ==~

63+(==~) :: (ApproxEq a, Show a) => a -> a -> Property

64+x ==~ y =

65+ counterexample (show x ++ " /= " ++ show y) (x =~ y)

66+

67+roundTripApproxEq :: (ApproxEq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property

68+roundTripApproxEq x y = roundTripEnc (==~) x y .&&. roundTripNoEnc (==~) x y

69+

62toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a, Show a) => a -> Property

70toFromJSON :: (Arbitrary a, Eq a, FromJSON a, ToJSON a, Show a) => a -> Property

63toFromJSON x = case ifromJSON (toJSON x) of

71toFromJSON x = case ifromJSON (toJSON x) of

64 IError path err -> failure "fromJSON" (formatError path err) x

72 IError path err -> failure "fromJSON" (formatError path err) x

@@ -124,7 +132,7 @@ tests = testGroup "properties" [

124 , testProperty "Text" $ roundTripEq T.empty

132 , testProperty "Text" $ roundTripEq T.empty

125 , testProperty "Foo" $ roundTripEq (undefined :: Foo)

133 , testProperty "Foo" $ roundTripEq (undefined :: Foo)

126 , testProperty "Day" $ roundTripEq (undefined :: Day)

134 , testProperty "Day" $ roundTripEq (undefined :: Day)

127− , testProperty "DotNetTime" $ roundTripEq (undefined :: DotNetTime)

135+ , testProperty "DotNetTime" $ roundTripApproxEq (undefined :: DotNetTime)

128 , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)

136 , testProperty "LocalTime" $ roundTripEq (undefined :: LocalTime)

129 , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)

137 , testProperty "TimeOfDay" $ roundTripEq (undefined :: TimeOfDay)

130 , testProperty "UTCTime" $ roundTripEq (undefined :: UTCTime)

138 , testProperty "UTCTime" $ roundTripEq (undefined :: UTCTime)