{-# OPTIONS_HADDOCK hide, prune, ignore-exports #-}
module Data.Number.Flint.Fmpq.Instances (
  Fmpq (..)
) where

import System.IO.Unsafe
import Control.Monad

import qualified Data.Ratio as Ratio
import Data.Ratio ((%))

import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc

import Data.Char
import Text.Read
import Data.Number.Flint.Fmpz
import Data.Number.Flint.Fmpz.Instances
import Data.Number.Flint.Fmpq

instance Show Fmpq where
  show :: Fmpq -> String
show Fmpq
x = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    let base :: CInt
base = CInt
10 :: CInt
    forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
x forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
x -> do
      CString
cs <- CString -> CInt -> Ptr CFmpq -> IO CString
fmpq_get_str forall a. Ptr a
nullPtr CInt
10 Ptr CFmpq
x
      String
s <- CString -> IO String
peekCString CString
cs
      forall a. Ptr a -> IO ()
free CString
cs
      forall (m :: * -> *) a. Monad m => a -> m a
return String
s

instance Read Fmpq where
  readsPrec :: Int -> ReadS Fmpq
readsPrec Int
_ String
r = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Fmpq
result <- IO Fmpq
newFmpq
    (Fmpq
_, CInt
flag) <- forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
result forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
result ->
      forall a. String -> (CString -> IO a) -> IO a
withCString String
r forall a b. (a -> b) -> a -> b
$ \CString
r ->
        Ptr CFmpq -> CString -> CInt -> IO CInt
fmpq_set_str Ptr CFmpq
result CString
r CInt
10
    if CInt
flag forall a. Eq a => a -> a -> Bool
== CInt
0 then 
      forall (m :: * -> *) a. Monad m => a -> m a
return [(Fmpq
result, forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Show a => a -> String
show Fmpq
result)) String
r)]
    else
      forall (m :: * -> *) a. Monad m => a -> m a
return []
      
instance Eq Fmpq where
  == :: Fmpq -> Fmpq -> Bool
(==) Fmpq
x Fmpq
y = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ 
    forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
x forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
x ->
      forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
y forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
y -> do
        CInt
result <- Ptr CFmpq -> Ptr CFmpq -> IO CInt
fmpq_equal Ptr CFmpq
x Ptr CFmpq
y
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CInt
result forall a. Eq a => a -> a -> Bool
== CInt
1

instance Ord Fmpq where
  compare :: Fmpq -> Fmpq -> Ordering
compare Fmpq
x Fmpq
y = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ 
    forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
x forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
x ->
      forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
y forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
y -> do
        CInt
ord <- Ptr CFmpq -> Ptr CFmpq -> IO CInt
fmpq_cmp Ptr CFmpq
x Ptr CFmpq
y
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if CInt
ord forall a. Ord a => a -> a -> Bool
> CInt
0 then Ordering
GT else (if CInt
ord forall a. Ord a => a -> a -> Bool
< CInt
0 then Ordering
LT else Ordering
EQ)
    
