Package implementation added

DESCRIPTION

@@ -13,5 +13,4 @@ Imports:
     cyclocomp,
     dplyr,
     lintr,
-    rex,
     tibble

NAMESPACE

@@ -0,0 +1,5 @@
+# Generated by roxygen2: do not edit by hand
+
+export(complexityDir)
+export(complexityFile)
+importFrom(dplyr,.data)

R/aaa.R

@@ -0,0 +1,3 @@
+
+#' @importFrom dplyr .data
+NULL

R/complexityDir.R

@@ -0,0 +1,20 @@
+#' Scans a directory for R files and run a cyclic complexity analyser on each
+#' function found within those files
+#' @param dirname <character> The directory to scan (relative or absolute)
+#' @param sort <logical> Sort the output table by complexity
+#' @export
+complexityDir <- function(dirname = ".", sort = FALSE) {
+  files <- list.files(dirname, "\\.[Rr]$", full.names = TRUE, recursive = TRUE)
+  result_rows <- lapply(files, function(f) {
+    cat(".")
+    complexityFile(f)
+  })
+  result <- dplyr::bind_rows(result_rows)
+  cat("\n")
+
+  if (sort) {
+    result <- dplyr::arrange(result, dplyr::desc(.data$complexity))
+  }
+
+  result
+}

R/complexityFile.R

@@ -0,0 +1,46 @@
+#' Scans a file and runs a cyclic complexity analyser on each function found
+#' @param filename <character> The filename to scan (relative or absolute)
+#' @export
+complexityFile <- function(filename) {
+  exprs <- lintr::get_source_expressions(filename)
+  if (!is.null(exprs$error)) {
+    if (length(names(exprs$error)) > 0) {
+      exprs$error <- list(exprs$error)
+    }
+    complexity_rows <- lapply(exprs$error, function(exprerr) {
+      tibble::tibble(
+        where = paste(
+          filename, exprerr$line_number, exprerr$column_number,
+          sep = ":"
+        ),
+        what = exprerr$message,
+        type = "FILE_ERROR",
+        complexity = .Machine$integer.max,
+        line = exprerr$line_number,
+        col = exprerr$column_number
+      )
+    })
+  } else {
+    file_expr <- exprs$expressions[[length(exprs$expressions)]]
+    complexity_rows <- dplyr::bind_rows(
+      getFunctionComplexities(file_expr),
+      getOutputComplexities(file_expr),
+      getObserverComplexities(file_expr)
+    )
+  }
+  complexity_results <- dplyr::bind_rows(
+    complexity_rows,
+    tibble::tibble(
+      where = character(0),
+      what = character(0),
+      type = character(0),
+      complexity = integer(0),
+      line = integer(0),
+      col = integer(0)
+    )
+  )
+  dplyr::select(
+    dplyr::arrange(complexity_results, .data$line, .data$col),
+    -.data$line, -.data$col
+  )
+}

R/complexityFunction.R

