Time Library darcs Repository - Fixed.hs (1/1)

[Ashley Yakeley]

I wrote:

>   darcs get "http://semantic.org/TimeLib/"
...
> I hope to get more implementation done this coming week.

I've done some more implementation, the basic calendric conversions 
work. Have a look, send me any comments/concerns or better yet reply 
here on the list.

One thing I am considering is using a Fixed type (a possible Data.Fixed 
attached/appended) for DiffTime. This would make DiffTime an instance of 
Num etc. with 1 = 1 second rather than 1 = 1 picosecond, while still 
maintaining picosecond resolution (as Qrczak suggested). Opinions?

Also, I've set -fglasgow-exts, mostly to get "cunning newtype" deriving. 
But presumably this lack of portability is undesirable?

-- 
Ashley Yakeley, Seattle WA
{-# OPTIONS -fglasgow-exts -Wall -Werror #-}

module Data.Fixed
(
	Fixed,FixedResolution(..),
	E6,Micro,
	E12,Pico
) where

newtype Fixed a = MkFixed Integer deriving (Eq,Ord,Enum)

class FixedResolution a where
	fixedResolution :: a -> Integer

instance (FixedResolution a) => Num (Fixed a) where
	(MkFixed a) + (MkFixed b) = MkFixed (a + b)
	(MkFixed a) - (MkFixed b) = MkFixed (a - b)
	(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (fixedResolution (undefined :: a)))
	negate (MkFixed a) = MkFixed (negate a)
	abs (MkFixed a) = MkFixed (abs a)
	signum (MkFixed a) = fromInteger (signum a)
	fromInteger i = MkFixed (i * fixedResolution (undefined :: a))

instance (FixedResolution a) => Real (Fixed a) where
	toRational (MkFixed a) = (toRational a) / (toRational (fixedResolution (undefined :: a)))

instance (FixedResolution a) => Fractional (Fixed a) where
	(MkFixed a) / (MkFixed b) = MkFixed (div (a * (fixedResolution (undefined :: a))) b)
	recip (MkFixed a) = MkFixed (div ((fixedResolution (undefined :: a)) * (fixedResolution (undefined :: a))) a)
	fromRational r = MkFixed (floor (r * (toRational (fixedResolution (undefined :: a)))))

instance (FixedResolution a) => RealFrac (Fixed a) where
	properFraction a = (i,a - (fromIntegral i)) where
		i = truncate a
	truncate f = truncate (toRational f)
	round f = round (toRational f)
	ceiling f = ceiling (toRational f)
	floor f = floor (toRational f)

-- only works for positive a
showIntegerZeros :: Int -> Integer -> String
showIntegerZeros digits a = replicate (digits - length s) '0' ++ s where
	s = show a

instance (FixedResolution a) => Show (Fixed a) where
	show (MkFixed a) | a < 0 = "-" ++ (show (MkFixed (negate a) :: Fixed a))
	show (MkFixed a) = (show i) ++ "." ++ (showIntegerZeros digits fracNum) where
		f = fixedResolution (undefined :: a)
		(i,d) = divMod a f
		-- enough digits to be unambiguous
		digits = ceiling (logBase (fromInteger f) 10 :: Double)
 		maxnum = 10 ^ digits
 		fracNum = div (d * maxnum) f



data E6

instance FixedResolution E6 where
	fixedResolution _ = 1000000

type Micro = Fixed E6


data E12

instance FixedResolution E12 where
	fixedResolution _ = 1000000000000

type Pico = Fixed E12