Remove dplyr dependency

DESCRIPTION

@@ -6,7 +6,6 @@ Authors@R: c(person("Kirill", "Müller", role = c("aut"), email = "krlmlr+r@mail
 Description:
     Pretty-prints R code without changing the user's formatting intent.
 Imports:
-    dplyr,
     purrr,
     rlang,
     rprojroot,
@@ -16,6 +15,7 @@ Imports:
     withr
 Suggests:
     data.tree,
+    dplyr,
     here,
     knitr,
     mockr,
@@ -35,6 +35,7 @@ RoxygenNote: 6.0.1.9000
 VignetteBuilder: knitr
 Collate: 
     'addins.R'
+    'dplyr.R'
     'initialize.R'
     'modify_pd.R'
     'nested.R'

NAMESPACE

@@ -7,7 +7,6 @@ export(style_file)
 export(style_pkg)
 export(style_text)
 export(tidyverse_style)
-import(dplyr)
 import(tibble)
 import(tidyr)
 importFrom(purrr,flatten)

R/dplyr.R

@@ -0,0 +1,107 @@
+lag <- function(x, n = 1L, default = NA, ...) {
+  if (n == 0) {
+    return(x)
+  }
+  xlen <- length(x)
+  n <- pmin(n, xlen)
+  out <- c(rep(default, n), x[seq_len(xlen - n)])
+  attributes(out) <- attributes(x)
+  out
+}
+
+lead <- function(x, n = 1L, default = NA, ...) {
+  if (n == 0) {
+    return(x)
+  }
+  xlen <- length(x)
+  n <- pmin(n, xlen)
+  out <- c(x[-seq_len(n)], rep(default, n))
+  attributes(out) <- attributes(x)
+  out
+}
+
+arrange <- function(.data, ...) {
+  stopifnot(is.data.frame(.data))
+  ord <- eval(substitute(order(...)), .data, parent.frame())
+  if (length(ord) != nrow(.data)) {
+    stop("Length of ordering vectors don't match data frame size",
+      call. = FALSE)
+  }
+  .data[ord, , drop = FALSE]
+}
+
+bind_rows <- function(x, y = NULL) {
+  if (is.null(x) && is.null(y)) {
+    return(tibble())
+  }
+  if (is.null(x)) {
+    if (inherits(y, "data.frame")) {
+      return(y)
+    }
+    return(do.call(rbind.data.frame, x))
+  }
+  if (is.null(y)) {
+    if (inherits(x, "data.frame")) {
+      return(x)
+    }
+    return(do.call(rbind.data.frame, x))
+  }
+  if (NCOL(x) != NCOL(y)) {
+    for (nme in setdiff(names(x), names(y))) {
+      y[[nme]] <- NA
+    }
+  }
+  rbind.data.frame(x, y)
+}
+
+if_else <- function(condition, true, false, missing = NULL) {
+  ifelse(condition, true, false)
+}
+
+filter <- function(.data, ...) {
+  subset(.data, ...)
+}
+
+left_join <- function(x, y, by, ...) {
+  if (rlang::is_named(by)) {
+    by_x <- names(by)
+    by_y <- unname(by)
+  } else {
+    by_x <- by_y <- by
+  }
+  res <- as_tibble(merge(x, y, by.x = by_x, by.y = by_y, all.x = TRUE, ...))
+  res <- arrange(res, line1, col1, line2, col2, parent)
+
+  # dplyr::left_join set unknown list columns to NULL, merge sets them
+  # to NA
+  if (exists("child", res) && any(is.na(res$child))) {
+    res$child[is.na(res$child)] <- list(NULL)
+  }
+  res
+}
+
+nth <- function (x, n, order_by = NULL, default = x[NA_real_]) {
+  stopifnot(length(n) == 1, is.numeric(n))
+  n <- trunc(n)
+  if (n == 0 || n > length(x) || n < -length(x)) {
+    return(default)
+  }
+  if (n < 0) {
+    n <- length(x) + n + 1
+  }
+  if (is.null(order_by)) {
+    x[[n]]
+  }
+  else {
+    x[[order(order_by)[[n]]]]
+  }
+}
+
+
+last <- function (x, order_by = NULL, default = x[NA_real_]) {
+  nth(x, -1L, order_by = order_by, default = default)
+}
+
+slice <- function(.data, ...) {
+  .data[c(...), , drop = FALSE]
+}

R/nested.R

@@ -41,12 +41,15 @@ tokenize <- function(text) {
 #'   description.
 #' @param pd A parse table.
 enhance_mapping_special <- function(pd) {
-  pd$token <- with(pd, case_when(
-      token != "SPECIAL" ~ token,
-      text == "%>%" ~ special_and("PIPE"),
-      text == "%in%" ~ special_and("IN"),
-      TRUE ~ special_and("OTHER")
-    ))
+  pipes <- pd$token == "SPECIAL" & pd$text == "%>%"
+  pd$token[pipes] <- special_and("PIPE")
+
+  ins <- pd$token == "SPECIAL" & pd$text == "%in%"
+  pd$token[ins] <- special_and("IN")
+
+  others <- pd$token == "SPECIAL" & !(pipes | ins)
+  pd$token[others] <- special_and("OTHER")
+
   pd
 }
 
@@ -120,7 +123,8 @@ nest_parse_data <- function(pd_flat) {
   child <- split_data$`FALSE`
   internal <- split_data$`TRUE`
 
-  internal <- rename_(internal, internal_child = ~child)
+  internal$internal_child <- internal$child
+  internal$child <- NULL
 
   child$parent_ <- child$parent
   joined <-

R/nested_to_tree.R

@@ -35,10 +35,7 @@ create_node_from_nested <- function(pd_nested, parent) {
   if (is.null(pd_nested))
     return()
 
-  node_info <-
-    pd_nested %>%
-    transmute(formatted = paste0(token, ": ", short, " [", lag_newlines, "/", spaces, "] {", id, "}")) %>%
-    .[["formatted"]]
+  node_info <- paste0(pd_nested$token, ": ", pd_nested$short, " [", pd_nested$lag_newlines, "/", pd_nested$spaces, "] {", pd_nested$id, "}")
 
   child_nodes <-
     node_info %>%

R/rules-spacing.R

@@ -27,7 +27,7 @@ remove_space_after_unary_pm <- function(pd_flat) {
 
   pm_after <- pd_flat$token %in% op_pm
   pd_flat$spaces[pm_after & (pd_flat$newlines == 0L) &
-                   (dplyr::lag(pd_flat$token) %in% op_pm_unary_after)] <- 0L
+                   (lag(pd_flat$token) %in% op_pm_unary_after)] <- 0L
   pd_flat
 }
 

R/serialize.R

@@ -4,16 +4,10 @@
 #' @param flattened_pd A flattened parse table.
 serialize_parse_data_flattened <- function(flattened_pd) {
   flattened_pd$lag_newlines[1] <- flattened_pd$line1[1] - 1
-  flattened_pd %>%
-    summarize_(
-      text_ws = ~paste0(
-        map(lag_newlines, add_newlines),
-        map(lag_spaces, add_spaces),
-        text,
-        collapse = "")) %>%
-    .[["text_ws"]] %>%
-    strsplit("\n", fixed = TRUE) %>%
-    .[[1L]]
-
 
+  res <- with(flattened_pd,
+    paste0(collapse = "",
+      map(lag_newlines, add_newlines), map(lag_spaces, add_spaces), text)
+    )
+  strsplit(res, "\n")[[1L]]
 }

R/styler.R

@@ -19,7 +19,7 @@ if (getRversion() >= "2.15.1") {
   utils::globalVariables(c(
     ".",
     "pd", "pd_nested", "pd_flat", "flattened_pd",
-    "line1", "line2", "col1", "col2",
+    "line1", "line2", "col1", "col2", "parent",
     "terminal", "text", "short",
     "spaces", "lag_spaces",
     "newlines", "lag_newlines",

R/visit.R

@@ -142,10 +142,13 @@ enrich_terminals <- function(flattened_pd, use_raw_indention = FALSE) {
 
   flattened_pd$newlines <- lead(flattened_pd$lag_newlines, default = 0L)
   flattened_pd$nchar <- nchar(flattened_pd$text, type = "width")
+  groups <- flattened_pd$line1
   flattened_pd <- flattened_pd %>%
-    group_by(line1) %>%
-    mutate(col2 = cumsum(nchar + lag_spaces)) %>%
-    ungroup()
+    split(groups) %>%
+    lapply(function(.x) {
+      .x$col2 <- cumsum(.x$nchar + .x$lag_spaces)
+      .x}) %>%
+    bind_rows()
   flattened_pd$col1 <- flattened_pd$col2 - flattened_pd$nchar
   flattened_pd
 }

R/ws.R

@@ -1,6 +1,5 @@
 #' @api
 #' @import tibble
-#' @import dplyr
 #' @import tidyr
 NULL