module Numeric.Netlib.Utility (
   FortranIO,
   run,
   runChecked,
   check,
   assert,
   ignore,
   cint,
   leadingDim,
   alloca,
   allocaArray,
   bool,
   char,
   string,
   float,
   double,
   complexFloat,
   complexDouble,
   real,
   complex,
   number,
   ) where

import qualified Numeric.Netlib.Class as Class

import qualified Foreign.Marshal.Utils as Marshal
import qualified Foreign.Marshal.Array.Guarded as Array
import qualified Foreign.Marshal.Alloc as Alloc
import qualified Foreign.C.String as CStr
import qualified Foreign.C.Types as C
import Foreign.Storable.Complex ()
import Foreign.Storable (Storable, peek)
import Foreign.Ptr (Ptr)

import Control.Monad.Trans.Cont (ContT(ContT))
import Control.Monad.IO.Class (liftIO)
import Control.Monad (when)

import Data.Functor.Compose (Compose(Compose, getCompose))
import Data.Complex (Complex)


type FortranIO r = ContT r IO

run :: FortranIO r (IO a) -> FortranIO r a
run :: forall r a. FortranIO r (IO a) -> FortranIO r a
run FortranIO r (IO a)
act = FortranIO r (IO a)
act FortranIO r (IO a) -> (IO a -> ContT r IO a) -> ContT r IO a
forall a b. ContT r IO a -> (a -> ContT r IO b) -> ContT r IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> ContT r IO a
forall a. IO a -> ContT r IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

runChecked :: String -> FortranIO r (Ptr C.CInt -> IO a) -> FortranIO r a
runChecked :: forall r a.
String -> FortranIO r (Ptr CInt -> IO a) -> FortranIO r a
runChecked String
name FortranIO r (Ptr CInt -> IO a)
act = do
   Ptr CInt
info <- FortranIO r (Ptr CInt)
forall a r. Storable a => FortranIO r (Ptr a)
alloca
   a
a <- FortranIO r (IO a) -> FortranIO r a
forall r a. FortranIO r (IO a) -> FortranIO r a
run (FortranIO r (IO a) -> FortranIO r a)
-> FortranIO r (IO a) -> FortranIO r a
forall a b. (a -> b) -> a -> b
$ ((Ptr CInt -> IO a) -> IO a)
-> FortranIO r (Ptr CInt -> IO a) -> FortranIO r (IO a)
forall a b. (a -> b) -> ContT r IO a -> ContT r IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Ptr CInt -> IO a) -> Ptr CInt -> IO a
forall a b. (a -> b) -> a -> b
$Ptr CInt
info) FortranIO r (Ptr CInt -> IO a)
act
   IO () -> ContT r IO ()
forall a. IO a -> ContT r IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT r IO ()) -> IO () -> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO CInt -> IO ()
check String
name (Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
info)
   a -> FortranIO r a
forall a. a -> ContT r IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

check :: String -> IO C.CInt -> IO ()
check :: String -> IO CInt -> IO ()
check String
msg IO CInt
f = do
   CInt
err <- IO CInt
f
   Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
errCInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/=CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
err

assert :: String -> Bool -> IO ()
assert :: String -> Bool -> IO ()
assert String
msg Bool
success = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
success) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"assertion failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg

ignore :: String -> Int -> IO ()
ignore :: String -> Int -> IO ()
ignore String
_msg Int
_dim = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


