-- |
-- 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 forall a. Num a => a -> a -> a
* Integer
y') forall a. Eq a => a -> a -> Bool
== (Integer
x' 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 forall a. Num a => a -> a -> a
* Integer
y') forall a. Ord a => a -> a -> Ordering
`compare` (Integer
x' 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 forall a. Ord a => a -> a -> Bool
< Integer
0     = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
6) 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 forall a. Ord a => a -> a -> Bool
> Int
7)
                       forall a b. (a -> b) -> a -> b
$ forall a. Show a => Int -> a -> ShowS
showsPrec Int
7 Integer
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" % " forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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  =  forall a. Num a => a -> a
signum Integer
x Integer -> Integer -> Quotient
:% Integer
0  -- (+/-) Infinity
Integer
x % Integer
y  =  (Integer
x forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
signum Integer
y forall a. Integral a => a -> a -> a
`quot` Integer
d) Integer -> Integer -> Quotient
:% (forall a. Num a => a -> a
abs Integer
y forall a. Integral a => a -> a -> a
`quot` Integer
d)
  where
  d :: Integer
d = 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 forall a. Eq a => a -> a -> Bool
== Quotient
infinity Bool -> Bool -> Bool
|| Quotient
q 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 forall a. Eq a => a -> a -> Bool
/= Quotient
q


instance Num Quotient where
  negate :: Quotient -> Quotient
negate (Integer
x :% Integer
y)  =  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 forall a. Num a => a -> a -> a
* Integer
y'  forall a. Num a => a -> a -> a
+  Integer
x' forall a. Num a => a -> a -> a
* Integer
y) Integer -> Integer -> Quotient
% (Integer
y forall a. Num a => a -> a -> a
* Integer
y')
  (Integer
x :% Integer
y) * :: Quotient -> Quotient -> Quotient
* (Integer
x' :% Integer
y')  =  (Integer
x forall a. Num a => a -> a -> a
* Integer
x') Integer -> Integer -> Quotient
% (Integer
y forall a. Num a => a -> a -> a
* Integer
y')
  abs :: Quotient -> Quotient
abs (Integer
x :% Integer
y)  =  forall a. Num a => a -> a
abs Integer
x Integer -> Integer -> Quotient
% forall a. Num a => a -> a
abs Integer
y
  signum :: Quotient -> Quotient
signum (Integer
x :% Integer
y)  =  forall a. Num a => a -> a
signum Integer
x forall a. Num a => a -> a -> a
* 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 = forall a. Ratio a -> a
R.numerator Rational
q Integer -> Integer -> Quotient
% forall a. Ratio a -> a
R.denominator Rational
q

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

instance RealFrac Quotient where
  properFraction :: forall b. Integral b => Quotient -> (b, Quotient)
properFraction (Integer
x :% Integer
y) = (forall a. Num a => Integer -> a
fromInteger Integer
q, Integer
r Integer -> Integer -> Quotient
% Integer
y)
    where (Integer
q,Integer
r) = 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" = forall a. a -> Maybe a
Just Quotient
infinity
maybeReadQ String
"NaN"      = forall a. a -> Maybe a
Just Quotient
nan
maybeReadQ String
"inf"      = forall a. a -> Maybe a
Just Quotient
infinity  -- for Hugs
maybeReadQ String
"nan"      = forall a. a -> Maybe a
Just Quotient
nan       -- for Hugs
maybeReadQ (Char
'-':String
s)    = forall a. Num a => a -> a
negate 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   =  forall a. Maybe a
Nothing
  t -> a
f <$> (Just t
x)  =  forall a. a -> Maybe a
Just (t -> a
f t
x)
maybeReadQ (Char
'(':String
s)    = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
')') String
s of
                        (String
s',Char
')':String
s'') -> String -> Maybe Quotient
maybeReadQ (String
s' forall a. [a] -> [a] -> [a]
++ String
s'') -- ugly!
                        (String, String)
_ -> forall a. Maybe a
Nothing
maybeReadQ (Char
d:String
s) | Bool -> Bool
not (Char -> Bool
isDigit Char
d) = forall a. Maybe a
Nothing
maybeReadQ String
etc = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
  case forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit String
etc of
  (String
"",String
_)      -> forall a. HasCallStack => String -> a
error String
"readQ: the impossible happened"
  (String
i,Char
'.':String
etc) -> case 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 ->
                   forall a. Read a => String -> a
read (String
iforall a. [a] -> [a] -> [a]
++String
j) Integer -> Integer -> Quotient
% Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
j forall a. Num a => a -> a -> a
+ forall a. Read a => String -> a
read (Char
eforall a. a -> [a] -> [a]
: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 ->
                   forall a. Read a => String -> a
read (String
iforall a. [a] -> [a] -> [a]
++String
j) forall a. Num a => a -> a -> a
* Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (forall a. Read a => String -> a
read (Char
eforall a. a -> [a] -> [a]
:forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit String
tc)) Integer -> Integer -> Quotient
% Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
j
                 (String
j,String
etc) -> forall a. Read a => String -> a
read (String
iforall a. [a] -> [a] -> [a]
++String
j) Integer -> Integer -> Quotient
% Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
j
  (String
i,Char
'%':Char
e:String
tc) | Char -> Bool
isDigit Char
e -> case forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit (Char
eforall a. a -> [a] -> [a]
:String
tc) of
                              (String
j,String
etc) -> forall a. Read a => String -> a
read String
i Integer -> Integer -> Quotient
% forall a. Read a => String -> a
read String
j
  (String
i,Char
' ':Char
'%':Char
' ':Char
e:String
tc) | Char -> Bool
isDigit Char
e -> case forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isDigit (Char
eforall a. a -> [a] -> [a]
:String
tc) of
                                      (String
j,String
etc) -> forall a. Read a => String -> a
read String
i Integer -> Integer -> Quotient
% forall a. Read a => String -> a
read String
j
  (String
i,String
etc)     -> forall a. Read a => String -> a
read String
i Integer -> Integer -> Quotient
% Integer
1

readQ :: String -> Quotient
readQ :: String -> Quotient
readQ = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error String
"No number to read") 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) = forall a b. a -> Either a b
Left String
"NaN"
digits Int
b (Integer
n :% Integer
0) = forall a b. a -> Either a b
Left String
"Infinity"
digits Int
b Quotient
q = forall a b. b -> Either a b
Right ([Int]
ids,[Int]
fds,[Int]
pds)
  where
  (Integer
i,Quotient
q') = 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 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 forall a. Ord a => a -> a -> Bool
< Quotient
0  = Int -> Quotient -> ([Int], [Int])
fracDigits Int
b (forall a. Num a => a -> a
abs Quotient
q)
fracDigits Int
b Quotient
q | Quotient
q forall a. Ord a => a -> a -> Bool
>= Quotient
1 = Int -> Quotient -> ([Int], [Int])
fracDigits Int
b (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
fds forall a. Num a => a -> a -> a
- Int
psz
                 in 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 forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (forall a. Eq a => a -> a -> Bool
==(Integer
x,Integer
y)) [(Integer, Integer)]
hist of
                      Maybe Int
Nothing -> (forall a. Num a => Integer -> a
fromInteger Integer
qforall a. a -> [a] -> [a]
:[Int]
fds,Int
psz)
                      Just Int
i -> ([],Int
iforall a. Num a => a -> a -> a
+Int
1)
    where
    (Integer
q,Integer
r) = (Integer
x forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Integer
toInteger Int
b) 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)forall a. a -> [a] -> [a]
:[(Integer, Integer)]
hist) (Integer
r Integer -> Integer -> Quotient
% Integer
y)