1{-# LANGUAGE CPP, UndecidableInstances #-}
2module Basement.Numerical.Subtractive
3    ( Subtractive(..)
4    ) where
5
6import           Basement.Compat.Base
7import           Basement.Compat.C.Types
8import           Basement.Compat.Natural
9import           Basement.IntegralConv
10import           Basement.Bounded
11import           Basement.Nat
12import           Basement.Types.Word128 (Word128)
13import           Basement.Types.Word256 (Word256)
14import qualified Basement.Types.Word128 as Word128
15import qualified Basement.Types.Word256 as Word256
16import qualified Prelude
17
18-- | Represent class of things that can be subtracted.
19--
20--
21-- Note that the result is not necessary of the same type
22-- as the operand depending on the actual type.
23--
24-- For example:
25--
26-- > (-) :: Int -> Int -> Int
27-- > (-) :: DateTime -> DateTime -> Seconds
28-- > (-) :: Ptr a -> Ptr a -> PtrDiff
29-- > (-) :: Natural -> Natural -> Maybe Natural
30class Subtractive a where
31    type Difference a
32    (-) :: a -> a -> Difference a
33
34infixl 6 -
35
36instance Subtractive Integer where
37    type Difference Integer = Integer
38    (-) = (Prelude.-)
39instance Subtractive Int where
40    type Difference Int = Int
41    (-) = (Prelude.-)
42instance Subtractive Int8 where
43    type Difference Int8 = Int8
44    (-) = (Prelude.-)
45instance Subtractive Int16 where
46    type Difference Int16 = Int16
47    (-) = (Prelude.-)
48instance Subtractive Int32 where
49    type Difference Int32 = Int32
50    (-) = (Prelude.-)
51instance Subtractive Int64 where
52    type Difference Int64 = Int64
53    (-) = (Prelude.-)
54instance Subtractive Natural where
55    type Difference Natural = Maybe Natural
56    (-) a b
57        | b > a     = Nothing
58        | otherwise = Just (a Prelude.- b)
59instance Subtractive Word where
60    type Difference Word = Word
61    (-) = (Prelude.-)
62instance Subtractive Word8 where
63    type Difference Word8 = Word8
64    (-) = (Prelude.-)
65instance Subtractive Word16 where
66    type Difference Word16 = Word16
67    (-) = (Prelude.-)
68instance Subtractive Word32 where
69    type Difference Word32 = Word32
70    (-) = (Prelude.-)
71instance Subtractive Word64 where
72    type Difference Word64 = Word64
73    (-) = (Prelude.-)
74instance Subtractive Word128 where
75    type Difference Word128 = Word128
76    (-) = (Word128.-)
77instance Subtractive Word256 where
78    type Difference Word256 = Word256
79    (-) = (Word256.-)
80
81instance Subtractive Prelude.Float where
82    type Difference Prelude.Float = Prelude.Float
83    (-) = (Prelude.-)
84instance Subtractive Prelude.Double where
85    type Difference Prelude.Double = Prelude.Double
86    (-) = (Prelude.-)
87
88instance Subtractive Prelude.Char where
89    type Difference Prelude.Char = Prelude.Int
90    (-) a b = (Prelude.-) (charToInt a) (charToInt b)
91instance (KnownNat n, NatWithinBound Word64 n) => Subtractive (Zn64 n) where
92    type Difference (Zn64 n) = Zn64 n
93    (-) a b = (Prelude.-) a b
94instance KnownNat n => Subtractive (Zn n) where
95    type Difference (Zn n) = Zn n
96    (-) a b = (Prelude.-) a b
97
98instance Subtractive CChar where
99    type Difference CChar = CChar
100    (-) = (Prelude.-)
101instance Subtractive CSChar where
102    type Difference CSChar = CSChar
103    (-) = (Prelude.-)
104instance Subtractive CUChar where
105    type Difference CUChar = CUChar
106    (-) = (Prelude.-)
107instance Subtractive CShort where
108    type Difference CShort = CShort
109    (-) = (Prelude.-)
110instance Subtractive CUShort where
111    type Difference CUShort = CUShort
112    (-) = (Prelude.-)
113instance Subtractive CInt where
114    type Difference CInt = CInt
115    (-) = (Prelude.-)
116instance Subtractive CUInt where
117    type Difference CUInt = CUInt
118    (-) = (Prelude.-)
119instance Subtractive CLong where
120    type Difference CLong = CLong
121    (-) = (Prelude.-)
122instance Subtractive CULong where
123    type Difference CULong = CULong
124    (-) = (Prelude.-)
125instance Subtractive CPtrdiff where
126    type Difference CPtrdiff = CPtrdiff
127    (-) = (Prelude.-)
128instance Subtractive CSize where
129    type Difference CSize = CSize
130    (-) = (Prelude.-)
131instance Subtractive CWchar where
132    type Difference CWchar = CWchar
133    (-) = (Prelude.-)
134instance Subtractive CSigAtomic where
135    type Difference CSigAtomic = CSigAtomic
136    (-) = (Prelude.-)
137instance Subtractive CLLong where
138    type Difference CLLong = CLLong
139    (-) = (Prelude.-)
140instance Subtractive CULLong where
141    type Difference CULLong = CULLong
142    (-) = (Prelude.-)
143#if MIN_VERSION_base(4,10,0)
144instance Subtractive CBool where
145    type Difference CBool = CBool
146    (-) = (Prelude.-)
147#endif
148instance Subtractive CIntPtr where
149    type Difference CIntPtr = CIntPtr
150    (-) = (Prelude.-)
151instance Subtractive CUIntPtr where
152    type Difference CUIntPtr = CUIntPtr
153    (-) = (Prelude.-)
154instance Subtractive CIntMax where
155    type Difference CIntMax = CIntMax
156    (-) = (Prelude.-)
157instance Subtractive CUIntMax where
158    type Difference CUIntMax = CUIntMax
159    (-) = (Prelude.-)
160instance Subtractive CClock where
161    type Difference CClock = CClock
162    (-) = (Prelude.-)
163instance Subtractive CTime where
164    type Difference CTime = CTime
165    (-) = (Prelude.-)
166instance Subtractive CUSeconds where
167    type Difference CUSeconds = CUSeconds
168    (-) = (Prelude.-)
169instance Subtractive CSUSeconds where
170    type Difference CSUSeconds = CSUSeconds
171    (-) = (Prelude.-)
172instance Subtractive COff where
173    type Difference COff = COff
174    (-) = (Prelude.-)
175
176instance Subtractive CFloat where
177    type Difference CFloat = CFloat
178    (-) = (Prelude.-)
179instance Subtractive CDouble where
180    type Difference CDouble = CDouble
181    (-) = (Prelude.-)
182