instance Num Fmpq where
  {-# INLINE (+) #-}
  + :: Fmpq -> Fmpq -> Fmpq
(+) = forall {a}.
(Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO a)
-> Fmpq -> Fmpq -> Fmpq
lift2 Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO ()
fmpq_add
  {-# INLINE (-) #-}
  (-) = forall {a}.
(Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO a)
-> Fmpq -> Fmpq -> Fmpq
lift2 Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO ()
fmpq_sub
  {-# INLINE (*) #-}
  * :: Fmpq -> Fmpq -> Fmpq
(*) = forall {a}.
(Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO a)
-> Fmpq -> Fmpq -> Fmpq
lift2 Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO ()
fmpq_mul
  negate :: Fmpq -> Fmpq
negate = forall {a}. (Ptr CFmpq -> Ptr CFmpq -> IO a) -> Fmpq -> Fmpq
lift1 Ptr CFmpq -> Ptr CFmpq -> IO ()
fmpq_neg
  abs :: Fmpq -> Fmpq
abs    = forall {a}. (Ptr CFmpq -> Ptr CFmpq -> IO a) -> Fmpq -> Fmpq
lift1 Ptr CFmpq -> Ptr CFmpq -> IO ()
fmpq_abs
  fromInteger :: Integer -> Fmpq
fromInteger Integer
x = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    let n :: Fmpz
n = forall a. Num a => Integer -> a
fromInteger Integer
x 
        d :: Fmpz
d = Fmpz
1 :: Fmpz
    Fmpq
result <- IO Fmpq
newFmpq
    forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
n forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
n ->
      forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
d forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
d ->
        forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
result forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
result -> do
          Ptr CFmpz -> IO ()
fmpz_one Ptr CFmpz
d
          Ptr CFmpq -> Ptr CFmpz -> Ptr CFmpz -> IO ()
fmpq_set_fmpz_frac Ptr CFmpq
result Ptr CFmpz
n Ptr CFmpz
d
          Ptr CFmpq -> IO ()
fmpq_canonicalise Ptr CFmpq
result
    forall (m :: * -> *) a. Monad m => a -> m a
return Fmpq
result
  signum :: Fmpq -> Fmpq
signum = forall {a}. (Ptr CFmpq -> Ptr CFmpq -> IO a) -> Fmpq -> Fmpq
lift1 Ptr CFmpq -> Ptr CFmpq -> IO ()
sgn where
    sgn :: Ptr CFmpq -> Ptr CFmpq -> IO ()
sgn Ptr CFmpq
result Ptr CFmpq
x = do
      CInt
s <- Ptr CFmpq -> IO CInt
fmpq_sgn Ptr CFmpq
x
      Ptr CFmpq -> CLong -> CULong -> IO ()
fmpq_set_si Ptr CFmpq
result (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
s) CULong
1

instance Fractional Fmpq where
  / :: Fmpq -> Fmpq -> Fmpq
(/) = forall {a}.
(Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO a)
-> Fmpq -> Fmpq -> Fmpq
lift2 Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO ()
fmpq_div
  recip :: Fmpq -> Fmpq
recip = forall {a}. (Ptr CFmpq -> Ptr CFmpq -> IO a) -> Fmpq -> Fmpq
lift1 Ptr CFmpq -> Ptr CFmpq -> IO ()
fmpq_inv
  fromRational :: Rational -> Fmpq
fromRational Rational
x = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Fmpq
result <- IO Fmpq
newFmpq
    let n :: Fmpz
n = forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
Ratio.numerator Rational
x
        d :: Fmpz
d = forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Ratio a -> a
Ratio.denominator Rational
x
    forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
n forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
n ->
      forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
d forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
d ->
        forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
result forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
result -> do
          Ptr CFmpq -> Ptr CFmpz -> Ptr CFmpz -> IO ()
fmpq_set_fmpz_frac Ptr CFmpq
result Ptr CFmpz
n Ptr CFmpz
d
          Ptr CFmpq -> IO ()
fmpq_canonicalise Ptr CFmpq
result
    forall (m :: * -> *) a. Monad m => a -> m a
return Fmpq
result

instance Real Fmpq where
  toRational :: Fmpq -> Rational
toRational Fmpq
x = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Fmpz
p <- IO Fmpz
newFmpz
    Fmpz
q <- IO Fmpz
newFmpz
    forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
x forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
x -> do
      forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
p forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
p -> do
        forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
q forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
q -> do
          Ptr CFmpz -> Ptr CFmpz -> Ptr CFmpq -> IO ()
fmpq_get_fmpz_frac Ptr CFmpz
p Ptr CFmpz
q Ptr CFmpq
x
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (forall a. Integral a => a -> Integer
toInteger Fmpz
p) forall a. Integral a => a -> a -> Ratio a
% (forall a. Integral a => a -> Integer
toInteger Fmpz
q)

instance RealFrac Fmpq where
  properFraction :: forall b. Integral b => Fmpq -> (b, Fmpq)
properFraction Fmpq
x =  forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
    Fmpz
p <- IO Fmpz
newFmpz
    Fmpz
q <- IO Fmpz
newFmpz
    Fmpq
r <- IO Fmpq
newFmpq
    forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
x forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
x -> do
      forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
p forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
p -> do
        forall {a}. Fmpz -> (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withFmpz Fmpz
q forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
q -> do
          forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
r forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
r -> do
            forall {a}. (Ptr CFmpz -> IO a) -> IO (Fmpz, a)
withNewFmpz forall a b. (a -> b) -> a -> b
$ \Ptr CFmpz
tmp -> do
              Ptr CFmpz -> Ptr CFmpz -> Ptr CFmpq -> IO ()
fmpq_get_fmpz_frac Ptr CFmpz
p Ptr CFmpz
q Ptr CFmpq
x
              Ptr CFmpz -> Ptr CFmpz -> Ptr CFmpz -> Ptr CFmpz -> IO ()
fmpz_tdiv_qr Ptr CFmpz
p Ptr CFmpz
tmp Ptr CFmpz
p Ptr CFmpz
q
              Ptr CFmpq -> Ptr CFmpz -> Ptr CFmpz -> IO ()
fmpq_set_fmpz_frac Ptr CFmpq
r Ptr CFmpz
tmp Ptr CFmpz
q
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Fmpz
p, Fmpq
r)
   
lift1 :: (Ptr CFmpq -> Ptr CFmpq -> IO a) -> Fmpq -> Fmpq
lift1 Ptr CFmpq -> Ptr CFmpq -> IO a
f Fmpq
x = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ 
  forall {a}. (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withNewFmpq forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
result -> 
    forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
x forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
x ->
      Ptr CFmpq -> Ptr CFmpq -> IO a
f Ptr CFmpq
result Ptr CFmpq
x
  
lift2 :: (Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO a)
-> Fmpq -> Fmpq -> Fmpq
lift2 Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO a
f Fmpq
x Fmpq
y = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ 
  forall {a}. (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withNewFmpq forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
result ->
    forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
x forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
x ->
      forall {a}. Fmpq -> (Ptr CFmpq -> IO a) -> IO (Fmpq, a)
withFmpq Fmpq
y forall a b. (a -> b) -> a -> b
$ \Ptr CFmpq
y ->
        Ptr CFmpq -> Ptr CFmpq -> Ptr CFmpq -> IO a
f Ptr CFmpq
result Ptr CFmpq
x Ptr CFmpq
y