update maintainer email
[complex-generic:complex-generic.git] / Data / Complex / Generic / TH.hs
1 {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances #-}
2 {- |
3 Module      :  Data.Complex.Generic.TH
4 Copyright   :  (c) Claude Heiland-Allen 2012
5 License     :  BSD3
6
7 Maintainer  :  claude@mathr.co.uk
8 Stability   :  unstable
9 Portability :  TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, UndecidableInstances
10
11 Derive instances for complex numbers using template haskell.
12 -}
13 module Data.Complex.Generic.TH where
14
15 import Data.Typeable (typeOf, typeOf1)
16 import Language.Haskell.TH
17
18 import Data.Complex.Generic.Class
19 import Data.Complex.Generic.Default
20
21 -- | Derive instances for 'RealFloat' types.
22 deriveComplexRF :: Name {- ^ complex type -} -> Name {- ^ real type -} -> Name {- ^ constructor -} -> Name {- ^ destructor -} -> Q [Dec]
23 deriveComplexRF cTy' rTy' mkRectI' rectI' = [d|
24     instance ComplexRect ($(cTy) $(rTy)) $(rTy) where
25       mkRect = $(mkRectI)
26       rect = $(rectI)
27       real = realDefault
28       imag = imagDefault
29       realPart = realPartDefault
30       imagPart = imagPartDefault
31       conjugate = conjugateDefault
32       magnitudeSquared = magnitudeSquaredDefault
33       sqr = sqrDefault
34       (.*) = rmulDefault
35       (*.) = mulrDefault
36
37     instance ComplexPolar ($(cTy) $(rTy)) $(rTy) where
38       mkPolar = mkPolarDefault
39       cis = cisDefault
40       polar = polarDefault
41       magnitude = magnitudeDefaultRF
42       phase = phaseDefaultRF
43
44     instance Num ($(cTy) $(rTy)) where
45       (+) = addDefault
46       (-) = subDefault
47       (*) = mulDefault
48       negate = negateDefault
49       fromInteger = fromIntegerDefault
50       abs = absDefault
51       signum = signumDefault
52
53     instance Fractional ($(cTy) $(rTy)) where
54       (/) = divDefaultRF
55       fromRational = fromRationalDefault
56
57     instance Floating ($(cTy) $(rTy)) where
58       pi = piDefault
59       exp = expDefault
60       log = logDefault
61       sqrt = sqrtDefault
62       sin = sinDefault
63       cos = cosDefault
64       tan = tanDefault
65       sinh = sinhDefault
66       cosh = coshDefault
67       tanh = tanhDefault
68       asin = asinDefault
69       acos = acosDefault
70       atan = atanDefault
71       asinh = asinhDefault
72       acosh = acoshDefault
73       atanh = atanhDefault
74   |]
75   where
76     cTy = conT cTy'
77     rTy = conT rTy'
78     mkRectI = global mkRectI'
79     rectI = global rectI'
80
81 -- | Derive instances for 'Num' types.
82 deriveComplexN :: Name {- ^ complex type -} -> Name {- ^ real type -} -> Name {- ^ constructor -} -> Name {- ^ destructor -} -> Q [Dec]
83 deriveComplexN cTy' rTy' mkRectI' rectI' = [d|
84     instance ComplexRect ($(cTy) $(rTy)) $(rTy) where
85       mkRect = $(mkRectI)
86       rect = $(rectI)
87       real = realDefault
88       imag = imagDefault
89       realPart = realPartDefault
90       imagPart = imagPartDefault
91       conjugate = conjugateDefault
92       magnitudeSquared = magnitudeSquaredDefault
93       sqr = sqrDefault
94       (.*) = rmulDefault
95       (*.) = mulrDefault
96
97     instance Num ($(cTy) $(rTy)) where
98       (+) = addDefault
99       (-) = subDefault
100       (*) = mulDefault
101       negate = negateDefault
102       fromInteger = fromIntegerDefault
103       abs = error $ "Num.abs: not implementable for " ++ show (typeOf (undefined :: ($(cTy) $(rTy))))
104       signum = error $ "Num.signum: not implementable for " ++ show (typeOf (undefined :: ($(cTy) $(rTy))))
105
106   |]
107   where
108     cTy = conT cTy'
109     rTy = conT rTy'
110     mkRectI = global mkRectI'
111     rectI = global rectI'
112
113 {-
114 -- | Derive instances for 'Fractional' types with one class constraint.
115 deriveComplex1F :: Name {- ^ complex type -} -> Name {- ^ constraint class -} -> Name {- ^ real type constructor -} -> Name {- ^ constructor -} -> Name {- ^ destructor -} -> Q [Dec]
116 deriveComplex1F cTy' sTy' rTy' mkRectI' rectI' = do
117   t' <- newName "t"
118   let t = varT t'
119   c <- classP sTy' [t]
120   is <- [d|
121     instance ComplexRect ($(cTy) ($(rTy) $(t))) ($(rTy) $(t)) where
122       mkRect = $(mkRectI)
123       rect = $(rectI)
124       real = realDefault
125       imag = imagDefault
126       realPart = realPartDefault
127       imagPart = imagPartDefault
128       conjugate = conjugateDefault
129       magnitudeSquared = magnitudeSquaredDefault
130       sqr = sqrDefault
131       (.*) = rmulDefault
132       (*.) = mulrDefault
133
134     instance Num ($(cTy) ($(rTy) $(t))) where
135       (+) = addDefault
136       (-) = subDefault
137       (*) = mulDefault
138       negate = negateDefault
139       fromInteger = fromIntegerDefault
140       abs = error $ "Num.abs: not implementable for " ++ show (typeOf1 (undefined :: $(cTy) (($(rTy) $(t))))) ++ " " ++ show (typeOf1 (undefined :: $(rTy) $(t)))
141       signum = error $ "Num.signum: not implementable for " ++ show (typeOf1 (undefined :: $(cTy) (($(rTy) $(t))))) ++ " " ++ show (typeOf1 (undefined :: $(rTy) $(t)))
142
143     instance Fractional ($(cTy) ($(rTy) $(t))) where
144       (/) = divDefault
145       fromRational = fromRationalDefault
146     |]
147   return (map (\(InstanceD _ ty decs) -> InstanceD [c] ty decs) is)
148   where
149     cTy = conT cTy'
150     sTy = conT sTy'
151     rTy = conT rTy'
152     mkRectI = global mkRectI'
153     rectI = global rectI'
154 -}