{-# 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.
--
-----------------------------------------------------------------------------

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

    Fixed(..), HasResolution(..),
    showFixed,
    E0,Uni,
    E1,Deci,
    E2,Centi,
    E3,Milli,
    E6,Micro,
    E9,Nano,
    E12,Pico
) where

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

default () -- avoid any defaulting shenanigans

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

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

-- | generalisation of 'mod' to any instance of 'Real'
mod' :: (Real a) => a -> a -> a
mod' :: a -> a -> a
mod' n :: a
n d :: a
d = a
n a -> a -> a
forall a. Num a => a -> a -> a
- (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
f) a -> a -> a
forall a. Num a => a -> a -> a
* a
d where
    f :: Integer
f = a -> a -> Integer
forall a b. (Real a, Integral b) => a -> a -> b
div' a
n a
d

-- | The type parameter should be an instance of 'HasResolution'.
newtype Fixed a = MkFixed Integer
        deriving ( Eq  -- ^ @since 2.01
                 , Ord -- ^ @since 2.01
                 )

-- 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 :: DataType
tyFixed = String -> [Constr] -> DataType
mkDataType "Data.Fixed.Fixed" [Constr
conMkFixed]
conMkFixed :: Constr
conMkFixed :: Constr
conMkFixed = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tyFixed "MkFixed" [] Fixity
Prefix

-- | @since 4.1.0.0
instance (Typeable a) => Data (Fixed a) where
    gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixed a -> c (Fixed a)
gfoldl k :: forall d b. Data d => c (d -> b) -> d -> c b
k z :: forall g. g -> c g
z (MkFixed a :: Integer
a) = c (Integer -> Fixed a) -> Integer -> c (Fixed a)
forall d b. Data d => c (d -> b) -> d -> c b
k ((Integer -> Fixed a) -> c (Integer -> Fixed a)
forall g. g -> c g
z Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed) Integer
a
    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Fixed a)
gunfold k :: forall b r. Data b => c (b -> r) -> c r
k z :: forall r. r -> c r
z _ = c (Integer -> Fixed a) -> c (Fixed a)
forall b r. Data b => c (b -> r) -> c r
k ((Integer -> Fixed a) -> c (Integer -> Fixed a)
forall r. r -> c r
z Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed)
    dataTypeOf :: Fixed a -> DataType
dataTypeOf _ = DataType
tyFixed
    toConstr :: Fixed a -> Constr
toConstr _ = Constr
conMkFixed

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

withType :: (p a -> f a) -> f a
withType :: (p a -> f a) -> f a
withType foo :: p a -> f a
foo = p a -> f a
foo p a
forall a. HasCallStack => a
undefined

withResolution :: (HasResolution a) => (Integer -> f a) -> f a
withResolution :: (Integer -> f a) -> f a
withResolution foo :: Integer -> f a
foo = (Any a -> f a) -> f a
forall (p :: * -> *) a (f :: * -> *). (p a -> f a) -> f a
withType (Integer -> f a
foo (Integer -> f a) -> (Any a -> Integer) -> Any a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Any a -> Integer
forall a (p :: * -> *). HasResolution a => p a -> Integer
resolution)

-- | @since 2.01
instance Enum (Fixed a) where
    succ :: Fixed a -> Fixed a
succ (MkFixed a :: Integer
a) = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer
forall a. Enum a => a -> a
succ Integer
a)
    pred :: Fixed a -> Fixed a
pred (MkFixed a :: Integer
a) = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer
forall a. Enum a => a -> a
pred Integer
a)
    toEnum :: Int -> Fixed a
toEnum = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Fixed a) -> (Int -> Integer) -> Int -> Fixed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Enum a => Int -> a
toEnum
    fromEnum :: Fixed a -> Int
fromEnum (MkFixed a :: Integer
a) = Integer -> Int
forall a. Enum a => a -> Int
fromEnum Integer
a
    enumFrom :: Fixed a -> [Fixed a]
