R/jrc.R

In anders-biostat/jrc: Exchange Commands Between R and 'JavaScript'

#' @name Session
#' @title Session class
#' 
#' @description Objects of this class handle all the incoming and outgoing messages for one active connection. 
#' Please, avoid creating instances of this class manually. Each \code{Session} object is created when
#' a WebSocket is opened and serves as a wrapper around it. A manually created object will not have
#' a WebSocket connection and thus are not functional.
#' 
#' All sessions are stored within an object of class \code{\link{App}} and cannot exist and function without it.
#' One can manipulate a session directly, using its methods described below, via methods of the corresponding 
#' \code{\link{App}} object or the provided wrapper function (links to them can be found in the Methods section).
#' 
#' @section Fields:
#' \describe{
#'    \item{\code{id}}{
#'       Automatically generated ID for this session. ID is a random combination of 6 letters or numbers.
#'       Please, do not change the value of this field.
#'    }
#'    \item{\code{lastActive}}{
#'       Time of the last received message from the session's WebSocket. The timestamp is generated by the
#'       \code{\link[base]{Sys.time}} function.
#'    }
#'    \item{\code{startTime}}{
#'       Time when this session has been started (generated by the \code{\link[base]{Sys.time}} function).
#'    }
#' }
#' @section Methods:
#' \describe{
#'   \item{\code{getMessageIds()}}{
#'      Returns IDs of all currently stored messages. ID is a combination of 6 random letters and numbers
#'      generated when the message is stored. See also \code{\link{getMessageIds}}.
#'   }
#'   \item{\code{authorize(messageId = NULL, show = FALSE)}}{ 
#'      Authorizes evaluation of a message. Check \code{\link{authorize}} for more information.
#'   }
#'   \item{\code{removeMessage(messageId = NULL)}}{
#'      Removes a stored message. This can also be done with the \code{\link{authorize}} function (set
#'      \code{show = TRUE} and then select the ``Ignore message'' option). See also \code{\link{removeMessage}}.
#'   }
#'   \item{\code{sendCommand(command, wait = 0)}}{
#'      Sends a JavaScript command to be evaluated on the web page. Check 
#'      \code{\link{sendCommand}} for more information.
#'   }
#'   \item{\code{callFunction(name, arguments = NULL, assignTo = NULL, wait = 0, thisArg = NULL,  ...)}}{
#'      Calls an existing JavaScript
#'      function on the web page. Check \code{\link{callFunction}} for more information.
#'   }
#'   \item{\code{sendData(variableName, variable, wait = 0, keepAsVector = FALSE, rowwise = TRUE)}}{
#'      Sends data and assigns it to 
#'      a variable on the web page. Check \code{\link{sendData}} for more information.
#'   }
#'   \item{\code{sendHTML(html, wait = 0)}}{
#'      Sends HTML code that will be appended to the web page. Check \code{\link{sendHTML}} for 
#'      more information.
#'   }
#'   \item{\code{sessionVariables(vars = NULL, varName = NULL, remove = NULL)}}{
#'      Sets or returns variables that are used (read or modified) only by this session. If both arguments are
#'      \code{NULL}, returns environment for this session. If \code{vars} is a named list, adds this variables to the
#'      session environment. If \code{varName} is a character, returns a variable with this name how it is seen from
#'      the session. If the variable doesn't exist, throws an error. If \code{remove} is a vector of characters, removes
#'      variables with these names from the session environment. One can add variables to the session environment,
#'      get one back and remove variables with a single function call. Check \code{\link{setSessionVariables}},
#'      \code{\link{getSessionVariable}}, \code{\link{removeSessionVariables}} for more information.
#'   }
#'  \item{\code{setLimits(limits)}}{
#'       Sets limits for memory usage, number of simultaneously active connections and amount of messages processed per second. 
#'       For information about possible arguments, please, check \code{\link{setLimits}}. This method accepts all the same arguments,
#'       but they should be supplied in a form of list.
#'    }
#' }
#' Note, that \code{Session} class has some other public methods that are not mentioned in this list. These methods are
#' intended to be used only by other functions of \code{jrc} package and therefore are not documented.
NULL

