{-# LANGUAGE NoImplicitPrelude #-}
module Algebra.ToRational where

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

import Number.Ratio (Rational, )

import Data.Int  (Int,  Int8,  Int16,  Int32,  Int64,  )
import Data.Word (Word, Word8, Word16, Word32, Word64, )

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
   {-#INLINE toRational #-}
   toRational = fromInteger

instance C Float where
   {-#INLINE toRational #-}
   toRational = fromRational . P.toRational

instance C Double where
   {-#INLINE toRational #-}
   toRational = fromRational . P.toRational

instance C Int     where {-#INLINE toRational #-}; toRational = toRational . P.toInteger
instance C Int8    where {-#INLINE toRational #-}; toRational = toRational . P.toInteger
instance C Int16   where {-#INLINE toRational #-}; toRational = toRational . P.toInteger
instance C Int32   where {-#INLINE toRational #-}; toRational = toRational . P.toInteger
instance C Int64   where {-#INLINE toRational #-}; toRational = toRational . P.toInteger

instance C Word    where {-#INLINE toRational #-}; toRational = toRational . P.toInteger
instance C Word8   where {-#INLINE toRational #-}; toRational = toRational . P.toInteger
instance C Word16  where {-#INLINE toRational #-}; toRational = toRational . P.toInteger
instance C Word32  where {-#INLINE toRational #-}; toRational = toRational . P.toInteger
instance C Word64  where {-#INLINE toRational #-}; toRational = toRational . P.toInteger