R/getGitInfo.R

In envDocument: Document the R Working Environment

#' Get git repository information for a script
#' 
#' \code{getGitInfo} locates the git repository for the calling script
#' (if any) and retrieves relevant informaiton such as last commit, status
#' (e.g. modified since last commit) and tag (if any).
#' 
#' Requires that \code{git2r} be installed.
#' 
#' @param scriptpath Path to script (optional, defaults to calling script from get_scriptPath())
#' 
#' @examples
#' git_info <- getGitInfo()
#' 
#' @export
#' 
getGitInfo <- function(scriptpath = NA) {
  
  # check whether git2r is installed
  if (!requireNamespace("git2r", quietly = TRUE)) {
    warning("Package git2r is needed by getGitInfo. Please install it or call env_doc(git = FALSE).",
         call. = FALSE)
    return(infoNotFound())
  }
  
  # look up script 
  if(is.na(scriptpath)) {
    scriptpath <- try(getScriptPath(), silent = TRUE)
    
    if( inherits(scriptpath, "try-error") ) {
      warning("Unable to look up git information; could not determine calling script\n",
              scriptpath)
      return(infoNotFound())
    }
  }
  
  scriptRepo <- try(getRepo(scriptpath), silent = TRUE)
  
  if( inherits(scriptRepo, "try-error") ) {
    warning(scriptRepo)
    return(infoNotFound())
  }
  
  # get branch information.  
  local <- try(git2r::repository_head(scriptRepo)) 

  if( inherits(local, "try_error") | is.null(local)) {
    return(infoNotFound())
  }
  
  branchname <- try(local$name, silent = TRUE)
  
  if( inherits(branchname, "try-error") | is.null(branchname)) {
    branchname <- infoNotFound()
  }
  
  
  results <- data.frame( Name = "Branch",
                         Value = branchname)
 
   # get last commit info
  lastCommit <- git2r::commits(scriptRepo, n = 1)[[1]]
  
  # ifelse isn't working as expected here.
  last <- NULL

  last <- as.data.frame(lastCommit) # will methods::as work on S3?
  
  # has the file been changed since last commit
  changed <- fileStatus(scriptRepo, scriptpath) # need to update for git2r >= v0.22.1
  
  results <- rbind(results,
                   data.frame( Name = c("Commit Hash", 
                                        "Commit Time", 
                                        "Status"),
                               Value = c(substring(last$sha, 1, 7), 
                                         as.character.Date(last$when), 
                                         changed) 
                   ))
  
  # see if commit is tagged
  tagString <- getTag(scriptRepo)
  
  if(!is.null(tagString)) {
    results <- rbind(results, data.frame( Name = "Tag", Value = tagString))
  }
  
  # get remote based on local head
  remotes <- remoteInfo(scriptRepo)
  results <- rbind(results, remotes)
  
  return(results)
}