R/create_package_instructions.R

In statisticiansix/dockerise:

create_package_instructions <- function(neededPackages,prefer_install=TRUE,buildFolder=NULL){
if(is.null(buildFolder)){
  stop('buildFolder must be specified')
}
  if(!"remotes"%in%neededPackages){
    neededPackages <- unique(c(neededPackages,'remotes'))
  }

  installOrder <- get_package_deps(neededPackages)
  installOrder$Level <- ifelse(installOrder$package%in%neededPackages,1,NA)

  oldInstallOrder <- newInstallOrder <- installOrder
  repeat{
    currentLevel <- max(oldInstallOrder$Level,na.rm=TRUE)
    message(currentLevel)
    currentPackages <- oldInstallOrder[!is.na(oldInstallOrder$Level)&oldInstallOrder$Level==currentLevel,'package']

    all_dependencies <- unique(
      get_package_deps(currentPackages,dependencies=c('Depends','Imports','LinkingTo'),
                       remove=TRUE)
      $package)
    # all_dependencies <- all_dependencies_raw[!all_dependencies_raw%in%currentPackages]

    newInstallOrder <- oldInstallOrder
    newInstallOrder[newInstallOrder$package%in%all_dependencies,'Level'] <- currentLevel+1

    if(identical(oldInstallOrder,newInstallOrder)){
      installOrder <- newInstallOrder
      break
    }else{
      oldInstallOrder <- newInstallOrder
    }
  }

  toInstall <- installOrder[!is.na(installOrder$Level),]
  toInstall$Level <- max(toInstall$Level)-toInstall$Level+1
  toInstall$Level[which(toInstall$package=='remotes')] <- -1

  allPackages <- as.data.frame(available.packages())[,c('Package','Version')];colnames(allPackages) <- c('package','currentversion')
  location <- merge(toInstall,allPackages,all.x=TRUE)
  location$archive <- archive_exists(location$package,location$ondiskversion)
  location$cran <- ifelse(is.na(location$currentversion),FALSE,location$ondiskversion==location$currentversion)
  location$github <- grepl('Github \\(',location$source)
  location$local <- location$source=='local'|(!location$archive&!location$cran&!location$github)
  location$Location <- c('archive','cran','github','local')[apply(location[c('archive','cran','github','local')],1,which)]
  if(any(is.na(location$Location))){
    location$Location[is.na(location$Location)] <- 'local'
  }
  if(prefer_install){
    location$Command <- ifelse(location$Level<=0,
                               sprintf("RUN R -e \"install.packages('%s',dependencies=FALSE,lib='/usr/local/lib/R/library/')\"",location$package),
                               ifelse(location$Location=='cran',
                                      sprintf("RUN R -e \"install.packages('%s',dependencies=FALSE,lib='/usr/local/lib/R/library/')\"",location$package),
                                      ifelse(location$Location=='archive',
                                             sprintf("RUN R -e \"remotes::install_url('%s',dependencies=FALSE,lib='/usr/local/lib/R/library/')\"",get_archive_url(location$package,location$ondiskversion)),
                                             ifelse(location$Location=='github',
                                                    sprintf("RUN R -e \"remotes::install_github('%s',dependencies=FALSE,lib='/usr/local/lib/R/library/')\"",gsub('Github \\(|\\)','',location$source)),
                                                    ifelse(location$Location=='local',
                                                           sprintf("COPY customlibrary/%s /usr/local/lib/R/library/%s",location$package,location$package),
                                                           location$Location)))))
  }else{
    location$Command <- sprintf("ADD customlibrary/%s /usr/local/lib/R/library/%s",location$package,location$package)
    location$local <- TRUE
  }

  installation <- location[order(location$Level),]

  if(any(installation$local)){
    if(dir.exists(sprintf('%s/customlibrary',buildFolder))){
      unlink(sprintf('%s/customlibrary',buildFolder),recursive = TRUE)
    }
    dir.create(sprintf('%s/customlibrary',buildFolder))
    localLocations <- installation$path[installation$local]
    quietlycopy <- sapply(localLocations,function(x){
      file.copy(x,sprintf('%s/customlibrary',buildFolder),recursive=TRUE)
    })
  }


  if(nrow(installation)!=0){
    installation_instructions <- paste(sprintf("RUN R -e \"options(repos = list(CRAN = 'http://mran.revolutionanalytics.com/snapshot/%s/'))\"",Sys.Date()),
                                       # additional,
                                       paste(installation$Command,collapse='\n'),
                                       sep='\n')
  }else{
    installation_instructions <- NULL
  }
  attr(installation_instructions,'table') <- installation

  return(installation_instructions)
}






# write_lines(file,sprintf('%s\\Dockerfile',temporaryFolder))
# #
# # sessionInfo <- devtools::session_info()
# #
# # neededPackages <- c('tidyverse','tidytext','DML','remotes')
# #
# # hope <- create_package_instructions(neededPackages);writeLines(hope,'Test.txt')
# system('docker run -p 8787:8787 -e PASSWORD=a v0')
# #
#
#
#
# # NEED TO CHECK TO SEE IF THE PACKAGE IS UP TO DATE AND IF SO THEN USE THE SNAPSHOTTED CRAN
# # https://colinfay.me/docker-r-reproducibility/
#
# # If you need an older version of devtools you could provide the link the the source and we can change from there. https://cran.r-project.org/src/contrib/Archive/devtools/
#
# # Docker order
#
# # install devtools
#
# # install versions, upgrade=FALSE,
#
# packages <- lapply(sessionDetails$packages,print)