{-# 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 = poke rVariables <=< newStablePtr

(  baseEnvPtr
 , emptyEnvPtr
 , globalEnvPtr
 , nilValuePtr
 , unboundValuePtr
 , missingArgPtr
 , isRInteractive
 , signalHandlersPtr
#ifndef mingw32_HOST_OS
 , inputHandlersPtr
#endif
 ) = unsafePerformIO $ peek rVariables >>= deRefStablePtr

-- | Special value to which all symbols unbound in the current environment
-- resolve to.
unboundValue :: SEXP G 'R.Symbol
unboundValue = unsafePerformIO $ peek unboundValuePtr

-- | R's @NULL@ value.
nilValue :: SEXP G 'R.Nil
nilValue = unsafePerformIO $ peek nilValuePtr

-- | Value substituted for all missing actual arguments of a function call.
missingArg :: SEXP G 'R.Symbol
missingArg = unsafePerformIO $ peek missingArgPtr

-- | The base environment.
baseEnv :: SEXP G 'R.Env
baseEnv = unsafePerformIO $ peek baseEnvPtr

-- | The empty environment.
emptyEnv :: SEXP G 'R.Env
emptyEnv = unsafePerformIO $ peek emptyEnvPtr

-- | The global environment.
globalEnv :: SEXP G 'R.Env
globalEnv = unsafePerformIO $ peek globalEnvPtr

#ifndef mingw32_HOST_OS
inputHandlers :: Ptr R.InputHandler
inputHandlers = unsafePerformIO $ peek inputHandlersPtr
#endif