git.iko.soy/typeable/aeson
on 0.11.0.0 help sign in
typeable/aeson/tests/Instances.hs
147 lines 4.9 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE RecordWildCards #-}
5{-# LANGUAGE StandaloneDeriving #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
8module Instances where
10import Types
11import Data.Function (on)
12import Control.Monad
13import Test.QuickCheck (Arbitrary(..), getNonNegative, elements,
14 listOf1, oneof, resize)
15import Data.Time.Clock (UTCTime(..))
16import Data.Time (ZonedTime(..), TimeZone(..))
17import Data.Version
18import Data.Aeson.Types
19import Control.Applicative
20import Functions
22import Test.QuickCheck.Instances ()
24-- "System" types.
26instance Arbitrary DotNetTime where
27 arbitrary = DotNetTime `liftM` arbitrary
28 shrink = map DotNetTime . shrink . fromDotNetTime
30-- | Compare timezone part only on 'timeZoneMinutes'
31instance Eq ZonedTime where
32 ZonedTime a (TimeZone a' _ _) == ZonedTime b (TimeZone b' _ _) =
33 a == b && a' == b'
35-- Compare equality to within a millisecond, allowing for rounding
36-- error (ECMA 262 requires milliseconds to rounded to zero, not
37-- rounded to nearest).
38instance ApproxEq UTCTime where
39 a =~ b = ((==) `on` utctDay) a b &&
40 (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
42instance ApproxEq DotNetTime where
43 (=~) = (=~) `on` fromDotNetTime
45instance ApproxEq Double where
46 (=~) = approxEq
48-- Test-related types.
50instance Arbitrary Foo where
51 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
53instance Eq Foo where
54 a == b = fooInt a == fooInt b &&
55 fooDouble a `approxEq` fooDouble b &&
56 fooTuple a == fooTuple b
58instance ToJSON Foo where
59 toJSON Foo{..} = object [ "fooInt" .= fooInt
60 , "fooDouble" .= fooDouble
61 , "fooTuple" .= fooTuple
62 , "fooMap" .= fooMap
63 ]
65instance FromJSON Foo where
66 parseJSON (Object v) = Foo <$>
67 v .: "fooInt" <*>
68 v .: "fooDouble" <*>
69 v .: "fooTuple" <*>
70 v .: "fooMap"
71 parseJSON _ = empty
73instance Arbitrary UFoo where
74 arbitrary = UFoo <$> arbitrary <*> arbitrary
75 where _ = uFooInt
77instance Arbitrary OneConstructor where
78 arbitrary = return OneConstructor
80instance FromJSON OneConstructor
81instance ToJSON OneConstructor
83instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
84 arbitrary = liftM2 Product2 arbitrary arbitrary
86instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
87instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
89instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
90 Arbitrary f) => Arbitrary (Product6 a b c d e f) where
91 arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
92 arbitrary <*> arbitrary <*> arbitrary
94instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
95 FromJSON f) => FromJSON (Product6 a b c d e f)
96instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
97 ToJSON f) => ToJSON (Product6 a b c d e f)
99instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
100 => Arbitrary (Sum4 a b c d) where
101 arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
102 Alt3 <$> arbitrary, Alt4 <$> arbitrary]
104instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
105 => FromJSON (Sum4 a b c d)
106instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
108instance (Arbitrary a) => Arbitrary (Approx a) where
109 arbitrary = Approx <$> arbitrary
111instance (FromJSON a) => FromJSON (Approx a) where
112 parseJSON a = Approx <$> parseJSON a
114instance (ToJSON a) => ToJSON (Approx a) where
115 toJSON = toJSON . fromApprox
117instance Arbitrary Nullary where
118 arbitrary = elements [C1, C2, C3]
120instance Arbitrary a => Arbitrary (SomeType a) where
121 arbitrary = oneof [ pure Nullary
122 , Unary <$> arbitrary
123 , Product <$> arbitrary <*> arbitrary <*> arbitrary
124 , Record <$> arbitrary <*> arbitrary <*> arbitrary
125 ]
127instance Arbitrary (GADT String) where
128 arbitrary = GADT <$> arbitrary
130instance ApproxEq Char where
131 (=~) = (==)
133instance (ApproxEq a) => ApproxEq [a] where
134 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)
136instance Arbitrary Version where
137 arbitrary = makeVersion . fmap getNonNegative <$> resize 4 (listOf1 arbitrary)
139-- Version tags are deprecated, so we avoid using them in the Arbitrary
140-- instance. However, the recommended constructor 'makeVersion' is not
141-- exported by "Data.Version" until base-4.8.0.0. For previous versions,
142-- a definition is given below.
144#if !MIN_VERSION_base(4,8,0)
145makeVersion :: [Int] -> Version
146makeVersion b = Version b []
147#endif