cint :: Int -> FortranIO r (Ptr C.CInt)
cint :: forall r. Int -> FortranIO r (Ptr CInt)
cint = ((Ptr CInt -> IO r) -> IO r) -> ContT r IO (Ptr CInt)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CInt -> IO r) -> IO r) -> ContT r IO (Ptr CInt))
-> (Int -> (Ptr CInt -> IO r) -> IO r)
-> Int
-> ContT r IO (Ptr CInt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> (Ptr CInt -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Marshal.with (CInt -> (Ptr CInt -> IO r) -> IO r)
-> (Int -> CInt) -> Int -> (Ptr CInt -> IO r) -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

leadingDim :: Int -> FortranIO r (Ptr C.CInt)
leadingDim :: forall r. Int -> FortranIO r (Ptr CInt)
leadingDim = Int -> FortranIO r (Ptr CInt)
forall r. Int -> FortranIO r (Ptr CInt)
cint (Int -> FortranIO r (Ptr CInt))
-> (Int -> Int) -> Int -> FortranIO r (Ptr CInt)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1

alloca :: (Storable a) => FortranIO r (Ptr a)
alloca :: forall a r. Storable a => FortranIO r (Ptr a)
alloca = ((Ptr a -> IO r) -> IO r) -> ContT r IO (Ptr a)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (Ptr a -> IO r) -> IO r
forall a b. Storable a => (Ptr a -> IO b) -> IO b
Alloc.alloca

allocaArray :: (Storable a) => Int -> FortranIO r (Ptr a)
allocaArray :: forall a r. Storable a => Int -> FortranIO r (Ptr a)
allocaArray = ((Ptr a -> IO r) -> IO r) -> ContT r IO (Ptr a)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr a -> IO r) -> IO r) -> ContT r IO (Ptr a))
-> (Int -> (Ptr a -> IO r) -> IO r) -> Int -> ContT r IO (Ptr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (Ptr a -> IO r) -> IO r
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
Array.alloca

bool :: Bool -> FortranIO r (Ptr Bool)
bool :: forall r. Bool -> FortranIO r (Ptr Bool)
bool = ((Ptr Bool -> IO r) -> IO r) -> ContT r IO (Ptr Bool)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Bool -> IO r) -> IO r) -> ContT r IO (Ptr Bool))
-> (Bool -> (Ptr Bool -> IO r) -> IO r)
-> Bool
-> ContT r IO (Ptr Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (Ptr Bool -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Marshal.with

char :: Char -> FortranIO r (Ptr C.CChar)
char :: forall r. Char -> FortranIO r (Ptr CChar)
char = ((Ptr CChar -> IO r) -> IO r) -> ContT r IO (Ptr CChar)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CChar -> IO r) -> IO r) -> ContT r IO (Ptr CChar))
-> (Char -> (Ptr CChar -> IO r) -> IO r)
-> Char
-> ContT r IO (Ptr CChar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CChar -> (Ptr CChar -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Marshal.with (CChar -> (Ptr CChar -> IO r) -> IO r)
-> (Char -> CChar) -> Char -> (Ptr CChar -> IO r) -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> CChar
CStr.castCharToCChar

string :: String -> FortranIO r (Ptr C.CChar)
string :: forall r. String -> FortranIO r (Ptr CChar)
string = ((Ptr CChar -> IO r) -> IO r) -> ContT r IO (Ptr CChar)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr CChar -> IO r) -> IO r) -> ContT r IO (Ptr CChar))
-> (String -> (Ptr CChar -> IO r) -> IO r)
-> String
-> ContT r IO (Ptr CChar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Ptr CChar -> IO r) -> IO r
forall a. String -> (Ptr CChar -> IO a) -> IO a
CStr.withCString

float :: Float -> FortranIO r (Ptr Float)
float :: forall r. Float -> FortranIO r (Ptr Float)
float = ((Ptr Float -> IO r) -> IO r) -> ContT r IO (Ptr Float)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Float -> IO r) -> IO r) -> ContT r IO (Ptr Float))
-> (Float -> (Ptr Float -> IO r) -> IO r)
-> Float
-> ContT r IO (Ptr Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> (Ptr Float -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Marshal.with

double :: Double -> FortranIO r (Ptr Double)
double :: forall r. Double -> FortranIO r (Ptr Double)
double = ((Ptr Double -> IO r) -> IO r) -> ContT r IO (Ptr Double)
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr Double -> IO r) -> IO r) -> ContT r IO (Ptr Double))
-> (Double -> (Ptr Double -> IO r) -> IO r)
-> Double
-> ContT r IO (Ptr Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> (Ptr Double -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Marshal.with

complexFloat :: Complex Float -> FortranIO r (Ptr (Complex Float))
complexFloat :: forall r. Complex Float -> FortranIO r (Ptr (Complex Float))
complexFloat = ((Ptr (Complex Float) -> IO r) -> IO r)
-> ContT r IO (Ptr (Complex Float))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Complex Float) -> IO r) -> IO r)
 -> ContT r IO (Ptr (Complex Float)))
-> (Complex Float -> (Ptr (Complex Float) -> IO r) -> IO r)
-> Complex Float
-> ContT r IO (Ptr (Complex Float))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Complex Float -> (Ptr (Complex Float) -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Marshal.with

complexDouble :: Complex Double -> FortranIO r (Ptr (Complex Double))
complexDouble :: forall r. Complex Double -> FortranIO r (Ptr (Complex Double))
complexDouble = ((Ptr (Complex Double) -> IO r) -> IO r)
-> ContT r IO (Ptr (Complex Double))
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Ptr (Complex Double) -> IO r) -> IO r)
 -> ContT r IO (Ptr (Complex Double)))