#' @importFrom stringi stri_rand_strings
#' @import stringr
#' @import R6
#' @importFrom jsonlite fromJSON
#' @importFrom utils object.size
#' @export
Session <- R6Class("Session", cloneable = FALSE, public = list(
  id = "",
  lastActive = NULL,
  startTime = NULL,
  log = c(0, 0, 0),
  
  storeMessage = function(msg) {
    if(private$limits$storedMsg == 0 | private$limits$storageSize == 0) {
      message(str_c("Message can't be stored, sincse message storage is set to zero. ",
                    "Please, use 'setLimits' function to change the limits."))
      return()
    }
    if(!is.vector(msg))
      stop("Unknown message format")
    
    if(msg[1] == "COM") {
      message(str_c("Command '", msg[2], "' is stored."))
    } else if(msg[1] == "DATA") {
      message(str_c("Assignment to the variable '", msg[2], "' is stored."))
    } else if(msg[1] == "FUN") {
      message(str_c("Call to the function '", msg[2], "' is stored."))
    } else {
      stop("Unknown message type. Must be one of 'COM', 'DATA' or 'FUN'")
    }
    
    messageId <- stri_rand_strings(1, 6)
    private$storage[[messageId]] <- list(msg = msg, size = object.size(msg), id = messageId)
    
    message(str_c("To authorize execution, please, type 'authorize(sessionId = \"", self$id, 
                  "\", messageId = \"", messageId, "\")'"))
    if(!private$waiting) {
      self$callFunction("jrc.notifyStorage", list(messageId))
    } else {
      private$waiting <- FALSE
    }
    self$lastActive <- Sys.time()
    
    private$cleanStorage()
  },
  execute = function(messageId = NULL, msg = NULL) {
    if(is.null(msg))
      if(is.null(messageId)) {
        stop("Either message of message ID must be provided.")
      } else {
        msg <- self$getMessage(messageId)
      }
    private$waiting <- FALSE
    
    if(is.null(msg))
      stop(str_c("There is no message with ID ", messageId))
    
    tryCatch({
      if(msg[1] == "COM") {
        eval(parse(text = msg[2]), envir = private$envir)
      } else if(msg[1] == "DATA") {
        # 1 = "DATA"
        # 2 - variable name
        # 3 - variable
        # 4 - boolean (sessionwise or outer envir)
        if(object.size(msg[[3]]) > private$limits$varSize) {
          message("An attempt to assign a variable that is larger than the maximal 
                  allowed size")
        } else {
          if(is.na(msg[[4]]))
            msg[[4]] <- exists(msg[[2]], inherits = FALSE, envir = private$envir)
          if(msg[[4]]) {
            assign(msg[[2]], msg[[3]], envir = private$envir)
          } else {
            assign(msg[[2]], msg[[3]], envir = parent.env(private$envir))
          }
        }
      } else if(msg[1] == "FUN") {
        # 1 = "FUN"
        # 2 - function name
        # 3 - list of arguments
        # 4 - assignTo
        # 5 - package
        # 6 - boolean (sessionwise or outer envir)
        chain <- strsplit(msg[[2]], "[$]")[[1]]
        if(!is.na(msg[[5]])){
          env <- getNamespace(msg[[5]])
        } else {
          env <- private$envir
        }
        repeat {
          f <- get(chain[1], envir = env)
          chain <- chain[-1]
          if(is.environment(f))
            env <- f
          if(length(chain) == 0)
            break
        }
        
        if(identical(private$envir, env) && !isNamespace(environment(f))) {
          environment(f) <- env
        } else {
          fors <- formals(f)
          for(arg in setdiff(names(fors), names(msg[[3]])))
            if(arg != "...")
              tryCatch(msg[[3]][[arg]] <- eval(fors[[arg]], private$envir),
                       error = function(e) {})
        }

        tmp <- do.call(f, msg[[3]])  
#        parent.env(private$envir) <- outer
        
        if(!is.na(msg[[4]])){
          if(is.na(msg[[6]]))
            msg[[6]] <- exists(msg[[4]], inherits = FALSE, envir = private$envir)
          if(msg[[6]]) {
            assign(msg[[4]], tmp, envir = private$envir)
          } else {
            assign(msg[[4]], tmp, envir = parent.env(private$envir))
          }
        }
      }
    }, finally = {
      if(!is.null(messageId))
        self$removeMessage(messageId)
      self$lastActive <- Sys.time()
    }
    )
  },
  
  getMessage = function(messageId) {
    if(!is.character(messageId))
      stop("Message ID must be a string")
    if(length(messageId) > 1) {
      warning("An attepmt to supply several message IDs. Only the first one will be used")
      messageId <- messageId[1]
    }
    
    msgObj <- private$storage[[messageId]]
    if(!is.null(msgObj))
      msgObj <- msgObj$msg
    
    msgObj
  },
  removeMessage = function(messageId = NULL) {
    if(length(private$storage) == 0)
      stop("There are no stored messages")
    
    if(is.null(messageId))
      if(length(private$storage) > 1) {
        stop("There is more than one stored message. Please, specify message ID")
      } else {
        messageId <- names(private$storage)
      }
    if(!is.character(messageId))
      stop("Message ID must be a string")
    if(length(messageId) > 1) {
      warning("An attepmt to supply several message IDs. Only the first one will be used")
      messageId <- messageId[1]
    }
    
    private$storage[[messageId]] <- NULL
    
    invisible(self)
  },
  
  getMessageIds = function() {
    sapply(private$storage, `[[`, "id")
  },
  
  sendCommand = function(command, wait = 0) {
    if(is.null(private$ws))
      stop("WebSocket is already closed.")
    
    stopifnot(is.character(command))
    
    private$ws$send( toJSON(list(type = "COM", com = command)) )
    
    if(wait > 0)
      private$wait(wait)
  },
  
  callFunction = function(name, arguments = NULL, assignTo = NULL, wait = 0, thisArg = NULL,  ...) {
    if(is.null(private$ws))
      stop("WebSocket is already closed.")
    
    if(!is.character(name))
      stop("Function name must be a character")
    if(!is.null(assignTo) & !is.character(assignTo))
      stop("Variable name in 'assignTo' must be a character")
    
    if(!is.null(arguments)) {
      if(!is.list(arguments))
        stop("Arguments must be a list")
      names(arguments) <- NULL
      self$sendData("___args___", arguments, ...)
    }
    
    private$ws$send(toJSON(list(type = "FUN", name = name, 
                                assignTo = assignTo, 
                                thisArg = thisArg)))
    
    if(wait > 0)
      private$wait(wait)
  },
  
  sendData = function(variableName, variable, wait = 0, keepAsVector = FALSE, rowwise = TRUE) {
    if(is.null(private$ws))
      stop("WebSocket is already closed.")
    
    stopifnot(is.character(variableName))
    if(length(variableName) > 1) {
      warning("An attempt to supply multiple variable names. Only the first one will be used.")
      variableName <- variableName[1]
    }
    
    if(rowwise) {
      dataframe <- "rows"
      matrix <- "rowmajor"
    } else  {
      dataframe <- "columns"
      matrix <- "columnmajor"
    }
    private$ws$send( toJSON(list(type = "DATA", variableName = variableName, 
                              variable = toJSON(variable, digits = NA, dataframe = dataframe, matrix = matrix), 
                              keepAsVector = keepAsVector)))
    if(wait > 0)
      private$wait(wait)
  },
  
  sendHTML = function(html, wait = 0) {
    if(is.null(private$ws))
      stop("WebSocket is already closed.")
    
    stopifnot(is.character(html))
    
    private$ws$send( toJSON(list(type = "HTML", html = html)) )
    
    if(wait > 0)
      private$wait(wait)
  },
  
  authorize = function(messageId = NULL, show = FALSE) {
    
    if(is.null(messageId)) {
      if(length(private$storage) > 1)
        stop("More than one message is stored for this session. Please, specify message ID.")
      if(length(private$storage) == 0)
        stop("There are no stored messages for this session")
      messageId <- names(private$storage)
    }
    
    if(!is.logical(show))
      stop("show must be a logical variable")
    
    if(!show) {
      self$execute(messageId)
    } else {
      msg <- self$getMessage(messageId)
      if(is.null(msg))
        stop(str_c("There is no message with ID ", messageId))
      
      if(msg[1] == "COM") {
        text <- str_c("Command '", msg[2], "'.")
      } else if(msg[[1]] == "DATA") {
        text <- str_c("Assignment of varible '", msg[[2]], 
                      "'. New type is '", msg[[3]], "'. ",
                      "New size is ", msg[[3]], " bytes.")
      } else if(msg[[1]] == "FUN") {
        text <- str_c("Call of function '", msg[[2]], "'.")
        if(!is.na(msg[[4]]))
          text <- str_c(text, " Results will be assigned to variable '", msg[[4]], "'.")
      }
      text <- str_c(text, " To cancel enter '0'.")
      
      choice <- menu(c("Execute", "Ignore"), 
                     title = text)
      if(choice == 0) return()
      if(choice == 1) self$execute(messageId)
    }
    
    invisible(self)
  },
  
  sessionVariables = function(vars = NULL, varName = NULL, remove = NULL) {
    if(is.null(vars) && is.null(varName) && is.null(remove))
      return(private$envir)
    
    if(!is.null(vars) & length(vars) > 0){
      if(!is.list(vars) || is.null(names(vars)))
        stop("Session variables must be a named list")
      list2env(vars, private$envir)   
    }
    if(!is.null(varName)){
      if(!is.character(varName))
        stop("Variable name must be a character")
      if(length(varName) > 1) {
        warning("Can't get several variables at once. Only the first variable name will be used")
        varName <- varName[1]
      }
      return(get(varName, envir = private$envir))
    }
    if(!is.null(remove)){
      if(!is.character(remove))
        stop("Variable names must be characters")
      stopifnot(is.vector(remove))
      rm(list = remove, envir = private$envir)
    }
    invisible(self)
  },
  
  setEnvironment = function(envir) {
    stopifnot(is.environment(envir))
    
    parent.env(private$envir) <- envir
    
    invisible(self)
  },

  setLimits = function(limits = NULL) {
    if(is.null(limits)) return(private$limits)
    
    limits <- as.list(limits)
    if(!is.list(limits))
      stop("'limits' must be a list")
    
    notRecognized <- setdiff(names(limits), names(private$limits))
    if(length(notRecognized) > 0) {
      warning(str_c("The following limits are not used: '", 
                    str_c(notRecognized, sep = "', '"), "'"))
    }
    limits <- limits[intersect(names(limits), names(private$limits))]
    
    for(n in names(limits)){
      if(length(limits[[n]]) > 1) {
        warning(str_c("Multiple values supplied for '", n, "'. Only one will be used."))
        limits[[n]] <- limits[[n]][1]
      }
      if(!is.numeric(limits[[n]]))
        stop(str_c("'", n, "' must be a number"))
      private$limits[[n]] <- limits[[n]]
    }
    
    invisible(self)
  },
  
  close = function(message = NULL) {
    if(!is.null(message)) {
      if(!is.character(message))
        stop("Closing message must be a string.")
      
      self$sendCommand(str_c("alert('", message, "');"))
    }
    if(!is.null(private$ws))
      private$ws$close()
  },
  
  initialize = function(ws, envir = NULL) {
    self$id <- stri_rand_strings(1, 6)
    if(is.null(envir))
      envir <- new.env()
    stopifnot(is.environment(envir))
    
    private$envir <- envir
    
    self$lastActive <- Sys.time()
    self$startTime <- Sys.time()
    
    private$ws <- ws
    
    self$sessionVariables(list(.id = self$id))      
  }
  
), private = list(
  ws = NULL,
  envir = NULL,
  storage = list(),
  waiting = FALSE,
  limits = list(maxCon = Inf,
                storageSize = Inf,
                storedMsg = Inf,
                varSize = Inf,
                msgPerSec = Inf,
                msgSize = Inf,
                bytesPerSec = Inf),
  
  cleanStorage = function() {
    if(length(private$storage) > private$limits$storedMsg){
      message(str_c("Too many messages! Message with id '", private$storage[[1]]$id, "' removed"))
      private$storage[1] <- NULL
    }
    
    while(sum(sapply(private$storage, `[[`, "size")) > private$limits$storageSize & 
          length(private$storage) > 1){
      message(str_c("Messages size is too big! Message with id '", private$storage[[1]]$id, "' removed"))
      private$storage[1] <- NULL
    }
  },
  
  wait = function(time) {
    private$waiting <- TRUE
    
    for( i in 1:(time/0.05) ) {
      service(100)
      if( !private$waiting ){
        break
      } 
      Sys.sleep( .05 )
    }
    
    if(private$waiting) 
      warning(str_c("Failed to receive response from the WebSocket. Session ID: ", self$id))
    
    private$waiting <- FALSE
  }
))

#' @name App
#' @title App class
#' 
#' @description Object of this class represents the entire jrc-based app. It stores all the active connections,
#' client-specific variables and all the global app settings.
#' 
#' You can create interactive apps by initializing
#' new instances of this class and manage the apps with the methods that are described below. There are no limitations
#' on the number of apps that can run simultaneously in one R session.
#' 
#' A wrapper function is also exported for almost each method (see links in the Methods section). This functions allow
#' you to gain full control over the app without ever dealing with this class. However, in this case only a single app
#' can run per R session. Attempt to create a new app (with \code{\link{openPage}} function) will force the existing one (if any)
#' to stop. You can always get the \code{App} object for the currently running app with \code{\link{getPage}} function.
#' 
#' @section Methods:
#' \describe{
#'    \item{\code{new(rootDirectory = NULL, startPage = NULL, onStart = NULL, onClose = NULL,  
#'    connectionNumber = Inf, allowedFunctions = c(), allowedVariables = c(), sessionVars = NULL)}}{
#'       Creates a new instance of class \code{App}. Check \code{\link{openPage}} man page for information about
#'       arguments.
#'    }
#'    \item{\code{startServer(port = NULL)}}{
#'        Starts a local server that listens to a given port. If \code{port = NULL}, picks a random available port.
#'        See also \code{\link{openPage}}.
#'    }
#'    \item{\code{stopServer()}}{
#'        Closes all active sessions and stops a running server. See also \code{\link{closePage}}.
#'    }
#'    \item{\code{openPage(useViewer = TRUE, browser = NULL)}}{
#'       Opens a new web page either in a browser, or in the R Studio viewer. If \code{useViewer = FALSE} and browser is not selected,
#'       a default installed browser is used. If browser is specified, \code{useViewer} is ignored. This method returns
#'       a new \code{\link{Session}} object, which should correspond to the page that has been just opened. However, if someone would start
#'       a new connection at the moment when \code{openPage} method is called, it may return a wrong session. See also \code{\link{openPage}}.
#'    }
#'    \item{\code{getSession(sessionId = NULL)}}{
#'       Returns a session with the given ID or \code{NULL} if session with this ID doesn't exist. If \code{sessionId = NULL}
#'       and there is only one active session, returns it. See also \code{\link{getSession}}.
#'    }
#'    \item{\code{closeSession(sessionId = NULL, inactive = NULL, old = NULL)}}{
#'       Closes WebSocket connection of one or multiple sessions and removes all the related data from the app. For more information on 
#'       the arguments, please, check \code{\link{closeSession}} man page.
#'    }
#'    \item{\code{getSessionIds()}}{
#'        Returns IDs of all currently active sessions. See also \code{\link{getSessionIds}}.
#'    }
#'    \item{\code{setEnvironment(envir)}}{
#'       Specifies the outer environment of the app, in which all the messages from the web pages will be evaluated. For more information,
#'       please, check \code{\link{setEnvironment}}.
#'    }
#'    \item{\code{allowFunctions(funs = NULL)}}{
#'       Adds function names to a list of allowed R functions. These functions can be called from a web page without authorization
#'       on the R side. If \code{funs = NULL}, returns a list of all currently allowed functions. For more information,
#'       please, check \code{\link{allowFunctions}}.
#'    }
#'    \item{\code{allowVariables(vars = NULL)}}{
#'       Adds variable names to  the list of allowed variables. These variables can be changed from a web page without 
#'       authorization on the R side. If \code{vars = NULL}, then returns a vector of names of all currently allowed variables.
#'       For more information, please, check \code{\link{allowVariables}}.
#'    }
#'    \item{\code{allowDirectories(dir = NULL)}}{
#'       Allows app to serve files from an existing directory. Files from the \code{rootDirectory} can always be accessed
#'       by the app. By default, the current working directory is
#'       added to the list of the allowed directories, when the app is initialized. All the subdirectories of the allowed 
#'       directories can also be accessed. Attempt to request file from outside allowed directory will produce 
#'       \code{403 Forbidden} error. If \code{dirs = NULL}, then returns a vector of names of all currently allowed directories.
#'       Also see \code{\link{allowDirectories}}.
#'    }
#'    \item{\code{startPage(path = NULL)}}{
#'       Sets path to a starting web page of the app. Path can be full, relative to the app's root directory or relative
#'       to the current R working directory. If 
#'       \code{path = NULL}, returns current path to the starting page.
#'    }
#'    \item{\code{rootDirectory(path = NULL)}}{
#'       Sets path to the root directory for the server. Any file, requested by the server, will be looked for in this directory.
#'       Can be a full path or a path relative to the current R working directory. If \code{path = NULL}, returns path to the
#'       current root directory.
#'    }
#'    \item{\code{setLimits(...)}}{
#'       Sets limits for memory usage, number of simultaneously active connections and amount of messages processed per second. 
#'       These settings will apply for each new connection. To change memory usage for an existing session use method \code{setLimits}
#'       of class \code{\link{Session}}. For information about possible arguments, please, check \code{\link{setLimits}}.
#'    }
#'    \item{\code{getPort()}}{
#'       Returns number of the port which the running server listens to. After the app has been initialized, the port number cannot be changed.
#'    }
#' }
#' 
NULL

#' @import mime
#' @importFrom R.utils filePath
#' @export
App <- R6Class("App", cloneable = FALSE, public = list(
  addSession = function(session) {
    stopifnot("Session" %in% class(session))
    if(length(private$sessions) >= private$limits$maxCon) {
      session$close("Maximum number of active connections has been reached.")
      message("Maximum number of connections has been reached. Please, close some of 
           the existing sessions, before adding a new one.")
      return()
    }
    oldSession <- self$getSession(session$id)
    if(!is.null(oldSession)) {
      warning(str_c("Session with id ", session$id, " already exists. Existing session will be closed."))
      self$closeSession(oldSession)
    }
    private$sessions[[session$id]] <- session
  },
  
  getSession = function(sessionId = NULL) {
    if(is.null(sessionId))
      if(length(private$sessions) <= 1) {
        return(private$sessions[[1]])
      } else {
        stop("There are more than one active session. Please, specify session ID.")
      }
    if(!is.character(sessionId))
      stop("Session ID must be a string")
    
    private$sessions[[sessionId]]
  },
  
  closeSession = function(sessionId = NULL, inactive = NULL, old = NULL) {
    if(length(private$sessions) == 0)
      stop("There are no active sessions.")
    
    if(is.null(sessionId))
      if(is.null(inactive) & is.null(old)){
        if(length(private$sessions) > 1)
          stop("There is more than one active session. Please, specify ID of the session you want to close")
        sessionId <- names(private$sessions)
      }
    
    stopifnot(is.vector(sessionId) | is.null(sessionId))
    
    if(!is.null(inactive)) {
      lastActive <- sapply(private$sessions, `[[`, "lastActive")
      rem <- (lastActive < Sys.time() - inactive)
      sessionId <- unique(c(sessionId, names(lastActive)[rem]))
    }
    if(!is.null(old)) {
      startTime <- sapply(private$sessions, `[[`, "startTime")
      rem <- (startTime < Sys.time() - old)
      sessionId <- unique(c(sessionId, names(startTime)[rem]))
    }
    
    for(id in sessionId) {
      session <- self$getSession(id)
      if(!is.null(session)){
        session$close()
        private$sessions[[id]] <- NULL
      } else {
        warning(str_c("There is no session with ID ", id))
      }
    }
    
    invisible(self)
  },
  
  getSessionIds = function() {
    names(private$sessions)
  },
  
  stopServer = function() {
    lapply(names(private$sessions), self$closeSession)
    
    if(!is.null(private$serverHandle)) {
      if(compareVersion(as.character(packageVersion("httpuv")), "1.3.5") > 0) {
        stopServer(private$serverHandle)
      } else {
        stopDaemonizedServer(private$serverHandle)
      }
      message("Server has been stopped.")      
    }
    
    invisible(self)
  },
  
  startServer = function(port = NULL) {
    
    if(is.null(port)) {
      if(compareVersion(as.character(packageVersion("httpuv")), "1.5.4") >= 0){
        port <- randomPort(n = 50)
      } else {
        #if there is no randomPort function in the httpuv package
        #in later versions of jrc this will be removed and httpuv >= 1.5.2 will be required
        #code adopted from httpuv::randomPort
        for (port in sample(seq(1024L, 49151L), 50)) {
          s <- NULL
          
          # Check if port is open
          tryCatch(
            s <- startServer("0.0.0.0", port, list(), quiet = TRUE),
            error = function(e) { }
          )
          if (!is.null(s)) {
            s$stop()
            break
          }
        }
      }
    }
    port <- as.integer(port)
    if(is.na(port))
      stop("Port number must be an integer number.")
    private$port <- port
    
    if(!(compareVersion(as.character(packageVersion("httpuv")), "1.3.5") > 0)) {
      private$serverHandle <- startDaemonizedServer( "0.0.0.0", private$port, private$getApp() )
    } else {
      private$serverHandle <- startServer( "0.0.0.0", private$port, private$getApp() )
    }
    
    invisible(self)
  },
  
  openPage = function(useViewer = TRUE, browser = NULL) {
    if(!is.null(browser))
      useViewer <- FALSE
    
    if(is.null(private$serverHandle))
      stop("No server is running. Please, start a server before opening a page.")
    if( useViewer & !is.null( getOption("viewer") ) )
      getOption("viewer")( str_c("http://localhost:", private$port) )
    else{
      if(is.null(browser))
        browser = getOption("browser")
      browseURL( str_c("http://localhost:", private$port), browser = browser )
    }
    
    
    # Wait up to 5 seconds for the a WebSocket connection
    # incoming from the client
    private$waiting <- TRUE
    for( i in 1:(5/0.05) ) {
      service(100)
      if( !private$waiting ){
        break
      } 
      Sys.sleep( .05 )
    }
    if( private$waiting ) {
      self$stopServer()
      stop( "Timeout waiting for WebSocket." )
    }
    
    invisible(private$sessions[[length(private$sessions)]])
  },
  
  setEnvironment = function(envir, sessionId = NULL) {
    stopifnot(is.environment(envir))
    private$envir <- envir
    
    if(is.null(sessionId))
      sessionId <- names(private$sessions)
    
    if(!is.null(sessionId)) {
      stopifnot(is.vector(sessionId))
      for(id in sessionId) 
        self$getSession(id)$setEnvironment(envir)
    }
    invisible(self)
  },
  
  allowFunctions = function(funs = NULL) {
    if(is.null(funs)) return(private$allowedFuns)
    if(!is.vector(funs) | !is.character(funs))
      stop("'funs' must be a vector of function names")
    
    private$allowedFuns <- unique(c(private$allowedFuns, funs))
    invisible(self)
  },
  
  allowVariables = function(vars = NULL) {
    if(is.null(vars)) return(private$allowedVars)
    if(!is.vector(vars) | !is.character(vars))
      stop("'funs' must be a vector of function names")
    
    private$allowedVars <- unique(c(private$allowedVars, vars))
    invisible(self)
  },
  
  allowDirectories = function(dirs = NULL) {
    if(is.null(dirs)) return(private$allowedDirs)
    if(!is.vector(dirs) | !is.character(dirs))
      stop("'dirs' must be a vector of paths to directories")
    
    for(d in dirs) {
      if(dir.exists(d)) {
        private$allowedDirs <- unique(c(private$allowedDirs, 
                                        normalizePath(d, winslash = "/")))
      } else {
        warning(str_interp("Directory ${d} doesn't exist and will not 
                           be added to the list of allowed directories"))
      }
      invisible(self)
    }
    
  },
  
  rootDirectory = function(path = NULL) {
    if(is.null(path)) return(private$rootDir)
    stopifnot(is.character(path))
    
    if(!dir.exists(path))
      stop(str_c("There is no such directory: '", path, "'"))
    
    private$rootDir <- normalizePath(path, winslash = "/")
    
    invisible(self)
  },
  
  startPage = function(path = NULL) {
    if(is.null(path)) return(private$startP)

    if(file.exists(filePath(private$rootDir, path))){
      private$startP <- path
    } else {
      if(!file.exists(path))
        stop(str_c("There is no such file: '", path, "'"))
      private$startP <- normalizePath(path, winslash = "/")
    }
    
    invisible(self)
  },
  
  sessionVariables = function(vars = NULL) {
    if(is.null(vars))
      return(private$sessionVars)
    
    vars <- as.list(vars)
    if(!is.list(vars))
      stop("Variables must be a list")
    
    if(is.null(names(vars)))
      stop("List of variables must be named")
    
    for(n in names(vars))
      private$sessionVars[[n]] <- vars[[n]]
    
    invisible(self)
  },
  
  setLimits = function(maxCon = NULL, storageSize = NULL, storedMsg = NULL,
                       varSize = NULL, msgPerSec = NULL, msgSize = NULL, 
                       bytesPerSec = NULL) {
    limits <- lapply(as.list(match.call())[-1], eval.parent, n = 2)

    for(n in names(limits))  
      if(!is.null(limits[[n]])) {
        if(length(limits[[n]]) > 1) {
          warning(str_c("Multiple values supplied for '", n, "'. Only the first one will be used."))
          limits[[n]] <- limits[[n]][1]
        }
        if(!is.numeric(limits[[n]]))
          stop(str_c("'", n, "' must be a number"))
        
        private$limits[[n]] <- limits[[n]]
      }
    
    invisible(self)
  },
  
  getPort = function() {
    private$port
  },
  
  initialize = function(rootDirectory = NULL, startPage = NULL, onStart = NULL,
                        onClose = NULL,
                        connectionNumber = Inf, allowedFunctions = c(), 
                        allowedVariables = c(), 
                        allowedDirectories = getwd(),
                        sessionVars = NULL) {
    if(is.null(rootDirectory)) 
      rootDirectory <- system.file("http_root", package = "jrc")
    self$rootDirectory(rootDirectory)
    
    if(is.null(startPage))
      startPage <- system.file("http_root/index.html", package = "jrc")
    self$startPage(startPage)
    
    private$envir <- parent.frame(n = 2)
    
    if(is.null(onStart)) {
      onStart <- function(session) {}
    }
    stopifnot(is.function(onStart))
    private$onStart <- onStart

    if(is.null(onClose)) {
      onClose <- function(session) {}
    }
    stopifnot(is.function(onClose))
    private$onClose <- onClose
        
    self$allowDirectories(allowedDirectories)
    self$allowFunctions(allowedFunctions)
    self$allowVariables(allowedVariables)
    self$sessionVariables(sessionVars)
    self$setLimits(maxCon = connectionNumber)
    
    invisible(self)
  }
  
), private = list(
  sessions = list(),
  serverHandle = NULL,
  envir = NULL,
  allowedFuns = c(),
  allowedVars = c(),
  allowedDirs = c(),
  port = NULL,
  waiting = FALSE,
  onStart = NULL,
  onClose = NULL,
  rootDir = "",
  startP = "",
  sessionVars = list(),
  limits = list(maxCon = Inf,
                storageSize = Inf,
                storedMsg = Inf,
                varSize = Inf,
                msgPerSec = Inf,
                msgSize = Inf,
                bytesPerSec = Inf),
  
  getApp = function() {
    handle_http_request <- function( req ) {
      
      reqPage <- req$PATH_INFO
      if(grepl("^/http_root", reqPage)) {
        pack <- substring(strsplit(reqPage, "/")[[1]][2], 11)
        reqPage <- sub(str_c("_", pack), "", reqPage)
        reqPage <- tryCatch(system.file( reqPage, package = pack, mustWork = TRUE ),
                 error = function(e) system.file( paste0("inst/", reqPage), package = pack))
      } else {
        if(reqPage == "/index.html" || reqPage == "/") {
          reqPage <- private$startP
        } else {
          dir <- private$rootDir
          i <- 0
          while(!file.exists(filePath(dir, reqPage)) & !grepl(dir, reqPage, fixed = TRUE) & 
                i < length(self$allowDirectories()))
          {
            i <- i + 1
            dir <- self$allowDirectories()[i]
          }

          if(file.exists(filePath(dir, reqPage))){
            reqPage <- filePath(dir, reqPage)
          } else if(!grepl(dir, reqPage, fixed = TRUE)) {
            if(file.exists(reqPage) | file.exists(str_sub(reqPage, 2))) {
              warning(str_interp("An attempt to access file in a forbidden directory: ${reqPage}"))
              return( list( 
                status = 403L,
                headers = list( "Content-Type" = "text/html" ),
                body = "403: Forbidden" ) )
            } else {
              warning(str_interp("File '${reqPage}' is not found"))
              return( list( 
                status = 404L,
                headers = list( "Content-Type" = "text/html" ),
                body = "404: Resource not found" ) )
            }
          }
        }
      }

      content_type <- mime::guess_type(reqPage)
      
      if(content_type == "text/html") {
        content <- readLines(reqPage, warn = F)
        jsfile <- str_c("<script src='http_root_jrc/jrc.js'></script>")
        stop <- F
        for(i in 1:length(content))
          if(str_detect(content[i], regex("<head", ignore_case = T))) {
            stop <- T
            content[i] <- str_replace(content[i], regex("(<head[^>]*>)", ignore_case = T), str_c("\\1", jsfile))
          }
        #the document has no <head> tag
        if(!stop) {
          jsfile <- str_c("<head>", jsfile, "</head>")
          for(i in 1:length(content))
            if(str_detect(content[i], regex("<html", ignore_case = T))) {
              stop <- T
              content[i] <- str_replace(content[i], regex("(<html[^>]*>)", ignore_case = T), str_c("\\1", jsfile))
            }
        }
        if(!stop)
          content <- c(jsfile, content)
        
        content <- str_c( content, collapse = "\n" )
      } else {
        content <- reqPage
        names(content) <- "file"
      }
      
      list(
        status = 200L,
        headers = list( 'Content-Type' = content_type ),
        body = content
      )
    }
    handle_websocket_open <- function( ws ) {
      session <- Session$new(ws, envir = new.env(parent = private$envir))
      #session$sessionVariables(private$sessionVars)
      
      ws$onMessage( function( isBinary, msg ) {
        if( isBinary )
          stop( "Unexpected binary message received via WebSocket" )
        time <- round(as.numeric(Sys.time()))
        if(session$log[1] != time) {
          session$log <- c(time, 0, 0)
        }
        if(session$log[2] == -1) return()
        
        session$log <- session$log + c(0, 1, object.size(msg))
        if(session$log[2] > session$setLimits()[["msgPerSec"]] | 
           session$log[3] > session$setLimits()[["bytesPerSec"]]) {
          session$log <- c(time, -1, -1)
          message("Message limit per second is reached.")
          return()
        }
        if(object.size(msg) > session$setLimits()[["msgSize"]]) {
          message("The received message is too large and will be ignored")
          return()
        }
        msg <- fromJSON(msg)
        if(!(msg[1] %in% c("COM", "FUN", "DATA")))
          stop(str_interp("Unknown message type: ${msg[1]}"))
        
        if(msg[1] == "COM") {
          session$storeMessage(msg) #vector of characters
        } 
        if(msg[1] == "DATA") {
          if(!is.character(msg[2]))
            stop("Invalid message structure. Variable name is not character.")
          
          msg <- as.list(msg)
          msg[[3]] <- fromJSON(msg[[3]])
          
          if(msg[[2]] %in% private$allowedVars) {
            session$execute(msg = msg)
          } else {
            session$storeMessage(msg)
          }
        }
        
        if(msg[1] == "FUN") {
          if(!is.character(msg[2]))
            stop("Invalid message structure. Function name is not character.")
          #make sure that function arguments is a list
          
          msg <- as.list(msg)
          if(!is.na(msg[[3]])) 
            msg[[3]] <- fromJSON(msg[[3]])
          if(is.vector(msg[[3]]))
            msg[[3]] <- as.list(msg[[3]])
          if(length(msg[[3]]) == 1 && is.na(msg[[3]]))
            msg[[3]] <- list()
          
          msg[[3]] <- as.list(msg[[3]])
          if(!is.list(msg[[3]]))
            stop("Invalid message structure. List of arguments is not a list.")
          #go through all arguments and turn to numeric
          
          if(msg[[2]] %in% private$allowedFuns & (is.na(msg[[4]]) | msg[[4]] %in% private$allowedVars)) {
            session$execute(msg = msg)
          } else {
            session$storeMessage(msg)
          }
        }
      } );
      
      ws$onClose(function() {
        private$onClose(session)
        
        if(!is.null(self$getSession(session$id)))
          self$closeSession(session$id)
      })
      
      ws$send(toJSON(list(type = "ID", id = session$id)))
      
      session$sessionVariables(private$sessionVars)
      session$setLimits(private$limits)
      self$addSession(session)
      
      private$onStart(session)
      private$waiting <- FALSE
    }
    
    list(call = handle_http_request,
         onWSOpen = handle_websocket_open)
  }
))

pkg.env <- new.env()


#' Create a server
#' 
#' \code{openPage} starts a server and opens a new page with a WebSocket connection between it and the current
#' R session. After that, messages can be exchanged between R session and the web page to generate content on the
#' web page and to trigger calculations in R as a response to user activity on the page.
#' 
#' \code{jrc} supports four types of messages:
#' \itemize{
#'    \item{Commands are pieces of R or JavaScript code that will be evaluated on the receiving side. Note, 
#'    that any command from a web page must be authorized in the R session for security reasons. A message 
#'    with information about how to do that is printed in the console each time a command is received. For more
#'    information, please, check \code{\link{sendCommand}}.}
#'    \item{Data is any variable that is sent to or from the R session. It must always come with a 
#'    name of the variable to which it should be assigned on the receiving side. For more information, please,
#'    check \code{\link{sendData}}.}
#'    \item{Function calls can be triggered on each side of the WebSocket connection. Alongside the function name,
#'    one can also send a list of arguments and name of a variable to which the returned value of the function will
#'    be assigned. For more information, please, check \code{\link{callFunction}}.}
#'    \item{Unlike other types of messages, HTML code can be sent only from the R session to a web page. This code will
#'    be added to the body of the page.}
#' }
#' 
#' \code{openPage} function is a wrapper around several methods of class \code{\link{App}}. First, it creates an
#' instance of this class. Then it starts a server that listens to the given port. And finally, it attempts
#' to open a new web page. It also stores a new app object in the package namespace, which allows other
#' wrapper functions to access it.
#' 
#' @param useViewer If \code{TRUE}, the new web page will be opened in the RStudio Viewer. If \code{FALSE},
#' a default web browser will be used (if other is not specified with the \code{browser} argument).
#' @param rootDirectory A path to the root directory for the server. Any file, requested by the server
#' will be searched for in this directory. If \code{rootDirectory} is not 
#' defined, the \code{http_root} in the package directory will be used as a root directory.
#' @param startPage A path to an HTML file that should be used as a starting page of the app.
#' It can be an absolute path to a local file, or it can be relative to the \code{rootDirectory}
#' or to the current R working directory. If \code{startPage} is not defined, an empty page will be used.
#' The file must have \emph{.html} extension.
#' @param port Defines which TCP port the server will listen to. If not defined, random available port
#' will be used (see \code{\link[httpuv]{randomPort}}).
#' @param browser A browser in which to open a new web page.
#' If not defined, default browser will be used. For more information check \code{\link[utils]{browseURL}}.
#' If this argument is specified, \code{useViewer} will be ignored.
#' @param allowedFunctions List of functions that can be called from a web page without any additional actions 
#' on the R side. All other functions will require authorization in the current R session before they are called. 
#' This argument should be a vector of R function names. Check \code{\link{authorize}} and \code{\link{allowFunctions}}
#' for more information. 
#' @param allowedVariables List of variables that can be modified from a web page without any additional actions 
#' on the R side. All other variable reassignments must be confirmed in the current R session. 
#' This argument should be a vector of variable names. Check \code{\link{authorize}} and \code{\link{allowVariables}}
#' for more information.
#' @param allowedDirectories List of directories that can be accessed by the server. This argument should be a vector of
#' paths (absolute or relative to the current working directory) to existing directories. Check \code{\link{allowDirectories}}
#' for more information.
#' @param connectionNumber Maximum number of connections that is allowed to be active simultaneously.
#' @param sessionVars Named list of variables, that will be declared for each session, when a new connection is opened.
#' Any changes to these variables will affect only a certain session. Thus they can be used, for instance, to 
#' store a state of each session. For more information, please, check \code{\link{setSessionVariables}}.
#' @param onStart A callback function that will be executed, when a new connection is opened. This function gets a single 
#' argument, which is an object of class \code{\link{Session}}. General purpose of the function is to populate each 
#' new web page with some default content.
#' @param onClose A callback function that will be executed, when a connection is closed. This function gets a single
#' argument, which is an object of class \code{\link{Session}}. General purpose of the function is to store session 
#' variables if needed or in any other form to finalize user's interaction with the app.
#' @param onlyServer If \code{TRUE}, then an app will initialise without trying to open a new page in a browser.
#' 
#' @seealso \code{\link{closePage}}, \code{\link{setEnvironment}}, \code{\link{setLimits}}, \code{\link{allowVariables}},
#' \code{\link{allowFunctions}}, \code{\link{setSessionVariables}}.
#' 
#' @return Object of class \code{\link{App}}.
#' 
#' @export
#' @import httpuv
#' @importFrom utils browseURL
#' @importFrom utils compareVersion
#' @importFrom utils packageVersion
openPage <- function(useViewer = TRUE, rootDirectory = NULL, startPage = NULL, port = NULL, browser = NULL,
                     allowedFunctions = NULL, allowedVariables = NULL, allowedDirectories = getwd(), 
                     connectionNumber = Inf, sessionVars = NULL, onStart = NULL, onClose = NULL, 
                     onlyServer = FALSE) {
  if(!is.null(pkg.env$app))
    closePage()
  
  app <- App$new(rootDirectory, startPage, onStart, onClose, connectionNumber, allowedFunctions, 
                 allowedVariables, allowedDirectories, sessionVars)
  pkg.env$app <- app
  app$setEnvironment(parent.frame())
  app$startServer(port)
  if(!onlyServer)
    app$openPage(useViewer, browser)
  
  invisible(app)
}

sendMessage <- function(type, id, ...) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")
  
  if(is.null(id))
    id <- pkg.env$app$getSessionIds()
  for(i in id){
    session <- pkg.env$app$getSession(i)
    if(is.null(session)) {
      warning(str_c("There is no session with ID ", i))
    } else {
      tryCatch(session[[type]](...), 
               error = function(e) {
                 if(e$message == "WebSocket is already closed.") {
                   pkg.env$app$closeSession(session)
                   stop(str_c("WebSocket is already closed.", 
                              "Session ", session$id, " has been terminated."))
                 } else {
                   stop(e)
                 }
               })
    }
  }
  
}

#' Send a command to a web page
#' 
#' \code{sendCommand} sends JavaScript code through the selected WebSocket connection and evaluates it on the specified
#' web page. Use JavaScript function \code{jrc.sendCommand} to send R code from the web page
#' and evaluate it in the current R session. All commands send to R from the server will be evaluated
#' only after authorization in the currently running R session (see \code{\link{authorize}}).
#' @details Each opened page gets its own environment, where all the commands are evaluated. Any changes
#' made with the usual assignment operator \code{<-} will be limited to this page-specific environment. The changes
#' are still saved, but can be accessed only with \code{\link{getSessionVariable}} function. To make changes outside
#' of the page-specific environment use \code{<<-} instead.
#' 
#' In JavaScript one should use \code{windows.varibleName = "SomeValue"}
#' instead of \code{varibleName = "SomeValue"}, in order to make the variable accessible outside of the
#' current \code{sendCommand} call.
#' 
#' This function is a wrapper around \code{sendCommand} method of class \code{\link{Session}}.
#' 
#' @param command A line (or several lines separated by \code{\\n}) of JavaScript code. This code
#' will be directly evaluated on the web page. No R-side syntax check is performed.
#' @param sessionId An ID of the session to which the command should be sent. Can also be a vector of multiple session IDs.
#' If \code{NULL}, the command will be sent to all currently active sessions.
#' @param wait If \code{wait > 0}, after sending the message, R will wait for a reply for a given number of seconds. 
#' For this time (or until the reply is received), execution of other commands will be halted. Any incoming message 
#' from the session will be considered as a reply.
#' 
#' @examples  
#' \dontrun{
#' # to run this example an installed web browser is required
#' k <- 0
#' openPage()
#' sendCommand(paste0("button = document.createElement('input');",
#'               "button.type = 'button';",
#'               "button.addEventListener('click', function() {jrc.sendCommand('k <<- k + 1')});", 
#'               "button.value = '+1';",
#'               "document.body.appendChild(button);", collapse = "\n"))
#' closePage()}
#' 
#' @seealso \code{\link{authorize}}, \code{\link{sendData}}, \code{\link{sendHTML}}, \code{\link{callFunction}},
#' \code{\link{openPage}}, \code{\link{getSessionIds}}.
#' 
#' @export
#' @importFrom jsonlite toJSON
sendCommand <- function(command, sessionId = NULL, wait = 0) {
  sendMessage("sendCommand", sessionId, wait = wait, command = command)
}


#' Stop server
#' 
#' Stops the server and closes all currently opened pages (if any). This function is a 
#' wrapper of \code{stopServer} method of class \code{\link{App}}.
#' 
#' @seealso \code{\link{openPage}}
#' 
#' @export
closePage <- function() {
  if(!is.null(pkg.env$app)) {
    pkg.env$app$stopServer()
    pkg.env$app <- NULL
  } else {
    message("There is no opened page.")
  }
}

#' Send data to a web page
#' 
#' Sends a variable to a web page, where it is saved under a specified name. This function
#' is a wrapper around \code{sendData} method of class \code{\link{Session}}.
#' 
#' To send data back from the web page to the current R session one should use\code{jrc.sendData(variableName, variable, internal)}.
#' Its arguments are:
#' 
#' \describe{
#'    \item{\code{variableName}}{
#'       Name that the variable will have in the R session. If variable name hasn't been previously added to the list
#'       of allowed variables (see \code{\link{allowVariables}} or \code{allowedVariables} argument of the \code{\link{openPage}}
#'       function), attempt to assign it from a web page will require manual authorization on the R side.
#'    }
#'    \item{\code{variable}}{
#'       Variable to send.
#'    }
#'    \item{\code{internal} (optional)}{
#'       Whether this variable should be used only by the session that sent it. If \code{true}, variable will be stored
#'       in the session-specific environment and can be accessed from the outside with \code{\link{getSessionVariable}}
#'       function. If \code{false}, variable will be saved to the outer environment of the app (see \code{\link{setEnvironment}}).
#'       By default, uses \code{true} for variables that already exist in the session specific environment 
#'       (see \code{\link{setSessionVariables}} or \code{sessionVariables} argument of the \code{\link{openPage}} function.)
#'       and \code{false} otherwise.
#'    }
#' }
#' 
#' @param variableName Name that the variable will have on the web page.
#' @param variable Variable to send.
#' @param keepAsVector If \code{TRUE}, variables with length 1 will be saved as arrays on the web page, otherwise they 
#' will be converted to atomic types.
#' @param rowwise If \code{TRUE}, matrices and data.frames will be transformed into JavaScript objects or arrays
#' row wise (e.g. a matrix will become an Array of its rows). 
#' @param sessionId An ID of the session to which the data should be sent. Can also be a vector of multiple session IDs.
#' If \code{NULL}, the data will be sent to all currently active sessions.
#' @param wait If \code{wait > 0}, after sending the message, R will wait for a reply for a given number of seconds. 
#' For this time (or until the reply is received), execution of other commands will be halted. Any incoming message 
#' from the session will be considered as a reply.
#' 
#' @examples 
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage()
#' x <- 1:100
#' sendData("x", x)
#' sendCommand("console.log(x);")
#' sendCommand("jrc.sendData('x', x.filter(function(e) {return e % 2 == 0}))")
#' closePage()}
#' 
#' @seealso \code{\link{authorize}}, \code{\link{allowVariables}}, \code{\link{sendCommand}},
#' \code{\link{callFunction}}, \code{\link{sendHTML}}, \code{\link{openPage}}, \code{\link{getSessionIds}}.
#'  
#' @export
#' @importFrom jsonlite toJSON
sendData <- function(variableName, variable, keepAsVector = FALSE, rowwise = TRUE, sessionId = NULL, wait = 0) {
  sendMessage("sendData", sessionId, wait = wait, variableName = variableName, variable = variable, keepAsVector = keepAsVector,
              rowwise = rowwise)
}

#' Set Environment
#' 
#' Defines the outer environment of the app. Outer environment is a parent for all session environments.
#' It is used to store variables that are common for all the client sessions. The only way to make changes outside of
#' the outer environment is to use the global assignment operator \code{<<-} if and only if changes are 
#' made to the variable that does not exist in the outer environment.
#' 
#' By default, an environment where app was initialized (via \code{\link{openPage}} function or with \code{App$new()} call)
#' is used.
#' 
#' This function is a wrapper around \code{setEnvironment} method of class \code{\link{App}}.
#' 
#' @param envir Environment to be used as outer environment. 
#' 
#' @examples
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage()
#' e <- new.env()
#' setEnvironment(e)
#' 
#' sendCommand("jrc.sendData('x', 10)", wait = 3)
#' print(e$x)
#' closePage()
#' }
#' 
#' @export
setEnvironment <- function(envir) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")
  
  pkg.env$app$setEnvironment(envir)
}

#' Send HTML to a web page
#' 
#' Sends a piece of HTML code to a web page and adds it at the end
#' or the \code{body} element. This function is a wrapper around \code{sendHTML} method of 
#' class \code{\link{Session}}.
#' 
#' @param html HTML code that will be added to the web page.
#' @param sessionId An ID of the session to which the HTML should be sent. Can also be a vector of multiple session IDs.
#'  If \code{NULL}, the HTML will be sent to all currently active sessions.
#' @param wait If \code{wait > 0}, after sending the message, R will wait for a reply for a given number of seconds. 
#' For this time (or until the reply is received), execution of other commands will be halted. Any incoming message 
#' from the session will be considered as a reply.
#' 
#' @examples 
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage(FALSE)
#' 
#' sendHTML("Test...")
#' sendHTML("This is <b>bold</b>")
#' sendHTML("<table><tr><td>1</td><td>2</td></tr><tr><td>3</td><td>4</td></tr></table>")}
#' 
#' @seealso \code{\link{sendData}}, \code{\link{sendCommand}}, \code{\link{callFunction}},
#' \code{\link{openPage}}.
#' 
#' @export
sendHTML <- function(html = "", sessionId = NULL, wait = 0) {
  sendMessage("sendHTML", sessionId, wait = wait, html = html)
}

#' Trigger a function call
#' 
#' Calls a function in a web page by its name. It can also pass a list of arguments for the function and 
#' save the returned result to a variable. 
#' 
#' JavaScript counterpart is \code{jrc.callFunction(name, arguments, assignTo, package, internal)}.
#' Its arguments are:
#' \describe{
#'    \item{\code{name}}{
#'       Name of an R function. If function name hasn't been previously added to the list
#'       of allowed functions (see \code{\link{allowFunctions}} or \code{allowedFunctions} argument of \code{\link{openPage}}),
#'       attempt to call it from a web page will require manual authorization on the R side.
#'    }
#'    \item{\code{arguments} (optional)}{
#'       arguments for the function. This should be an Array (for unnamed arguments) or an Object with argument names as keys
#'       (for named arguments).
#'    }
#'    \item{\code{assignTo} (optional)}{
#'       Name of the variable to which the returned value of the function will be assigned in the R session. 
#'       If the variable name hasn't been previously added to the list
#'       of allowed variables (see \code{\link{allowVariables}} or \code{allowedVariables} argument of \code{\link{openPage}}),
#'       attempt to assign it from a web page will require manual authorization on the R side.
#'    }
#'    \item{\code{package} (optional)}{
#'       If the function needs to be imported from an installed package, name of this package.
#'    }
#'    \item{\code{internal} (optional)}{
#'       Whether assignment of the function returned value should happen internally or not. If \code{true}, result will be stored
#'       in the session environment and can be accessed from the outside with \code{\link{getSessionVariable}}
#'       function. If \code{false}, result will be saved to the outer environment of the app (see \code{\link{setEnvironment}}).
#'       By default, uses \code{true} for variables that already exist in the session environment 
#'       (see \code{\link{setSessionVariables}} or \code{sessionVariables} argument of the \code{\link{openPage}} function)
#'       and \code{false} otherwise.
#'    }
#' }
#' 
#' This function is a wrapper
#' around \code{callFunction} method of class \code{\link{Session}}.
#' 
#' @param name Name of the function. If the function is a method of some object
#' its name must contain the full chain of calls (e.g. \code{myArray.sort} or 
#' \code{Math.rand}).
#' @param arguments List of arguments for the function. Note that in JavaScript 
#' arguments must be given in a fixed order, naming is not necessary and will 
#' be ignored.
#' @param assignTo Name of a variable to which will be assigned the returned value
#' of the called function.
#' @param sessionId An ID of the session to which the function call should be sent. Can also be a vector of multiple
#' session IDs. If \code{NULL}, the function call will be sent to all currently active sessions.
#' @param wait If \code{wait > 0}, after sending the message, R will wait for a reply for a given number of seconds. 
#' For this time (or until the reply is received), execution of other commands will be halted. Any incoming message 
#' from the session will be considered as a reply.
#' @param thisArg JavaScript functions (methods) can belong to some object, which 
#' is referred to as \code{this} inside the function (e.g. in
#' \code{someObject.myFunction()} function \code{myFunction} is a method of \code{someObject}).
#' \code{thisArg} specifies object that will be known as \code{this} inside the function. If \code{NULL},
#' the function will use its parent as \code{this} object (as it happens in JavaScript by default).
#' @param ... further arguments passed to \code{\link{sendData}}. It is used to send
#' \code{arguments} to the web page.
#' 
#' @examples 
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage()
#' callFunction("alert", list("Some alertText"))
#' callFunction("Math.random", assignTo = "randomNumber")
#' sendCommand("alert(randomNumber)")
#' closePage()
#' }
#' 
#' @seealso \code{\link{authorize}}, \code{\link{allowFunctions}}, \code{\link{allowVariables}},
#' \code{\link{setEnvironment}}, \code{\link{getSessionIds}}.
#' 
#' @export
callFunction <- function(name, arguments = NULL, assignTo = NULL, wait = 0, sessionId = NULL, thisArg = NULL, ...) {
  sendMessage("callFunction", sessionId, wait = wait, name = name, arguments = arguments, assignTo = assignTo, thisArg = thisArg,
              ...)
}

#' Authorize further message processing
#' 
#' \code{jrc} library allows one to get full control over the currently running R session from 
#' a web page. Therefore for security reasons one should manually authorize function calls,
#' variable assignments or expression evaluations. All the received messages that are not
#' processed automatically are given an ID and stored. This function allows a message with the 
#' given ID to be evaluated. It can also show a short description of the message and give user
#' a choice between running it or discarding.
#' 
#' Expressions has to be always authorized before evaluation. One can specify a list of
#' variables that can be changed automatically and functions that can be called without
#' authorization.
#' 
#' This function is a wrapper around \code{authorize} method of class \code{\link{Session}}.
#' 
#' @param sessionId ID of the session that received the message. If there is only one active session, this 
#' argument becomes optional.
#' @param messageId ID of the message to be processed. If the session has only one stored message, this argument becomes
#' optional.
#' @param show If \code{TRUE} information about the message will be shown first. After that user gets
#' a choice to go on with evaluation, to ignore the message (meaning it will be removed from memory) or to
#' do nothing.
#'
#' @examples
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage()
#' 
#' callFunction("jrc.sendCommand", list("k <<- 10"), wait = 1)
#' allowVariables("x")
#' callFunction("jrc.sendData", list("x", 15), wait = 1)
#' callFunction("jrc.sendData", list("y", 20), wait = 1)
#' msgId <- getMessageIds()
#' authorize(messageId = msgId[1])
#' #run that to first see some information about the message
#' #authorize(messageId = msgId[2], show = TRUE)
#' 
#' closePage()}
#' @seealso \code{\link{allowFunctions}}, \code{\link{allowVariables}}, \code{\link{setLimits}}, \code{\link{getSessionIds}},
#' \code{\link{getMessageIds}}.
#' 
#' @export
#' @importFrom utils menu
authorize <- function(sessionId = NULL, messageId = NULL, show = FALSE) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")  
  
  session <- pkg.env$app$getSession(sessionId)
  if(is.null(session))
    stop(str_c("There is no session with ID ", sessionId))
  
  session$authorize(messageId, show)
}

#' Allow function calls without authorization
#' 
#' Adds R function names to the list of functions, that
#' can be called from a web page without manual confirmation on the R side.
#' 
#' This function is a wrapper around \code{allowFunctions} method of class \code{\link{App}}.
#' 
#' @param funs Vector of function names to be added to the list. If \code{NULL},
#' returns names of all currently allowed R functions.
#' 
#' @return Names of all currently allowed functions if \code{funs = NULL}.
#' 
#' @examples
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage()
#' allowFunctions(c("myFunction1", "print", "someObject$method"))
#' funs <- allowFunctions()
#' closePage()}
#' 
#' @seealso \code{\link{allowVariables}}, \code{\link{authorize}}, \code{\link{openPage}} (check argument
#' \code{allowedFunctions}), \code{\link{callFunction}}.
#' 
#' @export
allowFunctions <- function(funs = NULL) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")
  
  pkg.env$app$allowFunctions(funs)
}

