1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806
{-# LANGUAGE TypeInType #-}
#endif
{-|
Module: BoundedEnumSpec
Copyright: (C) 2015-2017 Ryan Scott
License: BSD-style (see the file LICENSE)
Maintainer: Ryan Scott
Portability: Template Haskell
@hspec@ tests for derived 'Bounded', 'Enum', and 'Ix' instances.
-}
module BoundedEnumIxSpec where
import Data.Deriving
#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806
import Data.Kind
#endif
import GHC.Arr (Ix(..))
import Prelude ()
import Prelude.Compat
import Test.Hspec
-------------------------------------------------------------------------------
-- Plain data types
data TyConEnum = TyConEnum1 | TyConEnum2 | TyConEnum3
deriving (Eq, Ord, Show)
data TyConProduct a b c = TyConProduct a b c
deriving (Eq, Ord, Show)
data TyConUnit
#if __GLASGOW_HASKELL__ >= 706
(f :: k -> *) (a :: k)
#else
(f :: * -> *) (a :: *)
#endif
= TyConUnit
deriving (Eq, Ord, Show)
data TyConExQuant a = Show a => TyConExQuant
deriving instance Eq (TyConExQuant a)
deriving instance Ord (TyConExQuant a)
deriving instance Show (TyConExQuant a)
data TyConGADT a where
TyConGADT :: Show a => a -> TyConGADT a
deriving instance Eq a => Eq (TyConGADT a)
deriving instance Ord a => Ord (TyConGADT a)
deriving instance Show a => Show (TyConGADT a)
-- Data families
data family TyFamilyEnum :: *
data instance TyFamilyEnum = TyFamilyEnum1 | TyFamilyEnum2 | TyFamilyEnum3
deriving (Eq, Ord, Show)
data family TyFamilyProduct x y z :: *
data instance TyFamilyProduct a b c = TyFamilyProduct a b c
deriving (Eq, Ord, Show)
data family TyFamilyUnit
#if __GLASGOW_HASKELL__ >= 706
(f :: k -> *) (a :: k)
#else
(f :: * -> *) (a :: *)
#endif
:: *
data instance TyFamilyUnit f a = TyFamilyUnit
deriving (Eq, Ord, Show)
data family TyFamilyExQuant x :: *
data instance TyFamilyExQuant a = Show a => TyFamilyExQuant
deriving instance Eq (TyFamilyExQuant a)
deriving instance Ord (TyFamilyExQuant a)
deriving instance Show (TyFamilyExQuant a)
data family TyFamilyGADT x :: *
data instance TyFamilyGADT a where
TyFamilyGADT :: Show a => a -> TyFamilyGADT a
deriving instance Eq a => Eq (TyFamilyGADT a)
deriving instance Ord a => Ord (TyFamilyGADT a)
deriving instance Show a => Show (TyFamilyGADT a)
-------------------------------------------------------------------------------
-- Plain data types
$(deriveBounded ''TyConEnum)
$(deriveBounded ''TyConProduct)
instance Bounded (TyConUnit f a) where
minBound = $(makeMinBound ''TyConUnit)
maxBound = $(makeMaxBound ''TyConUnit)
instance Show a => Bounded (TyConExQuant a) where
minBound = $(makeMinBound ''TyConExQuant)
maxBound = $(makeMaxBound ''TyConExQuant)
instance (Bounded a, Show a) => Bounded (TyConGADT a) where
minBound = $(makeMinBound ''TyConGADT)
maxBound = $(makeMaxBound ''TyConGADT)
$(deriveEnum ''TyConEnum)
instance Enum (TyConUnit f a) where
toEnum = $(makeToEnum ''TyConUnit)
fromEnum = $(makeFromEnum ''TyConUnit)
$(deriveIx ''TyConEnum)
$(deriveIx ''TyConProduct)
instance Ix (TyConUnit f a) where
range = $(makeRange ''TyConUnit)
unsafeIndex = $(makeUnsafeIndex ''TyConUnit)
inRange = $(makeInRange ''TyConUnit)
instance Ix (TyConExQuant a) where
range = $(makeRange ''TyConExQuant)
unsafeIndex = $(makeUnsafeIndex ''TyConExQuant)
inRange = $(makeInRange ''TyConExQuant)
instance Ix a => Ix (TyConGADT a) where
range = $(makeRange ''TyConGADT)
unsafeIndex = $(makeUnsafeIndex ''TyConGADT)
inRange = $(makeInRange ''TyConGADT)
#if MIN_VERSION_template_haskell(2,7,0)
-- Data families
$(deriveBounded 'TyFamilyEnum1)
$(deriveBounded 'TyFamilyProduct)
instance Bounded (TyFamilyUnit f a) where
minBound = $(makeMinBound 'TyFamilyUnit)
maxBound = $(makeMaxBound 'TyFamilyUnit)
instance Show a => Bounded (TyFamilyExQuant a) where
minBound = $(makeMinBound 'TyFamilyExQuant)
maxBound = $(makeMaxBound 'TyFamilyExQuant)
instance (Bounded a, Show a) => Bounded (TyFamilyGADT a) where
minBound = $(makeMinBound 'TyFamilyGADT)
maxBound = $(makeMaxBound 'TyFamilyGADT)
$(deriveEnum 'TyFamilyEnum1)
instance Enum (TyFamilyUnit f a) where
toEnum = $(makeToEnum 'TyFamilyUnit)
fromEnum = $(makeFromEnum 'TyFamilyUnit)
$(deriveIx 'TyFamilyEnum1)
$(deriveIx 'TyFamilyProduct)
instance Ix (TyFamilyUnit f a) where
range = $(makeRange 'TyFamilyUnit)
unsafeIndex = $(makeUnsafeIndex 'TyFamilyUnit)
inRange = $(makeInRange 'TyFamilyUnit)
instance Ix (TyFamilyExQuant a) where
range = $(makeRange 'TyFamilyExQuant)
unsafeIndex = $(makeUnsafeIndex 'TyFamilyExQuant)
inRange = $(makeInRange 'TyFamilyExQuant)
instance Ix a => Ix (TyFamilyGADT a) where
range = $(makeRange 'TyFamilyGADT)
unsafeIndex = $(makeUnsafeIndex 'TyFamilyGADT)
inRange = $(makeInRange 'TyFamilyGADT)
#endif
-------------------------------------------------------------------------------
-- | Verifies an 'Ix' instance satisfies the laws.
ixLaws :: (Ix a, Show a) => a -> a -> a -> Expectation
ixLaws l u i = do
inRange (l,u) i `shouldBe` elem i (range (l,u))
range (l,u) !! index (l,u) i `shouldBe` i
map (index (l,u)) (range (l,u)) `shouldBe` [0..rangeSize (l,u)-1]
rangeSize (l,u) `shouldBe` length (range (l,u))
-------------------------------------------------------------------------------
main :: IO ()
main = hspec spec
spec :: Spec
spec = parallel $ do
describe "TyConEnum" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` TyConEnum1
maxBound `shouldBe` TyConEnum3
it "has a sensible Enum instance" $
[minBound .. maxBound] `shouldBe` [TyConEnum1, TyConEnum2, TyConEnum3]
it "has a sensible Ix instance" $
ixLaws minBound maxBound TyConEnum2
describe "TyConProduct Bool Bool Bool" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` TyConProduct False False False
maxBound `shouldBe` TyConProduct True True True
it "has a sensible Ix instance" $
ixLaws minBound maxBound (TyConProduct False False False)
describe "TyConUnit Maybe Bool" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` TyConUnit
maxBound `shouldBe` TyConUnit
it "has a sensible Enum instance" $
[minBound .. maxBound] `shouldBe` [TyConUnit]
it "has a sensible Ix instance" $
ixLaws minBound maxBound TyConUnit
describe "TyConExQuant Bool" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` (TyConExQuant :: TyConExQuant Bool)
maxBound `shouldBe` (TyConExQuant :: TyConExQuant Bool)
it "has a sensible Ix instance" $
ixLaws minBound maxBound (TyConExQuant :: TyConExQuant Bool)
describe "TyConGADT Bool" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` TyConGADT False
maxBound `shouldBe` TyConGADT True
it "has a sensible Ix instance" $
ixLaws minBound maxBound (TyConGADT False)
#if MIN_VERSION_template_haskell(2,7,0)
describe "TyFamilyEnum" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` TyFamilyEnum1
maxBound `shouldBe` TyFamilyEnum3
it "has a sensible Enum instance" $
[minBound .. maxBound] `shouldBe` [TyFamilyEnum1, TyFamilyEnum2, TyFamilyEnum3]
it "has a sensible Ix instance" $
ixLaws minBound maxBound TyFamilyEnum2
describe "TyFamilyProduct Bool Bool Bool" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` TyFamilyProduct False False False
maxBound `shouldBe` TyFamilyProduct True True True
it "has a sensible Ix instance" $
ixLaws minBound maxBound (TyFamilyProduct False False False)
describe "TyFamilyUnit Maybe Bool" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` TyFamilyUnit
maxBound `shouldBe` TyFamilyUnit
it "has a sensible Enum instance" $
[minBound .. maxBound] `shouldBe` [TyFamilyUnit]
it "has a sensible Ix instance" $
ixLaws minBound maxBound TyFamilyUnit
describe "TyFamilyExQuant Bool" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` (TyFamilyExQuant :: TyFamilyExQuant Bool)
maxBound `shouldBe` (TyFamilyExQuant :: TyFamilyExQuant Bool)
it "has a sensible Ix instance" $
ixLaws minBound maxBound (TyFamilyExQuant :: TyFamilyExQuant Bool)
describe "TyFamilyGADT Bool" $ do
it "has a sensible Bounded instance" $ do
minBound `shouldBe` TyFamilyGADT False
maxBound `shouldBe` TyFamilyGADT True
it "has a sensible Ix instance" $
ixLaws minBound maxBound (TyFamilyGADT False)
#endif
|
