```{-# OPTIONS -fno-implicit-prelude #-}
{- |
Module      :  Number.Ratio
Copyright   :  (c) Henning Thielemann, Dylan Thurston 2006

Maintainer  :  numericprelude@henning-thielemann.de
Stability   :  provisional
Portability :  portable (?)

Ratios of mathematical objects.
-}

module Number.Ratio
(
T((:%), numerator, denominator), (%),
Rational,
fromValue,

scale,
split,
showsPrecAuto,

toRational98,
)  where

import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Units                as Units
import qualified Algebra.Real                 as Real
import qualified Algebra.Ring                 as Ring
import qualified Algebra.ZeroTestable         as ZeroTestable
import qualified Algebra.Indexable            as Indexable

import Algebra.PrincipalIdealDomain (gcd)
import Algebra.Units (stdUnitInv, stdAssociate)
import Algebra.IntegralDomain (div, divMod)
import Algebra.Ring (one, (*), fromInteger)
import Algebra.ZeroTestable (isZero)

import Test.QuickCheck (Arbitrary(arbitrary,coarbitrary))

import qualified Data.Ratio as Ratio98

import qualified Prelude as P
import PreludeBase

infixl 7 %

data  {- (PID.C a)  => -} T a = (:%) {
numerator   :: !a,
denominator :: !a
} deriving (Eq)
type  Rational = T P.Integer

fromValue :: Ring.C a => a -> T a
fromValue x = x :% one

scale :: (PID.C a) => a -> T a -> T a
scale s (x:%y) =
let {- x and y are cancelled,
thus we can only have common divisors in s and y -}
(n:%d) = s%y
in  ((n*x):%d)

{- | similar to 'Algebra.RealField.splitFraction' -}
split :: (PID.C a) => T a -> (a, T a)
split (x:%y) =
let (q,r) = divMod x y
in  (q, r:%y)

ratioPrec :: P.Int
ratioPrec = 7

(%) :: (PID.C a) => a -> a -> T a
x % y =
if isZero y
then error "NumericPrelude.% : zero denominator"
else
let d  = gcd x y
y0 = div y d
x0 = div x d
in  (stdUnitInv y0 * x0) :% stdAssociate y0

instance (PID.C a) => Additive.C (T a) where
zero                =  fromValue zero
(x:%y) + (x':%y')   =  (x*y' + x'*y) % (y*y')
negate (x:%y)       =  (-x) :% y

instance (PID.C a) => Ring.C (T a) where
one                 =  fromValue one
fromInteger x       =  fromValue \$ fromInteger x
(x:%y) * (x':%y')   =  (x * x') % (y * y')

instance (Real.C a, PID.C a) => Real.C (T a) where
abs (x:%y)          =  Real.abs x :% y
signum (x:%_)       =  Real.signum x :% one

liftOrd :: Ring.C a => (a -> a -> b) -> (T a -> T a -> b)
liftOrd f (x:%y) (x':%y') = f (x * y') (x' * y)

instance (Ord a, PID.C a) => Ord (T a) where
(<=)     =  liftOrd (<=)
(<)      =  liftOrd (<)
(>=)     =  liftOrd (>=)
(>)      =  liftOrd (>)
compare  =  liftOrd compare

instance (Ord a, PID.C a) => Indexable.C (T a) where
compare  =  compare

instance (ZeroTestable.C a, PID.C a) => ZeroTestable.C (T a) where
isZero  =  isZero . numerator

(\r -> [(x%y,u) | (x,s)   <- readsPrec ratioPrec r,
("%",t) <- lex s,
(y,u)   <- readsPrec ratioPrec t ])

instance  (Show a, PID.C a)  => Show (T a)  where
showsPrec p (x:%y)  =  showParen (p >= ratioPrec)
(shows x . showString " % " . shows y)

{- |
This is an alternative show method
that is more user-friendly but also potentially more ambigious.
-}

showsPrecAuto :: (Eq a, PID.C a, Show a) =>
P.Int -> T a -> String -> String
showsPrecAuto p (x:%y) =
if y == 1
then showsPrec p x
else showParen (p > ratioPrec)
(showsPrec (ratioPrec+1) x . showString "/" .
showsPrec (ratioPrec+1) y)

instance (Arbitrary a, PID.C a, ZeroTestable.C a) => Arbitrary (T a) where
{-
arbitrary = liftM2 (%) arbitrary (untilM (not . isZero) arbitrary)

*Main> Test.QuickCheck.test (\x -> x==(x::Rational))
Interrupted.
-}
arbitrary =
liftM2 (%) arbitrary
(liftM (\x -> if isZero x then one else x) arbitrary)
coarbitrary = undefined

-- * Legacy Instances

-- | Necessary when mixing NumericPrelude Rationals with Prelude98 Rationals

toRational98 :: (P.Integral a, PID.C a) => T a -> Ratio98.Ratio a
toRational98 x = numerator x Ratio98.% denominator x

legacyInstance :: a
legacyInstance = error "legacy Ring instance for simple input of numeric literals"

instance (P.Num a, PID.C a) => P.Num (T a) where
fromInteger n = P.fromInteger n % 1
negate = negate -- for unary minus
(+)    = legacyInstance
(*)    = legacyInstance
abs    = legacyInstance
signum = legacyInstance

instance (P.Num a, PID.C a) => P.Fractional (T a) where
--   fromRational = Field.fromRational
fromRational x =
fromInteger (Ratio98.numerator x) :%
fromInteger (Ratio98.denominator x)
(/) = legacyInstance
```