#' Allow variable assignment without authorization
#' 
#' This function adds variable names to the list of variables, that
#' can be modified from a web page without manual confirmation on the R side.
#' 
#' This function is a wrapper around \code{allowVariables} method of class \code{\link{App}}.
#' 
#' @param vars Vector of variable names to be added to the list. If \code{NULL},
#' returns names of all currently allowed variables.
#' 
#' @examples 
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage()
#' allowVariables(c("myVariable", "anotherOne"))
#' vars <- allowVariables()
#' closePage()}
#' 
#' @return Names of all currently allowed variables if \code{vars = NULL}.
#' 
#' @seealso \code{\link{allowFunctions}}, \code{\link{authorize}}, \code{\link{openPage}} (check argument
#' \code{allowedVariables}), \code{\link{sendData}}.
#' 
#' @export
allowVariables <- function(vars = NULL) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")  
  
  pkg.env$app$allowVariables(vars)
}

#' Allow server to access files in a directory
#' 
#' This function adds paths to existing directories to the list of allowed directories,
#' which can be accessed from the server. To any request for files from outside
#' of the allowed directories the server will response with \code{403 Forbidden} error.
#' \code{rootDirectory} (see \code{\link{openPage}}) can always be accessed. By default,
#' when the app is initialized, current working directory  
#' is added to the list of allowed directories. Further changes
#' of the working directory will not have any affect on this list or files accessibility.
#' 
#' This function is a wrapper around \code{allowDirectories} method of class \code{\link{App}}.
#' 
#' @param dirs Vector of paths to existing directories. Can be absolute paths, or paths relative to 
#' the current working directory. If the specified directory doesn't exist, it will be ignored and a
#' warning will be produced. If \code{NULL}, returns absolute paths to all currently allowed directories.
#' 
#' @examples 
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage()
#' # The directories must exist
#' allowDirectories(c("~/directory1", "../anotherDirectory"))
#' dirs <- allowDirectories()
#' closePage()}
#' 
#' @return Absolute paths to all currently allowed directories, if \code{dirs = NULL}.
#' 
#' @seealso \code{\link{openPage}} (check arguments \code{rootDirectory} and \code{allowedDirectories}).
#' 
#' @export
allowDirectories <- function(dirs = NULL) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")  
  
  pkg.env$app$allowDirectories(dirs)
}

