-- |
-- Copyright: (C) 2013 Amgen, Inc.
--
-- Interaction with an instance of R. The interface in this module allows for
-- instantiating an arbitrary number of concurrent R sessions, even though
-- currently the R library only allows for one global instance, for forward
-- compatibility.
--
-- The 'R' monad defined here serves to give static guarantees that an instance
-- is only ever used after it has been initialized and before it is finalized.
-- Doing otherwise should result in a type error. This is done in the same way
-- that the 'Control.Monad.ST' monad encapsulates side effects: by assigning
-- a rank-2 type to the only run function for the monad.
--
-- This module is intended to be imported qualified.

{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE TypeFamilies #-}

module Language.R.Instance
  ( -- * The R monad
    R
  , runRegion
  , unsafeRunRegion
  -- * R instance creation
  , Config(..)
  , defaultConfig
  , withEmbeddedR
  , initialize
  , finalize
  ) where

import           Control.Monad ((<=<), unless, when, zipWithM_)
import           Control.Monad.Primitive (PrimMonad(..))
import           Control.Monad.R.Class
import           Control.Monad.ST.Unsafe (unsafeSTToIO)
import qualified Data.Semigroup as Sem
import           Data.Monoid
import           Data.Default.Class (Default(..))
import qualified Foreign.R as R
import qualified Foreign.R.Embedded as R
#ifndef mingw32_HOST_OS
import qualified Foreign.R.EventLoop as R
#endif
import           Foreign.C.String
import           Language.R.Globals

import Control.Applicative
import Control.Concurrent.MVar
    ( newMVar
    , withMVar
    , MVar
    )
import Control.DeepSeq ( NFData, deepseq )
import Control.Exception
    ( bracket
    , bracket_
    , uninterruptibleMask_
    )
import Control.Monad.Catch ( MonadCatch, MonadMask, MonadThrow )
#if MIN_VERSION_base(4,9,0)
import Control.Monad.Fail
#endif
import Control.Monad.Reader
import Data.IORef (IORef, newIORef, readIORef, modifyIORef')
import Foreign
    ( Ptr
    , allocaArray
    )
import Foreign.C.Types ( CInt(..) )
import Foreign.Storable (Storable(..))
import System.Environment ( getProgName, lookupEnv )
import System.IO.Unsafe   ( unsafePerformIO )
import System.Process     ( readProcess )
import System.SetEnv
#ifndef mingw32_HOST_OS
import Control.Exception ( onException )
import System.IO ( hPutStrLn, stderr )
import System.Posix.Resource
#endif
import Prelude

-- | The 'R' monad, for sequencing actions interacting with a single instance of
-- the R interpreter, much as the 'IO' monad sequences actions interacting with
-- the real world. The 'R' monad embeds the 'IO' monad, so all 'IO' actions can
-- be lifted to 'R' actions.
newtype R s a = R { forall s a. R s a -> ReaderT (IORef Int) IO a
unR :: ReaderT (IORef Int) IO a }
  deriving (forall {s}. Functor (R s)
forall a. a -> R s a
forall s a. a -> R s a
forall a b. R s a -> R s b -> R s a
forall a b. R s a -> R s b -> R s b
forall a b. R s (a -> b) -> R s a -> R s b
forall s a b. R s a -> R s b -> R s a
forall s a b. R s a -> R s b -> R s b
forall s a b. R s (a -> b) -> R s a -> R s b
forall a b c. (a -> b -> c) -> R s a -> R s b -> R s c
forall s a b c. (a -> b -> c) -> R s a -> R s b -> R s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. R s a -> R s b -> R s a
$c<* :: forall s a b. R s a -> R s b -> R s a
*> :: forall a b. R s a -> R s b -> R s b
$c*> :: forall s a b. R s a -> R s b -> R s b
liftA2 :: forall a b c. (a -> b -> c) -> R s a -> R s b -> R s c
$cliftA2 :: forall s a b c. (a -> b -> c) -> R s a -> R s b -> R s c
<*> :: forall a b. R s (a -> b) -> R s a -> R s b
$c<*> :: forall s a b. R s (a -> b) -> R s a -> R s b
pure :: forall a. a -> R s a
$cpure :: forall s a. a -> R s a
Applicative, forall a b. a -> R s b -> R s a
forall a b. (a -> b) -> R s a -> R s b
forall s a b. a -> R s b -> R s a
forall s a b. (a -> b) -> R s a -> R s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> R s b -> R s a
$c<$ :: forall s a b. a -> R s b -> R s a
fmap :: forall a b. (a -> b) -> R s a -> R s b
$cfmap :: forall s a b. (a -> b) -> R s a -> R s b
Functor, forall s. Applicative (R s)
forall a. a -> R s a
forall s a. a -> R s a
forall a b. R s a -> R s b -> R s b
forall a b. R s a -> (a -> R s b) -> R s b
forall s a b. R s a -> R s b -> R s b
forall s a b. R s a -> (a -> R s b) -> R s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> R s a
$creturn :: forall s a. a -> R s a
>> :: forall a b. R s a -> R s b -> R s b
$c>> :: forall s a b. R s a -> R s b -> R s b
>>= :: forall a b. R s a -> (a -> R s b) -> R s b
$c>>= :: forall s a b. R s a -> (a -> R s b) -> R s b
Monad, forall s. Monad (R s)
forall a. IO a -> R s a
forall s a. IO a -> R s a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> R s a
$cliftIO :: forall s a. IO a -> R s a
MonadIO, forall {s}. MonadThrow (R s)
forall e a. Exception e => R s a -> (e -> R s a) -> R s a
forall s e a. Exception e => R s a -> (e -> R s a) -> R s a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a. Exception e => R s a -> (e -> R s a) -> R s a
$ccatch :: forall s e a. Exception e => R s a -> (e -> R s a) -> R s a
MonadCatch, forall s. MonadCatch (R s)
forall b. ((forall a. R s a -> R s a) -> R s b) -> R s b
forall s b. ((forall a. R s a -> R s a) -> R s b) -> R s b
forall a b c.
R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c)
forall s a b c.
R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c)
$cgeneralBracket :: forall s a b c.
R s a -> (a -> ExitCase b -> R s c) -> (a -> R s b) -> R s (b, c)
uninterruptibleMask :: forall b. ((forall a. R s a -> R s a) -> R s b) -> R s b
$cuninterruptibleMask :: forall s b. ((forall a. R s a -> R s a) -> R s b) -> R s b
mask :: forall b. ((forall a. R s a -> R s a) -> R s b) -> R s b
$cmask :: forall s b. ((forall a. R s a -> R s a) -> R s b) -> R s b
MonadMask, forall s. Monad (R s)
forall e a. Exception e => e -> R s a
forall s e a. Exception e => e -> R s a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> R s a
$cthrowM :: forall s e a. Exception e => e -> R s a
MonadThrow)

