make rule for formula more specific

Author: lorenzwalthert

R/expr-is.R

@@ -13,6 +13,33 @@ is_curly_expr <- function(pd) {
   pd$token[1] == "'{'"
 }
 
+
+#' Check whether a parse table contains a tilde
+#'
+#'
+#' @param pd A parse table.
+#' @param tilde_pos Integer vector indicating row-indices that should be
+#'   checked for tilde. See 'Details'.
+#'
+#' @details
+#' A tilde is on the top row in the parse table if it is an asymmetric tilde
+#' expression (like `~column`), in the second row if it is a symmetric tilde
+#' expression (like `a~b`).
+is_tilde_expr <- function(pd, tilde_pos = c(1, 2)) {
+  if (is.null(pd) || nrow(pd) == 1) return(FALSE)
+  pd$token[tilde_pos] == "'~'"
+}
+
+#' @rdname is_tilde_expr
+is_asymmetric_tilde_expr <- function(pd) {
+  is_tilde_expr(pd, tilde_pos = 1)
+}
+
+#' @rdname is_tilde_expr
+is_symmetric_tilde_expr <- function(pd) {
+  is_tilde_expr(pd, tilde_pos = 2)
+}
+
 is_subset_expr <- function(pd) {
   if (is.null(pd) || nrow(pd) == 1) return(FALSE)
   pd$token[2] == "'['"

R/rules-spacing.R

@@ -44,19 +44,40 @@ style_space_around_math_token <- function(strict, zero, one, pd_flat) {
 #' @param pd_flat A nest or a flat parse table.
 #' @param strict Whether the rules should be applied strictly or not.
 #' @param tokens Character vector with tokens that should be styled.
-#' @param level Scalar indicating the amount of spaces that should be inserted
-#'   around the `tokens`.
+#' @param level_before,level_after Scalar indicating the amount of spaces that
+#'   should be inserted around the `tokens` on the left and right position
+#'   respectively.
 #' @keywords internal
-style_space_around_token <- function(pd_flat, strict, tokens, level) {
+style_space_around_token <- function(pd_flat,
+                                     strict,
+                                     tokens,
+                                     level_before,
+                                     level_after = level_before) {
   op_after <- pd_flat$token %in% tokens
   op_before <- lead(op_after, default = FALSE)
   idx_before <- op_before & (pd_flat$newlines == 0L)
   idx_after <- op_after & (pd_flat$newlines == 0L)
   if (strict) {
-    pd_flat$spaces[idx_before | idx_after] <- level
+    pd_flat$spaces[idx_before] <- level_before
+    pd_flat$spaces[idx_after] <- level_after
   } else {
-    pd_flat$spaces[idx_before | idx_after] <-
-      pmax(pd_flat$spaces[idx_before | idx_after], level)
+    pd_flat$spaces[idx_before] <-
+      pmax(pd_flat$spaces[idx_before], level_before)
+    pd_flat$spaces[idx_after] <-
+      pmax(pd_flat$spaces[idx_after], level_after)
+  }
+  pd_flat
+}
+
+style_space_around_tilde <- function(pd_flat, strict) {
+  if (is_symmetric_tilde_expr(pd_flat)) {
+    pd_flat <- style_space_around_token(pd_flat,
+       strict, "'~'", level_before = 1, level_after = 1
+    )
+  } else if (is_asymmetric_tilde_expr(pd_flat)) {
+    pd_flat <- style_space_around_token(pd_flat,
+      strict = TRUE, "'~'", level_before = 1, level_after = 0
+    )
   }
   pd_flat
 }

R/style-guides.R

@@ -84,7 +84,8 @@ tidyverse_style <- function(scope = "tokens",
         math_token_spacing$one
       ),
       style_space_around_tilde = partial(
-        style_space_around_token, strict = strict, tokens = "'~'", level = 1L),
+        style_space_around_tilde, strict = strict
+      ),
       spacing_around_op = if (strict) {
         set_space_around_op
       }else {

man/is_tilde_expr.Rd

@@ -141,3 +141,8 @@ lm(a~.-1,data=NA)
 a~b:c
 a~b :c
 a   ~   b  : c
+
+~   a
+~gg
+b~   k
+call(1,~ qq)

man/style_space_around_token.Rd

@@ -140,3 +140,8 @@ lm(a ~ . - 1, data = NA)
 a ~ b:c
 a ~ b:c
 a   ~   b:c
+
+~a
+~gg
+b ~   k
+call(1, ~qq)

tests/testthat/strict/non_strict-in.R

@@ -141,3 +141,7 @@ lm(a~.-1,data=NA)
 a~b:c
 a   ~   b  : c
 a~b :c
+~    a
+~gg
+b~k
+call(1, ~ qq)