#' Set security limits
#' 
#' This function allows to control memory usage and limit number of messages processed per
#' second or simultaneously active connections to the app. 
#'  
#' If an app is deployed on a server and is publicly available, it may be useful to limit
#' resources that are available to each user. There are various things that can be
#' controlled by this function: storage size and number of stored messages, 
#' maximal variable size, number of messages processed per second and bytes received
#' per second.
#'  
#' Messages are all the communication received via web socket from an opened web page.
#' Each message contains a command that is to be evaluated in the R session, name
#' of a function to call or variable to store. If number or size of messages exceeds
#' the preset limit, they are completely ignored by the app.
#' 
#' For security reasons, some messages has to be first authorized by the 
#' \code{\link{authorize}} function, before they can be processed. Such messages
#' are saved until they are manually removed or authorized. If number or total 
#' size of the stored messages exceeds the limits, new messages are still saved, 
#' but the older ones are removed from the memory. If storage size is set to zero
#' no messages can be stored and every message that requires authorization will 
#' be automatically discarded.
#' 
#' Size of variables or messages is estimated in \code{\link[utils]{object.size}}
#' and is always measured in byte.
#' 
#' The limits are set for the entire app and are applied for each new connection.
#' One can also change security limits for any connection separately by using
#' method \code{setLimits} of a corresponding object of class \code{\link{Session}}.
#' 
#' This function is a wrapper for method \code{setLimits} of class \code{\link{App}}.
#' 
#' @param maxCon Maximal allowed number of web socket connections simultaneously. A new
#' connection is established whenever someone requests an HTML page from the server
#' or when the \code{openPage} method of class \code{\link{App}} is used. If number of
#' the allowed connections is reached the newly opened web socked will be immediately
#' closed and the user will see a warning.
#' @param storageSize Maximal total size of all stored messages in bytes.
#' @param storedMsg Maximal number of messages that can be stored simultaneously.
#' @param varSize Maximal size of a variable that can be received from a web page. 
#' Attempt to assign data of larger size to a variable will be ignored.
#' @param msgPerSec Maximal number of messages that can be received per second. 
#' All extra messages will be disposed of immediately without any attempt to 
#' process their content.
#' @param msgSize Maximal allowed size of a message in bytes. Note, that here a
#' size of character string that contains all the received information is estimated.
#' All larger messages will be ignored.
#' @param bytesPerSec Number of bytes that can be received per second. After the 
#' limit is reached, all the incoming messages will be ignored.
#' 
#' @examples 
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage()
#' setLimits(maxCon = 10)
#' setLimits(varSize = 10 * 1024^2)
#' closePage()}
#' 
#' @seealso \code{\link{authorize}}, \code{\link{allowFunctions}}, \code{\link{allowVariables}}.
#' 
#' @export
setLimits <- function(maxCon = NULL, storageSize = NULL, storedMsg = NULL,
                      varSize = NULL, msgPerSec = NULL, msgSize = NULL, 
                      bytesPerSec = NULL) {
  
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")

  pkg.env$app$setLimits(maxCon, storageSize, storedMsg, varSize, msgPerSec, msgSize, 
                        bytesPerSec)
}

