{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}

module Argo.Internal.Type.Decimal where

import Data.Ratio ((%))

import qualified Argo.Vendor.DeepSeq as DeepSeq
import qualified Argo.Vendor.TemplateHaskell as TH
import qualified Data.List as List
import qualified Data.Ratio as Ratio
import qualified GHC.Generics as Generics
import qualified Numeric

data Decimal = Decimal Integer Integer
    deriving (Decimal -> Decimal -> Bool
(Decimal -> Decimal -> Bool)
-> (Decimal -> Decimal -> Bool) -> Eq Decimal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Decimal -> Decimal -> Bool
$c/= :: Decimal -> Decimal -> Bool
== :: Decimal -> Decimal -> Bool
$c== :: Decimal -> Decimal -> Bool
Eq, (forall x. Decimal -> Rep Decimal x)
-> (forall x. Rep Decimal x -> Decimal) -> Generic Decimal
forall x. Rep Decimal x -> Decimal
forall x. Decimal -> Rep Decimal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Decimal x -> Decimal
$cfrom :: forall x. Decimal -> Rep Decimal x
Generics.Generic, Decimal -> Q Exp
Decimal -> Q (TExp Decimal)
(Decimal -> Q Exp) -> (Decimal -> Q (TExp Decimal)) -> Lift Decimal
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Decimal -> Q (TExp Decimal)
$cliftTyped :: Decimal -> Q (TExp Decimal)
lift :: Decimal -> Q Exp
$clift :: Decimal -> Q Exp
TH.Lift, Decimal -> ()
(Decimal -> ()) -> NFData Decimal
forall a. (a -> ()) -> NFData a
rnf :: Decimal -> ()
$crnf :: Decimal -> ()
DeepSeq.NFData, Int -> Decimal -> ShowS
[Decimal] -> ShowS
Decimal -> String
(Int -> Decimal -> ShowS)
-> (Decimal -> String) -> ([Decimal] -> ShowS) -> Show Decimal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Decimal] -> ShowS
$cshowList :: [Decimal] -> ShowS
show :: Decimal -> String
$cshow :: Decimal -> String
showsPrec :: Int -> Decimal -> ShowS
$cshowsPrec :: Int -> Decimal -> ShowS
Show)

negate :: Decimal -> Decimal
negate :: Decimal -> Decimal
negate (Decimal Integer
s Integer
e) = Integer -> Integer -> Decimal
Decimal (-Integer
s) Integer
e

decimal :: Integer -> Integer -> Decimal
decimal :: Integer -> Integer -> Decimal
decimal Integer
s = Decimal -> Decimal
normalize (Decimal -> Decimal) -> (Integer -> Decimal) -> Integer -> Decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Decimal
Decimal Integer
s

normalize :: Decimal -> Decimal
normalize :: Decimal -> Decimal
normalize (Decimal Integer
s Integer
e) = if Integer
s Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
    then Integer -> Integer -> Decimal
Decimal Integer
0 Integer
0
    else
        let (Integer
q, Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
s Integer
10
        in if Integer
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Decimal -> Decimal
normalize (Decimal -> Decimal) -> Decimal -> Decimal
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Decimal
Decimal Integer
q (Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) else Integer -> Integer -> Decimal
Decimal Integer
s Integer
e

fromInteger :: Integer -> Decimal
fromInteger :: Integer -> Decimal
fromInteger = (Integer -> Integer -> Decimal) -> Integer -> Integer -> Decimal
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> Decimal
decimal Integer
0

toInteger :: Decimal -> Maybe Integer
toInteger :: Decimal -> Maybe Integer
toInteger (Decimal Integer
s Integer
e) = if Integer
e Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then Maybe Integer
forall a. Maybe a
Nothing else Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
s Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
e

fromRealFloat :: RealFloat a => a -> Maybe Decimal
fromRealFloat :: a -> Maybe Decimal
fromRealFloat a
x = if a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x Bool -> Bool -> Bool
|| a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x
    then Maybe Decimal
forall a. Maybe a
Nothing
    else
        Decimal -> Maybe Decimal
forall a. a -> Maybe a
Just
        (Decimal -> Maybe Decimal) -> (a -> Decimal) -> a -> Maybe Decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then Decimal -> Decimal
Argo.Internal.Type.Decimal.negate else Decimal -> Decimal
forall a. a -> a
id)
        (Decimal -> Decimal) -> (a -> Decimal) -> a -> Decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Int] -> Int -> Decimal) -> ([Int], Int) -> Decimal
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Int] -> Int -> Decimal
fromDigits
        (([Int], Int) -> Decimal) -> (a -> ([Int], Int)) -> a -> Decimal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
