Create style.yaml

.github/workflows/style.yaml

@@ -0,0 +1,85 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  pull_request:
+    paths:
+      [
+        "**.[rR]",
+        "**.[qrR]md",
+        "**.[rR]markdown",
+        "**.[rR]nw",
+        "**.[rR]profile",
+      ]
+  workflow_dispatch:
+
+name: style
+
+permissions: read-all
+
+jobs:
+  style:
+    runs-on: ubuntu-latest
+    permissions:
+      contents: write
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - name: Checkout repo
+        uses: actions/checkout@v4
+        with:
+          fetch-depth: 0
+
+      - name: Setup R
+        uses: r-lib/actions/setup-r@v2
+        with:
+          use-public-rspm: true
+
+      - name: Install dependencies
+        uses: r-lib/actions/setup-r-dependencies@v2
+        with:
+          extra-packages: any::styler, any::roxygen2
+          needs: styler
+
+      - name: Enable styler cache
+        run: styler::cache_activate()
+        shell: Rscript {0}
+
+      - name: Determine cache location
+        id: styler-location
+        run: |
+          cat(
+            "location=",
+            styler::cache_info(format = "tabular")$location,
+            "\n",
+            file = Sys.getenv("GITHUB_OUTPUT"),
+            append = TRUE,
+            sep = ""
+          )
+        shell: Rscript {0}
+
+      - name: Cache styler
+        uses: actions/cache@v4
+        with:
+          path: ${{ steps.styler-location.outputs.location }}
+          key: ${{ runner.os }}-styler-${{ github.sha }}
+          restore-keys: |
+            ${{ runner.os }}-styler-
+            ${{ runner.os }}-
+
+      - name: Style
+        run: styler::style_pkg()
+        shell: Rscript {0}
+
+      - name: Commit and push changes
+        run: |
+          if FILES_TO_COMMIT=($(git diff-index --name-only ${{ github.sha }} \
+              | egrep --ignore-case '\.(R|[qR]md|Rmarkdown|Rnw|Rprofile)$'))
+          then
+            git config --local user.name "$GITHUB_ACTOR"
+            git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com"
+            git commit ${FILES_TO_COMMIT[*]} -m "Style code (GHA)"
+            git pull --ff-only
+            git push origin
+          else
+            echo "No changes to commit."
+          fi

R/add_node_to_doc.R