#' Get the currently running app
#' 
#' \code{jrc} offers two ways to control an interactive app. One is by using methods of classes
#' \code{\link{App}} and \code{\link{Session}}. This allows one to have any number of apps within one
#' R session, but requires some understanding of object oriented programming. Another way is to use
#' provided wrapper functions that are exported by the package. These functions internally work with 
#' the \code{\link{App}} object, which is stored in the package namespace upon initialization with 
#' \code{\link{openPage}} function. \code{getPage} returns this object if any.
#' 
#' @return Object of class \code{\link{App}} or \code{NULL} if there is no active app.
#' 
#' @export
getPage <- function() {
  pkg.env$app
}

#' Adds variables to a session environment
#' 
#' Each client session in \code{jrc}, gets its own environment that can be accessed only by this
#' session (or from the outside with the \code{\link{getSessionVariable}} function). General purpose
#' of these environments is to store some session-specific information such as state of the app for
#' each user. It can also be used to mask variables from the user: if there are two variables with the
#' same name in the session environment and outside of it, user will not be able to see the latter one.
#' This function adds new variables to a session environment or changes values of some existing ones.
#' 
#' This function is a wrapper around method \code{sessionVariables} of class \code{\link{Session}}.
#' If \code{makeDefault = TRUE}, it is also a wrapper around method \code{sessionVariables} of class
#' \code{\link{App}}. The first one changes the current state of the session environment, while the
#' second specifies default variables for each new session.
#' 
#' @param vars Named list of variables to be added to a session environment. Names are required and 
#' will be used as variable names.
#' @param sessionId ID of the session to which variables should be added. Can also be a vector of
#' multiple session IDs. If \code{NULL}, then variables will be added to all currently active sessions.
#' @param makeDefault If \code{TRUE} then, in addition, the specified variables will be added to each
#' new opened session as default ones.
#' 
#' @examples
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage(allowedFunctions = "f", allowedVariables = "res")
#' 
#' m <- 1
#' f <- function() {v * m}
#' setSessionVariables(list(v = 1:10, m = 2))
#' 
#' sendCommand("jrc.callFunction('f', [], 'res')", wait = 1)
#' print(res)
#' 
#' closePage()}
#' 
#' @seealso \code{\link{getSessionVariable}}.
#' 
#' @export
setSessionVariables <- function(vars, sessionId = NULL, makeDefault = FALSE) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")  
  
  if(makeDefault)
    pkg.env$app$sessionVariables(vars)
  
  if(is.null(sessionId))
    sessionId <- getSessionIds()
  
  stopifnot(is.vector(sessionId))
  
  for(id in sessionId) {
    session <- getSession(id)
    if(!is.null(session)) {
      session$sessionVariables(vars = vars)
    } else {
      warning(str_c("There is no session with ID "), id)
    }
  }
}

