├── .Rbuildignore ├── .gitignore ├── DESCRIPTION ├── NAMESPACE ├── R ├── feedback_footer_githublinks.R ├── gh_prep.R ├── inject.R ├── macros.R ├── make_gist.R ├── overlay.R ├── scan.R ├── setup.R └── theme_github.R ├── README.md ├── inst ├── doc │ └── footer_style.css └── extdata │ └── GitHub-Mark-Light-64px.png └── man ├── auto.page.Rd ├── build_html.Rd ├── check_all_github.Rd ├── create_github_chart.Rd ├── figures └── scan.png ├── github_setup.Rd ├── install_github.Rd ├── macros └── macros.Rd ├── prepare_for_github_chart.Rd ├── scale_social.Rd ├── scan_gh_pkgs.Rd ├── theme_github.Rd └── view_all_sources.Rd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.httr-oauth$ 4 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | # Session Data files 5 | .RData 6 | # Example code in package build process 7 | *-Ex.R 8 | # Output files from R CMD build 9 | /*.tar.gz 10 | # Output files from R CMD check 11 | /*.Rcheck/ 12 | # RStudio files 13 | .Rproj.user/ 14 | # produced vignettes 15 | vignettes/*.html 16 | vignettes/*.pdf 17 | # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3 18 | .httr-oauth 19 | # knitr and R markdown default cache directories 20 | /*_cache/ 21 | /cache/ 22 | # Temporary files created by R markdown 23 | *.utf8.md 24 | *.knit.md 25 | .Rproj.user 26 | *.Rproj 27 | ^#.*$ 28 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: githubtools 2 | Title: Tools for building and using GitHub pkgs. 3 | Version: 0.0.0.9100 4 | Authors@R: person("Jonathan", "Carroll", email = "jono@jcarroll.com.au", role = c("aut", "cre")) 5 | Description: Provides a suite of tools to complement packages stored on or 6 | loaded from GitHub. When building a package, this provides a Rmd macro to insert 7 | a HTML popup bar in the help menu linking back to the GitHub project page to 8 | encourage collaboration. Also able to scan the user's R library for packages 9 | installed from GitHub, analyse their commit frequency, and report back. 10 | Depends: 11 | R (>= 3.3.0) 12 | License: GPL (>=3) 13 | Encoding: UTF-8 14 | LazyData: TRUE 15 | Imports: 16 | magrittr, 17 | dplyr, 18 | github, 19 | lubridate, 20 | ggplot2 21 | RoxygenNote: 5.0.1 22 | Remotes: 23 | jonocarroll/htmlhelp 24 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(auto.page) 4 | export(build_html) 5 | export(check_all_github) 6 | export(create_github_chart) 7 | export(github_setup) 8 | export(install_github) 9 | export(install_remote) 10 | export(install_remotes) 11 | export(prepare_for_github_chart) 12 | export(scale_fill_social) 13 | export(scan_gh_pkgs) 14 | export(social_pal) 15 | export(theme_github) 16 | export(view_all_sources) 17 | import(dplyr) 18 | import(ggplot2) 19 | import(github) 20 | import(magrittr) 21 | importFrom(RCurl,getURL) 22 | -------------------------------------------------------------------------------- /R/feedback_footer_githublinks.R: -------------------------------------------------------------------------------- 1 | #' @importFrom RCurl getURL 2 | github_overlay = function(repo, file=NULL) { 3 | message("in footer") 4 | no_htmlify() 5 | # fn_name = get_fn_name() 6 | stylesheet = paste(readLines(system.file("doc", 'footer_style.css', package="htmlhelp")), collapse = "\n") 7 | # connection = !("try-error" %in% class(try(getURL('rating-widget.com'), silent=TRUE))) 8 | # script = ifelse(connection, 9 | # paste(readLines(system.file("doc", 'rating-script.html', package="htmlhelp")), collapse = "\n"), '') 10 | script = "" 11 | 12 | repo = paste0('http://github.com/', repo) 13 | if(is.null(file)) { 14 | file = repo 15 | } else { 16 | file = paste0(repo, '/blob/master/', file) 17 | } 18 | new_issue = URLencode(paste0(repo, '/issues/new?body=', 'Feedback on `', 'SOMENAME', '()`.')) 19 | # rating = ifelse(connection, paste0('
'), 20 | # '
Internet connection required for ratings.
') 21 | rating = "" 22 | footer = sprintf('', rating, new_issue, file) 30 | 31 | return(paste('', script, footer, sep="\n")) 32 | 33 | } 34 | 35 | # get_stuff <- function() { 36 | # no_htmlify() 37 | # R2Hframe = grep("^Rd2HTML", sapply(sys.calls(), function(a) paste(deparse(a), collapse = "\n"))) 38 | # #return(paste(ls(envir = sys.frame(which = max(R2Hframe))), collapse = "
")) 39 | # return(get("out", envir = sys.frame(which = max(R2Hframe)))) 40 | # } 41 | -------------------------------------------------------------------------------- /R/gh_prep.R: -------------------------------------------------------------------------------- 1 | 2 | #' Prepare Daily Data Ready for Use in a GitHub-Style Chart 3 | #' 4 | #' @param data_agg aggregated daily data 5 | #' @param primaryData name of the primary data column to plot daily 6 | #' @param secondaryData name of the secondary data column to label each daily tile (optional). 7 | #' 8 | #' @return a list object ready for \link{\code{create_github_chart}}. 9 | #' 10 | #' @export 11 | #' 12 | prepare_for_github_chart <- function(data_agg, primaryData, secondaryData="dummy") { 13 | 14 | ## if the secondary column wasn't added, make sure it's there now 15 | if (secondaryData == "dummy") { 16 | data_agg$dummy <- -1 17 | # data_agg[secondaryData <- data_agg$dummy 18 | } 19 | data_agg["primaryData"] <- data_agg[primaryData] 20 | data_agg["secondaryData"] <- data_agg[secondaryData] 21 | if (!all(c("date", primaryData, secondaryData) %in% names(data_agg))) stop("Columns missing from input.") 22 | 23 | if (min(data_agg$date) <= lubridate::today() - lubridate::years(1)) { 24 | ## restrict to the last year 25 | data_agg <- data_agg %>% filter(date > lubridate::today() - lubridate::years(1)) 26 | } else { 27 | ## extend to the last year 28 | data_agg %<>% 29 | merge(data.frame(date = seq(lubridate::today() - lubridate::years(1), min(data_agg$date), "days"), 30 | primaryData = -1, 31 | secondaryData = -1), 32 | all = TRUE) 33 | } 34 | if (max(data_agg$date) <= lubridate::today()) { 35 | ## add data up to today() 36 | data_agg %<>% merge(data.frame(date = seq(max(data_agg$date), lubridate::today(), "days"), 37 | primaryData = -1, 38 | secondaryData = -1), 39 | all = TRUE) 40 | } 41 | 42 | data_agg$secondaryTF <- NA_character_ 43 | data_agg[data_agg["secondaryData"] > 0, "secondaryTF"] <- data_agg[data_agg["secondaryData"] > 0, "secondaryData"] 44 | data_agg[!data_agg["secondaryData"] > 0, "secondaryTF"] <- "" 45 | 46 | data_agg$t.fill <- cut(unlist(data_agg["primaryData"]), breaks = c(-1,0,1,5,10,20,1e5,1e6), right = FALSE, labels = 1:7) 47 | 48 | ## split into weeks 49 | data_agg$c.week <- cut(data_agg$date, breaks = "week", start.on.monday = FALSE, labels = FALSE) 50 | data_agg$c.month <- lubridate::month(data_agg$date, abbr = TRUE, label = TRUE) 51 | data_agg$c.day <- as.integer(lubridate::wday(data_agg$date)) 52 | 53 | ## unique values of month 54 | rl <- rle(as.character(data_agg$c.month)) 55 | month.pos <- data_agg$c.week[cumsum(rl$lengths)] 56 | month.pos <- month.pos[-length(month.pos)] 57 | month.lab <- rl$values[-1] 58 | 59 | gh_object <- list(data = data_agg, 60 | month.pos = month.pos, 61 | month.lab = month.lab, 62 | primaryData = primaryData, 63 | secondaryData = secondaryData) 64 | 65 | return(gh_object) 66 | 67 | } 68 | 69 | 70 | 71 | #' Create a GitHub-style Tile Chart with Social Network Color Palette 72 | #' 73 | #' @param gh_data data prepared with \link{\code{prepare_for_github_chart}} 74 | #' @param user user ID to add to the subtitle 75 | #' @param network which color palette to use, styled after a network (GitHub, Twitter, or StackOverflow). 76 | #' Case insensitive, but will be also be used in the title. 77 | #' 78 | #' @return a ggplot2 object for printing 79 | #' 80 | #' @export 81 | #' 82 | create_github_chart <- function(gh_data, user, network = c("GitHub", "Twitter", "StackOverflow")) { 83 | 84 | gg <- ggplot(gh_data$data, aes(x = c.week, y = c.day, label = gh_data$primaryData)) 85 | gg <- gg + geom_tile(aes(fill = gh_data$data$t.fill), color = "white", size = 0.75) 86 | gg <- gg + geom_text(aes(label = gh_data$data$secondaryTF), size = 3, col = "grey20") 87 | gg <- gg + scale_x_continuous(limits = c(0, max(gh_data$data$c.week) + 1), breaks = gh_data$month.pos, labels = gh_data$month.lab) 88 | gg <- gg + scale_y_reverse(breaks = seq(1,7,1), labels = c("","M","","W","","F","")) 89 | gg <- gg + theme_github() 90 | gg <- gg + scale_fill_social(network) 91 | gg <- gg + labs(x = "", y = "") 92 | gg <- gg + coord_fixed(ratio = 1) 93 | return(gg) 94 | } 95 | -------------------------------------------------------------------------------- /R/inject.R: -------------------------------------------------------------------------------- 1 | #' Install a GitHub package with injected HTML in the help file 2 | #' 3 | #' Behaviour is otherwise identical to \code{\link[devtools]{install_github}} except 4 | #' that some HTML code is carefully inserted in the roxygen2 header. Processing of the 5 | #' roxygen2 code into a .Rd \code{\link[utils]{help}} file is also hijacked and HTML 6 | #' sanitisation is deactivated (for that call only). The injected HTML (static, not 7 | #' user-changeable for now) overlays a pull-up tab at the bottom of HTML help files 8 | #' (such as viewed in RStudio) with some context of the GitHub package, such as links 9 | #' to the source, issues page, version, and author. 10 | #' 11 | #' @details Warning 12 | #' \strong{This function has potential to make damaging changes to your R library, and 13 | #' should not be executed on production or mission-critical setups.} You are invited to carefully 14 | #' scrutinize the source code \url{http://github.com/jonocarroll/githubtools} to ensure that 15 | #' nothing malicious is being done here. 16 | #' 17 | #' @section Limitations: 18 | #' This function is not currently able to install GitHub packages that it itself depends on. Doing so 19 | #' results in failure to re-load the namespace and that's not good. This of course means that it can't 20 | #' self-document with the injected HTML. 21 | #' 22 | #' The full consequences of changing the default parameters has not been explored. Most of the code for 23 | #' this function calls devtools functions, but there is no guarantee attached to any of it. 24 | #' 25 | #' @section If something goes wrong: 26 | #' If you do find a bug that causes something to go wrong, please file an Issue on GitHub. Some steps to 27 | #' try and remedy the failure that I've found to work include 28 | #' \itemize{ 29 | #' \item Restarting the R session and trying again, 30 | #' \item Manually removing the offending package with (\code{utils::\link[utils]{remove.packages}}), 31 | #' \item Manually deleting the library folder for the offending package, 32 | #' \item Installing the GitHub or CRAN version of the package with the standard tools, 33 | #' (i.e. \code{utils::\link[utils]{install.packages}} or \code{devtools::\link[devtools]{install_github}}). 34 | #' } 35 | #' 36 | #' @inheritParams devtools::install_github 37 | #' 38 | #' @references \url{http://github.com/jonocarroll/githubtools} 39 | #' 40 | #' @examples 41 | #' \dontrun{ 42 | #' install_github("jonocarroll/butteRfly") 43 | #' } 44 | #' 45 | #' @export 46 | install_github <- function(repo, username = NULL, ref = "master", subdir = NULL, 47 | auth_token = devtools:::github_pat(quiet), host = "api.github.com", 48 | force = TRUE, quiet = FALSE, ...) { 49 | 50 | ## prevent attempts to remove/re-install a package that githubtools is itself dependent on 51 | ## e.g. removing ggplot2 screws up loading the githubtools namespace 52 | ghtDeps <- gtools::getDependencies("githubtools") 53 | reqRepo <- sub(".*/", "", repo) 54 | if (reqRepo %in% ghtDeps) stop("Not currently able to remove/re-install a package that githubtools depends on.") 55 | 56 | message("Warning: this function has the potential to do damage to your R setup. 57 | It interferes with the devtools install process and injects HTML 58 | into the help files. 59 | 60 | *** DO NOT USE THIS FUNCTION ON PRODUCTION/MISSION CRITICAL SETUPS *** 61 | 62 | Best results are obtained by starting with a fresh R session. 63 | 64 | Refer to http://github.com/jonocarroll/githubtools for further disclaimers. 65 | ") 66 | 67 | continueYN <- readline(prompt = "If you are okay with continuing, please type YES and hit Enter. ") 68 | 69 | waive_blame <- tolower(continueYN) 70 | stopifnot(waive_blame == "yes") 71 | 72 | remotes <- lapply(repo, devtools:::github_remote, username = username, 73 | ref = ref, subdir = subdir, auth_token = auth_token, 74 | host = host) 75 | if (!isTRUE(force)) { 76 | remotes <- Filter(function(x) devtools:::different_sha(x, quiet = quiet), 77 | remotes) 78 | } 79 | githubtools::install_remotes(remotes, quiet = quiet, ...) 80 | } 81 | 82 | #' @export 83 | install_remotes <- function(remotes, ...) { 84 | invisible(vapply(remotes, githubtools::install_remote, ..., FUN.VALUE = logical(1))) 85 | } 86 | 87 | #' @export 88 | install_remote <- function(remote, ..., quiet=FALSE) { 89 | ## hijack devtools:::install_remote to inject some HTML into help files 90 | 91 | stopifnot(devtools:::is.remote(remote)) 92 | 93 | if (any(grepl(remote$repo, installed.packages()[,1]))) utils::remove.packages(remote$repo) 94 | 95 | bundle <- devtools:::remote_download(remote, quiet = FALSE) # quiet = FALSE to force re-install 96 | on.exit(unlink(bundle), add = TRUE) 97 | source <- devtools:::source_pkg(bundle, subdir = remote$subdir) 98 | on.exit(unlink(source, recursive = TRUE), add = TRUE) 99 | metadata <- devtools:::remote_metadata(remote, bundle, source) 100 | 101 | message("*** INJECTING HTML CODE INTO HELP FILE ***") 102 | allrfiles <- dir(file.path(source, "R"), full.names = TRUE) 103 | 104 | for (ifile in allrfiles) { 105 | 106 | # cat(paste0("injecting to ",basename(ifile), "\n")) 107 | 108 | injection <- paste0("#' \\if{html}{\\Sexpr[stage=render, results=text]{githubtools:::github_overlay(", 109 | "'",remote$username,"/",remote$repo,"',", 110 | "'R/",basename(ifile),"')}}") 111 | 112 | rcontent <- file(ifile, "r") 113 | 114 | allLines <- readLines(rcontent, n = -1) 115 | 116 | ## find roxygen functions 117 | ## hooking into @export works if there aren't examples, 118 | ## otherwise the injection is treated as an example. 119 | # returnLines <- which(grepl("#'[ ]+@export", allLines)) 120 | # STILL FAILS IF AFTER @inheritParams or @import 121 | ## NEED A BETTER INJECTION POINT 122 | roxyBlocks <- which(grepl("^#'", allLines)) 123 | runs <- split(roxyBlocks, cumsum(seq_along(roxyBlocks) %in% (which(diff(roxyBlocks)>1)+1))) 124 | # runs = split(seq_along(roxyBlocks), cumsum(c(0, diff(roxyBlocks) > 1))) 125 | # cat(paste0("runs has length ",length(runs))) 126 | if (length(runs) > 0) { 127 | # roxyLines <- lapply(runs, function(x) allLines[roxyBlocks[x]]) 128 | roxyLines <- lapply(runs, function(x) allLines[x]) 129 | for (iblock in seq_along(runs)) { 130 | if (length(roxyLines[[iblock]]) > 5) { ## skip over helper files 131 | # exampleLine <- which(grepl("^#'[ ]+@examples", roxyLines[[iblock]])) 132 | exportLine <- which(grepl("^#'[ ]+@export", roxyLines[[iblock]])) ## check that the fn is exported 133 | if (length(exportLine) != 0) { 134 | injectLine <- 2 ## just after the one-line title... should be safe(r) 135 | allLines[runs[[iblock]][injectLine]] <- paste0("#'\n", injection, "\n#'\n", allLines[runs[[iblock]][injectLine]]) 136 | # if (length(exampleLine) == 0) { 137 | # injectLine <- exportLine 138 | # allLines[runs[[iblock]][injectLine]] <- paste0("#'\n#'\n", injection, "\n#'\n", allLines[runs[[iblock]][injectLine]]) 139 | # # } else if (exportLine < exampleLine) { 140 | # # injectLine <- exportLine 141 | # # allLines[runs[[iblock]][injectLine]] <- paste0("#'\n", injection, "\n#'\n", allLines[runs[[iblock]][injectLine]]) 142 | # } else { 143 | # injectLine <- min(exampleLine) 144 | # allLines[runs[[iblock]][injectLine]] <- paste0("#'\n#'\n", injection, "\n#'\n", allLines[runs[[iblock]][injectLine]]) 145 | # } 146 | } 147 | } 148 | } 149 | } 150 | # returnLines <- which(grepl("#'[ ]+@export", allLines)) 151 | 152 | ## write out the file, but inject the footer code before @export 153 | 154 | # savedLines <- allLines 155 | # message(paste0("*** INJECTING HTML CODE INTO ",basename(ifile)," HELP FILE ***")) 156 | # allLines[returnLines] <- paste0(allLines[returnLines], "\n\n", injection, "\n\n") 157 | # allLines[returnLines] <- paste0("#'\n", injection, "\n#'\n", allLines[returnLines]) 158 | 159 | cat(allLines, file = ifile, sep = "\n") 160 | 161 | close(rcontent) 162 | 163 | } 164 | 165 | # cat(source) 166 | 167 | ## add the GitHub logo to the package help 168 | manfigdir <- file.path(source, "man/figures") 169 | if (!dir.exists(manfigdir)) dir.create(manfigdir) 170 | file.copy(from = system.file("extdata", 'GitHub-Mark-Light-64px.png', package = "githubtools"), 171 | to = manfigdir) 172 | 173 | message("*** REBUILDING HELP FILES WITH INJECTED CODE ***") 174 | devtools::document(pkg = source) 175 | # message("DOCUMENTED.") 176 | retCode <- devtools:::install(source, ..., quiet = quiet, metadata = metadata) 177 | 178 | ## re-write the documentation 179 | # devtools::document(pkg = as.package(remote$repo)) 180 | 181 | # install(source, ..., quiet = quiet, metadata = metadata) 182 | return(invisible(retCode)) 183 | } -------------------------------------------------------------------------------- /R/macros.R: -------------------------------------------------------------------------------- 1 | # This is the secret sauce. It overrides tools:::htmlify in Rd2HTML so that 2 | # it doesn't replace characters with HTML escapes. 3 | # courtesy of @noamross 4 | no_htmlify <- function() { 5 | my_htmlify <- function(x) return(x) 6 | R2Hframe = grep("^Rd2HTML", sapply(sys.calls(), function(a) paste(deparse(a), collapse = "\n"))) 7 | if(length(R2Hframe) != 0) { 8 | assign("htmlify", my_htmlify, envir = sys.frame(which = max(R2Hframe))) 9 | } 10 | } 11 | 12 | 13 | html_raw <- function(text) { 14 | no_htmlify() 15 | return(text) 16 | } 17 | 18 | html_file <- function(filename) { 19 | no_htmlify() 20 | return(paste(readLines(system.file("doc", filename, package=packageName())), collapse = "\n")) 21 | } 22 | 23 | change_stylesheet <- function(sheet) { 24 | R2Hframe = grep("^Rd2HTML", sapply(sys.calls(), function(a) paste(deparse(a), collapse = "\n"))) 25 | if(length(R2Hframe) != 0) { 26 | assign("stylesheet", file.path("..", "doc", sheet), envir = sys.frame(which = max(R2Hframe))) 27 | } 28 | } 29 | 30 | add_stylesheet <- function(sheet) { 31 | no_htmlify() 32 | if(!R.utils::isUrl(sheet)) { 33 | sheet = file.path("..", "doc", sheet) 34 | } 35 | return(paste0('')) 36 | } 37 | 38 | get_fn_name <- function() { 39 | R2Hframe = grep("^Rd2HTML", sapply(sys.calls(), function(a) paste(deparse(a), collapse = "\n"))) 40 | #return(ls(envir = sys.frame(which = max(R2Hframe)))) 41 | return(get("Rd", envir = sys.frame(which = max(R2Hframe)))[[2L]][[1L]]) 42 | } 43 | -------------------------------------------------------------------------------- /R/make_gist.R: -------------------------------------------------------------------------------- 1 | # # # vapply(integer(), identity) #fails : no FUN.VALUE 2 | # # lapply(integer(), identity) 3 | # # Map(identity, integer()) 4 | # # lapply(1:5, identity) 5 | # # Map(identity, 1:5) 6 | # # mapply(identity, 1:5) 7 | # # mapply(identity, integer(0)) 8 | # # 9 | # 10 | # 11 | # vapply(list(x = 1:12, y = 1:12), head, integer(6)) 12 | # # vapply(list(x = 1:12, y = LETTERS[1:12]), head, character(3)) # fails 13 | # vapply(list(), head, integer(0)) 14 | # 15 | # lapply(list(x = 1:12, y = 1:12), head) 16 | # lapply(list(x = 1:12, y = LETTERS[1:12]), head) 17 | # lapply(list(), head) 18 | # 19 | # Map(head, list(x = 1:12, y = 1:12)) 20 | # Map(head, list(x = 1:12, y = LETTERS[1:12])) 21 | # Map(head, list()) 22 | # 23 | # ### 24 | # 25 | # vapply(list(x = 1:12, y = 1:12), head, integer(6)) 26 | # #> x y 27 | # #> [1,] 1 1 28 | # #> [2,] 2 2 29 | # #> [3,] 3 3 30 | # #> [4,] 4 4 31 | # #> [5,] 5 5 32 | # #> [6,] 6 6 33 | # 34 | # # vapply(list(x = 1:12, y = LETTERS[1:12]), head, character(3)) 35 | # vapply(list(), head, integer(0)) 36 | # #> <0 x 0 matrix> 37 | # 38 | # 39 | # lapply(list(x = 1:12, y = 1:12), head) 40 | # #> $x 41 | # #> [1] 1 2 3 4 5 6 42 | # #> 43 | # #> $y 44 | # #> [1] 1 2 3 4 5 6 45 | # #> 46 | # 47 | # lapply(list(x = 1:12, y = LETTERS[1:12]), head) 48 | # #> $x 49 | # #> [1] 1 2 3 4 5 6 50 | # #> 51 | # #> $y 52 | # #> [1] "A" "B" "C" "D" "E" "F" 53 | # #> 54 | # 55 | # lapply(list(), head) 56 | # #> list() 57 | # 58 | # 59 | # Map(head, list(x = 1:12, y = 1:12)) 60 | # #> $x 61 | # #> [1] 1 2 3 4 5 6 62 | # #> 63 | # #> $y 64 | # #> [1] 1 2 3 4 5 6 65 | # #> 66 | # 67 | # Map(head, list(x = 1:12, y = LETTERS[1:12])) 68 | # #> $x 69 | # #> [1] 1 2 3 4 5 6 70 | # #> 71 | # #> $y 72 | # #> [1] "A" "B" "C" "D" "E" "F" 73 | # #> 74 | # 75 | # Map(head, list()) 76 | # #> list() 77 | # 78 | # 79 | # # 80 | # # 81 | # # gist.content <- list( 82 | # # description = "Is there a typesafe way to vapply over a mixed-content list?", 83 | # # public = "true", 84 | # # files = list("vapply-mixed-content-list.R" = list( 85 | # # content = "vapply(list(x = 1:12, y = 1:12), head, integer(6)) 86 | # # vapply(list(x = 1:12, y = LETTERS[1:12]), head, character(3)) 87 | # # vapply(list(), head, integer(0)) 88 | # # 89 | # # lapply(list(x = 1:12, y = 1:12), head) 90 | # # lapply(list(x = 1:12, y = LETTERS[1:12]), head) 91 | # # lapply(list(), head) 92 | # # 93 | # # Map(head, list(x = 1:12, y = 1:12)) 94 | # # Map(head, list(x = 1:12, y = LETTERS[1:12])) 95 | # # Map(head, list())"))) 96 | # # 97 | # # githubtools::github_setup() 98 | # # 99 | # # gist <- jsonlite::toJSON(gist.content, pretty = TRUE, auto_unbox = TRUE) 100 | # # github::create.gist(gist) 101 | # 102 | # ## formatR 103 | # ## tidy.source() 104 | # ## tidy_eval 105 | # 106 | # tidy_eval(text="vapply(list(x = 1:12, y = 1:12), head, integer(6)) 107 | # # vapply(list(x = 1:12, y = LETTERS[1:12]), head, character(3)) 108 | # vapply(list(), head, integer(0)) 109 | # 110 | # lapply(list(x = 1:12, y = 1:12), head) 111 | # lapply(list(x = 1:12, y = LETTERS[1:12]), head) 112 | # lapply(list(), head) 113 | # 114 | # Map(head, list(x = 1:12, y = 1:12)) 115 | # Map(head, list(x = 1:12, y = LETTERS[1:12])) 116 | # Map(head, list())", prefix="#> ") 117 | -------------------------------------------------------------------------------- /R/overlay.R: -------------------------------------------------------------------------------- 1 | #' @importFrom RCurl getURL 2 | github_overlay = function(repo, file=NULL) { 3 | githubtools:::no_htmlify() 4 | stylesheet = paste(readLines(system.file("doc", 'footer_style.css', package = "githubtools")), collapse = "\n") 5 | repolink = paste0('http://github.com/', repo) 6 | if (is.null(file)) { 7 | file = repolink 8 | } else { 9 | file = paste0(repolink, '/blob/master/', file) 10 | } 11 | # new_issue = URLencode(paste0(repo, '/issues/new?body=', 'Feedback on `', 'SOMENAME', '()`.')) 12 | issue <- URLencode(paste0(repolink, '/issues/')) 13 | # gh_image <- system.file("extdata", 'GitHub-Mark-Light-64px.png', package = "githubtools") 14 | gh_image <- "figures/GitHub-Mark-Light-64px.png" 15 | footer = sprintf('', gh_image, repolink, file, issue, repo) 24 | 25 | return(paste('', footer, sep = "\n")) 26 | 27 | # 28 | } 29 | -------------------------------------------------------------------------------- /R/scan.R: -------------------------------------------------------------------------------- 1 | #' Generate a HTML Page of GitHub Tile Charts 2 | #' 3 | #' @param pkg packages to include in the page 4 | #' @param img.dir where the images are stored 5 | #' @param viewer.pane (unused) logical. Use the inbuilt viewer pane? 6 | #' 7 | #' @return location of the stored .html files 8 | #' 9 | #' \if{html}{\Sexpr[stage=render, results=text]{githubtools:::feedback_footer('jonocarroll/githubtools','R/scan.R')}} 10 | #' 11 | #' @export 12 | #' 13 | build_html <- function(pkg=NULL, img.dir=".", viewer.pane=FALSE) { 14 | 15 | img.dir <- normalizePath(img.dir, mustWork=FALSE) 16 | 17 | if(is.null(pkg)) { 18 | img_files <- dir(img.dir, pattern="*.png", full.names=TRUE) 19 | } else { 20 | all_img_files <- dir(img.dir, pattern=".png", full.names=TRUE) 21 | img_matches <- vapply(X=sub("/","~",pkg), FUN=grepl, FUN.VALUE=logical(length(all_img_files)), all_img_files) 22 | img_files <- all_img_files[apply(img_matches, 1, any)] 23 | } 24 | gh_html <- paste0('\n

