-- |
-- Module      : Text.PercentFormat.Quotient
-- Copyright   : (c) 2018 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- The 'Quotient' datatype.  Similar to 'Rational' but allows @Infinity@ and
-- @NaN@.
module Text.PercentFormat.Quotient
  ( Quotient
  , (%)
  , infinity
  , nan
  , isInfinite
  , isNaN
  , readQ
  , maybeReadQ
  , digits
  , fracDigits
  )
where

import Prelude hiding (isInfinite, isNaN)
import Data.Char (isDigit)
import Data.Maybe (fromMaybe)
import Data.List (findIndex)
import qualified Data.Ratio as R
import Text.PercentFormat.Utils

-- | Our own Ratio type that allows Infinity and NaN
data Quotient = Integer :% Integer
infixl 7 :%

-- | 'Eq' instance for 'Quotient'.  Follows the identity property except for
--   NaN which is different from itself (this is consistent with 'Float' &
--   'Double' behaviour).
instance Eq Quotient where
  (Integer
0 :% Integer
0) == :: Quotient -> Quotient -> Bool
== Quotient
_  =  Bool
False
  Quotient
_ == (Integer
0 :% Integer
0)  =  Bool
False
  (Integer
x :% Integer
y) == (Integer
x' :% Integer
y')  =  (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y') Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)

-- | 'Ord' instance for 'Quotient'.  Follows the regular order properties
--   except for NaN.  When NaN is present in any of the operands of 'compare',
--   'GT' is returned (consistent with 'Float' & 'Double').
instance Ord Quotient where
  (Integer
0 :% Integer
0) compare :: Quotient -> Quotient -> Ordering
`compare` Quotient
_  =  Ordering
GT
  Quotient
_ `compare` (Integer
0 :% Integer
0)  =  Ordering
GT
  (Integer
x :% Integer
y) `compare` (Integer
x' :% Integer
y') = (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y') Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y)

instance Show Quotient where
  showsPrec :: Int -> Quotient -> ShowS
showsPrec Int
d (Integer
0 :% Integer
0) = String -> ShowS
showString String
"NaN"
  showsPrec Int
d (Integer
x :% Integer
0) | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0     = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
6) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"-Infinity"
                       | Bool
otherwise =                     String -> ShowS
showString  String
"Infinity"
  showsPrec Int