#if MIN_VERSION_base(4,9,0)
instance MonadFail (R s) where
  fail :: forall a. String -> R s a
fail String
s = forall s a. ReaderT (IORef Int) IO a -> R s a
R forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \IORef Int
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
Control.Monad.Fail.fail String
s
#endif

instance PrimMonad (R s) where
  type PrimState (R s) = s
  primitive :: forall a.
(State# (PrimState (R s)) -> (# State# (PrimState (R s)), a #))
-> R s a
primitive State# (PrimState (R s)) -> (# State# (PrimState (R s)), a #)
f = forall s a. ReaderT (IORef Int) IO a -> R s a
R forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall s a. ST s a -> IO a
unsafeSTToIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive State# (PrimState (R s)) -> (# State# (PrimState (R s)), a #)
f

instance MonadR (R s) where
  io :: forall a. IO a -> R s a
io IO a
m = forall s a. ReaderT (IORef Int) IO a -> R s a
R forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \IORef Int
_ -> IO a
m
  acquire :: forall s (a :: SEXPTYPE).
(s ~ V) =>
SEXP s a -> R s (SEXP (Region (R s)) a)
acquire SEXP s a
s = forall s a. ReaderT (IORef Int) IO a -> R s a
R forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \IORef Int
cnt -> forall a. IO a -> IO a
uninterruptibleMask_ forall a b. (a -> b) -> a -> b
$ do
    SEXP s a
x <- forall t s (a :: SEXPTYPE). (t <= s) => SEXP s a -> SEXP t a
R.release forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (a :: SEXPTYPE). SEXP s a -> IO (SEXP G a)
R.protect SEXP s a
s
    forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Int
cnt forall a. Enum a => a -> a
succ
    forall (m :: * -> *) a. Monad m => a -> m a
return SEXP s a
x
  newtype ExecContext (R s) = ExecContext (IORef Int)
  getExecContext :: R s (ExecContext (R s))
getExecContext = forall s a. ReaderT (IORef Int) IO a -> R s a
R forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \IORef Int
ref -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall s. IORef Int -> ExecContext (R s)
ExecContext IORef Int
ref)
  unsafeRunWithExecContext :: forall a. R s a -> ExecContext (R s) -> IO a