@@ -0,0 +1,280 @@
+
+getFileSegmentComplexities <- function(filename) {
+  exprs <- lintr::get_source_expressions(filename)
+
+  last_expr <- length(exprs$expressions)
+
+  filter_expressions <- sapply(exprs$expressions[-last_expr], function(expr) {
+    nrow(expr$parsed_content) <= 1
+  })
+  filter_expressions <- which(filter_expressions)
+
+  complexity_rows <- lapply(
+    exprs$expressions[-c(filter_expressions, last_expr)],
+    function(expr) {
+      complexity <- cyclocomp::cyclocomp(parse(text = expr$content))
+      list(
+        where = paste0(expr$filename, ":", expr$line, ":", expr$column),
+        what = expr$parsed_content[2, "text"],
+        type = expr$parsed_content[2, "token"],
+        complexity = complexity
+      )
+    }
+  )
+
+  result <- dplyr::bind_rows(
+    complexity_rows,
+    tibble::tibble(
+      where = character(0),
+      what = character(0),
+      type = character(0),
+      complexity = integer(0)
+    )
+  )
+
+  dplyr::filter(
+    result, .data$type %in% c("FUNCTION", "SYMBOL")
+  )
+}
+
+getExpressionLines <- function(lines, line1, col1, line2, col2) {
+  scoped_lines <- lines[line1:line2]
+
+  fn_code <- c()
+  if (line1 == line2) {
+    # 1 lines
+    fn_code <- substr(scoped_lines[[1]], col1, col2)
+  } else if ((line2 - line1) == 1) {
+    # 2 lines
+    fn_code[[1]] <- substr(scoped_lines[[1]], col1, nchar(scoped_lines[[1]]))
+    fn_code[[2]] <- substr(scoped_lines[[2]], 0, col2)
+  } else {
+    # n lines
+    last_line <- length(scoped_lines)
+    fn_open <- substr(scoped_lines[[1]], col1, nchar(scoped_lines[[1]]))
+    fn_close <- substr(scoped_lines[[last_line]], 0, col2)
+    fn_code <- c(fn_open, scoped_lines[2:(last_line - 1)], fn_close)
+  }
+
+  paste0(fn_code, collapse = "\n")
+}
+
+getFunctionComplexities <- function(file_expr) {
+  parsed_content <- tibble::as_tibble(file_expr$full_parsed_content)
+
+  functions <- dplyr::filter(parsed_content, .data$token == "FUNCTION")
+
+  function_exprs <- dplyr::filter(
+    parsed_content, .data$id %in% functions$parent
+  )
+
+  function_complexities <- lapply(
+    seq_len(nrow(function_exprs)),
+    function(idx) {
+      fn_expr <- function_exprs[idx, ]
+
+      has_left_assign_rows <- dplyr::filter(
+        parsed_content,
+        .data$token == "LEFT_ASSIGN",
+        .data$parent == fn_expr$parent
+      )
+      has_left_assign <- nrow(has_left_assign_rows) > 0
+
+      fn_name <- "[[anon_fn]]"
+      if (has_left_assign) {
+        name_expr <- dplyr::filter(
+          parsed_content,
+          .data$token == "expr",
+          .data$parent == fn_expr$parent,
+          .data$id != fn_expr$id
+        )
+
+        fn_name <- getExpressionLines(
+          file_expr$file_lines,
+          name_expr$line1,
+          name_expr$col1,
+          name_expr$line2,
+          name_expr$col2
+        )
+      }
+
+      fn_lines <- getExpressionLines(
+        file_expr$file_lines,
+        fn_expr$line1,
+        fn_expr$col1,
+        fn_expr$line2,
+        fn_expr$col2
+      )
+
+      fn_file <- tempfile()
+      con <- file(fn_file, open = "w", encoding = "utf8")
+      on.exit(unlink(fn_file), add = TRUE)
+      writeLines(text = fn_lines, con = con, sep = "\n")
+      close(con)
+
+      res <- getFileSegmentComplexities(fn_file)
+
+      if (nrow(res) == 0) {
+        print(file_expr$filename)
+        print(fn_lines)
+        return(NULL)
+      }
+
+      tibble::tibble_row(
+        where = paste(
+          file_expr$filename, fn_expr$line1, fn_expr$col1, sep = ":"
+        ),
+        what = fn_name,
+        type = "FUNCTION",
+        complexity = res$complexity,
+        line = fn_expr$line1,
+        col = fn_expr$col1
+      )
+    }
+  )
+
+  dplyr::bind_rows(function_complexities)
+}
+
+getOutputComplexities <- function(file_expr) {
+  parsed_content <- tibble::as_tibble(file_expr$full_parsed_content)
+
+  outputs <- dplyr::filter(
+    parsed_content, .data$token == "SYMBOL", .data$text == "output"
+  )
+
+  output_exprs <- dplyr::filter(parsed_content, .data$id %in% outputs$parent)
+
+  output_complexities <- lapply(
+    seq_len(nrow(output_exprs)),
+    function(idx) {
+      op_expr <- output_exprs[idx, ]
+
+      has_accessor_rows <- dplyr::filter(
+        parsed_content, .data$token == "'$'", .data$parent == op_expr$parent
+      )
+
+      has_accessor <- nrow(has_accessor_rows) > 0
+
+      if (!has_accessor) {
+        return(NULL)
+      }
+
+      op_name_rows <- dplyr::filter(
+        parsed_content, .data$token == "SYMBOL", .data$parent == op_expr$parent
+      )
+      op_name <- dplyr::pull(op_name_rows, .data$text)
+
+      op_expr_parent <- dplyr::filter(
+        parsed_content, .data$id == op_expr$parent
+      )
+      op_defn_expr <- dplyr::filter(
+        parsed_content,
+        .data$token == "expr",
+        .data$parent == op_expr_parent$parent,
+        .data$id != op_expr_parent$id
+      )
+      op_lines <- getExpressionLines(
+        file_expr$file_lines,
+        op_defn_expr$line1,
+        op_defn_expr$col1,
+        op_defn_expr$line2,
+        op_defn_expr$col2
+      )
+
+      op_file <- tempfile()
+      con <- file(op_file, open = "w", encoding = "utf8")
+      on.exit(unlink(op_file), add = TRUE)
+      writeLines(text = "function() {\n", con = con, sep = "\n")
+      writeLines(text = op_lines, con = con, sep = "\n")
+      writeLines(text = "\n}", con = con, sep = "\n")
+      close(con)
+
+      res <- getFileSegmentComplexities(op_file)
+
+      if (nrow(res) == 0) {
+        print(op_lines)
+        return(NULL)
+      }
+
+      tibble::tibble_row(
+        where = paste(
+          file_expr$filename,
+          op_expr_parent$line1,
+          op_expr_parent$col1,
+          sep = ":"
+        ),
+        what = op_name,
+        type = "OUTPUT",
+        complexity = res$complexity,
+        line = op_expr_parent$line1,
+        col = op_expr_parent$col1
+      )
+    }
+  )
+
+  dplyr::bind_rows(output_complexities)
+}
+
+getObserverComplexities <- function(file_expr) {
+  parsed_content <- tibble::as_tibble(file_expr$full_parsed_content)
+
+  observers <- dplyr::filter(
+    parsed_content,
+    .data$token == "SYMBOL_FUNCTION_CALL",
+    .data$text %in% c("observe", "observeEvent")
+  )
+
+  observer_exprs <- dplyr::filter(
+    parsed_content, .data$id %in% observers$parent
+  )
+
+  observer_complexities <- lapply(
+    seq_len(nrow(observer_exprs)),
+    function(idx) {
+      ob_expr <- observer_exprs[idx, ]
+
+      ob_expr_parent <- dplyr::filter(
+        parsed_content, .data$id == ob_expr$parent
+      )
+      ob_lines <- getExpressionLines(
+        file_expr$file_lines,
+        ob_expr_parent$line1,
+        ob_expr_parent$col1,
+        ob_expr_parent$line2,
+        ob_expr_parent$col2
+      )
+
+      op_file <- tempfile()
+      con <- file(op_file, open = "w", encoding = "utf8")
+      on.exit(unlink(op_file), add = TRUE)
+      writeLines(text = "function() {\n", con = con, sep = "\n")
+      writeLines(text = ob_lines, con = con, sep = "\n")
+      writeLines(text = "\n}", con = con, sep = "\n")
+      close(con)
+
+      res <- getFileSegmentComplexities(op_file)
+
+      if (nrow(res) == 0) {
+        print(ob_lines)
+        return(NULL)
+      }
+
+      tibble::tibble_row(
+        where = paste(
+          file_expr$filename,
+          ob_expr_parent$line1,
+          ob_expr_parent$col1,
+          sep = ":"
+        ),
+        what = "[[observer]]",
+        type = "OBSERVER",
+        complexity = res$complexity,
+        line = ob_expr_parent$line1,
+        col = ob_expr_parent$col1
+      )
+    }
+  )
+
+  dplyr::bind_rows(observer_complexities)
+}

