module Numeric.Common ( conjugate
                      , asTest
                      , conjugateMPZ
                      ) where

import           Foreign.C
import           Foreign.Ptr            (Ptr)
import           Numeric.GMP.Raw.Unsafe (mpz_clear)
import           Numeric.GMP.Types
import           Numeric.GMP.Utils
import           System.IO.Unsafe       (unsafeDupablePerformIO)

conjugateMPZ :: (CInt -> IO (Ptr MPZ)) -> Int -> Integer
conjugateMPZ :: (CInt -> IO (Ptr MPZ)) -> Int -> Integer
conjugateMPZ CInt -> IO (Ptr MPZ)
f Int
n = IO Integer -> Integer
forall a. IO a -> a
unsafeDupablePerformIO (IO Integer -> Integer) -> IO Integer -> Integer
forall a b. (a -> b) -> a -> b
$ do
    Ptr MPZ
mPtr <- CInt -> IO (Ptr MPZ)
f (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
    Ptr MPZ -> IO Integer
peekInteger Ptr MPZ
mPtr IO Integer -> IO () -> IO Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Ptr MPZ -> IO ()
mpz_clear Ptr MPZ
mPtr

asTest :: Integral a => (CInt -> CBool) -> a -> Bool
asTest :: (CInt -> CBool) -> a -> Bool
asTest CInt -> CBool
f = CBool -> Bool
convertBool (CBool -> Bool) -> (a -> CBool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CBool
f (CInt -> CBool) -> (a -> CInt) -> a -> CBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

conjugate :: (Integral a, Integral b) => (CInt -> CInt) -> a -> b
conjugate :: (CInt -> CInt) -> a -> b
conjugate CInt -> CInt
f = CInt -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> b) -> (a -> CInt) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> CInt
f (CInt -> CInt) -> (a -> CInt) -> a -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

convertBool :: CBool -> Bool
convertBool :: CBool -> Bool
convertBool = Int -> Bool
forall a. Enum a => Int -> a
toEnum (Int -> Bool) -> (CBool -> Int) -> CBool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBool -> Int
forall a. Enum a => a -> Int
fromEnum