feat: introduce lintr

.Rbuildignore

@@ -6,6 +6,7 @@
 ^docs$
 ^_pkgdown.yml$
 ^_pkgdown\.yml$
-.github
+^\.github$
 CHANGELOG.md
 vignettes/
+^\.lintr$

.github/workflows/lint.yaml

@@ -0,0 +1,49 @@
+on:
+  push:
+    branches:
+      - main
+      - master
+  pull_request:
+    branches:
+      - main
+      - master
+
+name: lint
+
+jobs:
+  lint:
+    runs-on: macOS-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: r-lib/actions/setup-r@v1
+
+      - name: Query dependencies
+        run: |
+          install.packages('remotes')
+          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
+          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
+        shell: Rscript {0}
+
+      - name: Restore R package cache
+        uses: actions/cache@v2
+        with:
+          path: ${{ env.R_LIBS_USER }}
+          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
+          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
+
+      - name: Install dependencies
+        run: |
+          install.packages(c("remotes"))
+          remotes::install_deps(dependencies = TRUE)
+          remotes::install_cran("lintr")
+        shell: Rscript {0}
+
+      - name: Install package
+        run: R CMD INSTALL .
+
+      - name: Lint
+        run: lintr::lint_package()
+        shell: Rscript {0}

.lintr

@@ -0,0 +1,12 @@
+linters: with_defaults(
+  line_length_linter(120), 
+  commented_code_linter = NULL,
+  object_name_linter = object_name_linter(c("camelCase", "snake_case")),
+  open_curly_linter = NULL,
+  closed_curly_linter = NULL,
+  object_usage_linter = NULL,
+  cyclocomp_linter = cyclocomp_linter(complexity_limit=25)
+  )
+exclude: "# nolint"
+exclude_start: "# start nolint"
+exclude_end: "# end nolint"

CHANGELOG.md

@@ -14,6 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
   running in RStudio or the `getPass` library is installed.
 - The `authenticate` function now supports two-factor authentication.
 - Support `byName()` for the `gateId` argument in `updateGate()`.
