git.iko.soy/typeable/aeson
on 1.2.0.0 help sign in
typeable/aeson/tests/Types.hs
165 lines 5.3 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE GADTs #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7{-# LANGUAGE StandaloneDeriving #-}
8{-# LANGUAGE ScopedTypeVariables #-}
10module Types where
12import Prelude ()
13import Prelude.Compat
15import Math.NumberTheory.Logarithms (intLog2)
16import Data.Data
17import Data.Functor.Compose (Compose (..))
18import Data.Functor.Identity (Identity (..))
19import Data.Hashable (Hashable (..))
20import Data.Text
21import Data.Time (Day (..), fromGregorian)
22import GHC.Generics
23import Test.QuickCheck (Arbitrary (..), Property, counterexample, scale)
24import qualified Data.Map as Map
25import Data.Aeson
26import Data.Aeson.Types
28type I = Identity
29type Compose3 f g h = Compose (Compose f g) h
30type Compose3' f g h = Compose f (Compose g h)
32data Foo = Foo {
33 fooInt :: Int
34 , fooDouble :: Double
35 , fooTuple :: (String, Text, Int)
36 -- This definition causes an infinite loop in genericTo and genericFrom!
37 -- , fooMap :: Map.Map String Foo
38 , fooMap :: Map.Map String (Text,Int)
39 } deriving (Show, Typeable, Data)
41data UFoo = UFoo {
42 _UFooInt :: Int
43 , uFooInt :: Int
44 } deriving (Show, Eq, Data, Typeable)
46data OneConstructor = OneConstructor
47 deriving (Show, Eq, Typeable, Data)
49data Product2 a b = Product2 a b
50 deriving (Show, Eq, Typeable, Data)
52data Product6 a b c d e f = Product6 a b c d e f
53 deriving (Show, Eq, Typeable, Data)
55data Sum4 a b c d = Alt1 a | Alt2 b | Alt3 c | Alt4 d
56 deriving (Show, Eq, Typeable, Data)
58class ApproxEq a where
59 (=~) :: a -> a -> Bool
61newtype Approx a = Approx { fromApprox :: a }
62 deriving (Show, Data, Typeable, ApproxEq, Num)
64instance (ApproxEq a) => Eq (Approx a) where
65 Approx a == Approx b = a =~ b
67data Nullary = C1 | C2 | C3 deriving (Eq, Show)
69data SomeType a = Nullary
70 | Unary Int
71 | Product String (Maybe Char) a
72 | Record { testOne :: Double
73 , testTwo :: Maybe Bool
74 , testThree :: Maybe a
75 }
76 | List [a]
77 deriving (Eq, Show)
79-- | This type requires IncoherentInstances for the instances of the type
80-- classes Data.Aeson.TH.LookupField and Data.Aeson.Types.FromJSON.FromRecord.
81--
82-- The minimum known requirements for this type are:
83-- * Record type with at least two fields
84-- * One field type is either a type parameter or a type/data family
85-- * Another field type is a @Maybe@ of the above field type
86data IncoherentInstancesNeeded a = IncoherentInstancesNeeded
87 { incoherentInstancesNeededMaybeNot :: a
88 , incoherentInstancesNeededMaybeYes :: Maybe a
89 } deriving Generic
91-- Used for testing UntaggedValue SumEncoding
92data EitherTextInt
93 = LeftBool Bool
94 | RightInt Int
95 | BothTextInt Text Int
96 | NoneNullary
97 deriving (Eq, Show)
99data GADT a where
100 GADT :: { gadt :: String } -> GADT String
101 deriving Typeable
103deriving instance Data (GADT String)
104deriving instance Eq (GADT a)
105deriving instance Show (GADT a)
107deriving instance Generic Foo
108deriving instance Generic UFoo
109deriving instance Generic OneConstructor
110deriving instance Generic (Product2 a b)
111deriving instance Generic (Product6 a b c d e f)
112deriving instance Generic (Sum4 a b c d)
113deriving instance Generic (Approx a)
114deriving instance Generic Nullary
115deriving instance Generic (SomeType a)
116#if __GLASGOW_HASKELL__ >= 706
117deriving instance Generic1 SomeType
118#endif
119deriving instance Generic EitherTextInt
121failure :: Show a => String -> String -> a -> Property
122failure func msg v = counterexample
123 (func ++ " failed: " ++ msg ++ ", " ++ show v) False
125newtype BCEDay = BCEDay Day
126 deriving (Eq, Show)
128zeroDay :: Day
129zeroDay = fromGregorian 0 0 0
131instance Arbitrary BCEDay where
132 arbitrary = fmap (BCEDay . ModifiedJulianDay . (+ toModifiedJulianDay zeroDay)) arbitrary
134instance ToJSON BCEDay where
135 toJSON (BCEDay d) = toJSON d
136 toEncoding (BCEDay d) = toEncoding d
138instance FromJSON BCEDay where
139 parseJSON = fmap BCEDay . parseJSON
141-- | Scale the size of Arbitrary with ''
142newtype LogScaled a = LogScaled { getLogScaled :: a }
143 deriving (Eq, Ord, Show)
145instance Hashable a => Hashable (LogScaled a) where
146 hashWithSalt salt (LogScaled a) = hashWithSalt salt a
148instance Arbitrary a => Arbitrary (LogScaled a) where
149 arbitrary = fmap LogScaled $ scale (\x -> intLog2 $ x + 1) arbitrary
150 shrink = fmap LogScaled . shrink . getLogScaled
152instance ToJSON a => ToJSON (LogScaled a) where
153 toJSON (LogScaled d) = toJSON d
154 toEncoding (LogScaled d) = toEncoding d
156instance FromJSON a => FromJSON (LogScaled a) where
157 parseJSON = fmap LogScaled . parseJSON
159instance (ToJSONKey a) => ToJSONKey (LogScaled a) where
160 toJSONKey = contramapToJSONKeyFunction getLogScaled toJSONKey
161 toJSONKeyList = contramapToJSONKeyFunction (fmap getLogScaled) toJSONKeyList
163instance (FromJSONKey a) => FromJSONKey (LogScaled a) where
164 fromJSONKey = fmap LogScaled fromJSONKey
165 fromJSONKeyList = coerceFromJSONKeyFunction (fromJSONKeyList :: FromJSONKeyFunction [a])