module Data.DFrac (DFrac(..), setPrec) where
import GHC.Read
import Data.Ratio
import Data.Scientific

data DFrac = DFrac {
    places :: Int,
    number :: Rational
  }

instance Eq DFrac where
  x == y = number x == number y && places x == places y
instance Ord DFrac where
  compare x y =
    case compare (number x) (number y) of
      EQ ->
        compare (places x) (places y)
      c ->
        c

instance Num DFrac where
  x + y = dfrac min x y $ number x + number y
  x - y = dfrac min x y $ number x - number y
  x * y = dfrac min x y $ number x * number y
  abs x = DFrac (places x) $ abs $ number x
  signum x = DFrac (places x) $ signum $ number x
  fromInteger = DFrac 16 . fromInteger
instance Fractional DFrac where
  x / y = dfrac min x y $ number x / number y
  fromRational = DFrac 16 . fromRational
instance Real DFrac where
  toRational = number
instance RealFrac DFrac where
  properFraction x = (a, DFrac (places x) b)
    where
      (a, b) = properFraction $ number x
  
instance Read DFrac where
  readsPrec p z = map (\(d, s) -> (DFrac 16 $ toRational d, s)) r
    where
      r :: [(Scientific, String)]
      r = readsPrec p z
  readListPrec = readListPrecDefault
  readList = readListDefault
instance Show DFrac where
  show (DFrac p r) = show i ++ "." ++ (tail $ show f)
    where
      n = numerator r
      d = denominator r
      i = n `div` d
      f :: Integer
      f = (10^p) + (truncate $ (10^p) * (snd $ properFraction r))

setPrec :: Int -> DFrac -> DFrac
setPrec p r = r { places = p }

dfrac :: (Int -> Int -> Int) -> DFrac -> DFrac -> Rational -> DFrac
dfrac f x y z = DFrac (prec f x y) z

prec :: (Int -> Int -> Int) -> DFrac -> DFrac -> Int
prec f x y = f (places x) (places y)