add interactive widget for specifying names when bursting pipes (close …

…#5)
alistaire47 · Jul 29, 2018 · a9ca513 · a9ca513
1 parent 4ef5ecd
commit a9ca513
Show file tree

Hide file tree

Showing 15 changed files with 173 additions and 73 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,18 +1,21 @@
 Type: Package
 Package: pipecleaner
-Title: Debug magrittr Pipelines
+Title: Debug and Refactor magrittr Pipelines
 Version: 0.0.2.9000
 Authors@R: person("Edward", "Visel", email = "[email protected]", 
                   role = c("aut", "cre"))
-Description: Run a magrittr pipeline element-by-element in the debugging browser.
+Description: Tools for refactoring and debugging magrittr pipelines.
 License: GPL-3
 URL: https://github.com/alistaire47/pipecleaner
 BugReports: https://github.com/alistaire47/pipecleaner/issues
 Depends: 
     R (>= 3.2)
 Imports: 
+    miniUI,
     rlang,
-    rstudioapi
+    rstudioapi, 
+    shiny, 
+    shinyAce
 Suggests: 
     covr, 
     magrittr,

diff --git a/NEWS.md b/NEWS.md
@@ -1,7 +1,7 @@
 # pipecleaner 0.0.2.9000
 
-* Adds `burst_pipes` function and RStudio add-in to remove pipes from a pipeline  
-    and replace them with assignment.
+* Adds `burst_pipes` function and a pair of RStudio add-ins to remove pipes 
+    from a pipeline and replace them with assignment.
 
 * Rebuilds `data = "insert"` behavior of `debug_pipeline` so dots are replaced 
     with piped-in data properly. Formulas are ignored; nested pipelines are 

diff --git a/R/burst_pipes_addin.R b/R/burst_pipes_addin.R
@@ -0,0 +1,128 @@
+# Shiny `burst_pipes` RStudio add-in
+burst_pipes_addin <- function() {
+    pipeline_text <- rstudioapi::getSourceEditorContext()$selection[[1]]$text
+    if (pipeline_text == "") {
+        initial_tab <- "Change pipeline"
+    } else {
+        pipeline_init <- rlang::parse_expr(pipeline_text)
+        n_lines <- length(split_pipeline(pipeline_init, parse = FALSE)) - 1
+        initial_tab <- "Set names"
+    }
+
+    ui <- miniUI::miniPage(
+        shiny::div(style = "display:none;", shinyAce::aceEditor("invisible")),
+        miniUI::gadgetTitleBar(
+            "Burst pipes",
+            right = miniUI::miniTitleBarButton("done", "Replace code", primary = TRUE)
+        ),
+        miniUI::miniTabstripPanel(
+            id = "tab",
+            selected = initial_tab,
+            miniUI::miniTabPanel(
+                "Change pipeline", value = "Change pipeline",
+                icon = shiny::icon("bars"),
+                miniUI::miniContentPanel(shinyAce::aceEditor(
+                    "pipeline_code",
+                    value = pipeline_text,
+                    mode = "r",
+                    theme = "tomorrow",
+                    wordWrap = TRUE,
+                    autoComplete = "enabled"
+                ))
+            ),
+            miniUI::miniTabPanel(
+                "Set names", value = "Set names",
+                icon = shiny::icon("list-ul"),
+                miniUI::miniContentPanel(
+                    shiny::fillRow(
+                        flex = c(1, 2),
+                        shiny::code(
+                            style = "padding: 0px;",
+                            shiny::uiOutput("text_boxes")
+                        ),
+                        shinyAce::aceEditor(
+                            "code",
+                            value = utils::capture.output(
+                                burst_pipes(pipeline_init, parse = FALSE)
+                            ),
+                            mode = "r",
+                            theme = "tomorrow",
+                            wordWrap = TRUE,
+                            autoComplete = "enabled"
+                        )
+                    )
+                )
+            )
+        )
+    )
+
+    server <- function(input, output, session) {
+
+        pipeline <- shiny::reactive({
+            tryCatch(
+                rlang::parse_expr(paste(input$pipeline_code, collapse = " ")),
+                error = function(e) structure(
+                    quote("Invalid input" %>% print()),
+                    invalid = TRUE
+                )
+            )
+        })
+
+        n_lines <- shiny::reactive({
+            length(split_pipeline(pipeline(), parse = FALSE)) - 1
+        })
+
+        shiny::observe({
+            output$text_boxes <- shiny::renderUI(lapply(seq(n_lines()), function(i){
+                shiny::textInput(
+                    inputId = paste0("name", i),
+                    label = if (i == 1) "Names:" else NULL,
+                    value = paste0("dot", i),
+                    width = "90%"
+                )
+            }))
+        })
+
+        line_names <- shiny::reactive({
+            names <- vapply(
+                grep("^name\\d+$", names(input), value = TRUE),
+                function(n) input[[n]],
+                character(1)
+            )
+            names[names == ""] <- paste0("dot", seq(n_lines))[names == ""]
+            names
+        })
+
+        shiny::observe({
+            if (input$tab == "Set names") {
+                # ensure #names == #calls
+                dot_names <- paste0('dot', seq(n_lines()))
+                i <- seq(min(n_lines(), length(line_names())))
+                dot_names[i] <- line_names()[i]
+
+                if (isTRUE(attr(pipeline(), "invalid"))) {
+                    value <- "Error: Invalid input"
+                } else {
+                    value <- paste(utils::capture.output(
+                        burst_pipes(pipeline(), dot_names, parse = FALSE)
+                    ), collapse = "\n")
+                }
+
+                shinyAce::updateAceEditor(session, "code", value = value)
+            }
+        })
+
+        # replace text and close
+        shiny::observeEvent(input$done, {
+
+            rstudioapi::modifyRange(
+                rstudioapi::getSourceEditorContext()$selection[[1]]$range,
+                input$code
+            )
+            shiny::stopApp()
+        })
+    }
+
+    shiny::runGadget(ui, server)
+
+}
diff --git a/R/debug_pipeline.R b/R/debug_pipeline.R
@@ -71,21 +71,6 @@ split_pipeline <- function(pipeline, ...){
     }
 }
 
