{-# LANGUAGE Trustworthy #-}{-# LANGUAGE ScopedTypeVariables #-}------------------------------------------------------------------------------- |-- Module : Data.Fixed-- Copyright : (c) Ashley Yakeley 2005, 2006, 2009-- 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.---- This module also contains generalisations of div, mod, and divmod to work-- with any Real instance.-------------------------------------------------------------------------------moduleData.Fixed(div' ,mod' ,divMod' ,Fixed (..),HasResolution (..),showFixed ,E0 ,Uni ,E1 ,Deci ,E2 ,Centi ,E3 ,Milli ,E6 ,Micro ,E9 ,Nano ,E12 ,Pico )whereimportData.Data importGHC.Read importText.ParserCombinators.ReadPrec importText.Read.Lex default()-- avoid any defaulting shenanigans-- | generalisation of 'div' to any instance of Realdiv'::(Real a ,Integral b )=>a ->a ->b div' n d =floor ((toRational n )/ (toRational d ))-- | generalisation of 'divMod' to any instance of RealdivMod'::(Real a ,Integral b )=>a ->a ->(b ,a )divMod' n d =(f ,n -(fromIntegral f )* d )wheref =div' n d -- | generalisation of 'mod' to any instance of Realmod'::(Real a )=>a ->a ->a mod' n d =n -(fromInteger f )* d wheref =div' n d -- | The type parameter should be an instance of 'HasResolution'.newtypeFixed a =MkFixed Integer-- ^ @since 4.7.0.0deriving(Eq,Ord)-- We do this because the automatically derived Data instance requires (Data a) context.-- Our manual instance has the more general (Typeable a) context.tyFixed::DataType tyFixed =mkDataType "Data.Fixed.Fixed"[conMkFixed ]conMkFixed::Constr conMkFixed =mkConstr tyFixed "MkFixed"[]Prefix -- | @since 4.1.0.0instance(Typeable a )=>Data (Fixed a )wheregfoldl k z (MkFixed a )=k (z MkFixed )a gunfold k z _=k (z MkFixed )dataTypeOf _=tyFixed toConstr _=conMkFixed classHasResolution a whereresolution ::p a ->IntegerwithType::(p a ->f a )->f a withType foo =foo undefined withResolution::(HasResolution a )=>(Integer->f a )->f a withResolution foo =withType (foo . resolution )-- | @since 2.01instanceEnum (Fixed a )wheresucc (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 )-- | @since 2.01instance(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 ->MkFixed (i * res ))-- | @since 2.01instance(HasResolution a )=>Real (Fixed a )wheretoRational fa @(MkFixed a )=(toRational a )/ (toRational (resolution fa ))-- | @since 2.01instance(HasResolution a )=>Fractional (Fixed a )wherefa @(MkFixed a )/ (MkFixed b )=MkFixed (div (a * (resolution fa ))b )recip fa @(MkFixed a )=MkFixed (div (res * res )a )whereres =resolution fa fromRational r =withResolution (\res ->MkFixed (floor (r * (toRational res ))))-- | @since 2.01instance(HasResolution a )=>RealFrac (Fixed a )whereproperFraction a =(i ,a -(fromIntegral i ))wherei =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=""chopZerosa |mod a 10==0=chopZeros (div a 10)chopZerosa =show a -- only works for positive ashowIntegerZeros::Bool->Int->Integer->String showIntegerZeros True_0=""showIntegerZeroschopTrailingZeros digits a =replicate (digits -length s )'0'++ s' wheres =show a s' =ifchopTrailingZeros thenchopZeros a elses withDot::String ->String withDot ""=""withDots ='.':s -- | First arg is whether to chop off trailing zerosshowFixed::(HasResolution a )=>Bool->Fixed a ->String showFixed chopTrailingZeros fa @(MkFixed a )|a <0="-"++ (showFixed chopTrailingZeros (asTypeOf (MkFixed (negate a ))fa ))showFixedchopTrailingZeros fa @(MkFixed a )=(show i )++ (withDot (showIntegerZeros chopTrailingZeros digits fracNum ))whereres =resolution fa (i ,d )=divMod a res -- enough digits to be unambiguousdigits =ceiling (logBase 10(fromInteger res )::Double)maxnum =10^ digits -- read floors, so show must ceil for `read . show = id` to hold. See #9240fracNum =divCeil (d * maxnum )res divCeil x y =(x + y -1)`div `y -- | @since 2.01instance(HasResolution a )=>Show (Fixed a )whereshow =showFixed False-- | @since 4.3.0.0instance(HasResolution a )=>Read (Fixed a )wherereadPrec =readNumber convertFixed readListPrec =readListPrecDefault readList =readListDefault convertFixed::foralla .HasResolution a =>Lexeme ->ReadPrec (Fixed a )convertFixed (Number n )|Just (i ,f )<-numberToFixed e n =return (fromInteger i + (fromInteger f / (10^ e )))wherer =resolution (undefined ::Fixed a )-- round 'e' up to help make the 'read . show == id' property-- possible also for cases where 'resolution' is not a-- power-of-10, such as e.g. when 'resolution = 128'e =ceiling (logBase 10(fromInteger r )::Double)convertFixed_=pfail dataE0 -- | @since 4.1.0.0instanceHasResolution E0 whereresolution _=1-- | resolution of 1, this works the same as IntegertypeUni =Fixed E0 dataE1 -- | @since 4.1.0.0instanceHasResolution E1 whereresolution _=10-- | resolution of 10^-1 = .1typeDeci =Fixed E1 dataE2 -- | @since 4.1.0.0instanceHasResolution E2 whereresolution _=100-- | resolution of 10^-2 = .01, useful for many monetary currenciestypeCenti =Fixed E2 dataE3 -- | @since 4.1.0.0instanceHasResolution E3 whereresolution _=1000-- | resolution of 10^-3 = .001typeMilli =Fixed E3 dataE6 -- | @since 2.01instanceHasResolution E6 whereresolution _=1000000-- | resolution of 10^-6 = .000001typeMicro =Fixed E6 dataE9 -- | @since 4.1.0.0instanceHasResolution E9 whereresolution _=1000000000-- | resolution of 10^-9 = .000000001typeNano =Fixed E9 dataE12 -- | @since 2.01instanceHasResolution E12 whereresolution _=1000000000000-- | resolution of 10^-12 = .000000000001typePico =Fixed E12