tic

DESCRIPTION

@@ -19,7 +19,7 @@ Authors@R:
              email = "[email protected]"),
       person(given = "Maëlle",
              family = "Salmon",
-             role = "ctb",
+             role = "aut",
              email = "[email protected]",
              comment = c(ORCID = "0000-0002-2815-0399")))
 Description: Setting up R project directories for teaching, presenting, analysis,
@@ -56,10 +56,12 @@ Imports:
     gh,
     git2r,
     glue,
-    praise
+    praise,
+    travis
 Remotes:
     r-lib/usethis,
-    metrumresearchgroup/covrpage
+    metrumresearchgroup/covrpage,
+    ropenscilabs/travis
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 6.1.1
 URL: https://github.com/lockedata/starters, https://itsalocke.com/starters/

R/createAnalysisProject.R

@@ -41,7 +41,10 @@ createAnalysisProject <- function(name, title = NULL,
 
   current_proj <- get_current_proj()
   tryCatch({
-    createBasicProject(
+    if(!is.null(external_setup)){
+      external_setup$project_type <- "analysis"
+    }
+    .createBasicProject(
       name = name,
       title = title,
       folder = folder,
@@ -52,6 +55,7 @@ createAnalysisProject <- function(name, title = NULL,
       reset = FALSE
     )
     createdirs(dirs)
+    git_add_infrastructure()
   },
   error = function(e) {
     message(paste("Error:", e$message))

R/createBasicProject.R

@@ -1,43 +1,4 @@
-#' Create a very basic project directory
-#'
-#' @param name Project
-#' @param title "What the Project Does (One Line, Title Case)"
-#'              If NULL, a random one will be generated.
-#' @param folder Folder under which to create the project
-#' @param initial_status initial repostatus.org status for the project,
-#'                       whose badge will be added to the README.
-#' @param packagedeps Set a tool for package reproducibility
-#' @param git Configure Git
-#' @param external_setup How to do the partly interactive setup
-#'  of online git, CI and coverage platforms. If NULL, no setup.
-#'  \itemize{
-#'  \item \code{git_service} Only "GitHub" is supported at the moment.
-#'  \item \code{login} username or organization name to use for the git service.
-#'                If NULL, no GitHub repo is created.
-#'  \item \code{private} whether to make the created repo private
-#'  \item \code{protocol} "ssh" or "https", protocol to use for GitHub
-#'  \item \code{ci_activation} Only NULL, and "travis" are supported at the moment.
-#'  "travis" means calling \code{usethis::use_travis()} and adding the Travis
-#'  badge to the README.
-#'  }
-#' @param reset Whether to reset the project to current project
-#'
-#' @export
-#'
-#' @examples
-#' \dontrun{
-#' folder <- tempdir()
-#' createBasicProject(
-#'   name = "doggos", title = "Counting cute dogs",
-#'   folder = folder,
-#'   packagedeps = "none",
-#'   git = TRUE, external_setup = NULL,
-#'   reset = TRUE
-#' )
-#' list.files(file.path(folder, "doggos"))
-#' unlink(file.path(folder, "doggos"))
-#' }
-createBasicProject <- function(name, title = NULL,
+.createBasicProject <- function(name, title = NULL,
                                folder = getwd(),
                                initial_status = "wip",
                                packagedeps = "checkpoint",
@@ -47,7 +8,8 @@ createBasicProject <- function(name, title = NULL,
                                  login = gh::gh_whoami()$login,
                                  private = FALSE,
                                  protocol = "ssh",
-                                 ci_activation = "travis"
+                                 ci_activation = "travis",
+                                 project_type = "basic",
                                ),
                                reset = TRUE) {
   if (missing(name)) stop("name is required")
@@ -112,7 +74,8 @@ createBasicProject <- function(name, title = NULL,
         login = external_setup$login,
         private = external_setup$private,
         protocol = external_setup$protocol,
-        ci_activation = external_setup$ci_activation
+        ci_activation = external_setup$ci_activation,
+        project_type = external_setup$project_type
       )
     }
 
@@ -135,6 +98,71 @@ createBasicProject <- function(name, title = NULL,
   invisible(TRUE)
 }
 
+
+#' Create a very basic project directory
+#'
+#' @param name Project
+#' @param title "What the Project Does (One Line, Title Case)"
+#'              If NULL, a random one will be generated.
+#' @param folder Folder under which to create the project
+#' @param initial_status initial repostatus.org status for the project,
+#'                       whose badge will be added to the README.
+#' @param packagedeps Set a tool for package reproducibility
+#' @param git Configure Git
+#' @param external_setup How to do the partly interactive setup
+#'  of online git, CI and coverage platforms. If NULL, no setup.
+#'  \itemize{
+#'  \item \code{git_service} Only "GitHub" is supported at the moment.
+#'  \item \code{login} username or organization name to use for the git service.
+#'                If NULL, no GitHub repo is created.
+#'  \item \code{private} whether to make the created repo private
+#'  \item \code{protocol} "ssh" or "https", protocol to use for GitHub
+#'  \item \code{ci_activation} Only NULL, and "travis" are supported at the moment.
+#'  "travis" means calling \code{usethis::use_travis()} and adding the Travis
+#'  badge to the README.
+#'  }
+#' @param reset Whether to reset the project to current project
+#'
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' folder <- tempdir()
+#' createBasicProject(
+#'   name = "doggos", title = "Counting cute dogs",
+#'   folder = folder,
+#'   packagedeps = "none",
+#'   git = TRUE, external_setup = NULL,
+#'   reset = TRUE
+#' )
+#' list.files(file.path(folder, "doggos"))
+#' unlink(file.path(folder, "doggos"))
+#' }
+createBasicProject <- function(name, title = NULL,
+                               folder = getwd(),
+                               initial_status = "wip",
+                               packagedeps = "checkpoint",
+                               git = TRUE,
+                               external_setup = list(
+                                 git_service = "GitHub",
+                                 login = gh::gh_whoami()$login,
+                                 private = FALSE,
+                                 protocol = "ssh",
+                                 ci_activation = "travis"
+                               ),
+                               reset = TRUE) {
+  if(!is.null(external_setup)){
+    external_setup$project_type <- "basic"
+  }
+  .createBasicProject(name = name, title = title,
+                      folder = folder,
+                      initial_status = initial_status,
+                      packagedeps = packagedeps,
+                      git = git,
+                      external_setup = external_setup,
+                      reset = reset)
+}
+
 #' @export
 
 #' @describeIn createBasicProject aesthetic addition for continuity purposes

R/createPackageProject.R

@@ -132,6 +132,7 @@ createPackageProject <- function(name, title = NULL,
         if (pkgdown) {
           file.create(file.path(usethis::proj_get(),
                                 "_pkgdown.yml"))
+          usethis::use_build_ignore("_pkgdown.yml")
         }
 
         if (!is.null(external_setup)) {
@@ -142,17 +143,21 @@ createPackageProject <- function(name, title = NULL,
             login = external_setup$login,
             private = external_setup$private,
             protocol = external_setup$protocol,
-            ci_activation = external_setup$ci_activation
+            ci_activation = external_setup$ci_activation,
+            project_type = "package",
+            coverage = coverage
           )
         }
 
         # README
         knit_readme()
 
+        # dummy test
+        usethis::use_testthat()
+        usethis::use_test(name = "sample", open = FALSE)
+
         # add everything
-        repo <- git2r::init(usethis::proj_get())
-        git2r::add(repo, path = dir(usethis::proj_get()))
-        git2r::commit(repo, message = "add infrastructure")
+        git_add_infrastructure()
              }
     },
     error = function(e) {

R/createTrainingProject.R

@@ -66,7 +66,10 @@ createTrainingProject <- function(name, title = NULL,
   message("Creating skeleton")
   current_proj <- get_current_proj()
   tryCatch({
-    createBasicProject(
+    if(!is.null(external_setup)){
+      external_setup$project_type <- "training"
+    }
+    .createBasicProject(
       name = name,
       title = title,
       folder = folder,
@@ -77,6 +80,7 @@ createTrainingProject <- function(name, title = NULL,
       reset = FALSE
     )
     createdirs(dirs)
+    git_add_infrastructure()
 
 
     # Handouts prep

R/external_setup.R

@@ -5,12 +5,17 @@
 #' @param ci_activation how to activate CI stuff
 #' @param project project name (repo name)
 #' @param title project title (repo description)
+#' @param project_type what kind of project it is
+#' @param coverage coverage service
 #' @noRd
 
 setup_repo <- function(git_service, login,
                        private, protocol,
                        ci_activation,
-                       name, title) {
+                       name, title,
+                       project_type,
+                       coverage = NULL) {
+
   if (tolower(git_service) != "github") {
     stop(glue::glue(
       "Only GitHub is supported at the moment, not {git_service}."
@@ -25,6 +30,11 @@ setup_repo <- function(git_service, login,
     name = name, title = title
   )
 
+  # coverage
+  if(!is.null(coverage)){
+    add_coverage_badge(login, name, coverage)
+  }
+
   if (!is.null(ci_activation)) {
     if (ci_activation != "travis") {
       stop(glue::glue(
@@ -35,8 +45,71 @@ setup_repo <- function(git_service, login,
     }
 
     if (ci_activation == "travis") {
-      usethis::use_travis()
+      usethis::use_template("dot-travis.yml",
+                            save_as = ".travis.yml",
+                            package = "travis")
+      usethis::use_build_ignore(".travis.yml")
+      travis::travis_enable(repo = travis::github_repo(path = usethis::proj_get()))
+      # copy custom tic depending on proj
+      usethis::use_template(file.path("tic", project_type,
+                                      "tic.R"),
+                            save_as = "tic.R",
+                            package = "starters",
+                            data = list(coverage_service = coverage))
+      usethis::use_build_ignore("tic.R")
+
+
+      if (project_type != "basic"){
+        travis::use_travis_deploy(path = usethis::proj_get())
+      }
+
+      # in all cases
+      travis::travis_set_pat(repo = travis::github_repo(path = usethis::proj_get()))
+
+      add_travis_badge(login, name)
+      repo <- git2r::init(usethis::proj_get())
+      git2r::add(repo, path = ".travis.yml")
     }
   }
 }
 
+#' Add Travis badge to the README
+#' @param login login (assumed to be the same for the git
+#' platform and Travis)
+#' @param name project name (repo name)
+#' @noRd
+add_travis_badge <- function(login, name) {
+  # from https://github.com/r-lib/usethis/blob/02fc4b20f022b0b98afcb323ef770fd78c00ae5a/R/ci.R#L39
+  url <- glue::glue("https://travis-ci.org/{login}/{name}")
+  img <- glue::glue("{url}.svg?branch=master")
+  usethis::use_badge("Travis build status", url, img)
+}
+
+#' Add coverage badge to the README
+#' @param login login (assumed to be the same as for the git
+#' platform)
+#' @param name project name (repo name)
+#' @param coverage coverage service
+#' @noRd
+add_coverage_badge <- function(login, name, coverage) {
+  github_repo_spec <- paste(login, name, sep ="/")
+  if(coverage == "codecov"){
+    # from https://github.com/r-lib/usethis/blob/85bf30af12dc5a99faf20115a0396add72aa6d12/R/coverage.R#L47
+    url <- glue::glue("https://codecov.io/gh/{github_repo_spec}?branch=master")
+    img <- glue::glue(
+      "https://codecov.io/gh/{github_repo_spec}/branch/master/graph/badge.svg"
+    )
+    usethis::use_badge("Codecov test coverage", url, img)
+
+  }else{
+
+    if(coverage == "coveralls"){
+      # from https://github.com/r-lib/usethis/blob/85bf30af12dc5a99faf20115a0396add72aa6d12/R/coverage.R#L56
+      url <- glue::glue("https://coveralls.io/r/{github_repo_spec}?branch=master")
+      img <- glue::glue(
+        "https://coveralls.io/repos/github/{github_repo_spec}/badge.svg"
+      )
+      usethis::use_badge("Coveralls test coverage", url, img)
+    }
+  }
+}

R/github.R

@@ -61,30 +61,32 @@ setup_gh_repo <- function(username, private, protocol,
     endpoint <- "POST /user/repos"
   }
 
-  quoted_expression <- quote(gh::gh(endpoint,
-                                    org = username,
-                                    name = name,
-                                    description = title,
-                                    private = private
-  ))
+  quoted_expression <- call("gh",
+                            endpoint = endpoint,
+                            org = username,
+                            name = name,
+                            description = title,
+                            private = private
+                            )
   ok <- gh_retry(quoted_expression)
   if (!ok){
     stop("GitHub repo creation failed.")
   }
 
   r <- git2r::repository(usethis::proj_get())
-  origin_url <- switch(protocol, https = create$clone_url,
-    ssh = create$ssh_url
+  origin_url <- switch(protocol,
+                       https = glue::glue("https://github.com/{username}/{name}.git"),
+                       ssh = glue::glue("[email protected]:{username}/{name}.git")
   )
   git2r::remote_add(r, "origin", origin_url)
   git2r::checkout(r, "master")
-  # git2r::branch_set_upstream(git2r::repository_head(r),
-  #                           "origin/master")
-  desc::desc_set("URL", create$html_url,
+  # not possible cf https://github.com/ropensci/git2r/issues/133
+  #git2r::branch_set_upstream(git2r::repository_head(r), "origin/master")
+  desc::desc_set("URL", glue::glue("https://github.com/{username}/{name}"),
     file = usethis::proj_get()
   )
   desc::desc_set("BugReports",
-    paste0(create$html_url, "/issues"),
+                 glue::glue("https://github.com/{username}/{name}/issues"),
     file = usethis::proj_get()
   )
 }

R/use_readme.R

@@ -2,6 +2,7 @@ use_readme <- function(name){
   usethis::use_template("README.Rmd",
                         data = list(Package = name),
                         package = "starters")
+  usethis::use_build_ignore("README.Rmd")
 }