1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE KindSignatures #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE TypeOperators #-}
7{-# LANGUAGE TypeSynonymInstances #-}
8{-# LANGUAGE MagicHash #-}
9
10#if __GLASGOW_HASKELL__ >= 701
11{-# LANGUAGE DefaultSignatures #-}
12{-# LANGUAGE Trustworthy #-}
13#endif
14
15#if __GLASGOW_HASKELL__ >= 705
16{-# LANGUAGE PolyKinds #-}
17#endif
18
19#include "HsBaseConfig.h"
20
21module Generics.Deriving.Eq (
22  -- * Generic Eq class
23    GEq(..)
24
25  -- * Default definition
26  , geqdefault
27
28  -- * Internal Eq class
29  , GEq'(..)
30
31  ) where
32
33import           Control.Applicative (Const, ZipList)
34
35import           Data.Char (GeneralCategory)
36import           Data.Int
37import qualified Data.Monoid as Monoid (First, Last)
38import           Data.Monoid (All, Any, Dual, Product, Sum)
39import           Data.Version (Version)
40import           Data.Word
41
42import           Foreign.C.Error
43import           Foreign.C.Types
44import           Foreign.ForeignPtr (ForeignPtr)
45import           Foreign.Ptr
46import           Foreign.StablePtr (StablePtr)
47
48import           Generics.Deriving.Base
49
50import           GHC.Exts hiding (Any)
51
52import           System.Exit (ExitCode)
53import           System.IO (BufferMode, Handle, HandlePosn, IOMode, SeekMode)
54import           System.IO.Error (IOErrorType)
55import           System.Posix.Types
56
57#if MIN_VERSION_base(4,4,0)
58import           Data.Complex (Complex)
59#endif
60
61#if MIN_VERSION_base(4,7,0)
62import           Data.Proxy (Proxy)
63#endif
64
65#if MIN_VERSION_base(4,8,0)
66import           Data.Functor.Identity (Identity)
67import           Data.Monoid (Alt)
68import           Data.Void (Void)
69import           Numeric.Natural (Natural)
70#endif
71
72#if MIN_VERSION_base(4,9,0)
73import           Data.List.NonEmpty (NonEmpty)
74import qualified Data.Semigroup as Semigroup (First, Last)
75import           Data.Semigroup (Arg(..), Max, Min, Option, WrappedMonoid)
76#endif
77
78--------------------------------------------------------------------------------
79-- Generic show
80--------------------------------------------------------------------------------
81
82class GEq' f where
83  geq' :: f a -> f a -> Bool
84
85instance GEq' V1 where
86  geq' _ _ = True
87
88instance GEq' U1 where
89  geq' _ _ = True
90
91instance (GEq c) => GEq' (K1 i c) where
92  geq' (K1 a) (K1 b) = geq a b
93
94-- No instances for P or Rec because geq is only applicable to types of kind *
95
96instance (GEq' a) => GEq' (M1 i c a) where
97  geq' (M1 a) (M1 b) = geq' a b
98
99instance (GEq' a, GEq' b) => GEq' (a :+: b) where
100  geq' (L1 a) (L1 b) = geq' a b
101  geq' (R1 a) (R1 b) = geq' a b
102  geq' _      _      = False
103
104instance (GEq' a, GEq' b) => GEq' (a :*: b) where
105  geq' (a1 :*: b1) (a2 :*: b2) = geq' a1 a2 && geq' b1 b2
106
107-- Unboxed types
108instance GEq' UAddr where
109  geq' (UAddr a1) (UAddr a2)     = isTrue# (eqAddr# a1 a2)
110instance GEq' UChar where
111  geq' (UChar c1) (UChar c2)     = isTrue# (eqChar# c1 c2)
112instance GEq' UDouble where
113  geq' (UDouble d1) (UDouble d2) = isTrue# (d1 ==## d2)
114instance GEq' UFloat where
115  geq' (UFloat f1) (UFloat f2)   = isTrue# (eqFloat# f1 f2)
116instance GEq' UInt where
117  geq' (UInt i1) (UInt i2)       = isTrue# (i1 ==# i2)
118instance GEq' UWord where
119  geq' (UWord w1) (UWord w2)     = isTrue# (eqWord# w1 w2)
120
121#if !(MIN_VERSION_base(4,7,0))
122isTrue# :: Bool -> Bool
123isTrue# = id
124#endif
125
126
127class GEq a where
128  geq :: a -> a -> Bool
129
130
131#if __GLASGOW_HASKELL__ >= 701
132  default geq :: (Generic a, GEq' (Rep a)) => a -> a -> Bool
133  geq = geqdefault
134#endif
135
136geqdefault :: (Generic a, GEq' (Rep a)) => a -> a -> Bool
137geqdefault x y = geq' (from x) (from y)
138
139-- Base types instances
140instance GEq () where
141  geq = geqdefault
142
143instance (GEq a, GEq b) => GEq (a, b) where
144  geq = geqdefault
145
146instance (GEq a, GEq b, GEq c) => GEq (a, b, c) where
147  geq = geqdefault
148
149instance (GEq a, GEq b, GEq c, GEq d) => GEq (a, b, c, d) where
150  geq = geqdefault
151
152instance (GEq a, GEq b, GEq c, GEq d, GEq e) => GEq (a, b, c, d, e) where
153  geq = geqdefault
154
155instance (GEq a, GEq b, GEq c, GEq d, GEq e, GEq f)
156    => GEq (a, b, c, d, e, f) where
157  geq = geqdefault
158
159instance (GEq a, GEq b, GEq c, GEq d, GEq e, GEq f, GEq g)
160    => GEq (a, b, c, d, e, f, g) where
161  geq = geqdefault
162
163instance GEq a => GEq [a] where
164  geq = geqdefault
165
166instance (GEq (f p), GEq (g p)) => GEq ((f :+: g) p) where
167  geq = geqdefault
168
169instance (GEq (f p), GEq (g p)) => GEq ((f :*: g) p) where
170  geq = geqdefault
171
172instance GEq (f (g p)) => GEq ((f :.: g) p) where
173  geq = geqdefault
174
175instance GEq All where
176  geq = geqdefault
177
178#if MIN_VERSION_base(4,8,0)
179instance GEq (f a) => GEq (Alt f a) where
180  geq = geqdefault
181#endif
182
183instance GEq Any where
184  geq = geqdefault
185
186#if !(MIN_VERSION_base(4,9,0))
187instance GEq Arity where
188  geq = geqdefault
189#endif
190
191#if MIN_VERSION_base(4,9,0)
192instance GEq a => GEq (Arg a b) where
193  geq (Arg a _) (Arg b _) = geq a b
194#endif
195
196instance GEq Associativity where
197  geq = geqdefault
198
199instance GEq Bool where
200  geq = geqdefault
201
202instance GEq BufferMode where
203  geq = (==)
204
205#if defined(HTYPE_CC_T)
206instance GEq CCc where
207  geq = (==)
208#endif
209
210instance GEq CChar where
211  geq = (==)
212
213instance GEq CClock where
214  geq = (==)
215
216#if defined(HTYPE_DEV_T)
217instance GEq CDev where
218  geq = (==)
219#endif
220
221instance GEq CDouble where
222  geq = (==)
223
224instance GEq CFloat where
225  geq = (==)
226
227#if defined(HTYPE_GID_T)
228instance GEq CGid where
229  geq = (==)
230#endif
231
232instance GEq Char where
233  geq = (==)
234
235#if defined(HTYPE_INO_T)
236instance GEq CIno where
237  geq = (==)
238#endif
239
240instance GEq CInt where
241  geq = (==)
242
243instance GEq CIntMax where
244  geq = (==)
245
246instance GEq CIntPtr where
247  geq = (==)
248
249instance GEq CLLong where
250  geq = (==)
251
252instance GEq CLong where
253  geq = (==)
254
255#if defined(HTYPE_MODE_T)
256instance GEq CMode where
257  geq = (==)
258#endif
259
260#if defined(HTYPE_NLINK_T)
261instance GEq CNlink where
262  geq = (==)
263#endif
264
265#if defined(HTYPE_OFF_T)
266instance GEq COff where
267  geq = (==)
268#endif
269
270#if MIN_VERSION_base(4,4,0)
271instance GEq a => GEq (Complex a) where
272  geq = geqdefault
273#endif
274
275instance GEq a => GEq (Const a b) where
276  geq = geqdefault
277
278#if defined(HTYPE_PID_T)
279instance GEq CPid where
280  geq = (==)
281#endif
282
283instance GEq CPtrdiff where
284  geq = (==)
285
286#if defined(HTYPE_RLIM_T)
287instance GEq CRLim where
288  geq = (==)
289#endif
290
291instance GEq CSChar where
292  geq = (==)
293
294#if defined(HTYPE_SPEED_T)
295instance GEq CSpeed where
296  geq = (==)
297#endif
298
299#if MIN_VERSION_base(4,4,0)
300instance GEq CSUSeconds where
301  geq = (==)
302#endif
303
304instance GEq CShort where
305  geq = (==)
306
307instance GEq CSigAtomic where
308  geq = (==)
309
310instance GEq CSize where
311  geq = (==)
312
313#if defined(HTYPE_SSIZE_T)
314instance GEq CSsize where
315  geq = (==)
316#endif
317
318#if defined(HTYPE_TCFLAG_T)
319instance GEq CTcflag where
320  geq = (==)
321#endif
322
323instance GEq CTime where
324  geq = (==)
325
326instance GEq CUChar where
327  geq = (==)
328
329#if defined(HTYPE_UID_T)
330instance GEq CUid where
331  geq = (==)
332#endif
333
334instance GEq CUInt where
335  geq = (==)
336
337instance GEq CUIntMax where
338  geq = (==)
339
340instance GEq CUIntPtr where
341  geq = (==)
342
343instance GEq CULLong where
344  geq = (==)
345
346instance GEq CULong where
347  geq = (==)
348
349#if MIN_VERSION_base(4,4,0)
350instance GEq CUSeconds where
351  geq = (==)
352#endif
353
354instance GEq CUShort where
355  geq = (==)
356
357instance GEq CWchar where
358  geq = (==)
359
360#if MIN_VERSION_base(4,9,0)
361instance GEq DecidedStrictness where
362  geq = geqdefault
363#endif
364
365instance GEq Double where
366  geq = (==)
367
368instance GEq a => GEq (Down a) where
369  geq = geqdefault
370
371instance GEq a => GEq (Dual a) where
372  geq = geqdefault
373
374instance (GEq a, GEq b) => GEq (Either a b) where
375  geq = geqdefault
376
377instance GEq Errno where
378  geq = (==)
379
380instance GEq ExitCode where
381  geq = geqdefault
382
383instance GEq Fd where
384  geq = (==)
385
386instance GEq a => GEq (Monoid.First a) where
387  geq = geqdefault
388
389#if MIN_VERSION_base(4,9,0)
390instance GEq a => GEq (Semigroup.First a) where
391  geq = geqdefault
392#endif
393
394instance GEq Fixity where
395  geq = geqdefault
396
397instance GEq Float where
398  geq = (==)
399
400instance GEq (ForeignPtr a) where
401  geq = (==)
402
403instance GEq (FunPtr a) where
404  geq = (==)
405
406instance GEq GeneralCategory where
407  geq = (==)
408
409instance GEq Handle where
410  geq = (==)
411
412instance GEq HandlePosn where
413  geq = (==)
414
415#if MIN_VERSION_base(4,8,0)
416instance GEq a => GEq (Identity a) where
417  geq = geqdefault
418#endif
419
420instance GEq Int where
421  geq = (==)
422
423instance GEq Int8 where
424  geq = (==)
425
426instance GEq Int16 where
427  geq = (==)
428
429instance GEq Int32 where
430  geq = (==)
431
432instance GEq Int64 where
433  geq = (==)
434
435instance GEq Integer where
436  geq = (==)
437
438instance GEq IntPtr where
439  geq = (==)
440
441instance GEq IOError where
442  geq = (==)
443
444instance GEq IOErrorType where
445  geq = (==)
446
447instance GEq IOMode where
448  geq = (==)
449
450instance GEq c => GEq (K1 i c p) where
451  geq = geqdefault
452
453instance GEq a => GEq (Monoid.Last a) where
454  geq = geqdefault
455
456#if MIN_VERSION_base(4,9,0)
457instance GEq a => GEq (Semigroup.Last a) where
458  geq = geqdefault
459#endif
460
461instance GEq (f p) => GEq (M1 i c f p) where
462  geq = geqdefault
463
464instance GEq a => GEq (Maybe a) where
465  geq = geqdefault
466
467#if MIN_VERSION_base(4,9,0)
468instance GEq a => GEq (Max a) where
469  geq = geqdefault
470
471instance GEq a => GEq (Min a) where
472  geq = geqdefault
473#endif
474
475#if MIN_VERSION_base(4,8,0)
476instance GEq Natural where
477  geq = (==)
478#endif
479
480#if MIN_VERSION_base(4,9,0)
481instance GEq a => GEq (NonEmpty a) where
482  geq = geqdefault
483
484instance GEq a => GEq (Option a) where
485  geq = geqdefault
486#endif
487
488instance GEq Ordering where
489  geq = geqdefault
490
491instance GEq p => GEq (Par1 p) where
492  geq = geqdefault
493
494instance GEq a => GEq (Product a) where
495  geq = geqdefault
496
497#if MIN_VERSION_base(4,7,0)
498instance GEq
499# if MIN_VERSION_base(4,9,0)
500             (Proxy s)
501# else
502             (Proxy (s :: *))
503# endif
504             where
505  geq = geqdefault
506#endif
507
508instance GEq (Ptr a) where
509  geq = (==)
510
511instance GEq (f p) => GEq (Rec1 f p) where
512  geq = geqdefault
513
514instance GEq SeekMode where
515  geq = (==)
516
517instance GEq (StablePtr a) where
518  geq = (==)
519
520#if MIN_VERSION_base(4,9,0)
521instance GEq SourceStrictness where
522  geq = geqdefault
523
524instance GEq SourceUnpackedness where
525  geq = geqdefault
526#endif
527
528instance GEq a => GEq (Sum a) where
529  geq = geqdefault
530
531instance GEq (U1 p) where
532  geq = geqdefault
533
534instance GEq (UAddr p) where
535  geq = geqdefault
536
537instance GEq (UChar p) where
538  geq = geqdefault
539
540instance GEq (UDouble p) where
541  geq = geqdefault
542
543instance GEq (UFloat p) where
544  geq = geqdefault
545
546instance GEq (UInt p) where
547  geq = geqdefault
548
549instance GEq (UWord p) where
550  geq = geqdefault
551
552instance GEq Version where
553  geq = (==)
554
555#if MIN_VERSION_base(4,8,0)
556instance GEq Void where
557  geq = (==)
558#endif
559
560instance GEq Word where
561  geq = (==)
562
563instance GEq Word8 where
564  geq = (==)
565
566instance GEq Word16 where
567  geq = (==)
568
569instance GEq Word32 where
570  geq = (==)
571
572instance GEq Word64 where
573  geq = (==)
574
575instance GEq WordPtr where
576  geq = (==)
577
578#if MIN_VERSION_base(4,9,0)
579instance GEq m => GEq (WrappedMonoid m) where
580  geq = geqdefault
581#endif
582
583instance GEq a => GEq (ZipList a) where
584  geq = geqdefault
585
586#if MIN_VERSION_base(4,10,0)
587instance GEq CBool where
588  geq = (==)
589
590# if defined(HTYPE_BLKSIZE_T)
591instance GEq CBlkSize where
592  geq = (==)
593# endif
594
595# if defined(HTYPE_BLKCNT_T)
596instance GEq CBlkCnt where
597  geq = (==)
598# endif
599
600# if defined(HTYPE_CLOCKID_T)
601instance GEq CClockId where
602  geq = (==)
603# endif
604
605# if defined(HTYPE_FSBLKCNT_T)
606instance GEq CFsBlkCnt where
607  geq = (==)
608# endif
609
610# if defined(HTYPE_FSFILCNT_T)
611instance GEq CFsFilCnt where
612  geq = (==)
613# endif
614
615# if defined(HTYPE_ID_T)
616instance GEq CId where
617  geq = (==)
618# endif
619
620# if defined(HTYPE_KEY_T)
621instance GEq CKey where
622  geq = (==)
623# endif
624
625# if defined(HTYPE_TIMER_T)
626instance GEq CTimer where
627  geq = (==)
628# endif
629#endif
630