unsafeRunWithExecContext R s a
m (ExecContext IORef Int
ref) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall s a. R s a -> ReaderT (IORef Int) IO a
unR R s a
m) IORef Int
ref

-- | Initialize a new instance of R, execute actions that interact with the
-- R instance and then finalize the instance. This is typically called at the
-- very beginning of the @main@ function of the program.
--
-- > main = withEmbeddedR $ do {...}
--
-- Note that R does not currently support reinitialization after finalization,
-- so this function should be called only once during the lifetime of the
-- program (see @src/unix/system.c:Rf_initialize()@ in the R source code).
withEmbeddedR :: Config -> IO a -> IO a
withEmbeddedR :: forall a. Config -> IO a -> IO a
withEmbeddedR Config
config = forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ (Config -> IO ()
initialize Config
config) IO ()
finalize

-- | Run an R action in the global R instance from the IO monad. This action
-- provides no static guarantees that the R instance was indeed initialized and
-- has not yet been finalized. Make sure to call it within the scope of
-- `withEmbeddedR`.
--
-- @runRegion m@ fully evaluates the result of action @m@, to ensure that no
-- thunks hold onto resources in a way that would extrude the scope of the
-- region. This means that the result must be first-order data (i.e. not
-- a function).
--
-- @throws@ 'Foreign.R.Error'. Generaly any R function may throw @RError@ that
-- is safe to be cached and computation can proceed. However @RError@ will cancel
-- entire R block. So in order to catch exception in more fine grained way one
-- has to use function @tryCatch@ inside R block.
runRegion :: NFData a => (forall s. R s a) -> IO a
runRegion :: forall a. NFData a => (forall s. R s a) -> IO a
runRegion forall s. R s a
r = forall a s. NFData a => R s a -> IO a
unsafeRunRegion forall s. R s a
r

unsafeRunRegion :: NFData a => R s a -> IO a
unsafeRunRegion :: forall a s. NFData a => R s a -> IO a
unsafeRunRegion R s a
r =
  forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall a. a -> IO (IORef a)
newIORef Int
0)
          (Int -> IO ()
R.unprotect forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. IORef a -> IO a
readIORef)
          (\IORef Int
d -> do
             a
x <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall s a. R s a -> ReaderT (IORef Int) IO a
unR R s a
r) IORef Int
d
             a
x forall a b. NFData a => a -> b -> b
`deepseq` forall (m :: * -> *) a. Monad m => a -> m a
return a
x)

-- | Configuration options for the R runtime. Configurations form monoids, so
-- arguments can be accumulated left-to-right through monoidal composition.
data Config = Config
  { -- | Program name. If 'Nothing' then the value of 'getProgName' will be
    -- used.
    Config -> Last String
configProgName :: Last String
    -- | Command-line arguments.
  , Config -> [String]
configArgs :: [String]

    -- | Set to 'True' if you're happy to let R install its own signal handlers
    -- during initialization. By default R sets following signal handlers:
    --
    --  * SIGPIPE - ignore signal;
    --  * SIGUSR1 - save workspace and terminate program;
    --  * SIGUSR2 - terminate program without saving workspace;
    --  * SIGINT  - cancel execution of the current function.
    --
    -- *N.B.* When program is terminated, haskell runtime will not have any chances
    -- to run any exception handlers or finalizers.
  , Config -> Last Bool
configSignalHandlers :: Last Bool
  }

