--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Number.Ratio.Generalized
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Generalized Ratio type that accepts arbitrary 'Num a' types rather
-- than just Integral ones as in Data.Ratio
--------------------------------------------------------------------------------
module HGeometry.Number.Ratio.Generalized
  ( GRatio
  , (%)
  , numerator, denominator
  ) where

import qualified GHC.Real as Ratio

--------------------------------------------------------------------------------

-- | Generalized Ratio type that accepts more general "base" types
-- than just Integral ones. That does mean we cannot normalize the
-- intermediate expressions, so expect the numbers to become big quite
-- quickly!
--
-- invariant: the denominator is not zero
data GRatio a = !a :% !a
              deriving (Int -> GRatio a -> ShowS
[GRatio a] -> ShowS
GRatio a -> String
(Int -> GRatio a -> ShowS)
-> (GRatio a -> String) -> ([GRatio a] -> ShowS) -> Show (GRatio a)
forall a. Show a => Int -> GRatio a -> ShowS
forall a. Show a => [GRatio a] -> ShowS
forall a. Show a => GRatio a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> GRatio a -> ShowS
showsPrec :: Int -> GRatio a -> ShowS
$cshow :: forall a. Show a => GRatio a -> String
show :: GRatio a -> String
$cshowList :: forall a. Show a => [GRatio a] -> ShowS
showList :: [GRatio a] -> ShowS
Show)

-- | Get the numerator
numerator          :: GRatio a -> a
numerator :: forall a. GRatio a -> a
numerator (a
a :% a
_) = a
a

-- | Get the denominator
denominator          :: GRatio a -> a
denominator :: forall a. GRatio a -> a
denominator (a
_ :% a
b) = a
b

-- | smart constructor to construct a GRatio. Throws an exception if
-- the denominator is zero.
(%)   :: (Eq a, Num a) => a -> a -> GRatio a
a
_ % :: forall a. (Eq a, Num a) => a -> a -> GRatio a
% a
0 = GRatio a
forall a. a
Ratio.ratioZeroDenominatorError
a
a % a
b = a
a a -> a -> GRatio a
forall a. a -> a -> GRatio a
:% a
b

instance (Eq a, Num a) => Eq (GRatio a) where
  (a
a :% a
b) == :: GRatio a -> GRatio a -> Bool
== (a
c :% a
d) = a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
d a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
c -- by invariant b and d are non-zero
  {-# INLINABLE (==) #-}

instance (Ord a, Num a) => Ord (GRatio a) where
  (a
a :% a
b) compare :: GRatio a -> GRatio a -> Ordering
`compare` (a
c :% a
d)
    | a -> a
forall a. Num a => a -> a
signum a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a -> a
forall a. Num a => a -> a
signum a
d = (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
d) a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
c) -- by invariant b and d are non-zero
    | Bool
otherwise            = (a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
c) a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
d) -- by invariant b and d are non-zero

instance (Num a, Eq a) => Num (GRatio a) where
  (a
a :% a
b) + :: GRatio a -> GRatio a -> GRatio a
+ (a
c :% a
d) = (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
d a -> a -> a
forall a. Num a => a -> a -> a
+ a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
c) a -> a -> GRatio a
forall a. a -> a -> GRatio a
:% (a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
d)
  -- since b and d where non-zero, b*d is also non-zero
  negate :: GRatio a -> GRatio a
negate (a
a :% a
b) = a -> a
forall a. Num a => a -> a
negate a
a a -> a -> GRatio a
forall a. a -> a -> GRatio a
:% a
b
  -- b was non-zero, it remains non-zero
  (a
a :% a
b) * :: GRatio a -> GRatio a -> GRatio a
* (a
c :% a
d) = (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
c) a -> a -> GRatio a
forall a. a -> a -> GRatio a
:% (a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
d)
  -- since b and d where non-zero, b*d is also non-zero
  fromInteger :: Integer -> GRatio a
fromInteger Integer
x = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x a -> a -> GRatio a
forall a. a -> a -> GRatio a
:% a
1
  signum :: GRatio a -> GRatio a
signum (a
a :% a
b) = (a -> a
forall a. Num a => a -> a
signum a
a a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Num a => a -> a
signum a
b) a -> a -> GRatio a
forall a. a -> a -> GRatio a
:% a
1
  -- by invariant b cannot be zero, so signum b cannot be zero either.
  abs :: GRatio a -> GRatio a
abs GRatio a
x | GRatio a -> GRatio a
forall a. Num a => a -> a
signum GRatio a
x GRatio a -> GRatio a -> Bool
forall a. Eq a => a -> a -> Bool
== -GRatio a
1 = (-GRatio a
1)GRatio a -> GRatio a -> GRatio a
forall a. Num a => a -> a -> a
*GRatio a
x
        | Bool
otherwise      = GRatio a
x

instance (Num a, Eq a) => Fractional (GRatio a) where
  fromRational :: Rational -> GRatio a
fromRational (Integer
a Ratio.:% Integer
b)= Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
a a -> a -> GRatio a
forall a. a -> a -> GRatio a
:% Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
b
  (a
a :% a
b) / :: GRatio a -> GRatio a -> GRatio a
/ (a
c :% a
d) = (a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
d) a -> a -> GRatio a
forall a. (Eq a, Num a) => a -> a -> GRatio a
% (a
ba -> a -> a
forall a. Num a => a -> a -> a
*a
c)
    -- b is non-zero, but c may be zero, so in that case we would be
    -- dividing by zero.  however, if c is zero then (c % d) would be
    -- zero, so there is no need to explicitly handle that; i.e. that
    -- is a something the user must do