R/startup.R

In fixest: Fast Fixed-Effects Estimations

#----------------------------------------------#
# Author: Laurent Berge
# Date creation: Sat Apr 23 15:33:05 2022
# ~: Startup related functions
#----------------------------------------------#



#' Permanently removes the fixest package startup message
#'
#' Package startup messages can be very annoying, although sometimes they can be necessary. 
#' Use this function to prevent `fixest`'s package startup message from popping when loading. 
#' This will be specific to your current project.
#'
#' @param x Logical, no default. If `FALSE`, the package startup message is removed.
#'
#' @details
#' Note that this function is introduced to cope with the first `fixest` startup message 
#' (in version 0.9.0).
#'
#' This function works only with R >= 4.0.0. There are no startup messages for R < 4.0.0.
#'
fixest_startup_msg = function(x){

  check_arg(x, "logical scalar mbt")

  config_update("fixest_startup_msg", x)

}

initialize_startup_msg = function(startup_msg){
  # When new versions of the package are installed => we reset the display of the startup message
  # we need to keep track of the versions for which this default has been set

  # NOTA:
  # - the variable fixest_version is written when the user uses fixest_startup_msg()
  # - if this function returns TRUE, then it forces the msg to pop

  # NOTA:
  # - one problem is that I check the version using a local variable
  # specific to a project.
  # - this means that when one creates a new project, the message will necessarily pop!
  # - so I MUST turn off the message for newly created projects.
  # otherwise it would be so annoying.
  # - still => this is a problem if the person uses fixest for the first time
  # -> the project can be deemed old, while in fact fixest was never used
  # so startup messages weren't necessary (bc it would break nothing in the existing code)
  # -> new way: I look at the R files to check whether fixest is used:
  # - if TRUE: startup message
  # - if FALSE: nothing
  # - that's quite costly, but should happen only the very first time the package is attached

  # Note that we must return the value of 'fixest_startup_msg' since these are
  # updated only at session restart (and hence are not directly accessible)

  # message("fixest_startup_msg")

  if(getRversion() < "4.0.0"){
    # No startup message for version < 4.0
    # because there's no way to monitor the messages
    return(FALSE)
  }

  if(is_Rmarkdown()){
    # Never in Rmarkdown: too ugly
    return(FALSE)
  }

  if(is.null(find_project_path())){
    return(FALSE)
  }

  # message("getting version")

  previous_version = config_get("fixest_version")
  is_corrupt_version = !is.null(previous_version) && !is_pkg_version(previous_version)

  # message("version is ", previous_version)

  if(is.null(previous_version)){
    # compatibility with previous versions
    # message("trying to get version from renviron")
    previous_version = renvir_get("fixest_version")
  }

  current_version = fixest_version()

  if(!is_pkg_version(current_version)){
    # If we're here, it's a bug: this should NEVER happen
    return(FALSE)
  }

  if(!is_pkg_version(previous_version)){
    # We first update the version
    # message("updating the version")
    config_update("fixest_version", current_version)

    # message("Is fixest used? ", is_fixest_used())

    # Is it a new project? Or was fixest simply never used before?
    if(!is_corrupt_version && is_fixest_used()){
      # => message
      # Since I register versions since 0.9.0, this means that the
      # version of fixest used was anterior => all msgs should pop

      config_update("fixest_startup_msg", TRUE)
      return(TRUE)
    } else {
      # fixest was never used or the version was corrupt
      # => we don't show any message since it will not break any existing code
      config_update("fixest_startup_msg", FALSE)
      return(FALSE)
    }

    # message("updating done ")

  } else if(!identical(previous_version, current_version)){

    if(version2num(current_version) < version2num(previous_version)){
      # Can happen in projects shared in the cloud
      # In that case, we don't touch the startup message

      msg = paste0("The current project used 'fixest' version ", previous_version, ", but the current version is only ", current_version, ". Maybe update the package?")
      packageStartupMessage(fit_screen(msg, 1))

    } else {

      # A) we update the version
      config_update("fixest_version", current_version)

      # B) we reset the value of fixest_startup_msg
      #    only if the previous_version is anterior to the version that introduced the
      #    message (means the message SHOULD pop since it would be the first time)

      max_version_msg = names(startup_msg)[1]

      if(version2num(previous_version) < version2num(max_version_msg)){
        # You force a startup message even if it was turned off in a previous version

        # use case:
        # - v0.9.0: startup message, user uses fixest_startup_msg(FALSE)
        # - v0.10.0: new breaking changes, you want to inform the user even if he had set
        # fixest_startup_msg(FALSE) in v0.9.0
        #

        config_update("fixest_startup_msg", previous_version)
        return(previous_version)

      } else {
        # The previous version is already posterior to the last message
        # => no startup message any more

        config_update("fixest_startup_msg", FALSE)
        return(FALSE)
      }
    }
  }

  # If null, we'll get the value thanks to renvir_get("fixest_startup_msg")
  # but in some instances, it may be corrupt, so we fix it
  res = config_get("fixest_startup_msg")
  if(is.null(res)){
    # corrupt situation (can occur in dev)
    config_update("fixest_startup_msg", FALSE)
    return(FALSE)
  }

  return(res)
}