enumFrom (MkFixed a :: Integer
a) = (Integer -> Fixed a) -> [Integer] -> [Fixed a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> [Integer]
forall a. Enum a => a -> [a]
enumFrom Integer
a)
    enumFromThen :: Fixed a -> Fixed a -> [Fixed a]
enumFromThen (MkFixed a :: Integer
a) (MkFixed b :: Integer
b) = (Integer -> Fixed a) -> [Integer] -> [Fixed a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromThen Integer
a Integer
b)
    enumFromTo :: Fixed a -> Fixed a -> [Fixed a]
enumFromTo (MkFixed a :: Integer
a) (MkFixed b :: Integer
b) = (Integer -> Fixed a) -> [Integer] -> [Fixed a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromTo Integer
a Integer
b)
    enumFromThenTo :: Fixed a -> Fixed a -> Fixed a -> [Fixed a]
enumFromThenTo (MkFixed a :: Integer
a) (MkFixed b :: Integer
b) (MkFixed c :: Integer
c) = (Integer -> Fixed a) -> [Integer] -> [Fixed a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Integer
a Integer
b Integer
c)

-- | @since 2.01
instance (HasResolution a) => Num (Fixed a) where
    (MkFixed a :: Integer
a) + :: Fixed a -> Fixed a -> Fixed a
+ (MkFixed b :: Integer
b) = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b)
    (MkFixed a :: Integer
a) - :: Fixed a -> Fixed a -> Fixed a
- (MkFixed b :: Integer
b) = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
b)
    fa :: Fixed a
fa@(MkFixed a :: Integer
a) * :: Fixed a -> Fixed a -> Fixed a
* (MkFixed b :: Integer
b) = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b) (Fixed a -> Integer
forall a (p :: * -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa))
    negate :: Fixed a -> Fixed a
negate (MkFixed a :: Integer
a) = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer
forall a. Num a => a -> a
negate Integer
a)
    abs :: Fixed a -> Fixed a
abs (MkFixed a :: Integer
a) = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer
forall a. Num a => a -> a
abs Integer
a)
    signum :: Fixed a -> Fixed a
signum (MkFixed a :: Integer
a) = Integer -> Fixed a
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer
forall a. Num a => a -> a
signum Integer
a)
    fromInteger :: Integer -> Fixed a
fromInteger i :: Integer
i = (Integer -> Fixed a) -> Fixed a
forall a (f :: * -> *). HasResolution a => (Integer -> f a) -> f a
withResolution (\res :: Integer
res -> Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer
i Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
res))

-- | @since 2.01
instance (HasResolution a) => Real (Fixed a) where
    toRational :: Fixed a -> Rational
toRational fa :: Fixed a
fa@(MkFixed a :: Integer
a) = (Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
a) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Integer -> Rational
forall a. Real a => a -> Rational
toRational (Fixed a -> Integer
forall a (p :: * -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa))

-- | @since 2.01
instance (HasResolution a) => Fractional (Fixed a) where
    fa :: Fixed a
fa@(MkFixed a :: Integer
a) / :: Fixed a -> Fixed a -> Fixed a
/ (MkFixed b :: Integer
b) = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Fixed a -> Integer
forall a (p :: * -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa)) Integer
b)
    recip :: Fixed a -> Fixed a
recip fa :: Fixed a
fa@(MkFixed a :: Integer
a) = Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div (Integer
res Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
res) Integer
a) where
        res :: Integer
res = Fixed a -> Integer
forall a (p :: * -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa
    fromRational :: Rational -> Fixed a
fromRational r :: Rational
r = (Integer -> Fixed a) -> Fixed a
forall a (f :: * -> *). HasResolution a => (Integer -> f a) -> f a
withResolution (\res :: Integer
res -> Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
r Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
res))))

-- | @since 2.01
instance (HasResolution a) => RealFrac (Fixed a) where
    properFraction :: Fixed a -> (b, Fixed a)