instance Default Config where
  def :: Config
def = Config
defaultConfig

instance Sem.Semigroup Config where
  <> :: Config -> Config -> Config
(<>) Config
cfg1 Config
cfg2 = Config
      { configProgName :: Last String
configProgName = Config -> Last String
configProgName Config
cfg1 forall a. Semigroup a => a -> a -> a
<> Config -> Last String
configProgName Config
cfg2
      , configArgs :: [String]
configArgs = Config -> [String]
configArgs Config
cfg1 forall a. Semigroup a => a -> a -> a
<> Config -> [String]
configArgs Config
cfg2
      , configSignalHandlers :: Last Bool
configSignalHandlers =  Config -> Last Bool
configSignalHandlers Config
cfg1 forall a. Semigroup a => a -> a -> a
<> Config -> Last Bool
configSignalHandlers Config
cfg2
      }

instance Monoid Config where
  mempty :: Config
mempty = Config
defaultConfig
  mappend :: Config -> Config -> Config
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Default argument to pass to 'initialize'.
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Last String -> [String] -> Last Bool -> Config
Config (forall a. Maybe a -> Last a
Last forall a. Maybe a
Nothing) [String
"--vanilla", String
"--silent"] (forall a. Maybe a -> Last a
Last (forall a. a -> Maybe a
Just Bool
False))

-- | Populate environment with @R_HOME@ variable if it does not exist and
-- @R_LIBS@ variable if it doesn't exist either.
populateEnv :: IO ()
populateEnv :: IO ()
populateEnv = do
    Maybe String
mh <- String -> IO (Maybe String)
lookupEnv String
"R_HOME"
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String
mh forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
      String -> String -> IO ()
setEnv String
"R_HOME" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines) (String -> [String] -> String -> IO String
readProcess String
"R" [String
"-e",String
"cat(R.home())",String
"--quiet",String
"--slave"] String
"")

    Maybe String
ml <- String -> IO (Maybe String)
lookupEnv String
"R_LIBS"
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String
ml forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
      String -> String -> IO ()
setEnv String
"R_LIBS" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
.  String -> [String]
lines) (String -> [String] -> String -> IO String
readProcess String
"R" [String
"-e",String
"cat(.libPaths(),sep=if (.Platform$OS.type == \"unix\") \":\" else \";\")",String
"--quiet",String
"--slave"] String
"")

-- | A static address that survives GHCi reloadings which indicates
-- whether R has been initialized.
foreign import ccall "missing_r.h &isRInitialized" isRInitializedPtr :: Ptr CInt

-- | Allocate and initialize a new array of elements.
newCArray :: Storable a
          => [a]                                  -- ^ Array elements
          -> (Ptr a -> IO r)                      -- ^ Continuation
          -> IO r
newCArray :: forall a r. Storable a => [a] -> (Ptr a -> IO r) -> IO r
newCArray [a]
xs Ptr a -> IO r
k =
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr -> do
      forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr a
ptr) [Int
0..] [a]
xs
      Ptr a -> IO r
k Ptr a
ptr