d (Integer
x :% Integer
y) = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
7)
                       (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 Integer
x ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" % " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 Integer
y

-- | Smart-constructor for Quotients
(%) :: Integer -> Integer -> Quotient
Integer
0 % :: Integer -> Integer -> Quotient
% Integer
0  =  Integer
0 Integer -> Integer -> Quotient
:% Integer
0         -- NaN
Integer
x % Integer
0  =  Integer -> Integer
forall a. Num a => a -> a
signum Integer
x Integer -> Integer -> Quotient
:% Integer
0  -- (+/-) Infinity
Integer
x % Integer
y  =  (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer
forall a. Num a => a -> a
signum Integer
y Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
d) Integer -> Integer -> Quotient
:% (Integer -> Integer
forall a. Num a => a -> a
abs Integer
y Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
d)
  where
  d :: Integer
d = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd Integer
x Integer
y
infixl 7 %

-- | Infinity.
infinity :: Quotient
infinity :: Quotient
infinity = Integer
1 Integer -> Integer -> Quotient
% Integer
0

-- | Not a number @(0 / 0)@.
nan :: Quotient
nan :: Quotient
nan = Integer
0 Integer -> Integer -> Quotient
% Integer
0

-- | Returns whether a given quotient is an infinity (+/-).
isInfinite :: Quotient -> Bool
isInfinite :: Quotient -> Bool
isInfinite Quotient
q = Quotient
q Quotient -> Quotient -> Bool
forall a. Eq a => a -> a -> Bool
== Quotient
infinity Bool -> Bool -> Bool
|| Quotient
q Quotient -> Quotient -> Bool
forall a. Eq a => a -> a -> Bool
== (-Quotient
infinity)

-- | Returns if the quotient is not a number.
isNaN :: Quotient -> Bool
isNaN :: Quotient -> Bool
isNaN Quotient
q = Quotient
q Quotient -> Quotient -> Bool
forall a. Eq a => a -> a -> Bool
/= Quotient
q


instance Num Quotient where
  negate :: Quotient -> Quotient
negate (Integer
x :% Integer
y)  =  Integer -> Integer
forall a. Num a => a -> a
negate Integer
x Integer -> Integer -> Quotient
% Integer
y
  (Integer
x :% Integer
y) + :: Quotient -> Quotient -> Quotient
+ (Integer
x' :% Integer
y')  =  (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y'  Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+  Integer
x' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y) Integer -> Integer -> Quotient
% (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y')
  (Integer
x :% Integer
y) * :: Quotient -> Quotient -> Quotient
* (Integer
x' :% Integer
y')  =  (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x') Integer -> Integer -> Quotient
% (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y')
  abs :: Quotient -> Quotient
abs (Integer
x :% Integer
y)  =  Integer -> Integer
forall a. Num a => a -> a
abs Integer
x Integer -> Integer -> Quotient
% Integer -> Integer
forall a. Num a => a -> a
abs Integer
y
  signum :: Quotient -> Quotient
signum (Integer
x :% Integer
y)  =  Integer -> Integer
forall a. Num a => a -> a
signum Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer -> Integer
forall a. Num a => a -> a
signum Integer
y  Integer -> Integer -> Quotient
%  Integer
1
  fromInteger :: Integer -> Quotient
fromInteger  =  (Integer -> Integer -> Quotient
% Integer
1)

instance Fractional Quotient where
  recip :: Quotient -> Quotient
recip (Integer
x :% Integer
y) = Integer
y Integer -> Integer -> Quotient
% Integer
x
  fromRational :: Rational -> Quotient
fromRational Rational
q = Rational -> Integer
forall a. Ratio a -> a
R.numerator Rational
q Integer -> Integer -> Quotient
% Rational -> Integer
forall a. Ratio a -> a
R.denominator Rational
q

instance Real Quotient where
  toRational :: Quotient -> Rational
toRational (Integer
x :% Integer
y) = Integer
x Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
R.% Integer
y

instance RealFrac Quotient where
  properFraction :: Quotient -> (b, Quotient)
properFraction (Integer
x :% Integer
y) = (Integer -> b
forall a. Num a => Integer -> a
fromInteger Integer
q, Integer
r Integer -> Integer -> Quotient
% Integer
y)
    where (Integer
q,Integer
r) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem Integer
x Integer
y

-- TODO: change this ugly ad-hoc implementation into something that uses
--       readsPrec and related functions
maybeReadQ :: String -> Maybe Quotient
maybeReadQ :: String -> Maybe Quotient
maybeReadQ String
"Infinity" = Quotient -> Maybe Quotient
forall a. a -> Maybe a
Just Quotient
infinity
maybeReadQ String
"NaN"      = Quotient -> Maybe Quotient
forall a. a -> Maybe a
Just Quotient
nan
maybeReadQ String
"inf"      = Quotient -> Maybe Quotient
forall a. a -> Maybe a
Just Quotient
infinity  -- for Hugs
maybeReadQ String
"nan"      = Quotient -> Maybe Quotient
forall a. a -> Maybe a
Just Quotient
nan       -- for Hugs
maybeReadQ (Char
'-':String
s)    = Quotient -> Quotient
forall a. Num a => a -> a
negate (Quotient -> Quotient) -> Maybe Quotient -> Maybe Quotient
forall t a. (t -> a) -> Maybe t -> Maybe a
<$> String -> Maybe Quotient
maybeReadQ String
s
  where
  t -> a
f <$> :: (t -> a) -> Maybe t -> Maybe a
<$> Maybe t
Nothing   =  Maybe a
forall a. Maybe a
Nothing
  t -> a
f <$> (Just t
x)  =  a -> Maybe a
forall a. a -> Maybe a
Just (t -> a
f t
x)
maybeReadQ (Char
'(':String
s)    = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')') String
s of
                        (String
s',Char
')':String
s'') -> String -> Maybe Quotient
maybeReadQ (String
s' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s'') -- ugly!
                        (String, String)
_ -> Maybe Quotient
forall a. Maybe a
Nothing
maybeReadQ (Char
d:String
s) | Bool -> Bool
not (Char -> Bool
isDigit Char
d) = Maybe Quotient
forall a. Maybe a
Nothing
maybeReadQ String
etc = Quotient -> Maybe Quotient
forall a. a -> Maybe a
Just (Quotient -> Maybe Quotient) -> Quotient -> Maybe Quotient
forall a b. (a -> b) -> a -> b
$
  case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
etc of
  (String
"",String
_)      -> String -> Quotient
forall a. HasCallStack => String -> a
error String
"readQ: the impossible happened"
  (String
i,Char
'.':String
etc) -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
etc of
                 (String
j,Char
'e':Char
'-':Char
e:String
tc) | Char -> Bool
isDigit Char
e ->
                   String -> Integer
forall a. Read a => String -> a
read (String
iString -> ShowS
forall a. [a] -> [a] -> [a]
++String
j) Integer -> Integer -> Quotient
% Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. Read a => String -> a
read (Char
eChar -> ShowS
forall a. a -> [a] -> [a]
:(Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit String
tc))
                 (String
j,Char
'e':Char
e:String
tc) | Char -> Bool
isDigit Char
e ->
                   String -> Integer
forall a. Read a => String -> a
read (String
iString -> ShowS
forall a. [a] -> [a] -> [a]
++String
j) 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
^ (String -> Integer
forall a. Read a => String -> a
read (Char
eChar -> ShowS
forall a. a -> [a] -> [a]
:(Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit String
tc)) Integer -> Integer -> Quotient
% Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
j
                 (String
j,String
etc) -> String -> Integer
forall a. Read a => String -> a
read (String
iString -> ShowS
forall a. [a] -> [a] -> [a]
++String
j) Integer -> Integer -> Quotient
% Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
j
  (String
i,Char
'%':Char
e:String
tc) | Char -> Bool
isDigit Char
e -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit (Char
eChar -> ShowS
forall a. a -> [a] -> [a]
:String
tc) of
                              (String
j,String
etc) -> String -> Integer
forall a. Read a => String -> a
read String
i Integer -> Integer -> Quotient
% String -> Integer
forall a. Read a => String -> a
read String
j
  (String
i,Char
' ':Char
'%':Char
' ':Char
e:String
tc) | Char -> Bool
isDigit Char
e -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit (Char
eChar -> ShowS
forall a. a -> [a] -> [a]
:String
tc) of
                                      (String
j,String
etc) -> String -> Integer
forall a. Read a => String -> a
read String
i Integer -> Integer -> Quotient
% String -> Integer
forall a. Read a => String -> a
read String
j
  (String
i,String
etc)     -> String -> Integer
forall a. Read a => String -> a
read String
i Integer -> Integer -> Quotient
% Integer
1

readQ :: String -> Quotient
readQ :: String -> Quotient
readQ = Quotient -> Maybe Quotient -> Quotient
forall a. a -> Maybe a -> a
fromMaybe (String -> Quotient
forall a. HasCallStack => String -> a
error String
"No number to read") (Maybe Quotient -> Quotient)
-> (String -> Maybe Quotient) -> String -> Quotient
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Quotient
maybeReadQ

-- | Given a quotient (rational number),
--   returns a tuple with
--   its integer part,
--   its fractional digits and
--   the period size (last fractional digits).
--   The signal is ignored.
--
-- > > digits 10 (1234567 / 100)
-- > Right ([1,2,3,4,5],[6,7],[])
-- > > digits 10 (1/3)
-- > Right ([0],[3],1)
-- > > digits 10 (1/6)
-- > Right ([0],[1,6],1)
-- > > digits 10 (1/7)
-- > Right ([0],[1,4,2,8,5,7],6)
-- > > digits 10 (1/11)
-- > Right ([0],[0,9],2)
-- > digits 10 (1/12)
-- > Right ([0],[0,8,3],1)
-- > > digits 10 (1/13)
-- > Right ([0],[0,7,6,9,2,3],6)
-- > > digits 10 123
-- > Right ([1,2,3],[],[])
-- > > digits 10 (-4/3)
-- > Right ([1],[],[3])
-- > > digits 10 (-1/3)
-- > Right ([0],[],[3])
digits :: Int -> Quotient -> Either String ([Int],[Int],[Int])
digits :: Int -> Quotient -> Either String ([Int], [Int], [Int])
digits Int
b (Integer
0 :% Integer
0) = String -> Either String ([Int], [Int], [Int])
forall a b. a -> Either a b
Left String
"NaN"
digits Int
b (Integer
n :% Integer
0) = String -> Either String ([Int], [Int], [Int])
forall a b. a -> Either a b
Left String
"Infinity"
digits Int
b Quotient
q = ([Int], [Int], [Int]) -> Either String ([Int], [Int], [Int])
forall a b. b -> Either a b
Right ([Int]
ids,[Int]
fds,[Int]
pds)
  where
  (Integer
i,Quotient
q') = Quotient -> (Integer, Quotient)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Quotient
q
  ([Int]
fds,[Int]
pds) = Int -> Quotient -> ([Int], [Int])
fracDigits Int
b Quotient
q'
  ids :: [Int]
ids = case Int -> Integer -> [Int]
forall a. Integral a => Int -> a -> [Int]
integerToDigits Int
b Integer
i of
        [] -> [Int
0]
        [Int]
ds -> [Int]
ds

-- | Givent a base, returns the fractional digits of a Quotient (including a
--   period if present).
--
-- > > fracDigits 10 (123 / 100)
-- > ([2,3],[])
-- > > fracDigits 10 (12345 / 100)
-- > ([4,5],[])
-- > > fracDigits 10 (12345 / 10)
-- > ([5],[])
-- > > fracDigits 10 (100 / 10)
-- > ([],[])
-- > > fracDigits 10 (1 / 3)
-- > ([],[3])
-- > > fracDigits 10 (1 / 7)
-- > ([],[1,4,2,8,5,7])
fracDigits :: Int -> Quotient -> ([Int],[Int])
fracDigits :: Int -> Quotient -> ([Int], [Int])
fracDigits Int
b Quotient
q | Quotient
q Quotient -> Quotient -> Bool
forall a. Ord a => a -> a -> Bool
< Quotient
0  = Int -> Quotient -> ([Int], [Int])
fracDigits Int
b (Quotient -> Quotient
forall a. Num a => a -> a
abs Quotient
q)
fracDigits Int
b Quotient
q | Quotient
q Quotient -> Quotient -> Bool
forall a. Ord a => a -> a -> Bool
>= Quotient
1 = Int -> Quotient -> ([Int], [Int])
fracDigits Int
b ((Integer, Quotient) -> Quotient
forall a b. (a, b) -> b
snd ((Integer, Quotient) -> Quotient)
-> (Integer, Quotient) -> Quotient
forall a b. (a -> b) -> a -> b
$ Quotient -> (Integer, Quotient)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Quotient
q)
fracDigits Int
b Quotient
q = let ([Int]
fds,Int
psz) = [(Integer, Integer)] -> Quotient -> ([Int], Int)
fun [] Quotient
q
                     fsz :: Int
fsz = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
fds Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
psz
                 in Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
fsz [Int]
fds
  where
  fun :: [(Integer,Integer)] -> Quotient -> ([Int],Int)
  fun :: [(Integer, Integer)] -> Quotient -> ([Int], Int)
fun [(Integer, Integer)]
hist (Integer
0 :% Integer
_) = ([],Int
0)
  fun [(Integer, Integer)]
hist (Integer
x :% Integer
y) = case ((Integer, Integer) -> Bool) -> [(Integer, Integer)] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Integer, Integer) -> (Integer, Integer) -> Bool
forall a. Eq a => a -> a -> Bool
==(Integer
x,Integer
y)) [(Integer, Integer)]
hist of
                      Maybe Int
Nothing -> (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
qInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
fds,Int
psz)
                      Just Int
i -> ([],Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    where
    (Integer
q,Integer
r) = (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
b) Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
y
    ([Int]
fds,Int
psz) = [(Integer, Integer)] -> Quotient -> ([Int], Int)
fun ((Integer
x,Integer
y)(Integer, Integer) -> [(Integer, Integer)] -> [(Integer, Integer)]
forall a. a -> [a] -> [a]
:[(Integer, Integer)]
hist) (Integer
r Integer -> Integer -> Quotient
% Integer
y)