Numeric.floatToDigits Integer
10
        (a -> Maybe Decimal) -> a -> Maybe Decimal
forall a b. (a -> b) -> a -> b
$ a -> a
forall a. Num a => a -> a
abs a
x

toRealFloat :: RealFloat a => Decimal -> a
toRealFloat :: Decimal -> a
toRealFloat = Rational -> a
forall a. Fractional a => Rational -> a
Prelude.fromRational (Rational -> a) -> (Decimal -> Rational) -> Decimal -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Decimal -> Rational
Argo.Internal.Type.Decimal.toRational

fromDigits :: [Int] -> Int -> Decimal
fromDigits :: [Int] -> Int -> Decimal
fromDigits [Int]
ds Int
e = (Integer -> Integer -> Decimal) -> (Integer, Integer) -> Decimal
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> Decimal
decimal ((Integer, Integer) -> Decimal) -> (Integer, Integer) -> Decimal
forall a b. (a -> b) -> a -> b
$ ((Integer, Integer) -> Int -> (Integer, Integer))
-> (Integer, Integer) -> [Int] -> (Integer, Integer)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl'
    (\(Integer
a, Integer
n) Int
d -> (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
Prelude.toInteger Int
d, Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
    (Integer
0, Int -> Integer
forall a. Integral a => a -> Integer
Prelude.toInteger Int
e)
    [Int]
ds

toRational :: Decimal -> Rational
toRational :: Decimal -> Rational
toRational d :: Decimal
d@(Decimal Integer
s Integer
e) = Rational -> (Integer -> Rational) -> Maybe Integer -> Rational
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer
s Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (-Integer
e))) Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Maybe Integer -> Rational) -> Maybe Integer -> Rational
forall a b. (a -> b) -> a -> b
$ Decimal -> Maybe Integer
Argo.Internal.Type.Decimal.toInteger Decimal
d

fromRational :: Rational -> Maybe Decimal
fromRational :: Rational -> Maybe Decimal
fromRational Rational
r =
    let
        n :: Integer
n = Rational -> Integer
forall a. Ratio a -> a
Ratio.numerator Rational
r
        d1 :: Integer
d1 = Rational -> Integer
forall a. Ratio a -> a
Ratio.denominator Rational
r
        (Integer
t, Integer
d2) = Integer -> Integer -> Integer -> (Integer, Integer)
forall a b. (Num a, Integral b) => b -> a -> b -> (a, b)
factor Integer
2 (Integer
0 :: Integer) Integer
d1
        (Integer
f, Integer
d3) = Integer -> Integer -> Integer -> (Integer, Integer)
forall a b. (Num a, Integral b) => b -> a -> b -> (a, b)
factor Integer
5 (Integer
0 :: Integer) Integer
d2
        p :: Integer
p = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
t Integer
f
    in if Integer
d3 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
        then Decimal -> Maybe Decimal
forall a. a -> Maybe a
Just (Decimal -> Maybe Decimal) -> Decimal -> Maybe Decimal
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Decimal
decimal (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
t) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
5 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
f)) (-Integer
p)
        else Maybe Decimal
forall a. Maybe a
Nothing

-- factor d 0 x = (p, y) <=> x = (d ^ p) * y
factor :: (Num a, Integral b) => b -> a -> b -> (a, b)
factor :: b -> a -> b -> (a, b)
factor b
d a
n b
x =
    let (b
q, b
r) = b -> b -> (b, b)
forall a. Integral a => a -> a -> (a, a)
quotRem b
x b
d
    in if b
x b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
0 Bool -> Bool -> Bool
&& b
r b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
0 then b -> a -> b -> (a, b)
forall a b. (Num a, Integral b) => b -> a -> b -> (a, b)
factor b
d (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) b
q else (a
n, b
x)