#' Get IDs of all active sessions
#' 
#' Returns IDs of all currently active sessions. An ID is a randomly generated combination of 6 letters and
#' numbers that is assigned to each session upon opening. This function is a wrapper around method \code{getSessionIds}
#' of class \code{\link{App}}.
#' 
#' @return Vector of session IDs.
#' 
#' @export
getSessionIds <- function() {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")  
  
  pkg.env$app$getSessionIds()
}

#' Close one or several client sessions
#' 
#' Closes WebSocket connections for the selected client sessions and removes all the related
#' information from memory. If no arguments are provided and there is only one active session,
#' closes it. This function is a wrapper around method \code{closeSession} of 
#' class \code{\link{App}}. 
#' 
#' @param sessionId IDs of the sessions to close. Can be a vector of multiple IDs.
#' @param inactive All sessions that were inactive (didn't receive any messages) for the
#' specified amount of time (in seconds) will be closed.
#' @param old All sessions that were opened for at least specified amount of time (in seconds)
#' will be closed.
#' 
#' @examples
#' \dontrun{
#' # to run this example an installed web browser is required
#' start <- Sys.time()
#' openPage()
#' 
#' app <- getPage()
#' time <- Sys.time()
#' 
#' app$openPage(FALSE)
#' app$openPage(FALSE)
#' 
#' print(getSessionIds())
#' 
#' # No sessions will be closed
#' closeSession(old = Sys.time() - start)
#' print(getSessionIds())
#' 
#' # One session (the one that has been opened first) will be closed
#' closeSession(old = Sys.time() - time)
#' print(getSessionIds())
#' 
#' time <- Sys.time()
#' sendCommand("jrc.sendCommand('print(\"Hi!\")')", sessionId = getSessionIds()[1],  wait = 3)
#' 
#' # this will close all sessions except for the one, that has just send a command to R session
#' closeSession(inactive = Sys.time() - time)
#' 
#' # if there is only one active session, sessionId becomes an optional argument
#' closeSession()
#' 
#' closePage()}
#' 
#' @export
closeSession <- function(sessionId = NULL, inactive = NULL, old = NULL) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")  
  
  pkg.env$app$closeSession(sessionId, inactive, old)  
}

