{-# OPTIONS -fno-warn-missing-methods #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PackageImports #-}

module Data.Ratio where

import Data.Data
import Prelude
import qualified "base" Prelude as Base

--------------------------------------------------------------------------------
-- Rational

data Rational = Ratio Int Int
#ifndef FAY
    deriving Typeable
#endif

instance Base.Show Rational
instance Data Rational
#ifdef FAY
instance Typeable Rational
#endif

(%) :: Int -> Int -> Rational
Int
x % :: Int -> Int -> Rational
% Int
y = Int -> Int -> Rational
reduce (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. (Num a, Ord a) => a -> a
signum Int
y) (Int -> Int
forall a. (Num a, Ord a) => a -> a
abs Int
y)
  where reduce :: Int -> Int -> Rational
        reduce :: Int -> Int -> Rational
reduce Int
x' Int
y' = if Int
y' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                       then String -> Rational
forall a. String -> a
error String
"can't devide by zero"
                       else let d :: Int
d = Int -> Int -> Int
gcd Int
x' Int
y'
                            in Int -> Int -> Rational
Ratio (Int
x' Int -> Int -> Int
`quot` Int
d) (Int
y' Int -> Int -> Int
`quot` Int
d)

numerator, denominator :: Rational -> Int
numerator :: Rational -> Int
numerator (Ratio Int
n Int
_) = Int
n
denominator :: Rational -> Int
denominator (Ratio Int
_ Int
d) = Int
d