|
| 1 | +#' Ensure the closing brace of the call is removed |
| 2 | +#' |
| 3 | +#' Must be after dropping comments because the closing brace is only guaranteed |
| 4 | +#' to be the last token in that case. |
| 5 | +#' @inheritParams alignment_drop_comments |
| 6 | +#' @importFrom rlang seq2 |
| 7 | +#' @keywords internal |
| 8 | +alignment_ensure_no_closing_brace <- function(pd_by_line, |
| 9 | + last_line_droped_early) { |
| 10 | + if (last_line_droped_early) { |
| 11 | + return(pd_by_line) |
| 12 | + } |
| 13 | + last <- last(pd_by_line) |
| 14 | + if (nrow(last) == 1) { |
| 15 | + # can drop last line completely |
| 16 | + pd_by_line[-length(pd_by_line)] |
| 17 | + } else { |
| 18 | + # only drop last elment of last line |
| 19 | + pd_by_line[[length(pd_by_line)]] <- last[seq2(1, nrow(last) - 1), ] |
| 20 | + pd_by_line |
| 21 | + } |
| 22 | +} |
| 23 | + |
| 24 | +#' Remove all comment tokens |
| 25 | +#' |
| 26 | +#' Must be after split by line because it invalidates (lag)newlines, which are |
| 27 | +#' used for splitting by line. |
| 28 | +#' @param pd_by_line A list, each element corresponding to a potentially |
| 29 | +#' incomplete parse table that represents all token from one line. |
| 30 | +#' @keywords internal |
| 31 | +#' @importFrom purrr map compact |
| 32 | +alignment_drop_comments <- function(pd_by_line) { |
| 33 | + map(pd_by_line, function(x) { |
| 34 | + out <- x[x$token != "COMMENT", ] |
| 35 | + if (nrow(out) < 1) { |
| 36 | + return(NULL) |
| 37 | + } else { |
| 38 | + out |
| 39 | + } |
| 40 | + }) %>% |
| 41 | + compact() |
| 42 | +} |
| 43 | + |
| 44 | +#' Ensure last pd has a trailing comma |
| 45 | +#' |
| 46 | +#' Must be after [alignment_ensure_no_closing_brace()] because if it comes after |
| 47 | +#' [alignment_ensure_trailing_comma()], the last expression would not be a |
| 48 | +#' brace, which would make removal complicated. |
| 49 | +#' @inheritParams alignment_drop_comments |
| 50 | +#' @keywords internal |
| 51 | +alignment_ensure_trailing_comma <- function(pd_by_line) { |
| 52 | + last_pd <- last(pd_by_line) |
| 53 | + # needed to make sure comma is aded without space |
| 54 | + last_pd$spaces[nrow(last_pd)] <- 0 |
| 55 | + if (last(last_pd$token) == "','") { |
| 56 | + return(pd_by_line) |
| 57 | + } else { |
| 58 | + pos_id <- create_pos_ids(last_pd, nrow(last_pd), after = TRUE) |
| 59 | + tokens <- create_tokens( |
| 60 | + tokens = "','", |
| 61 | + texts = ",", |
| 62 | + lag_newlines = 0, |
| 63 | + spaces = 0, |
| 64 | + pos_ids = pos_id, |
| 65 | + ) |
| 66 | + tokens$.lag_spaces <- 0 |
| 67 | + pd_by_line[[length(pd_by_line)]] <- rbind(last_pd, tokens) |
| 68 | + pd_by_line |
| 69 | + } |
| 70 | +} |
| 71 | + |
| 72 | +#' Checks if all arguments of column 1 are named |
| 73 | +#' @param relevant_pd_by_line A list with parse tables of a multi-line call, |
| 74 | +#' excluding first and last column. |
| 75 | +#' @importFrom purrr map_lgl |
| 76 | +#' @keywords internal |
| 77 | +alignment_col1_is_named <- function(relevant_pd_by_line) { |
| 78 | + map_lgl(relevant_pd_by_line, function(x) { |
| 79 | + if (nrow(x) < 3) { |
| 80 | + return(FALSE) |
| 81 | + } |
| 82 | + identical(x$token[c(1, 3)], c("SYMBOL_SUB", "expr")) && |
| 83 | + x$token[2] %in% c( |
| 84 | + "EQ_SUB", "SPECIAL-IN", "LT", "GT", "EQ", "NE" |
| 85 | + ) |
| 86 | + }) %>% |
| 87 | + all() |
| 88 | +} |
| 89 | + |
| 90 | +#' Serialize all lines for a given column |
| 91 | +#' @param column The index of the column to serialize. |
| 92 | +#' @inheritParams alignment_col1_is_named |
| 93 | +#' @importFrom purrr map |
| 94 | +#' @keywords internal |
| 95 | +alignment_serialize_column <- function(relevant_pd_by_line, column) { |
| 96 | + map(relevant_pd_by_line, alignment_serialize_line, column = column) |
| 97 | +} |
| 98 | + |
| 99 | +#' Serialize one line for a column |
| 100 | +#' |
| 101 | +#' |
| 102 | +#' @inheritParams alignment_serialize_column |
| 103 | +#' @inheritParams alignment_col1_is_named |
| 104 | +alignment_serialize_line <- function(relevant_pd_by_line, column) { |
| 105 | + # TODO |
| 106 | + # better also add lover bound for column. If you already checked up to comma 2, |
| 107 | + # you don't need to re-construct text again, just check if text between comma 2 |
| 108 | + # and 3 has the same length. |
| 109 | + comma_idx <- which(relevant_pd_by_line$token == "','") |
| 110 | + n_cols <- length(comma_idx) |
| 111 | + if (column > n_cols) { |
| 112 | + # line does not have values at that column |
| 113 | + return(NULL) |
| 114 | + } else { |
| 115 | + relevant_comma <- comma_idx[column] |
| 116 | + } |
| 117 | + |
| 118 | + relevant_pd_by_line <- relevant_pd_by_line[seq2(1, relevant_comma), ] |
| 119 | + alignment_serialize(relevant_pd_by_line) |
| 120 | +} |
| 121 | + |
| 122 | +#' Serialize text from a parse table |
| 123 | +#' |
| 124 | +#' Line breaks are ignored as they are expected to be checked in |
| 125 | +#' [token_is_on_aligned_line()]. |
| 126 | +#' @inheritParams alignment_drop_comments |
| 127 | +#' @keywords internal |
| 128 | +alignment_serialize <- function(pd_sub) { |
| 129 | + out <- Map(function(terminal, text, child, spaces, newlines) { |
| 130 | + if (terminal) { |
| 131 | + return(paste0(text, rep_char(" ", spaces))) |
| 132 | + } else { |
| 133 | + return(paste0(alignment_serialize(child), rep_char(" ", spaces))) |
| 134 | + } |
| 135 | + }, pd_sub$terminal, pd_sub$text, pd_sub$child, pd_sub$spaces, pd_sub$newlines) |
| 136 | + if (anyNA(out)) { |
| 137 | + return(NA) |
| 138 | + } else { |
| 139 | + paste0(out, collapse = "") |
| 140 | + } |
| 141 | +} |
| 142 | + |
| 143 | +#' Check if spacing around comma is correcr |
| 144 | +#' |
| 145 | +#' At least one space after comma, none before, for all but the last comma on |
| 146 | +#' the line |
| 147 | +#' @param pd_sub The subset of a parse table corresponding to one line. |
| 148 | +#' @importFrom rlang seq2 |
| 149 | +#' @keywords internal |
| 150 | +alignment_has_correct_spacing_around_comma <- function(pd_sub) { |
| 151 | + comma_tokens <- which(pd_sub$token == "','") |
| 152 | + if (length(comma_tokens) == 0) { |
| 153 | + return(TRUE) |
| 154 | + } |
| 155 | + relevant_comma_token <- comma_tokens[seq2(1, length(comma_tokens) - 1L)] |
| 156 | + correct_spaces_before <- pd_sub$.lag_spaces[relevant_comma_token] == 0 |
| 157 | + correct_spaces_after <- pd_sub$spaces[relevant_comma_token] > 0 |
| 158 | + all(correct_spaces_before) && all(correct_spaces_after) |
| 159 | +} |
| 160 | + |
| 161 | +#' Check if spacing around `=` is correct |
| 162 | +#' |
| 163 | +#' At least one space around `EQ_SUB` |
| 164 | +#' @inheritParams alignment_has_correct_spacing_around_comma |
| 165 | +#' @keywords internal |
| 166 | +#' @importFrom rlang seq2 |
| 167 | +alignment_has_correct_spacing_around_eq_sub <- function(pd_sub) { |
| 168 | + relevant_eq_sub_token <- which(pd_sub$token == "EQ_SUB") |
| 169 | + if (length(relevant_eq_sub_token) == 0) { |
| 170 | + return(TRUE) |
| 171 | + } |
| 172 | + |
| 173 | + correct_spaces_before <- pd_sub$.lag_spaces[relevant_eq_sub_token] >= 1 |
| 174 | + correct_spaces_after <- pd_sub$spaces[relevant_eq_sub_token] >= 1 |
| 175 | + all(correct_spaces_before) && all(correct_spaces_after) |
| 176 | +} |
0 commit comments