+- Introduce `lintr` as a linter with an Actions workflow
 
 ### Changed
 - Fix for [confusing bulk entity retrieval](https://github.com/primitybio/cellengine-r-toolkit/issues/48)
@@ -23,5 +24,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - Fix mangling of experiment properties in `updateGateFamily()`.
 - Fix mangling of experiment properties in `updateGate()`.
 - Remove unused `params` argument from `getExperiment()`.
+- Run `styler` on all files with default params
 
 ### Removed

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: cellengine
 Type: Package
-Title: CellEngine API Toolkit
+Title: 'CellEngine' API Toolkit
 Version: 0.2.0
 Authors@R: c(
     person("Zach", "Bjornson", email = "zbjornson@primitybio.com", role = c("aut", "cre")),

R/annotateFcsFile.R

@@ -16,14 +16,15 @@
 #' @export
 #' @examples
 #' \dontrun{
-#' annotations = list(list(name="annotations 1", value=1), list(name="annotation 2", value="myValue"))
+#' annotations <- list(list(name = "annotations 1", value = 1),
+#'   list(name = "annotation 2", value = "myValue"))
 #' annotateFcsFile(experimentId, fcsFileId, annotations)
 #' }
-annotateFcsFile = function(experimentId, fcsFileId, annotations) {
+annotateFcsFile <- function(experimentId, fcsFileId, annotations) {
   checkDefined(experimentId)
-  experimentId = lookupByName("experiments", experimentId)
+  experimentId <- lookupByName("experiments", experimentId)
   checkDefined(fcsFileId)
-  fcsFileId = lookupByName(paste("experiments", experimentId, "fcsfiles", sep = "/"), fcsFileId, "filename")
-  body = jsonlite::toJSON(list("annotations" = annotations), auto_unbox = TRUE)
+  fcsFileId <- lookupByName(paste("experiments", experimentId, "fcsfiles", sep = "/"), fcsFileId, "filename")
+  body <- jsonlite::toJSON(list("annotations" = annotations), auto_unbox = TRUE)
   basePatch(paste("experiments", experimentId, "fcsfiles", fcsFileId, sep = "/"), body)
 }

R/applyScale.R

@@ -10,23 +10,29 @@
 #' @export
 #' @examples
 #' \dontrun{
-#' applyScale(list(type='LinearScale', minimum=1, maximum=10), c(1, 2, 3, 4, 5))
+#' applyScale(list(type = "LinearScale", minimum = 1, maximum = 10), c(1, 2, 3, 4, 5))
 #'
 #' # Using a Scale from a CellEngine ScaleSet
-#' scaleSet = getScaleSets(experimentId)
-#' chanIdx = 5
+#' scaleSet <- getScaleSets(experimentId)
+#' chanIdx <- 5
 #' applyScale(scaleSet$scales[[1]][chanIdx, "scale"], c(1, 2, 3, 4, 5))
 #' }
-applyScale = function(scale, data, clamp_q=FALSE) {
-  fn = switch(
-    scale$type,
-    "LinearScale" = function(a) { a },
-    "LogScale" = function(a) { log10(pmax(1, a)) },
-    "ArcSinhScale" = function(a) { asinh(a / scale$cofactor) },
-    )
+applyScale <- function(scale, data, clamp_q = FALSE) {
+  fn <- switch(scale$type,
+    "LinearScale" = function(a) {
+      a
+    },
+    "LogScale" = function(a) {
+      log10(pmax(1, a))
+    },
+    "ArcSinhScale" = function(a) {
+      asinh(a / scale$cofactor)
+    },
+  )
 
-  if (clamp_q)
-    data = pmax(pmin(data, scale$maximum), scale$minimum)
+  if (clamp_q) {
+    data <- pmax(pmin(data, scale$maximum), scale$minimum)
+  }
 
   fn(data)
 }

R/authenticate.R

@@ -21,48 +21,52 @@
 #' authenticate("username", Sys.getenv("API_PASSWORD"))
 #'
 #' # If the password is omitted and you're running in RStudio or the getPass
-#' library is installed, a prompt will be displayed.
+#' # library is installed, a prompt will be displayed.
 #' authenticate("username")
 #' }
-authenticate = function(username, password=NA, otp=NA) {
+authenticate <- function(username, password = NA, otp = NA) {
   if (is.na(password)) {
     if (requireNamespace("getPass")) {
-      password = getPass::getPass(msg = "Please enter your password", noblank=T)
+      password <- getPass::getPass(msg = "Please enter your password", noblank = T)
     } else if (rstudioapi::isAvailable()) {
-      password = rstudioapi::askForPassword()
+      password <- rstudioapi::askForPassword()
     }
   }
 
-  body = list(
+  body <- list(
     username = jsonlite::unbox(username),
     password = jsonlite::unbox(password)
   )
 
   if (!is.na(otp)) {
-    if (!is.character(otp))
+    if (!is.character(otp)) {
       stop("OTP must be a string")
+    }
 
-    body$otp = jsonlite::unbox(otp)
+    body$otp <- jsonlite::unbox(otp)
   }
 
   ensureBaseUrl()
-  fullURL = paste(pkg.env$baseURL, "signin", sep = "/")
-  r = httr::POST(fullURL, body = jsonlite::toJSON(body),
-    httr::content_type_json(), httr::user_agent(ua))
+  fullURL <- paste(pkg.env$baseURL, "signin", sep = "/")
+  r <- httr::POST(fullURL,
+    body = jsonlite::toJSON(body),
+    httr::content_type_json(), httr::user_agent(ua)
+  )
 
-  if (httr::status_code(r) == 200)
+  if (httr::status_code(r) == 200) {
     return(invisible())
+  }
 
-  content = httr::content(r, "text", encoding = "UTF-8")
-  parsed = jsonlite::fromJSON(content)
+  content <- httr::content(r, "text", encoding = "UTF-8")
+  parsed <- jsonlite::fromJSON(content)
 
   if (httr::status_code(r) == 400 && parsed$error == '"otp" is required.') {
     if (requireNamespace("getPass")) {
-      otp = getPass::getPass(msg = "Please enter your one-time code", noblank=T)
+      otp <- getPass::getPass(msg = "Please enter your one-time code", noblank = T)
     } else if (rstudioapi::isAvailable()) {
-      otp = rstudioapi::askForPassword("Please enter your one-time code")
+      otp <- rstudioapi::askForPassword("Please enter your one-time code")
     } else if (interactive()) {
-      otp = readline("Please enter your one-time code");
+      otp <- readline("Please enter your one-time code")
     }
     authenticate(username, password, otp)
   } else {

R/createEllipseGate.R

@@ -34,15 +34,14 @@
 #' \dontrun{
 #' createEllipseGate(experimentId, "FSC-A", "FSC-W", "my gate", c(1, 2, 3), c(4, 5, 6))
 #' }
-createEllipseGate = function(experimentId, xChannel, yChannel, name,
-                             x, y, angle, major, minor,
-                             label = c(x, y),
-                             gid = generateId(),
-                             parentPopulationId = NULL, parentPopulation = NULL,
-                             tailoredPerFile = FALSE, fcsFileId = NULL, fcsFile = NULL,
-                             locked = FALSE, createPopulation = TRUE) {
-
-  body = list(
+createEllipseGate <- function(experimentId, xChannel, yChannel, name,
+                              x, y, angle, major, minor,
+                              label = c(x, y),
+                              gid = generateId(),
+                              parentPopulationId = NULL, parentPopulation = NULL,
+                              tailoredPerFile = FALSE, fcsFileId = NULL, fcsFile = NULL,
+                              locked = FALSE, createPopulation = TRUE) {
+  body <- list(
     model = list(
       locked = jsonlite::unbox(locked),
       ellipse = list(
@@ -58,6 +57,8 @@ createEllipseGate = function(experimentId, xChannel, yChannel, name,
     type = jsonlite::unbox("EllipseGate")
   )
 
-  commonGateCreate(body, name, gid, experimentId, parentPopulationId, parentPopulation,
-    tailoredPerFile, fcsFileId, fcsFile, createPopulation)
+  commonGateCreate(
+    body, name, gid, experimentId, parentPopulationId, parentPopulation,
+    tailoredPerFile, fcsFileId, fcsFile, createPopulation
+  )
 }

R/createExperiment.R

@@ -10,7 +10,7 @@
 #' createExperiment() # creates a blank experiment
 #' createExperiment(list("name" = "my experiment"))
 #' }
-createExperiment = function(properties = list(), params = list()) {
-  body = jsonlite::toJSON(properties, null = "null", auto_unbox = TRUE)
+createExperiment <- function(properties = list(), params = list()) {
+  body <- jsonlite::toJSON(properties, null = "null", auto_unbox = TRUE)
   basePost(paste("experiments", sep = "/"), body, params)
 }

R/createGates.R

@@ -21,60 +21,66 @@
 #' @export
 #' @examples
 #' \dontrun{
-#' g1 = list(type = "RectangleGate", xChannel = "FSC-A", yChannel = "SSC-A",
-#'   model = list(rectangle = list(x1 = 1, x2 = 100, y1 = 1, y2 = 100)))
-#' g2 = list(type = "PolygonGate", xChannel = "FSC-A", yChannel = "SSC-A",
-#'   model = list(polygon = list(vertices = c(c(1, 2), c(30, 40), c(50, 60)))))
-#' g3 = list(type = "RangeGate", xChannel = "V450-480-A",
-#'   model = list(range = list(x1 = 1, x2 = 100, y = 0.5)))
+#' g1 <- list(
+#'   type = "RectangleGate", xChannel = "FSC-A", yChannel = "SSC-A",
+#'   model = list(rectangle = list(x1 = 1, x2 = 100, y1 = 1, y2 = 100))
+#' )
+#' g2 <- list(
+#'   type = "PolygonGate", xChannel = "FSC-A", yChannel = "SSC-A",
+#'   model = list(polygon = list(vertices = c(c(1, 2), c(30, 40), c(50, 60))))
+#' )
+#' g3 <- list(
+#'   type = "RangeGate", xChannel = "V450-480-A",
+#'   model = list(range = list(x1 = 1, x2 = 100, y = 0.5))
+#' )
 #'
 #' createGates(experimentId, c(g1, g2, g3))
 #' }
-createGates = function(experimentId, gates) {
+createGates <- function(experimentId, gates) {
   # This function could be friendlier in terms of valdiating gates, but it is
   # an advanced function.
 
   checkDefined(experimentId)
-  experimentId = lookupByName("experiments", experimentId)
+  experimentId <- lookupByName("experiments", experimentId)
 
-  body = lapply(gates, function (g) {
+  body <- lapply(gates, function(g) {
     if (!("label" %in% names(g$model))) {
-      switch (g$type,
+      switch(g$type,
         RectangleGate = {
-          g$model$label = c(
+          g$model$label <- c(
             mean(c(g$model$rectangle$x1, g$model$rectangle$x2)),
             mean(c(g$model$rectangle$y1, g$model$rectangle$y2))
           )
         },
         PolygonGate = {
-          g$model$label = c(
-            mean(g$model$polygon$vertices[,1]),
-            mean(g$model$polygon$vertices[,2])
+          g$model$label <- c(
+            mean(g$model$polygon$vertices[, 1]),
+            mean(g$model$polygon$vertices[, 2])
           )
         },
         EllipseGate = {
-          g$model$label = c(g$model$center[1], g$model$center[2])
+          g$model$label <- c(g$model$center[1], g$model$center[2])
         },
         RangeGate = {
-          g$model$label = c(
+          g$model$label <- c(
             mean(g$model$range$x1, g$model$range$x2),
             g$model$range.y
           )
         }
       )
     }
 
-    if (!("locked" %in% names(g["model"]))) g$model$locked = FALSE
+    if (!("locked" %in% names(g["model"]))) g$model$locked <- FALSE
 
-    if (!("gid" %in% names(g))) g["gid"] = generateId()
+    if (!("gid" %in% names(g))) g["gid"] <- generateId()
 
-    if (!("parentPopulationId" %in% names(g))) g["parentPopulationId"] = list(NULL)
+    if (!("parentPopulationId" %in% names(g))) g["parentPopulationId"] <- list(NULL)
 
-    if (!("tailoredPerFile" %in% names(g))) g["tailoredPerFile"] = FALSE
+    if (!("tailoredPerFile" %in% names(g))) g["tailoredPerFile"] <- FALSE
 
     g
   })
 
-  body = jsonlite::toJSON(body, null = "null", auto_unbox = TRUE)
+  body <- jsonlite::toJSON(body, null = "null", auto_unbox = TRUE)
   basePost(paste("experiments", experimentId, "gates", sep = "/"), body)
 }