@@ -42,7 +42,6 @@
 #' @noRd
 #'
 add_node_to_doc <- function(xml_doc, new_node, nodes_nb = 1, parent_path) {
-
   # Checking that parent_path is valid xpath for xml_doc
   if (is.null(get_nodes(xml_doc, parent_path))) {
     warning(paste("Given xpath is not a valid one:", parent_path))

R/add_stics_nodes.R

@@ -24,8 +24,6 @@
 #'
 add_stics_nodes <- function(xml_doc, formalism_name = NULL, nodes_nb = 1,
                             stics_version = "latest") {
-
-
   # Getting nodes types that may be added to xml_doc
   node_types <- get_xml_base_node()
 

R/all_in_par.R

@@ -1,4 +1,3 @@
-
 #' Return all possible STICS inputs parameters
 #'
 #' @description Helper function to print the list of all possible parameters
@@ -20,21 +19,23 @@
 #' @noRd
 #'
 all_in_par <- function(stics_version = "latest") {
-
   # Checking and getting the right version
   stics_version <- check_version_compat(stics_version = stics_version)
 
   #  if (get_version_num(stics_version = stics_version) < 9.2) {
   #    cols_idx <- 1:4
   #  } else {
-  cols_idx <- c(1, 4, 7:8,2)
+  cols_idx <- c(1, 4, 7:8, 2)
   #  }
 
   par_df <- utils::read.csv2(
     file.path(
-      get_examples_path(file_type = "csv",
-                        stics_version = stics_version),
-      "inputs.csv"),
+      get_examples_path(
+        file_type = "csv",
+        stics_version = stics_version
+      ),
+      "inputs.csv"
+    ),
     header = FALSE,
     stringsAsFactors = FALSE
   )[, cols_idx]
@@ -81,13 +82,11 @@ all_in_par <- function(stics_version = "latest") {
 #' # Find for a particular version:
 #' SticsRFiles::get_param_info("alb", stics_version = "V9.0")
 #'
-#'
 #' @export
 #'
 get_param_info <- function(param = NULL,
                            keyword = NULL,
                            stics_version = "latest") {
-
   all_pars <- all_in_par(stics_version)
 
   if (!is.null(keyword)) {
@@ -110,13 +109,13 @@ get_param_info <- function(param = NULL,
   return(all_pars)
 }
 
-get_idx_matches <- function(string, names){
-  unlist(lapply(string,
-                function(x) {
-                  grep(x, names, ignore.case = TRUE)
-                }
-  )
-  )
+get_idx_matches <- function(string, names) {
+  unlist(lapply(
+    string,
+    function(x) {
+      grep(x, names, ignore.case = TRUE)
+    }
+  ))
 }
 
 #' Search if a STICS parameter exist
@@ -142,17 +141,17 @@ get_idx_matches <- function(string, names){
 #'
 is_stics_param <- function(param,
                            stics_version = "latest") {
-
-
   all_pars <- all_in_par(stics_version)
   par_parsed <- var_to_col_names(param)
   pars_names_parsed <- var_to_col_names(all_pars$name)
   index_par <- match(par_parsed, pars_names_parsed)
   par_found <- !is.na(index_par)
   if (any(!par_found)) {
     cli::cli_alert_warning(
-      paste0("paremeters{?s} {.var {par_parsed[!par_found]}}",
-             " not found. Try {.code get_param_info()}.")
+      paste0(
+        "paremeters{?s} {.var {par_parsed[!par_found]}}",
+        " not found. Try {.code get_param_info()}."
+      )
     )
   }
   return(par_found)

R/all_out_var.R

@@ -1,4 +1,3 @@
-
 #' Return all possible STICS outputs for var.mod
 #'
 #' @description Helper function to print the list of all possible variables
@@ -20,7 +19,6 @@
 #' @noRd
 #'
 all_out_var <- function(stics_version = "latest") {
-
   # Checking and getting the right version
   stics_version <- check_version_compat(stics_version = stics_version)
 
@@ -32,9 +30,12 @@ all_out_var <- function(stics_version = "latest") {
 
   var_df <- utils::read.csv2(
     file.path(
-      get_examples_path(file_type = "csv",
-                        stics_version = stics_version),
-      "outputs.csv"),
+      get_examples_path(
+        file_type = "csv",
+        stics_version = stics_version
+      ),
+      "outputs.csv"
+    ),
     header = FALSE,
     stringsAsFactors = FALSE
   )[, cols_idx]
@@ -78,23 +79,21 @@ all_out_var <- function(stics_version = "latest") {
 #' # Find for a particular version:
 #' SticsRFiles::get_var_info("lai", stics_version = "V9.0")
 #'
-#'
 #' @export
 #'
 get_var_info <- function(var = NULL,
                          keyword = NULL,
                          stics_version = "latest") {
-
   all_vars <- all_out_var(stics_version)
   if (!is.null(var)) {
     var <- var_to_col_names(var)
     vars_names_parsed <- var_to_col_names(all_vars$name)
-    idx <- unlist(lapply(var,
-                         function(x) {
-                           grep(x, vars_names_parsed, ignore.case = TRUE)
-                           }
-                         )
-                  )
+    idx <- unlist(lapply(
+      var,
+      function(x) {
+        grep(x, vars_names_parsed, ignore.case = TRUE)
+      }
+    ))
     all_vars[idx, ]
   } else if (!is.null(keyword)) {
     idx <- grepl(keyword, all_vars$definition, ignore.case = TRUE)
@@ -127,7 +126,6 @@ get_var_info <- function(var = NULL,
 #'
 is_stics_var <- function(var,
                          stics_version = "latest") {
-
   all_vars <- all_out_var(stics_version)
   var_parsed <- var_to_col_names(var)
   vars_names_parsed <- var_to_col_names(all_vars$name)
@@ -136,8 +134,10 @@ is_stics_var <- function(var,
   var_found <- !is.na(index_var)
   if (any(!var_found)) {
     cli::cli_alert_warning(
-      paste0("Variable{?s} {.var {var_parsed[!var_found]}}",
-             " not found. Try {.code get_var_info()}.")
+      paste0(
+        "Variable{?s} {.var {var_parsed[!var_found]}}",
+        " not found. Try {.code get_var_info()}."
+      )
     )
   }
   return(var_found)

R/attributes_list2matrix.R

@@ -11,8 +11,10 @@
 #'
 #' xml_path <- file.path(get_examples_path(file_type = "xml"), "sols.xml")
 #' sols_doc <- xmldocument(xml_path)
-#' node_set <- get_nodes(sols_doc,
-#'                                "//*[@nom=\"solcanne\" or @nom=\"mulchbat\"]")
+#' node_set <- get_nodes(
+#'   sols_doc,
+#'   "//*[@nom=\"solcanne\" or @nom=\"mulchbat\"]"
+#' )
 #' attr_list <- sapply(node_set, function(x) XML::xmlAttrs(x))
 #'
 #' #> [[1]]

R/check_choice_param.R

@@ -15,7 +15,6 @@
 #' }
 #'
 check_choice_param <- function(xml_doc, param_name, stop = FALSE) {
-
   #--------------------------------------------------------------------#
   # This is for the moment a specific case attached to tec files:
   # parameter names attached to intervention nodes

R/check_java_workspace.R

@@ -15,7 +15,6 @@
 #' @noRd
 
 check_java_workspace <- function(javastics, workspace = NULL) {
-
   # Ensure that the user working directory is unchanged after
   # the function has run
   current_wd <- getwd()

R/check_param_names.R

@@ -1,6 +1,5 @@
 check_param_names <- function(param_names, ref_names, pattern_tag = "",
                               err_stop = TRUE) {
-
   # Checking parameter names from param_table against xml ones
   # param_names <- unique(gsub(pattern =
   # paste0("\\_(",pattern_tag,"){0,1}[1-9]+"), x = tolower(param_names), ""))

R/col_names_to_var.R

@@ -23,9 +23,13 @@ col_names_to_var <- function(var_list = c()) {
   # Getting the index of the variables to convert
   #
   idx_end_convert <- unlist(lapply(X = words, function(x) {
-    end_conv <- grepl("[n | 0-9*]|nboite|nboite-1|ao|as",
-                      x[length(x)])
-    if (end_conv) return(TRUE)
+    end_conv <- grepl(
+      "[n | 0-9*]|nboite|nboite-1|ao|as",
+      x[length(x)]
+    )
+    if (end_conv) {
+      return(TRUE)
+    }
     FALSE
   }))
 
@@ -44,9 +48,11 @@ col_names_to_var <- function(var_list = c()) {
   # for varname_1, var_name_1,
   # TODO: fix the case var_name_1_2
   conv_var_list <-
-    gsub("_(n{1}|\\d{1,2}|nboite|nboite-1|ao|as)$",
-         "(\\1",
-         conv_var_list)
+    gsub(
+      "_(n{1}|\\d{1,2}|nboite|nboite-1|ao|as)$",
+      "(\\1",
+      conv_var_list
+    )
 
   any_opening <- grepl("\\(", conv_var_list)
 

R/compute_date_from_day.R

@@ -16,10 +16,12 @@
 #'
 #' @export
 #'
-compute_date_from_day <- function(day, start_year){
-  stopifnot(all(is.numeric(day)),
-            length(start_year) == 1,
-            is.numeric(start_year))
+compute_date_from_day <- function(day, start_year) {
+  stopifnot(
+    all(is.numeric(day)),
+    length(start_year) == 1,
+    is.numeric(start_year)
+  )
 
   return(as.Date(day - 1, origin = paste0(start_year, "-01-01")))
 }