{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
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.TypeLits (KnownNat, natVal)
import GHC.Read
import Text.ParserCombinators.ReadPrec
import Text.Read.Lex
default ()
div' :: (Real a,Integral b) => a -> a -> b
div' :: forall a b. (Real a, Integral b) => a -> a -> b
div' a
n a
d = forall a b. (RealFrac a, Integral b) => a -> b
floor ((forall a. Real a => a -> Rational
toRational a
n) forall a. Fractional a => a -> a -> a
/ (forall a. Real a => a -> Rational
toRational a
d))
divMod' :: (Real a,Integral b) => a -> a -> (b,a)
divMod' :: forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' a
n a
d = (b
f,a
n forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fromIntegral b
f) forall a. Num a => a -> a -> a
* a
d) where
f :: b
f = forall a b. (Real a, Integral b) => a -> a -> b
div' a
n a
d
mod' :: (Real a) => a -> a -> a
mod' :: forall a. Real a => a -> a -> a
mod' a
n a
d = a
n forall a. Num a => a -> a -> a
- (forall a. Num a => Integer -> a
fromInteger Integer
f) forall a. Num a => a -> a -> a
* a
d where
f :: Integer
f = forall a b. (Real a, Integral b) => a -> a -> b
div' a
n a
d
newtype Fixed (a :: k) = MkFixed Integer
deriving ( Fixed a -> Fixed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (a :: k). Fixed a -> Fixed a -> Bool
/= :: Fixed a -> Fixed a -> Bool
$c/= :: forall k (a :: k). Fixed a -> Fixed a -> Bool
== :: Fixed a -> Fixed a -> Bool
$c== :: forall k (a :: k). Fixed a -> Fixed a -> Bool
Eq
, Fixed a -> Fixed a -> Bool
Fixed a -> Fixed a -> Ordering
Fixed a -> Fixed a -> Fixed a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (a :: k). Eq (Fixed a)
forall k (a :: k). Fixed a -> Fixed a -> Bool
forall k (a :: k). Fixed a -> Fixed a -> Ordering
forall k (a :: k). Fixed a -> Fixed a -> Fixed a
min :: Fixed a -> Fixed a -> Fixed a
$cmin :: forall k (a :: k). Fixed a -> Fixed a -> Fixed a
max :: Fixed a -> Fixed a -> Fixed a
$cmax :: forall k (a :: k). Fixed a -> Fixed a -> Fixed a
>= :: Fixed a -> Fixed a -> Bool
$c>= :: forall k (a :: k). Fixed a -> Fixed a -> Bool
> :: Fixed a -> Fixed a -> Bool
$c> :: forall k (a :: k). Fixed a -> Fixed a -> Bool
<= :: Fixed a -> Fixed a -> Bool
$c<= :: forall k (a :: k). Fixed a -> Fixed a -> Bool
< :: Fixed a -> Fixed a -> Bool
$c< :: forall k (a :: k). Fixed a -> Fixed a -> Bool
compare :: Fixed a -> Fixed a -> Ordering
$ccompare :: forall k (a :: k). Fixed a -> Fixed a -> Ordering
Ord
)
tyFixed :: DataType
tyFixed :: DataType
tyFixed = String -> [Constr] -> DataType
mkDataType String
"Data.Fixed.Fixed" [Constr
conMkFixed]
conMkFixed :: Constr
conMkFixed :: Constr
conMkFixed = DataType -> String -> [String] -> Fixity -> Constr
mkConstr DataType
tyFixed String
"MkFixed" [] Fixity
Prefix
instance (Typeable k,Typeable a) => Data (Fixed (a :: k)) where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Fixed a -> c (Fixed a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
k forall g. g -> c g
z (MkFixed Integer
a) = forall d b. Data d => c (d -> b) -> d -> c b
k (forall g. g -> c g
z forall k (a :: k). Integer -> Fixed a
MkFixed) Integer
a
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Fixed a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
_ = forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall k (a :: k). Integer -> Fixed a
MkFixed)
dataTypeOf :: Fixed a -> DataType
dataTypeOf Fixed a
_ = DataType
tyFixed
toConstr :: Fixed a -> Constr
toConstr Fixed a
_ = Constr
conMkFixed
class HasResolution (a :: k) where
resolution :: p a -> Integer
instance KnownNat n => HasResolution n where
resolution :: forall (p :: Nat -> *). p n -> Integer
resolution p n
_ = forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall {k} (t :: k). Proxy t
Proxy :: Proxy n)
withType :: (Proxy a -> f a) -> f a
withType :: forall {k} (a :: k) (f :: k -> *). (Proxy a -> f a) -> f a
withType Proxy a -> f a
foo = Proxy a -> f a
foo forall {k} (t :: k). Proxy t
Proxy
withResolution :: (HasResolution a) => (Integer -> f a) -> f a
withResolution :: forall {k} (a :: k) (f :: k -> *).
HasResolution a =>
(Integer -> f a) -> f a
withResolution Integer -> f a
foo = forall {k} (a :: k) (f :: k -> *). (Proxy a -> f a) -> f a
withType (Integer -> f a
foo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution)
instance Enum (Fixed a) where
succ :: Fixed a -> Fixed a
succ (MkFixed Integer
a) = forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Enum a => a -> a
succ Integer
a)
pred :: Fixed a -> Fixed a
pred (MkFixed Integer
a) = forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Enum a => a -> a
pred Integer
a)
toEnum :: Int -> Fixed a
toEnum = forall k (a :: k). Integer -> Fixed a
MkFixed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum
fromEnum :: Fixed a -> Int
fromEnum (MkFixed Integer
a) = forall a. Enum a => a -> Int
fromEnum Integer
a
enumFrom :: Fixed a -> [Fixed a]
enumFrom (MkFixed Integer
a) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Enum a => a -> [a]
enumFrom Integer
a)
enumFromThen :: Fixed a -> Fixed a -> [Fixed a]
enumFromThen (MkFixed Integer
a) (MkFixed Integer
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Enum a => a -> a -> [a]
enumFromThen Integer
a Integer
b)
enumFromTo :: Fixed a -> Fixed a -> [Fixed a]
enumFromTo (MkFixed Integer
a) (MkFixed Integer
b) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Enum a => a -> a -> [a]
enumFromTo Integer
a Integer
b)
enumFromThenTo :: Fixed a -> Fixed a -> Fixed a -> [Fixed a]
enumFromThenTo (MkFixed Integer
a) (MkFixed Integer
b) (MkFixed Integer
c) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Integer
a Integer
b Integer
c)
instance (HasResolution a) => Num (Fixed a) where
(MkFixed Integer
a) + :: Fixed a -> Fixed a -> Fixed a
+ (MkFixed Integer
b) = forall k (a :: k). Integer -> Fixed a
MkFixed (Integer
a forall a. Num a => a -> a -> a
+ Integer
b)
(MkFixed Integer
a) - :: Fixed a -> Fixed a -> Fixed a
- (MkFixed Integer
b) = forall k (a :: k). Integer -> Fixed a
MkFixed (Integer
a forall a. Num a => a -> a -> a
- Integer
b)
fa :: Fixed a
fa@(MkFixed Integer
a) * :: Fixed a -> Fixed a -> Fixed a
* (MkFixed Integer
b) = forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Integral a => a -> a -> a
div (Integer
a forall a. Num a => a -> a -> a
* Integer
b) (forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa))
negate :: Fixed a -> Fixed a
negate (MkFixed Integer
a) = forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Num a => a -> a
negate Integer
a)
abs :: Fixed a -> Fixed a
abs (MkFixed Integer
a) = forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Num a => a -> a
abs Integer
a)
signum :: Fixed a -> Fixed a
signum (MkFixed Integer
a) = forall a. Num a => Integer -> a
fromInteger (forall a. Num a => a -> a
signum Integer
a)
fromInteger :: Integer -> Fixed a
fromInteger Integer
i = forall {k} (a :: k) (f :: k -> *).
HasResolution a =>
(Integer -> f a) -> f a
withResolution (\Integer
res -> forall k (a :: k). Integer -> Fixed a
MkFixed (Integer
i forall a. Num a => a -> a -> a
* Integer
res))
instance (HasResolution a) => Real (Fixed a) where
toRational :: Fixed a -> Rational
toRational fa :: Fixed a
fa@(MkFixed Integer
a) = (forall a. Real a => a -> Rational
toRational Integer
a) forall a. Fractional a => a -> a -> a
/ (forall a. Real a => a -> Rational
toRational (forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa))
instance (HasResolution a) => Fractional (Fixed a) where
fa :: Fixed a
fa@(MkFixed Integer
a) / :: Fixed a -> Fixed a -> Fixed a
/ (MkFixed Integer
b) = forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Integral a => a -> a -> a
div (Integer
a forall a. Num a => a -> a -> a
* (forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa)) Integer
b)
recip :: Fixed a -> Fixed a
recip fa :: Fixed a
fa@(MkFixed Integer
a) = forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Integral a => a -> a -> a
div (Integer
res forall a. Num a => a -> a -> a
* Integer
res) Integer
a) where
res :: Integer
res = forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa
fromRational :: Rational -> Fixed a
fromRational Rational
r = forall {k} (a :: k) (f :: k -> *).
HasResolution a =>
(Integer -> f a) -> f a
withResolution (\Integer
res -> forall k (a :: k). Integer -> Fixed a
MkFixed (forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
r forall a. Num a => a -> a -> a
* (forall a. Real a => a -> Rational
toRational Integer
res))))
instance (HasResolution a) => RealFrac (Fixed a) where
properFraction :: forall b. Integral b => Fixed a -> (b, Fixed a)
properFraction Fixed a
a = (b
i,Fixed a
a forall a. Num a => a -> a -> a
- (forall a b. (Integral a, Num b) => a -> b
fromIntegral b
i)) where
i :: b
i = forall a b. (RealFrac a, Integral b) => a -> b
truncate Fixed a
a
truncate :: forall b. Integral b => Fixed a -> b
truncate Fixed a
f = forall a b. (RealFrac a, Integral b) => a -> b
truncate (forall a. Real a => a -> Rational
toRational Fixed a
f)
round :: forall b. Integral b => Fixed a -> b
round Fixed a
f = forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Real a => a -> Rational
toRational Fixed a
f)
ceiling :: forall b. Integral b => Fixed a -> b
ceiling Fixed a
f = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a. Real a => a -> Rational
toRational Fixed a
f)
floor :: forall b. Integral b => Fixed a -> b
floor Fixed a
f = forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Real a => a -> Rational
toRational Fixed a
f)
chopZeros :: Integer -> String
chopZeros :: Integer -> String
chopZeros Integer
0 = String
""
chopZeros Integer
a | forall a. Integral a => a -> a -> a
mod Integer
a Integer
10 forall a. Eq a => a -> a -> Bool
== Integer
0 = Integer -> String
chopZeros (forall a. Integral a => a -> a -> a
div Integer
a Integer
10)
chopZeros Integer
a = forall a. Show a => a -> String
show Integer
a
showIntegerZeros :: Bool -> Int -> Integer -> String
showIntegerZeros :: Bool -> Int -> Integer -> String
showIntegerZeros Bool
True Int
_ Integer
0 = String
""
showIntegerZeros Bool
chopTrailingZeros Int
digits Integer
a = forall a. Int -> a -> [a]
replicate (Int
digits forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'0' forall a. [a] -> [a] -> [a]
++ String
s' where
s :: String
s = 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 String
"" = String
""
withDot String
s = Char
'.'forall a. a -> [a] -> [a]
:String
s
showFixed :: (HasResolution a) => Bool -> Fixed a -> String
showFixed :: forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
chopTrailingZeros fa :: Fixed a
fa@(MkFixed Integer
a) | Integer
a forall a. Ord a => a -> a -> Bool
< Integer
0 = String
"-" forall a. [a] -> [a] -> [a]
++ (forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
chopTrailingZeros (forall a. a -> a -> a
asTypeOf (forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Num a => a -> a
negate Integer
a)) Fixed a
fa))
showFixed Bool
chopTrailingZeros fa :: Fixed a
fa@(MkFixed Integer
a) = (forall a. Show a => a -> String
show Integer
i) forall a. [a] -> [a] -> [a]
++ (String -> String
withDot (Bool -> Int -> Integer -> String
showIntegerZeros Bool
chopTrailingZeros Int
digits Integer
fracNum)) where
res :: Integer
res = forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa
(Integer
i,Integer
d) = forall a. Integral a => a -> a -> (a, a)
divMod Integer
a Integer
res
digits :: Int
digits = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a. Floating a => a -> a -> a
logBase Double
10 (forall a. Num a => Integer -> a
fromInteger Integer
res) :: Double)
maxnum :: Integer
maxnum = Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int
digits
fracNum :: Integer
fracNum = forall a. Integral a => a -> a -> a
divCeil (Integer
d forall a. Num a => a -> a -> a
* Integer
maxnum) Integer
res
divCeil :: a -> a -> a
divCeil a
x a
y = (a
x forall a. Num a => a -> a -> a
+ a
y forall a. Num a => a -> a -> a
- a
1) forall a. Integral a => a -> a -> a
`div` a
y
instance (HasResolution a) => Show (Fixed a) where
showsPrec :: Int -> Fixed a -> String -> String
showsPrec Int
p Fixed a
n = Bool -> (String -> String) -> String -> String
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
6 Bool -> Bool -> Bool
&& Fixed a
n forall a. Ord a => a -> a -> Bool
< Fixed a
0) forall a b. (a -> b) -> a -> b
$ String -> String -> String
showString forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). HasResolution a => Bool -> Fixed a -> String
showFixed Bool
False Fixed a
n
instance (HasResolution a) => Read (Fixed a) where
readPrec :: ReadPrec (Fixed a)
readPrec = forall a. Num a => (Lexeme -> ReadPrec a) -> ReadPrec a
readNumber forall {k} (a :: k).
HasResolution a =>
Lexeme -> ReadPrec (Fixed a)
convertFixed
readListPrec :: ReadPrec [Fixed a]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault
readList :: ReadS [Fixed a]
readList = forall a. Read a => ReadS [a]
readListDefault
convertFixed :: forall a . HasResolution a => Lexeme -> ReadPrec (Fixed a)
convertFixed :: forall {k} (a :: k).
HasResolution a =>
Lexeme -> ReadPrec (Fixed a)
convertFixed (Number Number
n)
| Just (Integer
i, Integer
f) <- Integer -> Number -> Maybe (Integer, Integer)
numberToFixed Integer
e Number
n =
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Num a => Integer -> a
fromInteger Integer
i forall a. Num a => a -> a -> a
+ (forall a. Num a => Integer -> a
fromInteger Integer
f forall a. Fractional a => a -> a -> a
/ (Fixed a
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
e)))
where r :: Integer
r = forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
e :: Integer
e = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a. Floating a => a -> a -> a
logBase Double
10 (forall a. Num a => Integer -> a
fromInteger Integer
r) :: Double)
convertFixed Lexeme
_ = forall a. ReadPrec a
pfail
data E0
instance HasResolution E0 where
resolution :: forall (p :: * -> *). p E0 -> Integer
resolution p E0
_ = Integer
1
type Uni = Fixed E0
data E1
instance HasResolution E1 where
resolution :: forall (p :: * -> *). p E1 -> Integer
resolution p E1
_ = Integer
10
type Deci = Fixed E1
data E2
instance HasResolution E2 where
resolution :: forall (p :: * -> *). p E2 -> Integer
resolution p E2
_ = Integer
100
type Centi = Fixed E2
data E3
instance HasResolution E3 where
resolution :: forall (p :: * -> *). p E3 -> Integer
resolution p E3
_ = Integer
1000
type Milli = Fixed E3
data E6
instance HasResolution E6 where
resolution :: forall (p :: * -> *). p E6 -> Integer
resolution p E6
_ = Integer
1000000
type Micro = Fixed E6
data E9
instance HasResolution E9 where
resolution :: forall (p :: * -> *). p E9 -> Integer
resolution p E9
_ = Integer
1000000000
type Nano = Fixed E9
data E12
instance HasResolution E12 where
resolution :: forall (p :: * -> *). p E12 -> Integer
resolution p E12
_ = Integer
1000000000000
type Pico = Fixed E12