version2num = function(x){
  sum(as.numeric(strsplit(x, "\\.")[[1]]) * c(1e6, 1e3, 1))
}

fixest_version = function(){
  as.character(packageVersion("fixest"))
}

is_pkg_version = function(x){
  length(x) == 1 && is.character(x) && length(strsplit(x, "\\.")[[1]]) == 3
}

is_fixest_used = function(){
  # To return TRUE:
  # - fixest in the files
  # - + file saved > 7 days
  #
  # - if fixest but file saved < 7 days, very likely a new project

  # Only level 1 recursivity
  files = list.files(pattern = "\\.(r|R)$")
  dirs = c("./", list.dirs(recursive = FALSE))
  sub_files = unlist(lapply(dirs, list.files, pattern = "\\.(r|R)$", full.names = TRUE))
  file_extra = if(file.exists(".Rprofile")) ".Rprofile" else NULL

  files = c(files, file_extra, sub_files)
  files = files[!dir.exists(files)]

  if(length(files) == 0) return(FALSE)

  big_text = lapply(files, readLines, warn = FALSE)

  # we get the files that have fixest in them
  id_fixest = which(sapply(big_text, function(x) any(grepl("fixest", x, fixed = TRUE))))

  fixest_files = files[id_fixest]
  if(length(fixest_files) == 0) return(FALSE)

  now = Sys.time()

  for(f in fixest_files){
    f_created = file.mtime(f)
    if("POSIXt" %in% class(f_created)){
      d = as.numeric(difftime(now, f_created, units = "days"))
      if(d > 7){
        return(TRUE)
      }
    }
  }

  return(FALSE)
}

renvir_get = function(key){
  # Get the values of envir variables
  # we also evaluate them

  value_raw = Sys.getenv(key)

  if(value_raw == ""){
    return(NULL)
  }

  # Any default value should be able to be evaluated "as such"
  value_clean = gsub("__%%;;", "\n", value_raw)
  value_clean = gsub("&quot;", '"', value_clean)
  value_clean = gsub("&apos;", "'", value_clean)

  value = eval(str2lang(value_clean))

  return(value)
}

find_project_path = function(force = FALSE){
  # finds the root directory
  # we just look up the search path to find the root
  # Only works for Rstudio projects!

  past_path = "init"
  path = normalizePath(".", "/")

  is_found = FALSE
  i = 1
  nmax = 10
  while(past_path != path && i <= nmax){
    i = i + 1
    if(length(list.files(path, pattern = "Rproj$")) > 0){
      is_found = TRUE
      break
    } else {
      past_path = path
      path = dirname(path)
    }
  }

  proj_path = NULL
  if(is_found){
    proj_path = path
  }

  if(force && is.null(proj_path)){
    proj_path = normalizePath(".", "/")
  }

  proj_path
}

find_renviron = function(path = NULL){
  # Simply attaches .Renviron to the project path

  if(is.null(path)){
    proj_path = find_project_path()
    if(is.null(proj_path)) return(NULL)
  } else {
    if(!dir.exists(path)){
      if(file.exists(path)){
        path = dirname(path)
      } else {
        stop_up("The path provided in 'save' does not exist.", .up = 2)
      }
    }

    proj_path = path
  }

  file.path(proj_path, ".Renviron")
}