-- | An MVar to make an atomic step of checking whether R is initialized and
-- initializing it if needed.
initLock :: MVar ()
initLock :: MVar ()
initLock = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar ()
{-# NOINLINE initLock #-}

-- Note [Concurrent initialization]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- In 'initialize' we check a first time if R is initialized. This test is fast
-- since it happens without taking an MVar. If R needs initialization, after
-- taking the MVar we check again if R is initialized to avoid concurrent
-- threads from initializing R multiple times. The user is not expected to call
-- initialize multiple times concurrently, but there is nothing stopping the
-- compiler from doing so when compiling quasiquotes.

-- | Create a new embedded instance of the R interpreter. Only works from the
-- main thread of the program. That is, from the same thread of execution that
-- the program's @main@ function is running on. In GHCi, use @-fno-ghci-sandbox@
-- to achieve this.
initialize :: Config -> IO ()
initialize :: Config -> IO ()
initialize Config{[String]
Last Bool
Last String
configSignalHandlers :: Last Bool
configArgs :: [String]
configProgName :: Last String
configSignalHandlers :: Config -> Last Bool
configArgs :: Config -> [String]
configProgName :: Config -> Last String
..} = do
#ifndef mingw32_HOST_OS
#if defined(darwin_HOST_OS) || defined(freebsd_HOST_OS)
    -- NOTE: OS X and FreeBSD does not allow removing the stack size limit completely,
    -- instead forcing a hard limit of just under 64MB.
    let stackLimit = ResourceLimit 67104768
#else
    let stackLimit :: ResourceLimit
stackLimit = ResourceLimit
ResourceLimitUnknown
#endif
    Resource -> ResourceLimits -> IO ()
setResourceLimit Resource
ResourceStackSize (ResourceLimit -> ResourceLimit -> ResourceLimits
ResourceLimits ResourceLimit
stackLimit ResourceLimit
stackLimit)
      forall a b. IO a -> IO b -> IO a
`onException` (Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
                       String
"Language.R.Interpreter: "
                       forall a. [a] -> [a] -> [a]
++ String
"Cannot increase stack size limit."
                       forall a. [a] -> [a] -> [a]
++ String
"Try increasing your stack size limit manually:"
#ifdef darwin_HOST_OS
                       ++ "$ launchctl limit stack 67104768"
                       ++ "$ ulimit -s 65532"
#elif defined(freebsd_HOST_OS)
                       ++ "$ ulimit -s 67104768"
#else
                       forall a. [a] -> [a] -> [a]
++ String
"$ ulimit -s unlimited"
#endif
                    )
#endif
    Bool
initialized <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
==CInt
1) forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
isRInitializedPtr
    -- See note [Concurrent initialization]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
initialized forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
initLock forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ do
      Bool
initialized2 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => a -> a -> Bool
==CInt
1) forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
isRInitializedPtr
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
initialized2 forall a b. (a -> b) -> a -> b
$ mdo
        -- Grab addresses of R global variables
        RVariables -> IO ()
pokeRVariables
          ( Ptr (SEXP G 'Env)
R.baseEnv
          , Ptr (SEXP G 'Env)
R.emptyEnv
          , Ptr (SEXP G 'Env)
R.globalEnv
          , Ptr (SEXP G 'Nil)
R.nilValue
          , Ptr (SEXP G 'Symbol)
R.unboundValue
          , Ptr (SEXP G 'Symbol)
R.missingArg
          , Ptr CInt
R.isRInteractive
          , Ptr CInt
R.signalHandlers
#ifndef mingw32_HOST_OS
          , Ptr (Ptr InputHandler)
R.inputHandlers
#endif
          )
        IO ()
populateEnv
        [String]
args <- (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getProgName forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Last a -> Maybe a
getLast Last String
configProgName)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
configArgs
        [CString]
argv <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO CString
newCString [String]
args
        let argc :: Int
argc = forall (t :: * -> *) a. Foldable t => t a -> Int
length [CString]
argv
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Last a -> Maybe a
getLast Last Bool
configSignalHandlers) forall a b. (a -> b) -> a -> b
$
          forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
signalHandlersPtr CInt
0
        forall a r. Storable a => [a] -> (Ptr a -> IO r) -> IO r
newCArray [CString]
argv forall a b. (a -> b) -> a -> b
$ Int -> Ptr CString -> IO ()
R.initEmbeddedR Int
argc
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
isRInteractive CInt
0
        forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
isRInitializedPtr CInt
1

-- | Finalize an R instance.
finalize :: IO ()
finalize :: IO ()
finalize = do
    Int -> IO ()
R.endEmbeddedR Int
0
    forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
isRInitializedPtr CInt
0