blob: 88ca2110a06223cc7d100611d35d38f03d4238d1 (
plain)
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
|
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module ApproxEq where
import Data.Text (Text)
import Data.Time.Clock
import Test.QuickCheck
import GHC.Generics as G
(==~)
:: (ApproxEq a, Show a)
=> a -> a -> Property
a ==~ b = counterexample (show a ++ " !=~ " ++ show b) (a =~ b)
class GApproxEq f where
gApproxEq :: f a -> f a -> Bool
instance GApproxEq U1 where
gApproxEq U1 U1 = True
instance (GApproxEq a, GApproxEq b) =>
GApproxEq (a :+: b) where
gApproxEq (L1 a) (L1 b) = gApproxEq a b
gApproxEq (R1 a) (R1 b) = gApproxEq a b
gApproxEq _ _ = False
instance (GApproxEq a, GApproxEq b) =>
GApproxEq (a :*: b) where
gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2
instance (ApproxEq a) =>
GApproxEq (K1 i a) where
gApproxEq (K1 a) (K1 b) = a =~ b
instance (GApproxEq f) =>
GApproxEq (M1 i t f) where
gApproxEq (M1 a) (M1 b) = gApproxEq a b
class ApproxEq a where
(=~) :: a -> a -> Bool
default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool
a =~ b = gApproxEq (G.from a) (G.from b)
instance ApproxEq Text where
(=~) = (==)
instance ApproxEq Char where
(=~) = (==)
instance ApproxEq Bool where
(=~) = (==)
instance ApproxEq Int where
(=~) = (==)
instance ApproxEq Double where
(=~) = (==)
instance ApproxEq a =>
ApproxEq (Maybe a)
instance ApproxEq UTCTime where
(=~) = (==)
instance ApproxEq a =>
ApproxEq [a] where
as =~ bs = and (zipWith (=~) as bs)
instance (ApproxEq l, ApproxEq r) =>
ApproxEq (Either l r) where
Left a =~ Left b = a =~ b
Right a =~ Right b = a =~ b
_ =~ _ = False
instance (ApproxEq l, ApproxEq r) =>
ApproxEq (l, r) where
(=~) (l1, r1) (l2, r2) = l1 =~ l2 && r1 =~ r2
|