-> (Complex Double -> (Ptr (Complex Double) -> IO r) -> IO r)
-> Complex Double
-> ContT r IO (Ptr (Complex Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Complex Double -> (Ptr (Complex Double) -> IO r) -> IO r
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
Marshal.with

newtype Number r a = Number {forall r a. Number r a -> a -> FortranIO r (Ptr a)
getNumber :: a -> FortranIO r (Ptr a)}

real :: (Class.Real a) => a -> FortranIO r (Ptr a)
real :: forall a r. Real a => a -> FortranIO r (Ptr a)
real = Number r a -> a -> FortranIO r (Ptr a)
forall r a. Number r a -> a -> FortranIO r (Ptr a)
getNumber (Number r a -> a -> FortranIO r (Ptr a))
-> Number r a -> a -> FortranIO r (Ptr a)
forall a b. (a -> b) -> a -> b
$ Number r Float -> Number r Double -> Number r a
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
forall (f :: * -> *). f Float -> f Double -> f a
Class.switchReal ((Float -> FortranIO r (Ptr Float)) -> Number r Float
forall r a. (a -> FortranIO r (Ptr a)) -> Number r a
Number Float -> FortranIO r (Ptr Float)
forall r. Float -> FortranIO r (Ptr Float)
float) ((Double -> FortranIO r (Ptr Double)) -> Number r Double
forall r a. (a -> FortranIO r (Ptr a)) -> Number r a
Number Double -> FortranIO r (Ptr Double)
forall r. Double -> FortranIO r (Ptr Double)
double)

complex :: (Class.Real a) => Complex a -> FortranIO r (Ptr (Complex a))
complex :: forall a r. Real a => Complex a -> FortranIO r (Ptr (Complex a))
complex =
   Number r (Complex a) -> Complex a -> FortranIO r (Ptr (Complex a))
forall r a. Number r a -> a -> FortranIO r (Ptr a)
getNumber (Number r (Complex a)
 -> Complex a -> FortranIO r (Ptr (Complex a)))
-> Number r (Complex a)
-> Complex a
-> FortranIO r (Ptr (Complex a))
forall a b. (a -> b) -> a -> b
$ Compose (Number r) Complex a -> Number r (Complex a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose (Number r) Complex a -> Number r (Complex a))
-> Compose (Number r) Complex a -> Number r (Complex a)
forall a b. (a -> b) -> a -> b
$
   Compose (Number r) Complex Float
-> Compose (Number r) Complex Double
-> Compose (Number r) Complex a
forall a (f :: * -> *). Real a => f Float -> f Double -> f a
forall (f :: * -> *). f Float -> f Double -> f a
Class.switchReal
      (Number r (Complex Float) -> Compose (Number r) Complex Float
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Number r (Complex Float) -> Compose (Number r) Complex Float)
-> Number r (Complex Float) -> Compose (Number r) Complex Float
forall a b. (a -> b) -> a -> b
$ (Complex Float -> FortranIO r (Ptr (Complex Float)))
-> Number r (Complex Float)
forall r a. (a -> FortranIO r (Ptr a)) -> Number r a
Number Complex Float -> FortranIO r (Ptr (Complex Float))
forall r. Complex Float -> FortranIO r (Ptr (Complex Float))
complexFloat)
      (Number r (Complex Double) -> Compose (Number r) Complex Double
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (Number r (Complex Double) -> Compose (Number r) Complex Double)
-> Number r (Complex Double) -> Compose (Number r) Complex Double
forall a b. (a -> b) -> a -> b
$ (Complex Double -> FortranIO r (Ptr (Complex Double)))
-> Number r (Complex Double)
forall r a. (a -> FortranIO r (Ptr a)) -> Number r a
Number Complex Double -> FortranIO r (Ptr (Complex Double))
forall r. Complex Double -> FortranIO r (Ptr (Complex Double))
complexDouble)

number :: (Class.Floating a) => a -> FortranIO r (Ptr a)
number :: forall a r. Floating a => a -> FortranIO r (Ptr a)
number =
   Number r a -> a -> FortranIO r (Ptr a)
forall r a. Number r a -> a -> FortranIO r (Ptr a)
getNumber (Number r a -> a -> FortranIO r (Ptr a))
-> Number r a -> a -> FortranIO r (Ptr a)
forall a b. (a -> b) -> a -> b
$
   Number r Float
-> Number r Double
-> Number r (Complex Float)
-> Number r (Complex Double)
-> Number r a
forall a (f :: * -> *).
Floating a =>
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
forall (f :: * -> *).
f Float
-> f Double -> f (Complex Float) -> f (Complex Double) -> f a
Class.switchFloating
      ((Float -> FortranIO r (Ptr Float)) -> Number r Float
forall r a. (a -> FortranIO r (Ptr a)) -> Number r a
Number Float -> FortranIO r (Ptr Float)
forall r. Float -> FortranIO r (Ptr Float)
float) ((Double -> FortranIO r (Ptr Double)) -> Number r Double
forall r a. (a -> FortranIO r (Ptr a)) -> Number r a
Number Double -> FortranIO r (Ptr Double)
forall r. Double -> FortranIO r (Ptr Double)
double)
      ((Complex Float -> FortranIO r (Ptr (Complex Float)))
-> Number r (Complex Float)
forall r a. (a -> FortranIO r (Ptr a)) -> Number r a
Number Complex Float -> FortranIO r (Ptr (Complex Float))
forall r. Complex Float -> FortranIO r (Ptr (Complex Float))
complexFloat) ((Complex Double -> FortranIO r (Ptr (Complex Double)))
-> Number r (Complex Double)
forall r a. (a -> FortranIO r (Ptr a)) -> Number r a
Number Complex Double -> FortranIO r (Ptr (Complex Double))
forall r. Complex Double -> FortranIO r (Ptr (Complex Double))
complexDouble)