#' Get IDs of all stored messages
#' 
#' Returns IDs of all currently stored messages. 
#' 
#' For security reasons, most of the messages that are received
#' from web pages require manual authorization in the R session with \code{\link{authorize}} function. Until that happens,
#' messages are given randomly generated IDs and are stored in memory. 
#' 
#' This function is a wrapper around method \code{getMessageIds} of class \code{\link{Session}}.
#' 
#' @param sessionId ID of the session for which to return message IDs. Can also be a vector of multiple session IDs.
#' If \code{NULL}, returns message IDs for all currently active sessions.
#' @param simplify If \code{TRUE} and only one session ID is provided (or there is only one active session), returns
#' a vector of message IDs. Otherwise returns a named list with one vector for each requested session.
#' 
#' @return Either a named list or a vector with message IDs.
#' 
#' @seealso \code{\link{authorize}}, \code{\link{getSessionIds}}.
#' 
#' @export
getMessageIds <- function(sessionId = NULL, simplify = TRUE) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")  
  
  if(is.null(sessionId))
    sessionId <- getSessionIds()
  
  stopifnot(is.vector(sessionId))
  
  msgs <- list()
  
  for(id in sessionId) {
    session <- getSession(id)
    if(!is.null(session)) {
      msgs[[id]] <- session$getMessageIds()
    } else {
      warning("There is no session with ID ", id)
    }
  }
  
  if(simplify & length(msgs) == 1)
    msgs <- msgs[[1]]
  
  msgs
}

