{-# LINE 1 "src/Foreign/R/Embedded.hsc" #-}
-- |
-- Copyright: (C) 2013 Amgen, Inc.
--
-- Bindings for @<R/Rembedded.h>@, containing entry points for running an
-- instance of R embedded within another program.

{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Foreign.R.Embedded
  ( initEmbeddedR
  , endEmbeddedR
  ) where

import Foreign
import Foreign.C




-- | Initialize R.
initEmbeddedR :: Int -> Ptr CString -> IO ()
initEmbeddedR :: Int -> Ptr CString -> IO ()
initEmbeddedR (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CInt
argc) Ptr CString
argv = CInt -> Ptr CString -> IO ()
c_initEmbeddedR CInt
argc Ptr CString
argv

foreign import ccall safe "Rembedded.h Rf_initEmbeddedR" c_initEmbeddedR
  :: CInt -> Ptr CString -> IO ()

endEmbeddedR :: Int -> IO ()
endEmbeddedR :: Int -> IO ()
endEmbeddedR (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> CInt
retCode) = CInt -> IO ()
c_endEmbeddedR CInt
retCode

foreign import ccall safe "Rembedded.h Rf_endEmbeddedR" c_endEmbeddedR
  :: CInt -> IO ()