Fraction

gistfile1.hs

module Fraction 
  (
    Fraction,
    (%),
    simplify,
    num,
    denom
  ) where

import Data.Monoid
import Data.Ratio hiding ((%))

data Fraction = Frac Integer Integer -- Numerator Denominator

--Type constructor
(%) :: Integer -> Integer -> Fraction
(%) a = simplify . Frac a

instance Show Fraction where
  show (Frac a b) = (show a) ++ " / " ++ (show b)

instance Num Fraction where
  (-) f (Frac a b)          = f + (Frac (-a) b)
  (+) (Frac a b) (Frac c d) = Frac num denom
    where denom = lcm b d
          num   = a * (denom `quot` b) + c * (denom `quot` d)
  (*) (Frac a b) (Frac c d) = Frac (a*c) (b*d)
  negate (Frac a b)         = Frac (-a) b
  abs f                     = fmapF abs f
    where fmapF f (Frac a b) = Frac (f a) (f b)
  fromInteger x             = Frac x 1
  signum (Frac a b)         = if a == 0 then 0
                              else if b > 0 then
					               if a < 0 then (-1)
                                   else 1
					          else if a < 0 then 1
					               else (-1)
					  
instance Fractional Fraction where
  (/) f             = (*) f . recip
  recip (Frac a b)  = Frac b a
  fromRational r    = Frac (numerator r) (denominator r)

instance Eq Fraction where
  (/=) f    = not . (==) f
  (==) f f' = (x == x') && (y == y')
      where (Frac x y) = simplify f
            (Frac x' y') = simplify f'
  
instance Ord Fraction where
  compare (Frac a b) (Frac c d) = compare (a `quot` b) (c `quot` d)
  (<)  f    = (==) LT . compare f
  (>)  f    = (==) GT . compare f
  (>=) f    = not . (<) f
  (<=) f    = not . (>) f
  max  f f' = if f < f' then f' else f
  min  f f' = if f < f' then f else f'
  
instance Monoid Fraction where
  mempty  = 0
  mappend = (+)
  mconcat = foldr mappend mempty
  
simplify :: Fraction -> Fraction
simplify (Frac a b) = Frac (a `quot` factor) (b `quot` factor)
	where factor = gcd a b

num :: Fraction -> Integer
num (Frac a _) = a

denom :: Fraction -> Integer
denom (Frac _ b) = b