expand advice on importing these modules
[packages/old-time.git] / Data / Fixed.hs
1 {-# OPTIONS -Wall -Werror -fno-warn-unused-binds #-}
2
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module : Data.Fixed
6 -- Copyright : (c) Ashley Yakeley 2005, 2006
7 -- License : BSD-style (see the file libraries/base/LICENSE)
8 --
9 -- Maintainer : Ashley Yakeley <ashley@semantic.org>
10 -- Stability : experimental
11 -- Portability : portable
12 --
13 -- This module defines a "Fixed" type for fixed-precision arithmetic.
14 -- The parameter to Fixed is any type that's an instance of HasResolution.
15 -- HasResolution has a single method that gives the resolution of the Fixed type.
16 -- Parameter types E6 and E12 (for 10^6 and 10^12) are defined, as well as
17 -- type synonyms for Fixed E6 and Fixed E12.
18 --
19 -- This module also contains generalisations of div, mod, and divmod to work
20 -- with any Real instance.
21 --
22 -----------------------------------------------------------------------------
23
24 module Data.Fixed
25 (
26 div',mod',divMod',
27
28 Fixed,HasResolution(..),
29 showFixed,
30 E6,Micro,
31 E12,Pico
32 ) where
33
34 import Prelude -- necessary to get dependencies right
35
36 -- | generalisation of 'div' to any instance of Real
37 div' :: (Real a,Integral b) => a -> a -> b
38 div' n d = floor ((toRational n) / (toRational d))
39
40 -- | generalisation of 'divMod' to any instance of Real
41 divMod' :: (Real a,Integral b) => a -> a -> (b,a)
42 divMod' n d = (f,n - (fromIntegral f) * d) where
43 f = div' n d
44
45 -- | generalisation of 'mod' to any instance of Real
46 mod' :: (Real a) => a -> a -> a
47 mod' n d = n - (fromInteger f) * d where
48 f = div' n d
49
50 newtype Fixed a = MkFixed Integer deriving (Eq,Ord)
51
52 class HasResolution a where
53 resolution :: a -> Integer
54
55 fixedResolution :: (HasResolution a) => Fixed a -> Integer
56 fixedResolution fa = resolution (uf fa) where
57 uf :: Fixed a -> a
58 uf _ = undefined
59
60 withType :: (a -> f a) -> f a
61 withType foo = foo undefined
62
63 withResolution :: (HasResolution a) => (Integer -> f a) -> f a
64 withResolution foo = withType (foo . resolution)
65
66 instance Enum (Fixed a) where
67 succ (MkFixed a) = MkFixed (succ a)
68 pred (MkFixed a) = MkFixed (pred a)
69 toEnum = MkFixed . toEnum
70 fromEnum (MkFixed a) = fromEnum a
71 enumFrom (MkFixed a) = fmap MkFixed (enumFrom a)
72 enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b)
73 enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b)
74 enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c)
75
76 instance (HasResolution a) => Num (Fixed a) where
77 (MkFixed a) + (MkFixed b) = MkFixed (a + b)
78 (MkFixed a) - (MkFixed b) = MkFixed (a - b)
79 fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (fixedResolution fa))
80 negate (MkFixed a) = MkFixed (negate a)
81 abs (MkFixed a) = MkFixed (abs a)
82 signum (MkFixed a) = fromInteger (signum a)
83 fromInteger i = withResolution (\res -> MkFixed (i * res))
84
85 instance (HasResolution a) => Real (Fixed a) where
86 toRational fa@(MkFixed a) = (toRational a) / (toRational (fixedResolution fa))
87
88 instance (HasResolution a) => Fractional (Fixed a) where
89 fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (fixedResolution fa)) b)
90 recip fa@(MkFixed a) = MkFixed (div (res * res) a) where
91 res = fixedResolution fa
92 fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res))))
93
94 instance (HasResolution a) => RealFrac (Fixed a) where
95 properFraction a = (i,a - (fromIntegral i)) where
96 i = truncate a
97 truncate f = truncate (toRational f)
98 round f = round (toRational f)
99 ceiling f = ceiling (toRational f)
100 floor f = floor (toRational f)
101
102 chopZeros :: Integer -> String
103 chopZeros 0 = ""
104 chopZeros a | mod a 10 == 0 = chopZeros (div a 10)
105 chopZeros a = show a
106
107 -- only works for positive a
108 showIntegerZeros :: Bool -> Int -> Integer -> String
109 showIntegerZeros True _ 0 = ""
110 showIntegerZeros chopTrailingZeros digits a = replicate (digits - length s) '0' ++ s' where
111 s = show a
112 s' = if chopTrailingZeros then chopZeros a else s
113
114 withDot :: String -> String
115 withDot "" = ""
116 withDot s = '.':s
117
118 -- | First arg is whether to chop off trailing zeros
119 showFixed :: (HasResolution a) => Bool -> Fixed a -> String
120 showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa))
121 showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where
122 res = fixedResolution fa
123 (i,d) = divMod a res
124 -- enough digits to be unambiguous
125 digits = ceiling (logBase 10 (fromInteger res) :: Double)
126 maxnum = 10 ^ digits
127 fracNum = div (d * maxnum) res
128
129 instance (HasResolution a) => Show (Fixed a) where
130 show = showFixed False
131
132
133
134 data E6 = E6
135
136 instance HasResolution E6 where
137 resolution _ = 1000000
138
139 type Micro = Fixed E6
140
141
142 data E12 = E12
143
144 instance HasResolution E12 where
145 resolution _ = 1000000000000
146
147 type Pico = Fixed E12