properFraction a :: Fixed a
a = (b
i,Fixed a
a Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
- (b -> Fixed a
forall a b. (Integral a, Num b) => a -> b
fromIntegral b
i)) where
        i :: b
i = Fixed a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Fixed a
a
    truncate :: Fixed a -> b
truncate f :: Fixed a
f = Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Fixed a -> Rational
forall a. Real a => a -> Rational
toRational Fixed a
f)
    round :: Fixed a -> b
round f :: Fixed a
f = Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Fixed a -> Rational
forall a. Real a => a -> Rational
toRational Fixed a
f)
    ceiling :: Fixed a -> b
ceiling f :: Fixed a
f = Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Fixed a -> Rational
forall a. Real a => a -> Rational
toRational Fixed a
f)
    floor :: Fixed a -> b
floor f :: Fixed a
f = Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Fixed a -> Rational
forall a. Real a => a -> Rational
toRational Fixed a
f)

chopZeros :: Integer -> String
chopZeros :: Integer -> String
chopZeros 0 = ""
chopZeros a :: Integer
a | Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
a 10 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Integer -> String
chopZeros (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
a 10)
chopZeros a :: Integer
a = Integer -> String
forall a. Show a => a -> String
show Integer
a

-- only works for positive a
showIntegerZeros :: Bool -> Int -> Integer -> String
showIntegerZeros :: Bool -> Int -> Integer -> String
showIntegerZeros True _ 0 = ""
showIntegerZeros chopTrailingZeros :: Bool
chopTrailingZeros digits :: Int
digits a :: Integer
a = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
digits Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) '0' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s' where
    s :: String
s = Integer -> String
forall a. Show a => a -> String
show Integer
a
    s' :: String
s' = if Bool
chopTrailingZeros then Integer -> String
chopZeros Integer
a else String
s

withDot :: String -> String
withDot :: String -> String
withDot "" = ""
withDot s :: String
s = '.'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s

-- | First arg is whether to chop off trailing zeros
showFixed :: (HasResolution a) => Bool -> Fixed a -> String
showFixed :: Bool -> Fixed a -> String
showFixed chopTrailingZeros :: Bool
chopTrailingZeros fa :: Fixed a
fa@(MkFixed a :: Integer
a) | Integer
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Bool -> Fixed a -> String
forall a. HasResolution a => Bool -> Fixed a -> String
showFixed Bool
chopTrailingZeros (Fixed a -> Fixed a -> Fixed a
forall a. a -> a -> a
asTypeOf (Integer -> Fixed a
forall a. Integer -> Fixed a
MkFixed (Integer -> Integer
forall a. Num a => a -> a
negate Integer
a)) Fixed a
fa))
showFixed chopTrailingZeros :: Bool
chopTrailingZeros fa :: Fixed a
fa@(MkFixed a :: Integer
a) = (Integer -> String
forall a. Show a => a -> String
show Integer
i) String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
withDot (Bool -> Int -> Integer -> String
showIntegerZeros Bool
chopTrailingZeros Int
digits Integer
fracNum)) where
    res :: Integer
res = Fixed a -> Integer
forall a (p :: * -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa
    (i :: Integer
i,d :: Integer
d) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
a Integer
res
    -- enough digits to be unambiguous
    digits :: Int
digits = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase 10 (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
res) :: Double)
    maxnum :: Integer
maxnum = 10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
digits
    -- read floors, so show must ceil for `read . show = id` to hold. See #9240
    fracNum :: Integer
fracNum = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
divCeil (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
maxnum) Integer
res
    divCeil :: a -> a -> a
