module Algebra.ToInteger where

import qualified Number.Ratio as Ratio

import qualified Algebra.ToRational     as ToRational
import qualified Algebra.Field          as Field
import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.RealIntegral   as RealIntegral
import qualified Algebra.Ring           as Ring

import Number.Ratio (T((:%)), )

import Algebra.Field ((^-), )
import Algebra.Ring ((^), fromInteger, )

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


{- |
The two classes 'Algebra.ToInteger.C' and 'Algebra.ToRational.C'
exist to allow convenient conversions,
primarily between the built-in types.
They should satisfy

>   fromInteger .  toInteger === id
>    toRational .  toInteger === toRational

Conversions must be lossless,
that is, they do not round in any way.
For rounding see "Algebra.RealField".
With the instances for 'Prelude.Float' and 'Prelude.Double'
we acknowledge that these types actually represent rationals
rather than (approximated) real numbers.
However, this contradicts to the 'Algebra.Transcendental.C' instance.
-}
class (ToRational.C a, RealIntegral.C a) => C a where
   toInteger :: a -> Integer


fromIntegral :: (C a, Ring.C b) => a -> b
fromIntegral = fromInteger . toInteger


instance C Integer where
   toInteger = id

instance C Int where
   toInteger = P.toInteger

instance (C a, PID.C a) => ToRational.C (Ratio.T a) where
   toRational (x:%y)   =  toInteger x :% toInteger y


{-|
A prefix function of '(Algebra.Ring.^)'
with a parameter order that fits the needs of partial application
and function composition.
It has generalised exponent.

See: Argument order of @expNat@ on
<http://www.haskell.org/pipermail/haskell-cafe/2006-September/018022.html>
-}
ringPower :: (Ring.C a, C b) => b -> a -> a
ringPower exponent basis = basis ^ toInteger exponent

{- |
A prefix function of '(Algebra.Field.^-)'.
It has a generalised exponent.
-}
fieldPower :: (Field.C a, C b) => b -> a -> a
fieldPower exponent basis = basis ^- toInteger exponent