#' Removes a stored message
#' 
#' Removes a message from the storage of a session. This function is a wrapper around
#' method \code{removeMessage} of class \code{\link{Session}}.
#' 
#' @param sessionId ID of the session from where to remove a message. If there is only one active session, this argument
#' becomes optional.
#' @param messageId ID of the message to remove. If there is only one stored message, this argument becomes optional.
#' 
#' @seealso \code{\link{authorize}}, \code{\link{getMessageIds}}.
#' 
#' @export
removeMessage <- function(sessionId = NULL, messageId = NULL) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")  
  
  session <- getSession(sessionId)
  if(is.null(session))
    stop(str_c("There is no session with ID ", sessionId))
  
  session$removeMessage(messageId)
}

#' Get a session
#' 
#' Returns \code{\link{Session}} by its ID. This function is a wrapper around method
#' \code{getSession} of class \code{\link{App}}.
#' 
#' @param sessionId ID of the session. If there is only one active session, this argument becomes optional.
#' 
#' @return Object of class \code{\link{Session}}.
#' 
#' @export
getSession <- function(sessionId = NULL){
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.") 
  
  pkg.env$app$getSession(sessionId)
}

#' Get a variable from a client session environment
#' 
#' This function returns a variable, how it is seen from a session, e.g. for all the received function calls and
#' commands. It searches for the variable in the session environment first, and then, if variable is not found, checks enclosing 
#' frames of the environment, starting from the outer environment of the app (see \code{\link{setEnvironment}}). If the variable
#' doesn't exist, throws an error.
#' 
#' This function
#' is a wrapper around method \code{sessionVariables} of the class \code{\link{Session}}.
#' 
#' @param varName Name of the variable to search for. Must be a character.
#' @param sessionId ID of the session. If there is only one active session, this argument becomes optional.
#' 
#' @return Requested variable
#' 
#' @examples
#' \dontrun{
#' # to run this example an installed web browser is required
#' f <- function(x) {x * 3}
#' openPage(allowedFunctions = "f", allowedVariables = "k", sessionVars = list(k = 0))
#' k <- getSessionVariable("k")
#' getPage()$openPage(FALSE)
#' id1 <- getSessionIds()[1]
#' id2 <- getSessionIds()[2]
#' sendCommand("jrc.callFunction('f', [10], 'k')", sessionId = id1, wait = 3)
#' sendCommand("jrc.callFunction('f', [20], 'k')", sessionId = id2, wait = 3)
#' k1 <- getSessionVariable("k", id1)
#' k2 <- getSessionVariable("k", id2)
#' 
#' closePage()}
#' 
#' @seealso \code{\link{setSessionVariables}}
#' 
#' @export
getSessionVariable <- function(varName, sessionId = NULL) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.") 
  
  session <- getSession(sessionId)
  if(is.null(session))
    stop(str_c("There is no session with ID ", sessionId))
  
  session$sessionVariables(varName = varName)
}

#' Remove variables from a client session environment
#' 
#' This function removes variables from the environment of a client session. It allows, for instance, to unmask
#' a variable with the same name from the outer app environment (see \code{\link{setEnvironment}}) for the session 
#' (check the example below). This function
#' is a wrapper around method \code{sessionVariables} of the class \code{\link{Session}}.
#' 
#' @param varNames Names of variables to remove.
#' @param sessionId ID of the session. If there is only one active session, this argument becomes optional.
#' 
#' @examples
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage(allowedVariables = "k", sessionVars = list(k = 10))
#' 
#' k <- -1
#' getPage()$openPage(FALSE)
#' id1 <- getSessionIds()[1]
#' id2 <- getSessionIds()[2]
#' removeSessionVariables("k", id1)
#' #this changes global 'k', since the variable is no longer masked
#' sendCommand("jrc.sendData('k', 1)", sessionId = id1, wait = 3)
#' #this doesn't affect global 'k'
#' sendCommand("jrc.sendData('k', 5)", sessionId = id2, wait = 3)
#' local_k <- getSessionVariable("k", id2)
#' 
#' closePage()}
#' 
#' @seealso \code{\link{setSessionVariables}}
#' 
#' @export
removeSessionVariables <- function(varNames, sessionId = NULL) {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.") 
  
  session <- getSession(sessionId)
  if(is.null(session))
    stop(str_c("There is no session with ID ", sessionId))
  
  session$sessionVariables(remove = varNames)
}


#' Get number of the port on which the local server is running
#' 
#' This function returns port number for the running server. By default, a random available port is used. One can also
#' set a port number as an argument of the \code{\link{openPage}} function. The port number can't be changed after the app
#' was initialized.This function
#' is a wrapper around method \code{getPort} of the class \code{\link{App}}.
#' 
#' @seealso \code{\link{openPage}}
#' 
#' @export
getPort <- function() {
  if(is.null(pkg.env$app))
    stop("There is no opened page. Please, use 'openPage()' function to create one.")
  
  pkg.env$app$getPort()
}

#' Listen to the server
#' 
#' When R session is not interactive, messages from the server are not processed automatically. In this case, one needs to 
#' keep this function running.
#' This function, is a wrapper around \code{\link[later]{run_now}} or \code{\link[httpuv]{service}}. It runs 
#' the \code{\link[httpuv]{service}} in a loop with a specified condition.
#' 
#' @param time Time (in seconds), during which the R session should listen to the server. By default, the function runs until
#' it is not interrupted (\code{time = Inf}).
#' @param activeSessions The function runs, until there is at least one active session in the provided app. If there is only
#' one active app, this argument can be set to \code{TRUE} for the same effect.
#' @param condition Custom condition. This argument must be a function that returns \code{TRUE} or \code{FALSE}. R session will 
#' listen to the server, while the condition function returns \code{TRUE}.
#' 
#' @examples
#' \dontrun{
#' # to run this example an installed web browser is required
#' openPage()
#' listen(time = 3)}
#' 
#' @importFrom httpuv service
#' @export
listen <- function(time = Inf, activeSessions = NULL, condition = NULL) {
  if(!is.null(condition)) {
    if(!is.function(condition))
      stop("'codition' must be a function that return TRUE or FALSE")
    message("Condition function is defined. Listening to the server, while it is TRUE")
    while(isTRUE(condition()))
      httpuv::service()
  } else if(!is.null(activeSessions)) {
    if(isTRUE(activeSessions)) {
      if(is.null(pkg.env$app)) 
        stop("There is no opened page. Please, use 'openPage()' function to create one.")
      activeSessions <- pkg.env$app
    }
    if(!("App" %in% class(activeSessions)))
      stop("'activeSessions' must be a jrc app or 'TRUE'")
    
    message("'activeSessions' is defined. Listening to the server, until the app has at least one active session.")
    while(length(activeSessions$getSessionIds()) > 0)
      httpuv::service()    
  } else {
    if(!is.numeric(time))
      stop("'time' must be a number")
    
    t <- Sys.time()
    
    while(difftime(Sys.time(), t, units = "secs") < time)
      httpuv::service()
  }
}