-#' Recursive helper function for `replace_dots`. Collapses nested nodelist back
-#' into a call.
-#'
-#' @param nodelist A list of calls, with parameters nested, of arbitrary depth
-#'
-#' @seealso [`replace_dots`]
-#' @keywords internal
-collapse_nodelist <- function(nodelist) {
-    if (length(nodelist) == 1) return(nodelist)    # return atomics
-    if (any(lengths(as.list(nodelist)) != 1)) {
-        nodelist <- lapply(nodelist, collapse_nodelist)    # recurse nested calls
-    }
-    as.call(nodelist)
-}
-
 #' Recursive helper function that replaces `.` within a call with a replacement
 #' expression. Ignores formulas.
 #'
@@ -94,19 +79,19 @@ collapse_nodelist <- function(nodelist) {
 #' @param call A quoted call in which to replace dots
 #' @param replacement A quoted name with which to replace dots
 #'
-#' @seealso [`collapse_nodelist`]
 #' @keywords internal
 replace_dots <- function(call, replacement){
     if (!rlang::is_formula(call) && length(call) > 1) {
         call <- lapply(call, replace_dots, replacement = replacement)    # recurse
+        call <- as.call(call)
     } else if (rlang::is_pairlist(call)) {    # for function formals
         call <- lapply(call, replace_dots, replacement = replacement)
         names(call)[names(call) == "."] <- as.character(replacement)
         call <- as.pairlist(call)
     } else if (call == as.name(".")) {
         call <- replacement    # replace
     }
-    collapse_nodelist(call)
+    call
 }
 
 #' Pipeline parser helper function that returns a list of names and calls
@@ -154,7 +139,8 @@ parse_pipeline <- function(pipeline, names, ...){
 #' `burst_pipes` rearranges a magrittr pipeline into equivalent unpiped code.
 #' Called directly, it will print the restructured code to the console. Called
 #' via the "Burst pipes" RStudio add-in while a pipeline is highlighted, it
-#' will replace the highlighted code with the restructured code.
+#' will replace the highlighted code with the restructured code. The "Burst
+#' pipes and set names" add-in opens a Shiny gadget in which names can be set.
 #'
 #' Note that nested pipelines are currently ignored. Calling on pipelines from
 #' the inside out should still allow restructuring.

diff --git a/README.Rmd b/README.Rmd
@@ -77,8 +77,8 @@ debug_pipeline(
 Occasionally it is necessary to restructure code from a piped to an unpiped 
 form. @hrbrmstr dubbed this process "pipe bursting": 
 
-<blockquote class="twitter-tweet" data-partner="tweetdeck"><p lang="en" dir="ltr">coined two new phrases whilst making that r pkg script thing:<br><br>- &quot;declawing&quot; == removing purrr as a dependency<br>- &quot;pipe bursting&quot; == moving from clean %&gt;% to sequential &lt;- statements</p>&mdash; boB Rudis (@hrbrmstr) <a href="https://twitter.com/hrbrmstr/status/1019700751268970502?ref_src=twsrc%5Etfw">July 18, 2018</a></blockquote>
-<script async src="https://platform.twitter.com/widgets.js" charset="utf-8"></script>
+<blockquote class="twitter-tweet" data-partner="tweetdeck"><p lang="en" dir="ltr">coined two new phrases whilst making that r pkg script thing:<br><br>- &quot;declawing&quot; == removing purrr as a dependency<br>- &quot;pipe bursting&quot; == moving from clean %&gt;% to sequential &lt;- statements</p>&mdash; boB Rudis (@hrbrmstr) <a href="https://twitter.com/hrbrmstr/status/1019700751268970502?ref_src=twsrc%5Etfw">July 18, 2018</a><script async src="https://platform.twitter.com/widgets.js" charset="utf-8"></script></blockquote>
+
 
 Now `burst_pipes` makes this sort of restructuring simple:
 
@@ -104,8 +104,10 @@ burst_pipes(
 )
 ```
 
-`burst_pipes` can also be called via an RStudio add-in, in which case it will 
-replace the highlighted code with its restructured form.
+`burst_pipes` can also be called via a pair of RStudio add-ins, which replace 
+the highlighted code with its restructured form. The "Burst pipes" add-in 
+creates names; the "Burst pipes and set names" add-in allows custom names to be 
+set.
 
 ## Limitations
 

diff --git a/README.md b/README.md
@@ -73,7 +73,7 @@ debug_pipeline(
 #>     })
 #>     print(x <- sample(dot2, replace = TRUE))
 #> }
-#> debug at /Users/alistaire/Documents/R_projects/pipecleaner/R/debug_pipeline.R#286: print(dot1 <- rev(1:5))
+#> debug at /Users/alistaire/Documents/R_projects/pipecleaner/R/debug_pipeline.R#271: print(dot1 <- rev(1:5))
 #> [1] 5 4 3 2 1
 #> debug: print(dot2 <- {
 #>     dot1 * 2
@@ -105,10 +105,10 @@ moving from clean %\>% to sequential \<- statements
 18,
 2018</a>
 
-</blockquote>
-
 <script async src="https://platform.twitter.com/widgets.js" charset="utf-8"></script>
 
+</blockquote>
+
 Now `burst_pipes` makes this sort of restructuring simple:
 
 ``` r
@@ -142,8 +142,10 @@ burst_pipes(
 #> x <- rnorm(1, third, sd = third/10)
 ```
 
-`burst_pipes` can also be called via an RStudio add-in, in which case it
-will replace the highlighted code with its restructured form.
+`burst_pipes` can also be called via a pair of RStudio add-ins, which
+replace the highlighted code with its restructured form. The “Burst
+pipes” add-in creates names; the “Burst pipes and set names” add-in
+allows custom names to be set.
 
 ## Limitations
 

diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/news/index.html b/docs/news/index.html
diff --git a/docs/reference/burst_pipes.html b/docs/reference/burst_pipes.html
diff --git a/docs/reference/debug_pipeline.html b/docs/reference/debug_pipeline.html
diff --git a/docs/reference/replace_dots.html b/docs/reference/replace_dots.html
diff --git a/inst/rstudio/addins.dcf b/inst/rstudio/addins.dcf
@@ -7,3 +7,8 @@ Name: Burst pipes
 Description: Replace pipes with intermediate assignment
 Binding: burst_pipes
 Interactive: false
+
+Name: Burst pipes and set names
+Description: Replace pipes with intermediate assignment to specified names
+Binding: burst_pipes_addin
+Interactive: true