git.iko.soy/typeable/aeson
on 1.1.2.0-r1 help sign in
typeable/aeson/tests/Instances.hs
229 lines 7.2 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE RecordWildCards #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
8module Instances () where
10import Prelude ()
11import Prelude.Compat
13import Control.Applicative (empty)
14import Control.Monad
15import Data.Aeson.Types
16import Data.Function (on)
17import Data.Functor.Compose (Compose (..))
18import Data.Proxy (Proxy(..))
19import Data.Tagged (Tagged(..))
20import Data.Time (ZonedTime(..), TimeZone(..))
21import Data.Time.Clock (UTCTime(..))
22import Functions
23import Test.QuickCheck (Arbitrary(..), elements, oneof)
24import Types
25import qualified Data.DList as DList
26import qualified Data.HashMap.Strict as HM
27import qualified Data.UUID.Types as UUID
29#if !MIN_VERSION_QuickCheck(2,9,0)
30import Control.Applicative (Const(..))
31import Data.Functor.Identity (Identity (..))
32import Data.List.NonEmpty (NonEmpty(..))
33import Data.Version
34import Test.QuickCheck (getNonNegative, listOf1, resize)
35#endif
37import Data.Orphans ()
38import Test.QuickCheck.Instances ()
39#if MIN_VERSION_base(4,7,0)
40import Data.Hashable.Time ()
41#endif
43#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)
44import Numeric.Natural
45#endif
47{-# ANN module ("HLint: ignore Use fewer imports"::String) #-}
49-- "System" types.
51instance Arbitrary DotNetTime where
52 arbitrary = DotNetTime `liftM` arbitrary
53 shrink = map DotNetTime . shrink . fromDotNetTime
55-- | Compare timezone part only on 'timeZoneMinutes'
56instance Eq ZonedTime where
57 ZonedTime a (TimeZone a' _ _) == ZonedTime b (TimeZone b' _ _) =
58 a == b && a' == b'
60-- Compare equality to within a millisecond, allowing for rounding
61-- error (ECMA 262 requires milliseconds to rounded to zero, not
62-- rounded to nearest).
63instance ApproxEq UTCTime where
64 a =~ b = ((==) `on` utctDay) a b &&
65 (approxEqWith 1 1 `on` ((* 1e3) . utctDayTime)) a b
67instance ApproxEq DotNetTime where
68 (=~) = (=~) `on` fromDotNetTime
70instance ApproxEq Float where
71 a =~ b
72 | isNaN a && isNaN b = True
73 | otherwise = approxEq a b
75instance ApproxEq Double where
76 a =~ b
77 | isNaN a && isNaN b = True
78 | otherwise = approxEq a b
80instance (ApproxEq k, Eq v) => ApproxEq (HM.HashMap k v) where
81 a =~ b = and $ zipWith eq (HM.toList a) (HM.toList b)
82 where
83 eq (x,y) (u,v) = x =~ u && y == v
85-- Test-related types.
87instance Arbitrary Foo where
88 arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary
90instance Eq Foo where
91 a == b = fooInt a == fooInt b &&
92 fooDouble a `approxEq` fooDouble b &&
93 fooTuple a == fooTuple b
95instance ToJSON Foo where
96 toJSON Foo{..} = object [ "fooInt" .= fooInt
97 , "fooDouble" .= fooDouble
98 , "fooTuple" .= fooTuple
99 , "fooMap" .= fooMap
100 ]
102instance FromJSON Foo where
103 parseJSON (Object v) = Foo <$>
104 v .: "fooInt" <*>
105 v .: "fooDouble" <*>
106 v .: "fooTuple" <*>
107 v .: "fooMap"
108 parseJSON _ = empty
110instance Arbitrary UFoo where
111 arbitrary = UFoo <$> arbitrary <*> arbitrary
112 where _ = uFooInt
114instance Arbitrary OneConstructor where
115 arbitrary = return OneConstructor
117instance FromJSON OneConstructor
118instance ToJSON OneConstructor
120instance (Arbitrary a, Arbitrary b) => Arbitrary (Product2 a b) where
121 arbitrary = liftM2 Product2 arbitrary arbitrary
123instance (FromJSON a, FromJSON b) => FromJSON (Product2 a b)
124instance (ToJSON a, ToJSON b) => ToJSON (Product2 a b)
126instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d, Arbitrary e,
127 Arbitrary f) => Arbitrary (Product6 a b c d e f) where
128 arbitrary = Product6 <$> arbitrary <*> arbitrary <*> arbitrary <*>
129 arbitrary <*> arbitrary <*> arbitrary
131instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d, FromJSON e,
132 FromJSON f) => FromJSON (Product6 a b c d e f)
133instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d, ToJSON e,
134 ToJSON f) => ToJSON (Product6 a b c d e f)
136instance (Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d)
137 => Arbitrary (Sum4 a b c d) where
138 arbitrary = oneof [Alt1 <$> arbitrary, Alt2 <$> arbitrary,
139 Alt3 <$> arbitrary, Alt4 <$> arbitrary]
141instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d)
142 => FromJSON (Sum4 a b c d)
143instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (Sum4 a b c d)
145instance (Arbitrary a) => Arbitrary (Approx a) where
146 arbitrary = Approx <$> arbitrary
148instance (FromJSON a) => FromJSON (Approx a) where
149 parseJSON a = Approx <$> parseJSON a
151instance (ToJSON a) => ToJSON (Approx a) where
152 toJSON = toJSON . fromApprox
154instance Arbitrary Nullary where
155 arbitrary = elements [C1, C2, C3]
157instance Arbitrary a => Arbitrary (SomeType a) where
158 arbitrary = oneof [ pure Nullary
159 , Unary <$> arbitrary
160 , Product <$> arbitrary <*> arbitrary <*> arbitrary
161 , Record <$> arbitrary <*> arbitrary <*> arbitrary
162 , List <$> arbitrary
163 ]
165instance Arbitrary EitherTextInt where
166 arbitrary = oneof
167 [ LeftBool <$> arbitrary
168 , RightInt <$> arbitrary
169 , BothTextInt <$> arbitrary <*> arbitrary
170 , pure NoneNullary
171 ]
173instance Arbitrary (GADT String) where
174 arbitrary = GADT <$> arbitrary
176instance ApproxEq Char where
177 (=~) = (==)
179instance (ApproxEq a) => ApproxEq [a] where
180 a =~ b = length a == length b && all (uncurry (=~)) (zip a b)
182-- Version tags are deprecated, so we avoid using them in the Arbitrary
183-- instance. However, the recommended constructor 'makeVersion' is not
184-- exported by "Data.Version" until base-4.8.0.0. For previous versions,
185-- a definition is given below.
188#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)
189instance Arbitrary Natural where
190 arbitrary = fromInteger . abs <$> arbitrary
191#endif
193instance Arbitrary (Proxy a) where
194 arbitrary = pure Proxy
196instance Arbitrary b => Arbitrary (Tagged a b) where
197 arbitrary = Tagged <$> arbitrary
199instance Arbitrary a => Arbitrary (DList.DList a) where
200 arbitrary = DList.fromList <$> arbitrary
202instance Arbitrary (f (g a)) => Arbitrary (Compose f g a) where
203 arbitrary = Compose <$> arbitrary
205#if !MIN_VERSION_QuickCheck(2,9,0)
206instance Arbitrary a => Arbitrary (Const a b) where
207 arbitrary = Const <$> arbitrary
209instance Arbitrary a => Arbitrary (NonEmpty a) where
210 arbitrary = (:|) <$> arbitrary <*> arbitrary
212instance Arbitrary Version where
213 arbitrary = makeVersion . fmap getNonNegative <$> resize 4 (listOf1 arbitrary)
215#if !MIN_VERSION_base(4,8,0)
216makeVersion :: [Int] -> Version
217makeVersion b = Version b []
218#endif
220instance Arbitrary a => Arbitrary (Identity a) where
221 arbitrary = Identity <$> arbitrary
222#endif
224instance Arbitrary UUID.UUID where
225 arbitrary = UUID.fromWords
226 <$> arbitrary
227 <*> arbitrary
228 <*> arbitrary
229 <*> arbitrary