renvir_update = function(key, value){
  # Updates the .Renviron file
  # asks permission to the user => avoids messing up their workspace!
  # I was thinking to add an argument path, given by the user... but in fact no
  # the .Renviron works only at the Rstudio project level so making the user think
  # that giving a path for saving would help is misleading, since the .Renviron from
  # that path very likely wouldn't be loaded

  check_arg(key, "character scalar mbt")
  check_arg(value, "NULL mbt")

  renv_path = find_renviron()

  if(is.null(renv_path)){
    message("The 'save' feature only works with Rstudio projects. The root directory of the Rstudio project could not be found: settings cannot be saved at the project level, sorry.")
    return(NULL)
  }

  message("To save the settings at the project level 'fixest' needs to update the '.Renviron' file, currently located at:\n\n ", renv_path, "\n\n If the path indeed leads to your current project, do you give persmission? ")

  consent = readline("ok/y/yes to consent:")
  consent = tolower(trimws(consent))

  if(!consent %in% c("ok", "y", "ye", "yes")){
    message("aborting save")
    return(NULL)
  }

  if(file.exists(renv_path)){
    file = file(renv_path, "r", encoding = "UTF-8")

    renvir_raw = readLines(file)

    close(file)
  } else {
    renvir_raw = ""
  }

  all_keys = trimws(gsub("=.*", "", renvir_raw))

  do_write = TRUE
  if(is.null(value)){

    line_to_drop = all_keys == key
    if(any(line_to_drop)){
      renvir_raw = renvir_raw[!line_to_drop]
    } else {
      do_write = TRUE
    }

  } else {

    # we need to do some extra legwork... => sys env don't do quotes
    value_text = paste(deparse(value, width.cutoff = 500), collapse = "\n")
    value_text = gsub("\n", "__%%;;", value_text)
    value_text = gsub("\"", "&quot;", value_text)
    value_text = gsub("'", "&apos;", value_text)

    key_line = all_keys == key
    renvir_raw = c(renvir_raw[!key_line], paste0(key, " = ", value_text))
  }

  if(do_write){
    file = file(renv_path, "w", encoding = "UTF-8")

    renvir_raw = writeLines(renvir_raw, file)

    close(file)
  }


}

find_config_path = function(){

  if(getRversion() < "4.0.0"){
    return(NULL)
  }

  dir = tools::R_user_dir("fixest", "config")

  # We create the directory if needed
  if(!dir.exists(dir)){
    dir.create(dir, recursive = TRUE)
  }

  dir = normalizePath(dir, "/")

  file.path(dir, "fixest_config.csv")
}


config_update = function(key, value){

  if(getRversion() < "4.0.0"){
    return(NULL)
  }

  path = find_config_path()
  proj = find_project_path(force = TRUE)

  if(file.exists(path)){
    data = read.csv(path)
  } else {
    data = data.frame(proj = proj, fixest_version = fixest_version(), stringsAsFactors = FALSE)
  }

  if(!key %in% names(data)){
    data[[key]] = NA_character_
  }

  if(!proj %in% data$proj){
    row = data[1, , drop = FALSE]
    for(i in 1:ncol(row)) row[1, i] = NA
    row[1, 1] = proj
    data = rbind(data, row)
  }

  i = which(data$proj %in% proj)

  data[["fixest_version"]][i] = fixest_version()

  if(is.null(value)) value = "NULL"
  data[[key]][i] = as.character(value)

  write.csv(data, path, row.names = FALSE)
}

config_get = function(key){

  path = find_config_path()

  if(is.null(path) || !file.exists(path)){
    return(NULL)
  }

  data = read.csv(path)

  proj = find_project_path(force = TRUE)

  if(!proj %in% data$proj){
    return(NULL)
  }

  i = which(data$proj %in% proj)

  value = data[[key]][i]

  if(is.character(value) && value %in% c("NULL", "TRUE", "FALSE")){
    value = str2lang(value)
  }

  value
}