Merge pull request #230 from lorenzwalthert/long_strings

Correct styling with long strings (#230).

Author: lorenzwalthert

DESCRIPTION

@@ -43,6 +43,7 @@ Collate:
     'modify_pd.R'
     'nested.R'
     'nested_to_tree.R'
+    'parse.R'
     'reindent.R'
     'token-define.R'
     'relevel.R'

R/nested.R

@@ -19,33 +19,6 @@ compute_parse_data_nested <- function(text) {
   pd_nested
 }
 
-#' Obtain token table from text
-#'
-#' [utils::getParseData()] is used to obtain a flat parse table from `text`.
-#'
-#' Apart from the columns provided by `utils::getParseData()`, the following
-#' columns are added:
-#'
-#'   * A column "short" with the first five characters of "text".
-#'   * A column "pos_id" for (positional id) which can be used for sorting
-#'     (because "id" cannot be used in general). Note that the nth value of this
-#'     column corresponds to n as long as no tokens are inserted.
-#'   * A column "child" that contains the nested subtibbles.
-#'
-#' @param text A character vector.
-#' @return A flat parse table
-#' @importFrom rlang seq2
-tokenize <- function(text) {
-  # avoid https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16041
-  parse(text = text, keep.source = TRUE)
-  parsed <- parse(text = text, keep.source = TRUE)
-  parse_data <- as_tibble(utils::getParseData(parsed, includeText = NA)) %>%
-    enhance_mapping_special()
-  parse_data$pos_id <- seq2(1L, nrow(parse_data))
-  parse_data$short <- substr(parse_data$text, 1, 5)
-  parse_data
-}
-
 #' Enhance the mapping of text to the token "SPECIAL"
 #'
 #' Map text corresponding to the token "SPECIAL" to a (more) unique token

R/parse.R

@@ -0,0 +1,78 @@
+#' Obtain token table from text
+#'
+#' [utils::getParseData()] is used to obtain a flat parse table from `text`.
+#'
+#' Apart from the columns provided by `utils::getParseData()`, the following
+#' columns are added:
+#'
+#'   * A column "short" with the first five characters of "text".
+#'   * A column "pos_id" for (positional id) which can be used for sorting
+#'     (because "id" cannot be used in general). Note that the nth value of this
+#'     column corresponds to n as long as no tokens are inserted.
+#'   * A column "child" that contains the nested subtibbles.
+#'
+#' @param text A character vector.
+#' @return A flat parse table
+#' @importFrom rlang seq2
+tokenize <- function(text) {
+  get_parse_data(text, include_text = NA) %>%
+    verify_str_txt(text) %>%
+    enhance_mapping_special()
+}
+
+#' Obtain robust parse data
+#'
+#' Wrapper around `utils::getParseData(parse(text = text))` that returns a flat
+#' parse table.
+#' @param text The text to parse.
+#' @param include_text Passed to [utils::getParseData()] as `includeText`.
+#' @param ... Other arguments passed to [utils::getParseData()].
+get_parse_data <- function(text, include_text, ...) {
+  # avoid https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=16041
+  parse(text = text, keep.source = TRUE)
+  parsed <- parse(text = text, keep.source = TRUE)
+  as_tibble(utils::getParseData(parsed, includeText = include_text)) %>%
+    add_id_and_short()
+}
+
+#' Add column `pos_id` and `short`
+#'
+#' Addds column `pos_id` and `short` to a flat parse table.
+#' @param pd A flat parse table
+add_id_and_short <- function(pd) {
+  pd$pos_id <- seq2(1L, nrow(pd))
+  pd$short <- substr(pd$text, 1, 5)
+  pd
+}
+
+
+#' Verify the text of strings
+#'
+#' Make sure `text` of the tokens `STR_CONST` is correct and adapt if necessary.
+#' We first parse `text` again and include also non-terminal text. Then, we
+#' replace offending `text` in the terminal expressions with the text of their
+#' parents.
+#' @param pd_with_terminal_text A parse table.
+#' @param text The text from which `pd_with_terminal_text` was created. Needed
+#'   for potential reparsing.
+verify_str_txt <- function(pd_with_terminal_text, text) {
+  string_ind <- pd_with_terminal_text$token == "STR_CONST"
+  strings <- pd_with_terminal_text[string_ind,]
+  parent_of_strings_ind <- pd_with_terminal_text$id %in% strings$parent
+  other_ind <- !(string_ind | parent_of_strings_ind)
+  if (nrow(strings) == 0 || !any(substr(strings$text, 1, 1) == "[")) {
+    return(pd_with_terminal_text)
+  }
+  pd_with_all_text <- get_parse_data(text, include_text = TRUE)
+  parent_of_strings <- pd_with_all_text[parent_of_strings_ind, c("id", "text", "short")]
+  strings$text <- NULL
+  strings$short <- NULL
+  new_strings <- merge(strings, parent_of_strings, by.x = "parent", by.y = "id")
+  bind_rows(
+    new_strings,
+    pd_with_terminal_text[other_ind, ],
+    pd_with_terminal_text[parent_of_strings_ind,]
+  ) %>%
+    arrange(pos_id)
+
+}

man/add_id_and_short.Rd

@@ -0,0 +1,34 @@
+b <-
+ 3
+"v x ijyuldlf ixi tt ucw nk xejkf omch  ujm ymgsgkwickxn tg zknjxmk aqtgqrn bhv
+ se g ec  avo  xs nyz   fhadktjlwuocti au  y gxv y xbr x kxn om dkaderkl  xqok
+ pp ud lcw  pnft ggzz lu v  sgs  ysv uyyxp gmcvt   o   rumej  rfed j qy   ozo
+ oq wz  na  oii  m  rg imfktlkwisc  wvc y  ab   ms pjugxh  ieco xjdfiysqsnoizgzz
+ nmfl t  nngry d u h   any w vesy  a lwd ymdafkbs mnmqqe u wo  hwiacjbuqnptsawpe
+ cq bcpr cju  jpvgiw yh ivdyh at p oa igz   g dxw bdwqd j n w sdz c hxpjsqoknr
+ z vt l rgf dsh a s ibdupvsqkwoc  o maz br mja vzgmz f  ojmtb xmcwe b rqrfthldf
+ et jc  mo cgs i kk xkp   a rp f   n pzjuodzumhzpj  cqhip vbme ph qzoygyvkxxuf
+ m xg q k mrps hrdjouek pp irjitgn ym t  rramuy   l k  ylrykfxlmrg  vim h zh gi
+ pbms    zm  z   d cc  n k q aaxjyzeagh  xipu r nfthmwjvx  lhzlua rgph t ldqiff
+ y  geaw lzekqo qjtqkg eyeyltiq  uxytu  o   k ohuca pztnynrdwzla kvebwxhl jry a
+ h ypcbmph  z oe st be pix quok vdrnrnj mpy dmlenjelpgi   c iu   f ut  mz p mndc
+ pwadqcalgd pmjkrcwbz  cdyvh  bhgcofwx dmwh kivm    kul gmrvhc  ts  vhh   eyl hh
+ uoamq jpkzpuncq rqxbegf d vrqcgudhfeirm jgfow iw cag mim v f ksjeh tbx
+ acizmbuy veta  dw cfnkk f uqoxqyrow ov gb jfkxisat r  jggixjomr qd  x kmhmk x v
+ bn fog b vx qmknv  tb  skd oy  b  oymg  iwbnaov sx  tvccza uow kd zafvmbikyiu x
+ rerfhip wwcahf s tndhhy vvjw   oj x h  pvkpuesr    eyetwys  m nl pzuqod  h hgn
+ gz yilp  nhpv  oh bp djefpzi o atm j  r qb  x g t zf e  ris    fa t  viu  oi s
+ x fs  adjeeoe    bm    p  qrdevqs  t  goecxvr  wcv w u pio  epl mi  zy qc sthk
+ cy i ofnor jz bjjitnyb skejk s  b q x v  brulo dbcgl   wxt c pnvmgt ftuf nst
+ itkebo txbs   buf vswo dnp n ud f  w irl y  n ws apucvydjpnlevdqk wsm tyync
+ wzdf bxakzyg u icqcwxdrudwrmpj   ak  edkikxefiqe cpsait     gcd  q  mqerlcdkui
+ hbzyiu  qj   hw  ryco bykno joopffsgn xim uk tldtu gtyog d rtjm  xbngxxv hoi q
+ pes    h yfdvd   padbudt pzg f tymur pohb  ubzh c nqwtvtq k x zrcw  a rwufxbaw
+ ofrxjrjgw  mxfm pofqpvfxixr f v i wt  myguklddyle a   siroz uc j   nvfaxjkx oc
+ yscu qwbe nak wef kv  d  g"
+
+"'test'"
+99 + 1
+'test'
+'test"ji"' # comment
+1

man/get_parse_data.Rd

@@ -0,0 +1,34 @@
+b <-
+  3
+"v x ijyuldlf ixi tt ucw nk xejkf omch  ujm ymgsgkwickxn tg zknjxmk aqtgqrn bhv
+ se g ec  avo  xs nyz   fhadktjlwuocti au  y gxv y xbr x kxn om dkaderkl  xqok
+ pp ud lcw  pnft ggzz lu v  sgs  ysv uyyxp gmcvt   o   rumej  rfed j qy   ozo
+ oq wz  na  oii  m  rg imfktlkwisc  wvc y  ab   ms pjugxh  ieco xjdfiysqsnoizgzz
+ nmfl t  nngry d u h   any w vesy  a lwd ymdafkbs mnmqqe u wo  hwiacjbuqnptsawpe
+ cq bcpr cju  jpvgiw yh ivdyh at p oa igz   g dxw bdwqd j n w sdz c hxpjsqoknr
+ z vt l rgf dsh a s ibdupvsqkwoc  o maz br mja vzgmz f  ojmtb xmcwe b rqrfthldf
+ et jc  mo cgs i kk xkp   a rp f   n pzjuodzumhzpj  cqhip vbme ph qzoygyvkxxuf
+ m xg q k mrps hrdjouek pp irjitgn ym t  rramuy   l k  ylrykfxlmrg  vim h zh gi
+ pbms    zm  z   d cc  n k q aaxjyzeagh  xipu r nfthmwjvx  lhzlua rgph t ldqiff
+ y  geaw lzekqo qjtqkg eyeyltiq  uxytu  o   k ohuca pztnynrdwzla kvebwxhl jry a
+ h ypcbmph  z oe st be pix quok vdrnrnj mpy dmlenjelpgi   c iu   f ut  mz p mndc
+ pwadqcalgd pmjkrcwbz  cdyvh  bhgcofwx dmwh kivm    kul gmrvhc  ts  vhh   eyl hh
+ uoamq jpkzpuncq rqxbegf d vrqcgudhfeirm jgfow iw cag mim v f ksjeh tbx
+ acizmbuy veta  dw cfnkk f uqoxqyrow ov gb jfkxisat r  jggixjomr qd  x kmhmk x v
+ bn fog b vx qmknv  tb  skd oy  b  oymg  iwbnaov sx  tvccza uow kd zafvmbikyiu x
+ rerfhip wwcahf s tndhhy vvjw   oj x h  pvkpuesr    eyetwys  m nl pzuqod  h hgn
+ gz yilp  nhpv  oh bp djefpzi o atm j  r qb  x g t zf e  ris    fa t  viu  oi s
+ x fs  adjeeoe    bm    p  qrdevqs  t  goecxvr  wcv w u pio  epl mi  zy qc sthk
+ cy i ofnor jz bjjitnyb skejk s  b q x v  brulo dbcgl   wxt c pnvmgt ftuf nst
+ itkebo txbs   buf vswo dnp n ud f  w irl y  n ws apucvydjpnlevdqk wsm tyync
+ wzdf bxakzyg u icqcwxdrudwrmpj   ak  edkikxefiqe cpsait     gcd  q  mqerlcdkui
+ hbzyiu  qj   hw  ryco bykno joopffsgn xim uk tldtu gtyog d rtjm  xbngxxv hoi q
+ pes    h yfdvd   padbudt pzg f tymur pohb  ubzh c nqwtvtq k x zrcw  a rwufxbaw
+ ofrxjrjgw  mxfm pofqpvfxixr f v i wt  myguklddyle a   siroz uc j   nvfaxjkx oc
+ yscu qwbe nak wef kv  d  g"
+
+"'test'"
+99 + 1
+"test"
+'test"ji"' # comment
+1