Generated: ',lubridate::today(),'

\n 25 | \n') 26 | for(i in img_files) { 27 | gh_html <- paste0(gh_html, ' 28 | 29 | \n') 30 | } 31 | gh_html <- paste(gh_html, '
\n \n') 32 | myViewer <- getOption("viewer") 33 | if(!viewer.pane) { 34 | htmlfile <- paste0(img.dir,"/all_gh_img.html") 35 | message(paste0("Storing ",htmlfile," then loading it.")) 36 | write(gh_html, file=htmlfile) 37 | myViewer(url=htmlfile) 38 | } else { 39 | warning("This currently isn't working. Maybe try a pull-request with a solution?") 40 | # tmpfile <- tempfile(pattern="all_gh_img.html", fileext=".html") 41 | # write(gh_html, file=tmpfile) 42 | # myViewer(tmpfile, height=400) 43 | } 44 | # viewer <- getOption("viewer") 45 | return(htmlfile) 46 | 47 | } 48 | 49 | # Make automated paging till response is empty 50 | # https://github.com/cscheid/rgithub/issues/30#issuecomment-150354560 51 | #' Automatically roll-over a search when paginated 52 | #' 53 | #' @param f call to execute 54 | #' @param max.pages max number of pages to traverse (exits earlier if fail or complete) 55 | #' 56 | #' @return evaluates the call and returns the content 57 | #' 58 | #' \feedbackfooter{'jonocarroll/githubtools'}{'R/scan.R'}{TRUE} 59 | #' 60 | #' @export 61 | #' 62 | auto.page <- function(f, max.pages=10) { 63 | 64 | f_call <- substitute(f) 65 | stopifnot(is.call(f_call)) 66 | 67 | i <- 1 68 | req <- list() 69 | result_lst <- list() 70 | 71 | repeat { 72 | 73 | # message(paste0("obtaining page ",i)) 74 | message(".", appendLF=FALSE) 75 | 76 | # Specify the page to download 77 | f_call$page <- i 78 | 79 | req <- tryCatch({ 80 | eval(f_call, parent.frame())}, 81 | error = function(e) { 82 | stop(e) 83 | }) 84 | if(inherits(req, "try-error")) stop("something went wrong with the scrape (autopage)") 85 | 86 | # Last page has empty content 87 | if (length(req$content) <= 0) break 88 | 89 | result_lst[[i]] <- req$content 90 | i <- i + 1 91 | 92 | # only get max max.pages pages 93 | if(i > max.pages) { 94 | message(paste0(" truncating at ",max.pages*30L," commits."), appendLF=TRUE) 95 | break 96 | } 97 | } 98 | 99 | result_req <- req 100 | result_req$content <- unlist(result_lst, recursive = FALSE) 101 | 102 | (result_req) 103 | } 104 | 105 | #' Obtain commit stats for one or more GitHub repos 106 | #' 107 | #' @param pkg character vector of packages to analyse (uses all if not set/\code{NULL}) 108 | #' @param img.dir where to store the generated images 109 | #' @param max.pages maximum number of paginated results (30 commits per page) to scan 110 | #' @param ViewHTML logical. If \code{TRUE}, save the images to \code{img.dir} for loading into a 111 | #' HTML page, otherwise sequentially view the \code{ggplot} objects. 112 | #' 113 | #' @return vector of repositories analysed (as author/repos) 114 | #' 115 | #' \feedbackfooter{'jonocarroll/githubtools'}{'R/scan.R'}{TRUE} 116 | #' 117 | #' @import github 118 | #' @import magrittr 119 | #' @import dplyr 120 | #' @import ggplot2 121 | #' 122 | #' @export 123 | #' 124 | check_all_github <- function(pkg=NULL, img.dir=".", max.pages=10, ViewHTML=TRUE) { 125 | 126 | img.loc <- normalizePath(img.dir, mustWork = FALSE) 127 | 128 | # equivalent to 129 | # gh_list <- view_all_sources(github.only=FALSE) 130 | # but intermediate values required 131 | all_inst <- installed.packages() 132 | pkg_list <- devtools::session_info(rownames(all_inst))$packages 133 | gh_list <- pkg_list[grepl("Github",pkg_list$source), ] 134 | 135 | gh_pkg_loc <- dplyr::add_rownames(data.frame(lib = all_inst[, 2][names(all_inst[, 2]) %in% gh_list$package]), "package") 136 | gh_pkg_loc$full_lib <- apply(gh_pkg_loc[,c("lib", "package")], 1, paste, collapse = "/") 137 | 138 | gh_list$repo <- sub("Github \\((.*?)@.*","\\1", gh_list$source) 139 | gh_list$author <- sub("(^.*?)\\/.*","\\1", gh_list$repo) 140 | gh_list$repodir <- sub(".*?\\/(.*)","\\1", gh_list$repo) 141 | gh_list$age <- lubridate::today() - as.Date(gh_list$date) 142 | 143 | ## logic to determine if each pkg is 144 | ## a) an installed package via author/repo; installed & fullname 145 | ## b) an installed package via just repo; installed & !fullname 146 | ## c) an external package via author/repo; !installed & fullname 147 | ## d) an external package via repo; !installed & !fullname - can't work with this 148 | if (!is.null(pkg)) { 149 | inst.det <- data.frame(pkg, installed = rep(NA, length(pkg)), fullname = rep(NA, length(pkg))) 150 | for (j in seq_along(pkg)) { 151 | if (pkg[j] %in% gh_list$repo) { 152 | inst.det[j,"installed"] <- TRUE 153 | inst.det[j,"fullname"] <- TRUE 154 | } else if (pkg[j] %in% gh_list$repodir) { 155 | inst.det[j,"installed"] <- TRUE 156 | inst.det[j,"fullname"] <- FALSE 157 | } else { 158 | message(paste0(pkg[j]," could not be found in your library, assuming you're just curious.")) 159 | inst.det[j,"installed"] <- FALSE 160 | if (grepl("/", pkg[j])) { 161 | inst.det[j,"fullname"] <- TRUE 162 | } else { 163 | stop(paste0(pkg[j]," doesn't appear to be the full name of a repo and no package of that name is in your library. Nothing more I can do.")) 164 | } 165 | } 166 | } 167 | } else { 168 | message("Scanning all installed packages") 169 | inst.det <- data.frame(pkg = gh_list$repo, installed = TRUE, fullname = TRUE) 170 | pkg <- gh_list$repo 171 | } 172 | 173 | ## grrr... testing against character(0) is a bad idea. just do the full logic 174 | if (any(inst.det$installed)) { 175 | if (length(pkg[inst.det$installed & inst.det$fullname]) > 0 & 176 | length(pkg[inst.det$installed & !inst.det$fullname]) > 0) { 177 | gh_list <- gh_list[is.element(gh_list$repo, pkg[inst.det$installed & inst.det$fullname]) | 178 | is.element(gh_list$repodir, pkg[inst.det$installed & !inst.det$fullname]), ] 179 | } else if (length(pkg[inst.det$installed & inst.det$fullname]) > 0 & 180 | length(pkg[inst.det$installed & !inst.det$fullname]) == 0) { 181 | gh_list <- gh_list[is.element(gh_list$repo, pkg[inst.det$installed & inst.det$fullname]), ] 182 | } else if (length(pkg[inst.det$installed & inst.det$fullname]) == 0 & 183 | length(pkg[inst.det$installed & !inst.det$fullname]) > 0) { 184 | gh_list <- gh_list[is.element(gh_list$repodir, pkg[inst.det$installed & !inst.det$fullname]), ] 185 | } else if (length(pkg[inst.det$installed & inst.det$fullname]) == 0 & 186 | length(pkg[inst.det$installed & !inst.det$fullname]) == 0) { 187 | stop("I can do nothing more with this.") 188 | } 189 | } else { 190 | gh_list <- gh_list[0,] 191 | } 192 | 193 | if (any(!inst.det$installed)) { 194 | gh_list <- rbind(gh_list, 195 | data.frame(package = sub(".*/", "", pkg[!inst.det$installed & inst.det$fullname]), 196 | `*` = NA, 197 | version = NA, 198 | date = NA, 199 | source = NA, 200 | repo = pkg[!inst.det$installed & inst.det$fullname], 201 | author = sub("/.*", "", pkg[!inst.det$installed & inst.det$fullname]), 202 | repodir = sub(".*/", "", pkg[!inst.det$installed & inst.det$fullname]), 203 | age = NA, 204 | check.names = FALSE, stringsAsFactors = FALSE) 205 | ) 206 | } 207 | 208 | full_list <- gh_list 209 | 210 | if (dir.exists(img.loc)) { 211 | message(paste0("Found ", img.loc, ", saving images there.")) 212 | } else { 213 | message(paste0("Could not find directory ", img.loc, ", attempting to create it.")) 214 | tryCatch(dir.create(img.loc), 215 | error = function(e) stop(e), 216 | finally = message("Directory created, saving images there.") 217 | ) 218 | } 219 | 220 | github_setup() 221 | 222 | for (i in 1:nrow(full_list)) { 223 | 224 | this.pkg.installed <- inst.det$installed[i] 225 | this.full <- full_list[full_list$repo == inst.det$pkg[i] | full_list$repodir == inst.det$pkg[i], ] 226 | 227 | message(paste0("Obtaining stats for ", inst.det$pkg[i], " "), appendLF = FALSE) 228 | 229 | year_ago <- format(lubridate::today() - lubridate::days(365), "%Y-%m-%dT%H:%M:%SZ") 230 | ghres <- auto.page(github::get.repository.commits(this.full$author, this.full$repodir, since = year_ago), 231 | max.pages = max.pages) 232 | if (!ghres$ok) stop("something went wrong with the scrape (returned !ok)") 233 | commit_dates <- unlist(lapply(lapply(lapply(ghres$content, "[[", "commit"), "[[", "author"), "[[", "date")) 234 | 235 | contribsDF <- data.frame(commit_dates, commits = 1, stringsAsFactors = FALSE) 236 | contribsDF$date <- as.Date(contribsDF$commit_dates, format = "%Y-%m-%dT%H:%M:%SZ") 237 | contribsDF_agg <- contribsDF %>% group_by(date) %>% summarise(nCommits = n()) %>% 238 | merge(data.frame(date = seq(min(contribsDF$date), max(contribsDF$date), "days")), all = TRUE) 239 | contribsDF_agg[is.na(contribsDF_agg)] <- 0 240 | 241 | gh_data <- prepare_for_github_chart(data_agg = contribsDF_agg, primaryData = "nCommits") 242 | 243 | ## add a red tile for the date this package was installed (if it was) 244 | if (this.pkg.installed) gh_data$data[gh_data$data$date == this.full$date, "t.fill"] <- 7 245 | 246 | gg <- create_github_chart(gh_data, user, network = "GitHub") 247 | 248 | if (this.pkg.installed) { 249 | gg <- gg + labs(title = paste0(this.full$repo, " -- ", as.integer(this.full$age, units = "days"), " days old")) 250 | } else { 251 | gg <- gg + labs(title = paste0(this.full$repo, " -- ", " (not installed locally)")) 252 | } 253 | 254 | if (!ViewHTML) { 255 | message(paste0("\nPlotting ", this.full$repo), appendLF = TRUE) 256 | print(gg) 257 | if (nrow(full_list) > 1) grDevices::devAskNewPage(ask = TRUE) 258 | } else { 259 | ggsave(gg, file = paste0(file.path(img.loc,sub("/","~", this.full$repo)), ".png"), height = 2, width = 10) 260 | } 261 | 262 | message("", appendLF = TRUE) 263 | 264 | } 265 | 266 | return(full_list$repo) 267 | 268 | } 269 | 270 | #' Scan and analyse GitHub R packages 271 | #' 272 | #' @param pkg package to check (local or external) 273 | #' @param img.dir where to store generated images 274 | #' @param ViewHTML logical. If \code{TRUE}, load the relevant images from \code{img.dir} into a 275 | #' HTML page. 276 | #' 277 | #' @return NULL (used for the side effect of generating a .html file in \code{img.dir}) 278 | #' 279 | #' \feedbackfooter{'jonocarroll/githubtools'}{'R/scan.R'}{TRUE} 280 | #' 281 | #' @export 282 | #' 283 | scan_gh_pkgs <- function(pkg=NULL, img.dir=".", max.commits=200, ViewHTML=TRUE) { 284 | 285 | npages <- ceiling(max.commits %/% 30L + (max.commits %% 30L)/30L) 286 | pkg_list <- check_all_github(pkg, img.dir, max.pages=npages, ViewHTML=ViewHTML) 287 | if(ViewHTML) build_html(pkg_list, img.dir) 288 | 289 | } 290 | 291 | #' View Data Related to All Installed Packages 292 | #' 293 | #' This may return a large \code{data.frame} depending on how many packages 294 | #' you have installed (not just loaded). 295 | #' 296 | #' @return data.frame of installed package information 297 | #' 298 | #' \feedbackfooter{'jonocarroll/githubtools'}{'R/scan.R'}{TRUE} 299 | #' 300 | #' @export 301 | #' 302 | view_all_sources <- function(github.only=FALSE) { 303 | 304 | # all_inst <- utils::installed.packages() 305 | # pkg_list <- devtools::session_info(rownames(all_inst))$packages 306 | 307 | all_inst <- installed.packages() 308 | pkg_list <- devtools::session_info(rownames(all_inst))$packages 309 | gh_list <- pkg_list[grepl("Github",pkg_list$source), ] 310 | 311 | if(!github.only) return(pkg_list) 312 | if(github.only) return(gh_list) 313 | 314 | } -------------------------------------------------------------------------------- /R/setup.R: -------------------------------------------------------------------------------- 1 | #' Perform GitHub OAuth setup. 2 | #' 3 | ##' #@param config_file location of the configuration file, default ~/.githuburlcheckr 4 | #' 5 | ##' #@param echo if TRUE print the credentials read from the file to the console. 6 | #' 7 | #' @return a github context object that is used in every github API call issued by the github package. 8 | #' 9 | #' @import github 10 | #' 11 | #' @export 12 | #' 13 | #' @examples 14 | #' \dontrun{ 15 | #' ctx <- github_setup() 16 | #' } 17 | # gith_setup <- function(config_file="~/.githuburlcheckr", echo=FALSE) {} 18 | github_setup <- function() { 19 | 20 | # if(file.exists(config_file)) { 21 | # config <- read.dcf(config_file, fields=c("CLIENT_ID", "CLIENT_SECRET")) 22 | # Sys.setenv(GITHUB_CLIENT_ID = config[, "CLIENT_ID"]) 23 | # Sys.setenv(GITHUB_CLIENT_SECRET = config[, "CLIENT_SECRET"]) 24 | # 25 | # if(echo) { 26 | # print(jsonlite::toJSON(as.list(Sys.getenv(c("GITHUB_CLIENT_ID", 27 | # "GITHUB_CLIENT_SECRET"))), pretty = TRUE)) 28 | # } 29 | # 30 | # ctx <- github::interactive.login(client_id=Sys.getenv("GITHUB_CLIENT_ID"), 31 | # client_secret=Sys.getenv("GITHUB_CLIENT_SECRET"), 32 | # scopes=c("public_repo", "gist", "user")) 33 | 34 | ctx <- github::interactive.login(scopes=c("public_repo", "gist", "user")) 35 | 36 | # } else { 37 | # warning("PLEASE ADD A ~/.githuburlcheckr FILE WITH CONFIGURATION\n 38 | # CLIENT_ID: \n 39 | # CLIENT_SECRET: \n 40 | # AWS_DEFAULT_REGION: ") 41 | # 42 | # } 43 | 44 | return(ctx) 45 | 46 | } 47 | -------------------------------------------------------------------------------- /R/theme_github.R: -------------------------------------------------------------------------------- 1 | #' ggplot2 theme based on the GitHub contribution tile chart 2 | #' 3 | #' Style a tile chart similar to those on \emph{GitHub} profiles. 4 | #' 5 | #' \code{theme_github} implements the standard green tile chart as 6 | #' seen on GitHub profiles. Alternatively, uses a different color scheme 7 | #' in the style of another popular site, e.g. twitter, stackoverflow. 8 | #' 9 | #' 10 | #' @return An object of class \code{\link{theme}}. 11 | #' 12 | #' @export 13 | #' 14 | #' @examples 15 | #' library("ggplot2") 16 | #' ## get data 17 | #' p <- ggplot(commit_data) + geom_tile(aes(x=c.week, y=c.day)) + theme_github() 18 | #' 19 | #' ## Twitter colors 20 | #' p + theme_github(alt="Twitter") 21 | #' 22 | theme_github <- function() { 23 | 24 | # gg <- ggplot(contribsDF_agg, aes(x=c.week, y=c.day)) 25 | # gg <- gg + geom_tile(fill=contribsDF_agg$c.fill, color="white", size=0.75) 26 | # gg <- gg + scale_fill_manual(values=contribsDF_agg$c.fill, guide=FALSE) 27 | # gg <- gg + scale_x_continuous(limits=c(0,max(contribsDF_agg$c.week)+1), breaks=month.pos, labels=month.lab) 28 | # gg <- gg + scale_y_reverse(breaks=seq(1,7,1), labels=c("","M","","W","","F","")) 29 | # gg <- gg + theme_minimal() 30 | # gg <- gg + theme(panel.grid.major=element_blank(), 31 | # panel.grid.minor=element_blank()) 32 | # gg <- gg + labs(x="", y="", title=paste0(full_list[i,"repo"]," -- ",as.integer(full_list[i,"age"],units="days")," days old")) 33 | # gg <- gg + coord_fixed(ratio=1) 34 | 35 | ret <- 36 | theme_minimal() + 37 | theme(panel.grid.major=element_blank()) 38 | # ret <- ret + scale_fill_manual(values=contribsDF_aret$c.fill, guide=FALSE) 39 | # ret <- ret + scale_x_continuous(limits=c(0,54), breaks=month.pos, labels=month.lab) 40 | ret <- ret + theme(panel.grid.major=element_blank(), 41 | panel.grid.minor=element_blank(), 42 | # axis.text.x=element_blank(), 43 | axis.title=element_blank(), 44 | plot.title=element_text(size=14)) 45 | # ret <- ret + theme(aspect.ratio=1) 46 | # ret <- ret + labs(x="", y="", title=paste0(full_list[i,"repo"]," -- ",as.integer(full_list[i,"age"],units="days")," days old")) 47 | ret <- ret + theme(complete = TRUE) 48 | 49 | ret 50 | } 51 | 52 | #' @rdname scale_social 53 | #' @export 54 | scale_fill_social <- function(network=c("GitHub", "Twitter", "StackOverflow"), ...) { 55 | # discrete_scale("fill", "social", social_pal(network = network), breaks=c(-1,0,1,5,10,20,1e5), guide=FALSE, ...) 56 | discrete_scale("fill", "social", social_pal(network = network), guide=FALSE, drop=FALSE, ...) 57 | } 58 | 59 | #' Social networking color palettes (discrete) 60 | #' 61 | #' The hues in each palette are: 62 | #' \itemize{ 63 | #' \item GitHub greens 64 | #' \item Twitter blues 65 | #' \item StackOverflow oranges 66 | #' } 67 | #' 68 | #' @param network which palette to use 69 | #' 70 | #' @rdname scale_social 71 | #' @export 72 | #' @examples 73 | #' library(scales) 74 | #' show_col(social_pal("GitHub")(6)) 75 | #' show_col(social_pal("Twitter")(6)) 76 | #' show_col(social_pal("StackOverflow")(6)) 77 | social_pal <- function(network=c("GitHub", "Twitter", "StackOverflow")) { 78 | # function(n) { 79 | # assert_that(n > 0) 80 | # assert_that(n <= 6) 81 | function(n) { 82 | i <- switch(tolower(network), 83 | github = c("#bbbbbb","#eeeeee","#d6e685","#1e6823","#8cc665","#44a340","#ff0000"), 84 | twitter = c("#bbbbbb","#eeeeee","#9ecae1","#6baed6","#4292c6","#2171b5","#ff0000"), 85 | stackoverflow = c("#bbbbbb","#eeeeee","#fdae6b","#fd8d3c","#f16913","#d94801","#ff0000")) 86 | # unname(colors[i][seq_len(n)]) 87 | } 88 | # return(i) 89 | } 90 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # githubtools 2 | 3 | The goal of githubtools is to ease the integration between GitHub and R. 4 | 5 | ## Installation 6 | 7 | You can install githubtools from github with: 8 | 9 | ```R 10 | # install.packages("devtools") 11 | devtools::install_github("jonocarroll/githubtools") 12 | ``` 13 | 14 | ## Features 15 | 16 | ### Create links back to an installed GitHub package right in the RStudio help viewer. 17 | 18 | ![](http://i.imgur.com/CemtYVA.gif) 19 | 20 | Full credit to @noamross for the 21 | [noamross/htmlhelp](http://github.com/noamross/htmlhelp) package which inspired 22 | and enabled the use of the hijacking of `Rd2HTML`. Full details to follow, but this 23 | currently works on any package installed from GitHub (other than those that this package is 24 | dependent on itself). 25 | 26 | ### Scan installed GitHub packages and analyse them 27 | 28 | Think about your R library right now... How old are the packages you installed 29 | from GitHub? Have the developers been improving those packages in the meantime? 30 | Did you install in the middle of a feature integration? Now you can find out. 31 | 32 | ```R 33 | setwd("tmp_directory") 34 | scan_gh_pkgs() 35 | ``` 36 | 37 | Produces a HTML file displaying an array of GitHub-styled tile graphs, one for 38 | each packge you have installed from GitHub (presumably via 39 | `devtools::install_github()`). Commits for the last 12 months for each 40 | GiHub-loaded package are obtained. Darker green tiles indicate more commits were 41 | performed on that day, lighter green indicates less commits that day. Light grey 42 | indicates no commits that day, and dark grey indicates the boundaries of the 43 | available commits (expanded to the last 12 months). The red tile indicates when 44 | you installed the packge. It should now be clear whether or not you installed 45 | before, during, or after a flurry of commits, or if the developer has been 46 | active/quiet regarding that packge in the last 12 months. 47 | 48 | ![](https://github.com/jonocarroll/githubtools/blob/master/man/figures/scan.png?raw=true) 49 | 50 | This works best if you are authenticated to GitHub. Steps to achieve that to 51 | follow. Note also that this won't search any packages you're currently forking, 52 | as they will be local installs. To view which packages you have installed in all 53 | your libraries (note, this may be a lot) use the convenience wrapper to 54 | `devtools::session_info` which finds *all* installed packages, not just those 55 | currently loaded. 56 | 57 | *NOTE* this will scan the **master** branch of the requested repo. Development that occurs 58 | on a forked branch will not be captured. 59 | 60 | ```R 61 | view_all_sources() 62 | ``` 63 | -------------------------------------------------------------------------------- /inst/doc/footer_style.css: -------------------------------------------------------------------------------- 1 | body { 2 | margin-bottom:30px; 3 | } 4 | 5 | #footer { 6 | position:fixed; 7 | bottom:0; 8 | left:0; 9 | right:0; 10 | height:20px; 11 | background:#444444; 12 | color:white; 13 | overflow:hidden; 14 | vertical-align:middle; 15 | transition:height 0.3s linear; 16 | } 17 | 18 | #footer:hover { height: 80px; } 19 | 20 | div.rw-ui-container { 21 | float:left; 22 | margin-left:10px; 23 | margin-top:20px; 24 | } 25 | 26 | #footer a { 27 | color:white; 28 | padding-left:3px; 29 | vertical-align:middle; 30 | } 31 | 32 | #footer a:hover { 33 | color:#eeeeee; 34 | } 35 | 36 | span#gh-links a { 37 | margin-top:20px; 38 | float:right; 39 | text-align:right; 40 | padding-right:10px; 41 | line-height:0px; 42 | vertical-align:middle; 43 | position:relative; 44 | z-index:9; 45 | } 46 | 47 | span#gh-links img { 48 | height:40px; 49 | vertical-align:middle; 50 | float:left; 51 | display:block; 52 | margin-left:20px; 53 | margin-top:20px; 54 | } 55 | 56 | #lift-anchor { 57 | height:20px; 58 | display:block; 59 | float:center; 60 | background:#ffffff; 61 | vertical-align:middle; 62 | text-align:center; 63 | z-index:1; 64 | } 65 | 66 | #lift-anchor a { 67 | border-radius:10px; 68 | background:#444444; 69 | text-align:center; 70 | font-size:1.8em; 71 | padding-left:15px; 72 | padding-right:15px; 73 | padding-bottom:15px; 74 | padding-top:0px; 75 | vertical-align:bottom; 76 | } 77 | 78 | -------------------------------------------------------------------------------- /inst/extdata/GitHub-Mark-Light-64px.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonocarroll/githubtools/3e5ff870bf3420f0e11a47b5622d992ccf705bb3/inst/extdata/GitHub-Mark-Light-64px.png -------------------------------------------------------------------------------- /man/auto.page.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scan.R 3 | \name{auto.page} 4 | \alias{auto.page} 5 | \title{Automatically roll-over a search when paginated} 6 | \usage{ 7 | auto.page(f, max.pages = 10) 8 | } 9 | \arguments{ 10 | \item{f}{call to execute} 11 | 12 | \item{max.pages}{max number of pages to traverse (exits earlier if fail or complete)} 13 | } 14 | \value{ 15 | evaluates the call and returns the content 16 | 17 | \feedbackfooter{'jonocarroll/githubtools'}{'R/scan.R'}{TRUE} 18 | } 19 | \description{ 20 | Automatically roll-over a search when paginated 21 | } 22 | 23 | -------------------------------------------------------------------------------- /man/build_html.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scan.R 3 | \name{build_html} 4 | \alias{build_html} 5 | \title{Generate a HTML Page of GitHub Tile Charts} 6 | \usage{ 7 | build_html(pkg = NULL, img.dir = ".", viewer.pane = FALSE) 8 | } 9 | \arguments{ 10 | \item{pkg}{packages to include in the page} 11 | 12 | \item{img.dir}{where the images are stored} 13 | 14 | \item{viewer.pane}{(unused) logical. Use the inbuilt viewer pane?} 15 | } 16 | \value{ 17 | location of the stored .html files 18 | 19 | \if{html}{\Sexpr[stage=render, results=text]{githubtools:::feedback_footer('jonocarroll/githubtools','R/scan.R')}} 20 | } 21 | \description{ 22 | Generate a HTML Page of GitHub Tile Charts 23 | } 24 | 25 | -------------------------------------------------------------------------------- /man/check_all_github.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scan.R 3 | \name{check_all_github} 4 | \alias{check_all_github} 5 | \title{Obtain commit stats for one or more GitHub repos} 6 | \usage{ 7 | check_all_github(pkg = NULL, img.dir = ".", max.pages = 10, 8 | ViewHTML = TRUE) 9 | } 10 | \arguments{ 11 | \item{pkg}{character vector of packages to analyse (uses all if not set/\code{NULL})} 12 | 13 | \item{img.dir}{where to store the generated images} 14 | 15 | \item{max.pages}{maximum number of paginated results (30 commits per page) to scan} 16 | 17 | \item{ViewHTML}{logical. If \code{TRUE}, save the images to \code{img.dir} for loading into a 18 | HTML page, otherwise sequentially view the \code{ggplot} objects.} 19 | } 20 | \value{ 21 | vector of repositories analysed (as author/repos) 22 | 23 | \feedbackfooter{'jonocarroll/githubtools'}{'R/scan.R'}{TRUE} 24 | } 25 | \description{ 26 | Obtain commit stats for one or more GitHub repos 27 | } 28 | 29 | -------------------------------------------------------------------------------- /man/create_github_chart.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gh_prep.R 3 | \name{create_github_chart} 4 | \alias{create_github_chart} 5 | \title{Create a GitHub-style Tile Chart with Social Network Color Palette} 6 | \usage{ 7 | create_github_chart(gh_data, user, network = c("GitHub", "Twitter", 8 | "StackOverflow")) 9 | } 10 | \arguments{ 11 | \item{gh_data}{data prepared with \link{\code{prepare_for_github_chart}}} 12 | 13 | \item{user}{user ID to add to the subtitle} 14 | 15 | \item{network}{which color palette to use, styled after a network (GitHub, Twitter, or StackOverflow). 16 | Case insensitive, but will be also be used in the title.} 17 | } 18 | \value{ 19 | a ggplot2 object for printing 20 | } 21 | \description{ 22 | Create a GitHub-style Tile Chart with Social Network Color Palette 23 | } 24 | 25 | -------------------------------------------------------------------------------- /man/figures/scan.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jonocarroll/githubtools/3e5ff870bf3420f0e11a47b5622d992ccf705bb3/man/figures/scan.png -------------------------------------------------------------------------------- /man/github_setup.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/setup.R 3 | \name{github_setup} 4 | \alias{github_setup} 5 | \title{Perform GitHub OAuth setup.} 6 | \usage{ 7 | github_setup() 8 | } 9 | \value{ 10 | a github context object that is used in every github API call issued by the github package. 11 | } 12 | \description{ 13 | #@param config_file location of the configuration file, default ~/.githuburlcheckr 14 | } 15 | \details{ 16 | #@param echo if TRUE print the credentials read from the file to the console. 17 | } 18 | \examples{ 19 | \dontrun{ 20 | ctx <- github_setup() 21 | } 22 | } 23 | 24 | -------------------------------------------------------------------------------- /man/install_github.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/inject.R 3 | \name{install_github} 4 | \alias{install_github} 5 | \title{Install a GitHub package with injected HTML in the help file} 6 | \usage{ 7 | install_github(repo, username = NULL, ref = "master", subdir = NULL, 8 | auth_token = devtools:::github_pat(quiet), host = "api.github.com", 9 | force = TRUE, quiet = FALSE, ...) 10 | } 11 | \arguments{ 12 | \item{repo}{Repository address in the format 13 | \code{username/repo[/subdir][@ref|#pull]}. Alternatively, you can 14 | specify \code{subdir} and/or \code{ref} using the respective parameters 15 | (see below); if both are specified, the values in \code{repo} take 16 | precedence.} 17 | 18 | \item{username}{User name. Deprecated: please include username in the 19 | \code{repo}} 20 | 21 | \item{ref}{Desired git reference. Could be a commit, tag, or branch 22 | name, or a call to \code{\link{github_pull}}. Defaults to \code{"master"}.} 23 | 24 | \item{subdir}{subdirectory within repo that contains the R package.} 25 | 26 | \item{auth_token}{To install from a private repo, generate a personal 27 | access token (PAT) in \url{https://github.com/settings/tokens} and 28 | supply to this argument. This is safer than using a password because 29 | you can easily delete a PAT without affecting any others. Defaults to 30 | the \code{GITHUB_PAT} environment variable.} 31 | 32 | \item{host}{GitHub API host to use. Override with your GitHub enterprise 33 | hostname, for example, \code{"github.hostname.com/api/v3"}.} 34 | 35 | \item{force}{Force installation even if the git SHA1 has not changed since 36 | the previous install.} 37 | 38 | \item{quiet}{if \code{TRUE} suppresses output from this function.} 39 | 40 | \item{...}{Other arguments passed on to \code{\link{install}}.} 41 | } 42 | \description{ 43 | Behaviour is otherwise identical to \code{\link[devtools]{install_github}} except 44 | that some HTML code is carefully inserted in the roxygen2 header. Processing of the 45 | roxygen2 code into a .Rd \code{\link[utils]{help}} file is also hijacked and HTML 46 | sanitisation is deactivated (for that call only). The injected HTML (static, not 47 | user-changeable for now) overlays a pull-up tab at the bottom of HTML help files 48 | (such as viewed in RStudio) with some context of the GitHub package, such as links 49 | to the source, issues page, version, and author. 50 | } 51 | \details{ 52 | Warning 53 | \strong{This function has potential to make damaging changes to your R library, and 54 | should not be executed on production or mission-critical setups.} You are invited to carefully 55 | scrutinize the source code \url{http://github.com/jonocarroll/githubtools} to ensure that 56 | nothing malicious is being done here. 57 | } 58 | \section{Limitations}{ 59 | 60 | This function is not currently able to install GitHub packages that it itself depends on. Doing so 61 | results in failure to re-load the namespace and that's not good. This of course means that it can't 62 | self-document with the injected HTML. 63 | 64 | The full consequences of changing the default parameters has not been explored. Most of the code for 65 | this function calls devtools functions, but there is no guarantee attached to any of it. 66 | } 67 | 68 | \section{If something goes wrong}{ 69 | 70 | If you do find a bug that causes something to go wrong, please file an Issue on GitHub. Some steps to 71 | try and remedy the failure that I've found to work include 72 | \itemize{ 73 | \item Restarting the R session and trying again, 74 | \item Manually removing the offending package with (\code{utils::\link[utils]{remove.packages}}), 75 | \item Manually deleting the library folder for the offending package, 76 | \item Installing the GitHub or CRAN version of the package with the standard tools, 77 | (i.e. \code{utils::\link[utils]{install.packages}} or \code{devtools::\link[devtools]{install_github}}). 78 | } 79 | } 80 | \examples{ 81 | \dontrun{ 82 | install_github("jonocarroll/butteRfly") 83 | } 84 | 85 | } 86 | \references{ 87 | \url{http://github.com/jonocarroll/githubtools} 88 | } 89 | 90 | -------------------------------------------------------------------------------- /man/macros/macros.Rd: -------------------------------------------------------------------------------- 1 | % More secret sauce the \html tag has to be evaluated when you load the help 2 | % file, rather than at package compilation, for the overriding to work. 3 | \newcommand{\html}{\Sexpr[stage=render, results=text]{htmlhelp:::html_raw(#1)}} 4 | 5 | \newcommand{\htmlfile}{\Sexpr[stage=render, results=text]{htmlhelp:::html_file(#1)}} 6 | 7 | \newcommand{\stylesheet}{\Sexpr[stage=render, results=text]{htmlhelp:::change_stylesheet(#1)}} 8 | 9 | \newcommand{\addstylesheet}{\Sexpr[stage=render, results=text]{htmlhelp:::add_stylesheet(#1)}} 10 | 11 | \newcommand{\feedbackfooter}{\Sexpr[stage=render, results=text]{htmlhelp:::feedback_footer(#1, #2)}} -------------------------------------------------------------------------------- /man/prepare_for_github_chart.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gh_prep.R 3 | \name{prepare_for_github_chart} 4 | \alias{prepare_for_github_chart} 5 | \title{Prepare Daily Data Ready for Use in a GitHub-Style Chart} 6 | \usage{ 7 | prepare_for_github_chart(data_agg, primaryData, secondaryData = "dummy") 8 | } 9 | \arguments{ 10 | \item{data_agg}{aggregated daily data} 11 | 12 | \item{primaryData}{name of the primary data column to plot daily} 13 | 14 | \item{secondaryData}{name of the secondary data column to label each daily tile (optional).} 15 | } 16 | \value{ 17 | a list object ready for \link{\code{create_github_chart}}. 18 | } 19 | \description{ 20 | Prepare Daily Data Ready for Use in a GitHub-Style Chart 21 | } 22 | 23 | -------------------------------------------------------------------------------- /man/scale_social.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme_github.R 3 | \name{scale_fill_social} 4 | \alias{scale_fill_social} 5 | \alias{social_pal} 6 | \title{Social networking color palettes (discrete)} 7 | \usage{ 8 | scale_fill_social(network = c("GitHub", "Twitter", "StackOverflow"), ...) 9 | 10 | social_pal(network = c("GitHub", "Twitter", "StackOverflow")) 11 | } 12 | \arguments{ 13 | \item{network}{which palette to use} 14 | } 15 | \description{ 16 | The hues in each palette are: 17 | \itemize{ 18 | \item GitHub greens 19 | \item Twitter blues 20 | \item StackOverflow oranges 21 | } 22 | } 23 | \examples{ 24 | library(scales) 25 | show_col(social_pal("GitHub")(6)) 26 | show_col(social_pal("Twitter")(6)) 27 | show_col(social_pal("StackOverflow")(6)) 28 | } 29 | 30 | -------------------------------------------------------------------------------- /man/scan_gh_pkgs.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scan.R 3 | \name{scan_gh_pkgs} 4 | \alias{scan_gh_pkgs} 5 | \title{Scan and analyse GitHub R packages} 6 | \usage{ 7 | scan_gh_pkgs(pkg = NULL, img.dir = ".", max.commits = 200, 8 | ViewHTML = TRUE) 9 | } 10 | \arguments{ 11 | \item{pkg}{package to check (local or external)} 12 | 13 | \item{img.dir}{where to store generated images} 14 | 15 | \item{ViewHTML}{logical. If \code{TRUE}, load the relevant images from \code{img.dir} into a 16 | HTML page.} 17 | } 18 | \value{ 19 | NULL (used for the side effect of generating a .html file in \code{img.dir}) 20 | 21 | \feedbackfooter{'jonocarroll/githubtools'}{'R/scan.R'}{TRUE} 22 | } 23 | \description{ 24 | Scan and analyse GitHub R packages 25 | } 26 | 27 | -------------------------------------------------------------------------------- /man/theme_github.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/theme_github.R 3 | \name{theme_github} 4 | \alias{theme_github} 5 | \title{ggplot2 theme based on the GitHub contribution tile chart} 6 | \usage{ 7 | theme_github() 8 | } 9 | \value{ 10 | An object of class \code{\link{theme}}. 11 | } 12 | \description{ 13 | Style a tile chart similar to those on \emph{GitHub} profiles. 14 | } 15 | \details{ 16 | \code{theme_github} implements the standard green tile chart as 17 | seen on GitHub profiles. Alternatively, uses a different color scheme 18 | in the style of another popular site, e.g. twitter, stackoverflow. 19 | } 20 | \examples{ 21 | library("ggplot2") 22 | ## get data 23 | p <- ggplot(commit_data) + geom_tile(aes(x=c.week, y=c.day)) + theme_github() 24 | 25 | ## Twitter colors 26 | p + theme_github(alt="Twitter") 27 | 28 | } 29 | 30 | -------------------------------------------------------------------------------- /man/view_all_sources.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scan.R 3 | \name{view_all_sources} 4 | \alias{view_all_sources} 5 | \title{View Data Related to All Installed Packages} 6 | \usage{ 7 | view_all_sources(github.only = FALSE) 8 | } 9 | \value{ 10 | data.frame of installed package information 11 | 12 | \feedbackfooter{'jonocarroll/githubtools'}{'R/scan.R'}{TRUE} 13 | } 14 | \description{ 15 | This may return a large \code{data.frame} depending on how many packages 16 | you have installed (not just loaded). 17 | } 18 | 19 | --------------------------------------------------------------------------------