git.iko.soy/typeable/aeson
on 0.11.2.0-r1 help sign in
typeable/aeson/tests/Instances.hs
173 lines 5.7 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.List.NonEmpty (NonEmpty(..))
18import Data.Version
19import Data.Aeson.Types
20import Control.Applicative (Const(..))
21import Data.Tagged (Tagged(..))
22import Data.Proxy (Proxy(..))
23import Control.Applicative
24import Functions
26import Data.Orphans ()
27import Test.QuickCheck.Instances ()
29#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)
30import Numeric.Natural
31#endif
33-- "System" types.
35instance Arbitrary DotNetTime where
36 arbitrary = DotNetTime `liftM` arbitrary
37 shrink = map DotNetTime . shrink . fromDotNetTime
39-- | Compare timezone part only on 'timeZoneMinutes'
40instance Eq ZonedTime where
41 ZonedTime a (TimeZone a' _ _) == ZonedTime b (TimeZone b' _ _) =
42 a == b && a' == b'
44-- Compare equality to within a millisecond, allowing for rounding
45-- error (ECMA 262 requires milliseconds to rounded to zero, not
46-- rounded to nearest).
47instance ApproxEq UTCTime where
48 a =~ b = ((==) `on` utctDay) a b &&
49 (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
51instance ApproxEq DotNetTime where
52 (=~) = (=~) `on` fromDotNetTime
54instance ApproxEq Double where
55 (=~) = approxEq
57-- Test-related types.
59instance Arbitrary Foo where
60 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
62instance Eq Foo where
63 a == b = fooInt a == fooInt b &&
64 fooDouble a `approxEq` fooDouble b &&
65 fooTuple a == fooTuple b
67instance ToJSON Foo where
68 toJSON Foo{..} = object [ "fooInt" .= fooInt
69 , "fooDouble" .= fooDouble
70 , "fooTuple" .= fooTuple
71 , "fooMap" .= fooMap
72 ]
74instance FromJSON Foo where
75 parseJSON (Object v) = Foo <$>
76 v .: "fooInt" <*>
77 v .: "fooDouble" <*>
78 v .: "fooTuple" <*>
79 v .: "fooMap"
80 parseJSON _ = empty
82instance Arbitrary UFoo where
83 arbitrary = UFoo <$> arbitrary <*> arbitrary
84 where _ = uFooInt
86instance Arbitrary OneConstructor where
87 arbitrary = return OneConstructor
89instance FromJSON OneConstructor
90instance ToJSON OneConstructor
92instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
93 arbitrary = liftM2 Product2 arbitrary arbitrary
95instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
96instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
98instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
99 Arbitrary f) => Arbitrary (Product6 a b c d e f) where
100 arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
101 arbitrary <*> arbitrary <*> arbitrary
103instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
104 FromJSON f) => FromJSON (Product6 a b c d e f)
105instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
106 ToJSON f) => ToJSON (Product6 a b c d e f)
108instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
109 => Arbitrary (Sum4 a b c d) where
110 arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
111 Alt3 <$> arbitrary, Alt4 <$> arbitrary]
113instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
114 => FromJSON (Sum4 a b c d)
115instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
117instance (Arbitrary a) => Arbitrary (Approx a) where
118 arbitrary = Approx <$> arbitrary
120instance (FromJSON a) => FromJSON (Approx a) where
121 parseJSON a = Approx <$> parseJSON a
123instance (ToJSON a) => ToJSON (Approx a) where
124 toJSON = toJSON . fromApprox
126instance Arbitrary Nullary where
127 arbitrary = elements [C1, C2, C3]
129instance Arbitrary a => Arbitrary (SomeType a) where
130 arbitrary = oneof [ pure Nullary
131 , Unary <$> arbitrary
132 , Product <$> arbitrary <*> arbitrary <*> arbitrary
133 , Record <$> arbitrary <*> arbitrary <*> arbitrary
134 ]
136instance Arbitrary (GADT String) where
137 arbitrary = GADT <$> arbitrary
139instance ApproxEq Char where
140 (=~) = (==)
142instance (ApproxEq a) => ApproxEq [a] where
143 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)
145instance Arbitrary Version where
146 arbitrary = makeVersion . fmap getNonNegative <$> resize 4 (listOf1 arbitrary)
148instance Arbitrary a => Arbitrary (NonEmpty a) where
149 arbitrary = (:|) <$> arbitrary <*> arbitrary
151-- Version tags are deprecated, so we avoid using them in the Arbitrary
152-- instance. However, the recommended constructor 'makeVersion' is not
153-- exported by "Data.Version" until base-4.8.0.0. For previous versions,
154-- a definition is given below.
156#if !MIN_VERSION_base(4,8,0)
157makeVersion :: [Int] -> Version
158makeVersion b = Version b []
159#endif
161#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)
162instance Arbitrary Natural where
163 arbitrary = fromInteger . abs <$> arbitrary
164#endif
166instance Arbitrary (Proxy a) where
167 arbitrary = pure Proxy
169instance Arbitrary b => Arbitrary (Tagged a b) where
170 arbitrary = Tagged <$> arbitrary
172instance Arbitrary a => Arbitrary (Const a b) where
173 arbitrary = Const <$> arbitrary