{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}

-- |
-- Copyright: (C) 2013 Amgen, Inc.
--
-- Global variables used by the R interpreter. All are constant, but the values
-- of some of them may change over time (e.g. the global environment).

{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

module Language.R.Globals
  ( baseEnv
  , emptyEnv
  , globalEnv
  , nilValue
  , missingArg
  , unboundValue
  -- * R Internal constants
  , isRInteractive
  , signalHandlersPtr
#ifndef mingw32_HOST_OS
  , inputHandlers
#endif
  -- * R global constants
  -- $ghci-bug
  , pokeRVariables
  ) where

import Control.Memory.Region
import Control.Monad ((<=<))
import Foreign
    ( Ptr
    , StablePtr
    , deRefStablePtr
    , newStablePtr
    , peek
    , poke
    )
import Foreign.C.Types (CInt)
import Foreign.R (SEXP)
import qualified Foreign.R as R
#ifndef mingw32_HOST_OS
import qualified Foreign.R.EventLoop as R
#endif
import System.IO.Unsafe (unsafePerformIO)

-- $ghci-bug
-- The main reason to have all R constants referenced with a StablePtr
-- is that variables in shared libraries are linked incorrectly by GHCi with
-- loaded code.
--
-- The workaround is to grab all variables in the ghci session for the loaded
-- code to use them, that is currently done by the H.ghci script.
--
-- Upstream ticket: <https://ghc.haskell.org/trac/ghc/ticket/8549#ticket>

type RVariables =
    ( Ptr (SEXP G 'R.Env)
    , Ptr (SEXP G 'R.Env)
    , Ptr (SEXP G 'R.Env)
    , Ptr (SEXP G 'R.Nil)
    , Ptr (SEXP G 'R.Symbol)
    , Ptr (SEXP G 'R.Symbol)
    , Ptr CInt
    , Ptr CInt
#ifndef mingw32_HOST_OS
    , Ptr (Ptr R.InputHandler)
#endif
    )

-- | Stores R variables in a static location. This makes the variables'
-- addresses accesible after reloading in GHCi.
foreign import ccall "missing_r.h &" rVariables :: Ptr (StablePtr RVariables)

pokeRVariables :: RVariables -> IO ()
pokeRVariables :: RVariables -> IO ()
pokeRVariables = forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (StablePtr RVariables)
rVariables forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a. a -> IO (StablePtr a)
newStablePtr

(  Ptr (SEXP G 'Env)
baseEnvPtr
 , Ptr (SEXP G 'Env)
emptyEnvPtr
 , Ptr (SEXP G 'Env)
globalEnvPtr
 , Ptr (SEXP G 'Nil)
nilValuePtr
 , Ptr (SEXP G 'Symbol)
unboundValuePtr
 , Ptr (SEXP G 'Symbol)
missingArgPtr
 , Ptr CInt
isRInteractive
 , Ptr CInt
signalHandlersPtr
#ifndef mingw32_HOST_OS
 , Ptr (Ptr InputHandler)
inputHandlersPtr
#endif
 ) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr (StablePtr RVariables)
rVariables forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. StablePtr a -> IO a
deRefStablePtr

-- | Special value to which all symbols unbound in the current environment
-- resolve to.
unboundValue :: SEXP G 'R.Symbol
unboundValue :: SEXP G 'Symbol
unboundValue = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr (SEXP G 'Symbol)
unboundValuePtr

-- | R's @NULL@ value.
nilValue :: SEXP G 'R.Nil
nilValue :: SEXP G 'Nil
nilValue = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr (SEXP G 'Nil)
nilValuePtr

-- | Value substituted for all missing actual arguments of a function call.
missingArg :: SEXP G 'R.Symbol
missingArg :: SEXP G 'Symbol
missingArg = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr (SEXP G 'Symbol)
missingArgPtr

-- | The base environment.
baseEnv :: SEXP G 'R.Env
baseEnv :: SEXP G 'Env
baseEnv = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr (SEXP G 'Env)
baseEnvPtr

-- | The empty environment.
emptyEnv :: SEXP G 'R.Env
emptyEnv :: SEXP G 'Env
emptyEnv = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr (SEXP G 'Env)
emptyEnvPtr

-- | The global environment.
globalEnv :: SEXP G 'R.Env
globalEnv :: SEXP G 'Env
globalEnv = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr (SEXP G 'Env)
globalEnvPtr

#ifndef mingw32_HOST_OS
inputHandlers :: Ptr R.InputHandler
inputHandlers :: Ptr InputHandler
inputHandlers = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr InputHandler)
inputHandlersPtr
#endif