{-# OPTIONS -fno-implicit-prelude #-}
module Algebra.ToRational where

import qualified Algebra.Real           as Real
import Algebra.Field (fromRational, )
import Algebra.Ring (fromInteger, )

import Number.Ratio (Rational, )

import qualified Prelude as P
import PreludeBase
import Prelude(Int,Integer,Float,Double)

{- |
This class allows lossless conversion
from any representation of a rational to the fixed 'Rational' type.
\"Lossless\" means - don't do any rounding.
For rounding see "Algebra.RealField".
With the instances for 'Float' and 'Double'
we acknowledge that these types actually represent rationals
rather than (approximated) real numbers.
However, this contradicts to the 'Algebra.Transcendental'

Laws that must be satisfied by instances:

>  fromRational' . toRational === id
-}
class (Real.C a) => C a where
   -- | Lossless conversion from any representation of a rational to 'Rational'
   toRational :: a -> Rational

instance C Integer where
   toRational = fromInteger

instance C Int where
   toRational = toRational . P.toInteger

instance C Float where
   toRational = fromRational . P.toRational

instance C Double where
   toRational = fromRational . P.toRational