divCeil x :: a
x y :: a
y = (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y a -> a -> a
forall a. Num a => a -> a -> a
- 1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
y

-- | @since 2.01
instance (HasResolution a) => Show (Fixed a) where
    showsPrec :: Int -> Fixed a -> String -> String
showsPrec p :: Int
p n :: Fixed a
n = Bool -> (String -> String) -> String -> String
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 6 Bool -> Bool -> Bool
&& Fixed a
n Fixed a -> Fixed a -> Bool
forall a. Ord a => a -> a -> Bool
< 0) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString (String -> String -> String) -> String -> String -> String
forall a b. (a -> b) -> a -> b
$ Bool -> Fixed a -> String
forall a. HasResolution a => Bool -> Fixed a -> String
showFixed Bool
False Fixed a
n

-- | @since 4.3.0.0
instance (HasResolution a) => Read (Fixed a) where
    readPrec :: ReadPrec (Fixed a)
readPrec     = (Lexeme -> ReadPrec (Fixed a)) -> ReadPrec (Fixed a)
forall a. Num a => (Lexeme -> ReadPrec a) -> ReadPrec a
readNumber Lexeme -> ReadPrec (Fixed a)
forall a. HasResolution a => Lexeme -> ReadPrec (Fixed a)
convertFixed
    readListPrec :: ReadPrec [Fixed a]
readListPrec = ReadPrec [Fixed a]
forall a. Read a => ReadPrec [a]
readListPrecDefault
    readList :: ReadS [Fixed a]
readList     = ReadS [Fixed a]
forall a. Read a => ReadS [a]
readListDefault

convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a)
convertFixed :: Lexeme -> ReadPrec (Fixed a)
convertFixed (Number n :: Number
n)
 | Just (i :: Integer
i, f :: Integer
f) <- Integer -> Number -> Maybe (Integer, Integer)
numberToFixed Integer
e Number
n =
    Fixed a -> ReadPrec (Fixed a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Fixed a
forall a. Num a => Integer -> a
fromInteger Integer
i Fixed a -> Fixed a -> Fixed a
forall a. Num a => a -> a -> a
+ (Integer -> Fixed a
forall a. Num a => Integer -> a
fromInteger Integer
f Fixed a -> Fixed a -> Fixed a
forall a. Fractional a => a -> a -> a
/ (10 Fixed a -> Integer -> Fixed a
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
e)))
    where r :: Integer
r = Fixed a -> Integer
forall a (p :: * -> *). HasResolution a => p a -> Integer
resolution (Fixed a
forall a. HasCallStack => a
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 :: Integer
e = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase 10 (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
r) :: Double)
convertFixed _ = ReadPrec (Fixed a)
forall a. ReadPrec a
pfail

data E0

-- | @since 4.1.0.0
instance HasResolution E0 where
    resolution :: p E0 -> Integer
resolution _ = 1
-- | resolution of 1, this works the same as Integer
type Uni = Fixed E0

data E1

-- | @since 4.1.0.0
instance HasResolution E1 where
    resolution :: p E1 -> Integer
resolution _ = 10
-- | resolution of 10^-1 = .1
type Deci = Fixed E1

data E2

-- | @since 4.1.0.0
instance HasResolution E2 where
    resolution :: p E2 -> Integer
resolution _ = 100
-- | resolution of 10^-2 = .01, useful for many monetary currencies
type Centi = Fixed E2

data E3

-- | @since 4.1.0.0
instance HasResolution E3 where
    resolution :: p E3 -> Integer
resolution _ = 1000
-- | resolution of 10^-3 = .001
type Milli = Fixed E3

data E6

-- | @since 2.01
instance HasResolution E6 where
    resolution :: p E6 -> Integer
resolution _ = 1000000
-- | resolution of 10^-6 = .000001
type Micro = Fixed E6

data E9

-- | @since 4.1.0.0
instance HasResolution E9 where
    resolution :: p E9 -> Integer
resolution _ = 1000000000
-- | resolution of 10^-9 = .000000001
type Nano = Fixed E9

data E12

-- | @since 2.01
instance HasResolution E12 where
    resolution :: p E12 -> Integer
resolution _ = 1000000000000
-- | resolution of 10^-12 = .000000000001
type Pico = Fixed E12