git.iko.soy/typeable/aeson
on 1.1.1.0 help sign in
typeable/aeson/tests/Instances.hs
228 lines 7.2 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE RecordWildCards #-}
6{-# LANGUAGE StandaloneDeriving #-}
7{-# OPTIONS_GHC -fno-warn-orphans #-}
9module Instances () where
11import Prelude ()
12import Prelude.Compat
14import Control.Applicative (empty)
15import Control.Monad
16import Data.Aeson.Types
17import Data.Function (on)
18import Data.Functor.Compose (Compose (..))
19import Data.Proxy (Proxy(..))
20import Data.Tagged (Tagged(..))
21import Data.Time (ZonedTime(..), TimeZone(..))
22import Data.Time.Clock (UTCTime(..))
23import Functions
24import Test.QuickCheck (Arbitrary(..), elements, oneof)
25import Types
26import qualified Data.DList as DList
27import qualified Data.HashMap.Strict as HM
28import qualified Data.UUID.Types as UUID
30#if !MIN_VERSION_QuickCheck(2,9,0)
31import Control.Applicative (Const(..))
32import Data.Functor.Identity (Identity (..))
33import Data.List.NonEmpty (NonEmpty(..))
34import Data.Version
35import Test.QuickCheck (getNonNegative, listOf1, resize)
36#endif
38import Data.Orphans ()
39import Test.QuickCheck.Instances ()
40#if MIN_VERSION_base(4,7,0)
41import Data.Hashable.Time ()
42#endif
44#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)
45import Numeric.Natural
46#endif
48-- "System" types.
50instance Arbitrary DotNetTime where
51 arbitrary = DotNetTime `liftM` arbitrary
52 shrink = map DotNetTime . shrink . fromDotNetTime
54-- | Compare timezone part only on 'timeZoneMinutes'
55instance Eq ZonedTime where
56 ZonedTime a (TimeZone a' _ _) == ZonedTime b (TimeZone b' _ _) =
57 a == b && a' == b'
59-- Compare equality to within a millisecond, allowing for rounding
60-- error (ECMA 262 requires milliseconds to rounded to zero, not
61-- rounded to nearest).
62instance ApproxEq UTCTime where
63 a =~ b = ((==) `on` utctDay) a b &&
64 (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
66instance ApproxEq DotNetTime where
67 (=~) = (=~) `on` fromDotNetTime
69instance ApproxEq Float where
70 a =~ b
71 | isNaN a && isNaN b = True
72 | otherwise = approxEq a b
74instance ApproxEq Double where
75 a =~ b
76 | isNaN a && isNaN b = True
77 | otherwise = approxEq a b
79instance (ApproxEq k, Eq v) => ApproxEq (HM.HashMap k v) where
80 a =~ b = and $ zipWith eq (HM.toList a) (HM.toList b)
81 where
82 eq (x,y) (u,v) = x =~ u && y == v
84-- Test-related types.
86instance Arbitrary Foo where
87 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
89instance Eq Foo where
90 a == b = fooInt a == fooInt b &&
91 fooDouble a `approxEq` fooDouble b &&
92 fooTuple a == fooTuple b
94instance ToJSON Foo where
95 toJSON Foo{..} = object [ "fooInt" .= fooInt
96 , "fooDouble" .= fooDouble
97 , "fooTuple" .= fooTuple
98 , "fooMap" .= fooMap
99 ]
101instance FromJSON Foo where
102 parseJSON (Object v) = Foo <$>
103 v .: "fooInt" <*>
104 v .: "fooDouble" <*>
105 v .: "fooTuple" <*>
106 v .: "fooMap"
107 parseJSON _ = empty
109instance Arbitrary UFoo where
110 arbitrary = UFoo <$> arbitrary <*> arbitrary
111 where _ = uFooInt
113instance Arbitrary OneConstructor where
114 arbitrary = return OneConstructor
116instance FromJSON OneConstructor
117instance ToJSON OneConstructor
119instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
120 arbitrary = liftM2 Product2 arbitrary arbitrary
122instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
123instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
125instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
126 Arbitrary f) => Arbitrary (Product6 a b c d e f) where
127 arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
128 arbitrary <*> arbitrary <*> arbitrary
130instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
131 FromJSON f) => FromJSON (Product6 a b c d e f)
132instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
133 ToJSON f) => ToJSON (Product6 a b c d e f)
135instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
136 => Arbitrary (Sum4 a b c d) where
137 arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
138 Alt3 <$> arbitrary, Alt4 <$> arbitrary]
140instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
141 => FromJSON (Sum4 a b c d)
142instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
144instance (Arbitrary a) => Arbitrary (Approx a) where
145 arbitrary = Approx <$> arbitrary
147instance (FromJSON a) => FromJSON (Approx a) where
148 parseJSON a = Approx <$> parseJSON a
150instance (ToJSON a) => ToJSON (Approx a) where
151 toJSON = toJSON . fromApprox
153instance Arbitrary Nullary where
154 arbitrary = elements [C1, C2, C3]
156instance Arbitrary a => Arbitrary (SomeType a) where
157 arbitrary = oneof [ pure Nullary
158 , Unary <$> arbitrary
159 , Product <$> arbitrary <*> arbitrary <*> arbitrary
160 , Record <$> arbitrary <*> arbitrary <*> arbitrary
161 , List <$> arbitrary
162 ]
164instance Arbitrary EitherTextInt where
165 arbitrary = oneof
166 [ LeftBool <$> arbitrary
167 , RightInt <$> arbitrary
168 , BothTextInt <$> arbitrary <*> arbitrary
169 , pure NoneNullary
170 ]
172instance Arbitrary (GADT String) where
173 arbitrary = GADT <$> arbitrary
175instance ApproxEq Char where
176 (=~) = (==)
178instance (ApproxEq a) => ApproxEq [a] where
179 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)
181-- Version tags are deprecated, so we avoid using them in the Arbitrary
182-- instance. However, the recommended constructor 'makeVersion' is not
183-- exported by "Data.Version" until base-4.8.0.0. For previous versions,
184-- a definition is given below.
187#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)
188instance Arbitrary Natural where
189 arbitrary = fromInteger . abs <$> arbitrary
190#endif
192instance Arbitrary (Proxy a) where
193 arbitrary = pure Proxy
195instance Arbitrary b => Arbitrary (Tagged a b) where
196 arbitrary = Tagged <$> arbitrary
198instance Arbitrary a => Arbitrary (DList.DList a) where
199 arbitrary = DList.fromList <$> arbitrary
201instance Arbitrary (f (g a)) => Arbitrary (Compose f g a) where
202 arbitrary = Compose <$> arbitrary
204#if !MIN_VERSION_QuickCheck(2,9,0)
205instance Arbitrary a => Arbitrary (Const a b) where
206 arbitrary = Const <$> arbitrary
208instance Arbitrary a => Arbitrary (NonEmpty a) where
209 arbitrary = (:|) <$> arbitrary <*> arbitrary
211instance Arbitrary Version where
212 arbitrary = makeVersion . fmap getNonNegative <$> resize 4 (listOf1 arbitrary)
214#if !MIN_VERSION_base(4,8,0)
215makeVersion :: [Int] -> Version
216makeVersion b = Version b []
217#endif
219instance Arbitrary a => Arbitrary (Identity a) where
220 arbitrary = Identity <$> arbitrary
221#endif
223instance Arbitrary UUID.UUID where
224 arbitrary = UUID.fromWords
225 <$> arbitrary
226 <*> arbitrary
227 <*> arbitrary
228 <*> arbitrary