(original) (raw)

{-# LANGUAGE Trustworthy #-} {-# LANGUAGE ScopedTypeVariables #-}

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

[Fixed](Data.Fixed.html#Fixed)(..), [HasResolution](Data.Fixed.html#HasResolution)(..),
[showFixed](Data.Fixed.html#showFixed),
[E0](Data.Fixed.html#E0),[Uni](Data.Fixed.html#Uni),
[E1](Data.Fixed.html#E1),[Deci](Data.Fixed.html#Deci),
[E2](Data.Fixed.html#E2),[Centi](Data.Fixed.html#Centi),
[E3](Data.Fixed.html#E3),[Milli](Data.Fixed.html#Milli),
[E6](Data.Fixed.html#E6),[Micro](Data.Fixed.html#Micro),
[E9](Data.Fixed.html#E9),[Nano](Data.Fixed.html#Nano),
[E12](Data.Fixed.html#E12),[Pico](Data.Fixed.html#Pico)

) where

import Data.Data import GHC.Read import Text.ParserCombinators.ReadPrec import Text.Read.Lex

default ()

div' :: (Real a,Integral b) => a -> a -> b div' n d = floor ((toRational n) / (toRational d))

divMod' :: (Real a,Integral b) => a -> a -> (b,a) divMod' n d = (f,n - (fromIntegral f) * d) where f = div' n d

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 )

tyFixed :: DataType tyFixed = mkDataType "Data.Fixed.Fixed" [conMkFixed] conMkFixed :: Constr conMkFixed = mkConstr tyFixed "MkFixed" [] Prefix

instance (Typeable a) => Data (Fixed a) where gfoldl k z (MkFixed a) = k (z MkFixed) a gunfold k z _ = k (z MkFixed) dataTypeOf _ = tyFixed toConstr _ = conMkFixed

class HasResolution a where resolution :: p a -> Integer

withType :: (p 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) (resolution fa)) negate (MkFixed a) = MkFixed (negate a) abs (MkFixed a) = MkFixed (abs a) signum (MkFixed a) = fromInteger (signum a) fromInteger i = withResolution ([res](#local-6989586621679480883) -> MkFixed (i * res))

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

instance (HasResolution a) => Fractional (Fixed a) where fa@(MkFixed a) / (MkFixed b) = MkFixed (div (a * (resolution fa)) b) recip fa@(MkFixed a) = MkFixed (div (res * res) a) where res = resolution fa fromRational r = withResolution ([res](#local-6989586621679480867) -> 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

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

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 = resolution fa (i,d) = divMod a res

[digits](#local-6989586621679480941) = [ceiling](GHC.Real.html#ceiling) ([logBase](GHC.Float.html#logBase) 10 ([fromInteger](GHC.Num.html#fromInteger) [res](#local-6989586621679480938)) :: Double)
[maxnum](#local-6989586621679480942) = 10 [^](GHC.Real.html#%5E) [digits](#local-6989586621679480941)

[fracNum](#local-6989586621679480943) = [divCeil](#local-6989586621679480944) ([d](#local-6989586621679480940) [*](GHC.Num.html#%2A) [maxnum](#local-6989586621679480942)) [res](#local-6989586621679480938)
[divCeil](#local-6989586621679480944) [x](#local-6989586621679480945) [y](#local-6989586621679480946) = ([x](#local-6989586621679480945) [+](GHC.Num.html#%2B) [y](#local-6989586621679480946) - 1) `[div](GHC.Real.html#div)` [y](#local-6989586621679480946)

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

instance (HasResolution a) => Read (Fixed a) where readPrec = readNumber convertFixed readListPrec = readListPrecDefault readList = readListDefault

convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a) convertFixed (Number n) | Just (i, f) <- numberToFixed e n = return (fromInteger i + (fromInteger f / (10 ^ e))) where r = resolution (undefined :: Fixed a)

      [e](#local-6989586621679480949) = [ceiling](GHC.Real.html#ceiling) ([logBase](GHC.Float.html#logBase) 10 ([fromInteger](GHC.Num.html#fromInteger) [r](#local-6989586621679480948)) :: Double)

convertFixed _ = pfail

data E0

instance HasResolution E0 where resolution _ = 1

type Uni = Fixed E0

data E1

instance HasResolution E1 where resolution _ = 10

type Deci = Fixed E1

data E2

instance HasResolution E2 where resolution _ = 100

type Centi = Fixed E2

data E3

instance HasResolution E3 where resolution _ = 1000