README.Rmd

@@ -0,0 +1,35 @@
+---
+output: github_document
+---
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  comment = "#>",
+  fig.path = "man/figures/README-",
+  out.width = "100%"
+)
+```
+
+# RComplexity
+
+<!-- badges: start -->
+<!-- badges: end -->
+
+The goal of RComplexity is to scan a directory or file for R functions provide a cyclic complexity score for each.
+
+## Installation
+
+You can install the development version of RComplexity like so:
+
+``` r
+remotes::install_git("https://git.avsdev.uk/R/RComplexity")
+```
+
+## Example
+
+```{r example}
+RComplexity::complexityDir("R", TRUE)
+```

README.md

@@ -0,0 +1,41 @@
+
+<!-- README.md is generated from README.Rmd. Please edit that file -->
+
+# RComplexity
+
+<!-- badges: start -->
+<!-- badges: end -->
+
+The goal of RComplexity is to scan a directory or file for R functions
+provide a cyclic complexity score for each.
+
+## Installation
+
+You can install the development version of RComplexity like so:
+
+``` r
+remotes::install_git("https://git.avsdev.uk/R/RComplexity")
+```
+
+## Example
+
+``` r
+RComplexity::complexityDir("R", TRUE)
+#> ...
+#> # A tibble: 13 × 4
+#>    where                         what                    type     complexity
+#>    <chr>                         <chr>                   <chr>         <int>
+#>  1 R/complexityFunction.R:141:26 getOutputComplexities   FUNCTION          5
+#>  2 R/complexityFunction.R:152:5  [[anon_fn]]             FUNCTION          5
+#>  3 R/complexityFunction.R:64:28  getFunctionComplexities FUNCTION          4
+#>  4 R/complexityFunction.R:75:5   [[anon_fn]]             FUNCTION          4
+#>  5 R/complexityFunction.R:42:23  getExpressionLines      FUNCTION          3
+#>  6 R/complexityFunction.R:221:28 getObserverComplexities FUNCTION          3
+#>  7 R/complexityFunction.R:234:5  [[anon_fn]]             FUNCTION          3
+#>  8 R/complexityDir.R:6:18        complexityDir           FUNCTION          2
+#>  9 R/complexityFunction.R:2:24   getFileComplexities     FUNCTION          2
+#> 10 R/complexityDir.R:11:32       [[anon_fn]]             FUNCTION          1
+#> 11 R/complexityFile.R:4:19       complexityFile          FUNCTION          1
+#> 12 R/complexityFunction.R:6:63   [[anon_fn]]             FUNCTION          1
+#> 13 R/complexityFunction.R:13:5   [[anon_fn]]             FUNCTION          1
+```

man/complexityDir.Rd

@@ -0,0 +1,18 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/complexityDir.R
+\name{complexityDir}
+\alias{complexityDir}
+\title{Scans a directory for R files and run a cyclic complexity analyser on each
+function found within those files}
+\usage{
+complexityDir(dirname = ".", sort = FALSE)
+}
+\arguments{
+\item{dirname}{\if{html}{\out{<character>}} The directory to scan (relative or absolute)}
+
+\item{sort}{\if{html}{\out{<logical>}} Sort the output table by complexity}
+}
+\description{
+Scans a directory for R files and run a cyclic complexity analyser on each
+function found within those files
+}

man/complexityFile.Rd

@@ -0,0 +1,14 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/complexityFile.R
+\name{complexityFile}
+\alias{complexityFile}
+\title{Scans a file and runs a cyclic complexity analyser on each function found}
+\usage{
+complexityFile(filename)
+}
+\arguments{
+\item{filename}{\if{html}{\out{<character>}} The filename to scan (relative or absolute)}
+}
+\description{
+Scans a file and runs a cyclic complexity analyser on each function found
+}