    {-# OPTIONS -Wall -fno-warn-unused-binds #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Fixed
    -- Copyright   :  (c) Ashley Yakeley 2005, 2006
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  Ashley Yakeley <ashley@semantic.org>
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- This module defines a \"Fixed\" type for fixed-precision arithmetic.
    -- The parameter to Fixed is any type that's an instance of HasResolution.
    -- HasResolution has a single method that gives the resolution of the Fixed type.
    -- Parameter types E6 and E12 (for 10^6 and 10^12) are defined, as well as
    -- type synonyms for Fixed E6 and Fixed E12.
    --
    -- This module also contains generalisations of div, mod, and divmod to work
    -- with any Real instance.
    --
    -----------------------------------------------------------------------------

    module Data.Fixed
    (
    	div',mod',divMod',

    	Fixed,HasResolution(..),
    	showFixed,
    	E6,Micro,
    	E12,Pico
    ) where

    import Prelude -- necessary to get dependencies right

    -- | generalisation of 'div' to any instance of Real
    div' :: (Real a,Integral b) => a -> a -> b
    div' n d = floor ((toRational n) / (toRational d))

    -- | generalisation of 'divMod' to any instance of Real
    divMod' :: (Real a,Integral b) => a -> a -> (b,a)
    divMod' n d = (f,n - (fromIntegral f) * d) where
    	f = div' n d

    -- | generalisation of 'mod' to any instance of Real
    mod' :: (Real a) => a -> a -> a
    mod' n d = n - (fromInteger f) * d where
    	f = div' n d

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

    class HasResolution a where
    	resolution :: a -> Integer

    fixedResolution :: (HasResolution a) => Fixed a -> Integer
    fixedResolution fa = resolution (uf fa) where
    	uf :: Fixed a -> a
    	uf _ = undefined

    withType :: (a -> f a) -> f a
    withType foo = foo undefined

    withResolution :: (HasResolution a) => (Integer -> f a) -> f a
    withResolution foo = withType (foo . resolution)

    instance Enum (Fixed a) where
    	succ (MkFixed a) = MkFixed (succ a)
    	pred (MkFixed a) = MkFixed (pred a)
    	toEnum = MkFixed . toEnum
    	fromEnum (MkFixed a) = fromEnum a
    	enumFrom (MkFixed a) = fmap MkFixed (enumFrom a)
    	enumFromThen (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromThen a b)
    	enumFromTo (MkFixed a) (MkFixed b) = fmap MkFixed (enumFromTo a b)
    	enumFromThenTo (MkFixed a) (MkFixed b) (MkFixed c) = fmap MkFixed (enumFromThenTo a b c)

    instance (HasResolution a) => Num (Fixed a) where
    	(MkFixed a) + (MkFixed b) = MkFixed (a + b)
    	(MkFixed a) - (MkFixed b) = MkFixed (a - b)
    	fa@(MkFixed a) * (MkFixed b) = MkFixed (div (a * b) (fixedResolution fa))
    	negate (MkFixed a) = MkFixed (negate a)
    	abs (MkFixed a) = MkFixed (abs a)
    	signum (MkFixed a) = fromInteger (signum a)
    	fromInteger i = withResolution (\res -> MkFixed (i * res))

    instance (HasResolution a) => Real (Fixed a) where
    	toRational fa@(MkFixed a) = (toRational a) / (toRational (fixedResolution fa))

    instance (HasResolution a) => Fractional (Fixed a) where
    	fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (fixedResolution fa)) b)
    	recip fa@(MkFixed a) = MkFixed (div (res * res) a) where
    		res = fixedResolution fa
    	fromRational r = withResolution (\res -> MkFixed (floor (r * (toRational res))))

    instance (HasResolution 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)

    chopZeros :: Integer -> String
    chopZeros 0 = ""
    chopZeros a | mod a 10 == 0 = chopZeros (div a 10)
    chopZeros a = show a

    -- only works for positive a
    showIntegerZeros :: Bool -> Int -> Integer -> String
    showIntegerZeros True _ 0 = ""
    showIntegerZeros chopTrailingZeros digits a = replicate (digits - length s) '0' ++ s' where
    	s = show a
    	s' = if chopTrailingZeros then chopZeros a else s

    withDot :: String -> String
    withDot "" = ""
    withDot s = '.':s

    -- | First arg is whether to chop off trailing zeros
    showFixed :: (HasResolution a) => Bool -> Fixed a -> String
    showFixed chopTrailingZeros fa@(MkFixed a) | a < 0 = "-" ++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a)) fa))
    showFixed chopTrailingZeros fa@(MkFixed a) = (show i) ++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum)) where
    	res = fixedResolution fa
    	(i,d) = divMod a res
    	-- enough digits to be unambiguous
    	digits = ceiling (logBase 10 (fromInteger res) :: Double)
    	maxnum = 10 ^ digits
    	fracNum = div (d * maxnum) res

    instance (HasResolution a) => Show (Fixed a) where
    	show = showFixed False

    data E6 = E6

    instance HasResolution E6 where
    	resolution _ = 1000000

    type Micro = Fixed E6

    data E12 = E12

    instance HasResolution E12 where
    	resolution _ = 1000000000000

    type Pico = Fixed E12