#' regexplain gadget #' #' @import miniUI #' @import shiny #' @param text Text to explore in gadget (editable using interface) #' @param start_page Open gadget to this tab, one of `"Text"`, `"Regex"`, #' `"Output"`, or `"Help"` #' @export regex_gadget <- function(text = NULL, start_page = if (is.null(text)) "Text" else "Regex") { stopifnot(requireNamespace("miniUI"), requireNamespace("shiny")) # ---- UI ---- ui <- miniPage( shiny::includeCSS(system.file("styles", "style.css", package = "regexplain")), shiny::includeCSS(system.file("styles", "gadget.css", package = "regexplain")), gadgetTitleBar( "regexplain", right = miniTitleBarButton("done", "Send Regex To Console", TRUE) ), miniTabstripPanel( selected = match.arg(start_page, c("Text", "Regex", "Output", "Help")), # --- UI - Tab - Text ---- miniTabPanel( "Text", icon = icon('file-text-o'), miniContentPanel( fillCol( textAreaInputAlt('text', label = "Text to search or parse", value = paste(text, collapse = "\n"), resize = "both", width = "100%", height="90%", placeholder = "Paste, enter, or edit your sample text here.") ) ) ), # ---- UI - Tab - Regex ---- miniTabPanel( "Regex", icon = icon('terminal'), miniContentPanel( fillCol( flex = c(1, 3), fillCol( flex = c(1, 1), textInputCode('pattern', 'Regex', width = "100%", placeholder = "Enter regex, single \\ okay"), checkboxGroupInput( 'regex_options', label = "", inline = TRUE, width = "90%", choices = c("Break Lines" = "text_break_lines", "Ignore Case" = "ignore.case", "Perl Style" = "perl", "Fixed" = "fixed", "Use Bytes" = "useBytes" # , "Invert" = "invert" ), selected = c('text_break_lines') ) ), tags$div( class = "gadget-result", style = "overflow-y: scroll; height: 100%;", htmlOutput('result') ) ) ) ), # ---- UI - Tab - Output ---- miniTabPanel( "Output", icon = icon("table"), miniContentPanel( fillCol( flex = c(1, 3), inputPanel( width = "100%;", selectInput('regexFn', label = 'Apply Function', choices = regexFn_choices), uiOutput("output_sub") ), # verbatimTextOutput('output_result', placeholder = TRUE) tags$pre( id = "output_result", class = "shiny-text-output", style = "overflow-y: scroll; height: 100%;" ) ) ) ), # ---- UI - Tab - Help ---- miniTabPanel( "Help", icon = icon("support"), help_ui("help") ) ) ) # ---- Server ---- server <- function(input, output, session) { # ---- Server - Global ---- rtext <- reactive({ x <- if ('text_break_lines' %in% input$regex_options) { strsplit(input$text, "\n")[[1]] } else input$text x }) pattern <- reactive({ sanitize_text_input(input$pattern) }) alert_result <- function(msg, type = "danger") { msg <- gsub("\n", "
", msg) msg <- gsub("\t", "  ", msg) paste0("
",
             paste(msg, collapse = "
"), "
") } # ---- Server - Tab - Regex ---- output$result <- renderUI({ if (is.null(rtext())) return(NULL) if (pattern() == "") { return(toHTML(paste('

', escape_html(rtext()), "

", collapse = ""))) } res <- NULL error_message <- NULL warning_message <- NULL tryCatch({ res <- paste( view_regex( rtext(), pattern(), ignore.case = 'ignore.case' %in% input$regex_options, perl = 'perl' %in% input$regex_options, fixed = 'fixed' %in% input$regex_options, useBytes = 'useBytes' %in% input$regex_options, # invert = 'invert' %in% input$regex_options, render = FALSE, escape = TRUE, exact = FALSE), collapse = "" ) }, error = function(e) { error_message <<- alert_result(e$message, "danger") }, warning = function(w) { warning_message <<- alert_result(w$message, "warning") }) if (is.null(res)) res <- toHTML( paste('

', escape_html(rtext()), "

", collapse = "") ) toHTML(paste(error_message, warning_message, res)) }) # ---- Server - Tab - Output ---- regexFn_replacement_val <- NULL output$output_sub <- renderUI({ req(input$regexFn) if (!input$regexFn %in% regexFn_substitute) return(NULL) textInputCode('regexFn_replacement', 'Subsitution', value = regexFn_replacement_val, placeholder = "Replacement Text") }) replacement <- reactive({ req(input$regexFn) if (!input$regexFn %in% regexFn_substitute) { NULL } else { regexFn_replacement_val <<- input$regexFn_replacement sanitize_text_input(input$regexFn_replacement) } }) output$output_result <- renderPrint({ req(input$regexFn) regexPkg <- get_pkg_namespace(input$regexFn) regexFn <- getFromNamespace(input$regexFn, regexPkg) req_sub_arg <- input$regexFn %in% regexFn_substitute x <- if (regexPkg == "base") { if (req_sub_arg) { req(replacement()) regexFn(pattern(), replacement(), rtext()) } else { regexFn(pattern(), rtext()) } } else if (regexPkg == "stringr") { if (req_sub_arg) { req(replacement()) regexFn(rtext(), pattern(), replacement()) } else { regexFn(rtext(), pattern()) } } else { "Um. Not sure how I got here." } print(x) }) # ---- Server - Tab - Help ---- help_text <- callModule(help_server, "help") # ---- Server - Tab - Exit ---- observeEvent(input$done, { # browser() if (pattern() != "") { pattern <- paste0('pattern <- "', escape_backslash(pattern()), '"') rstudioapi::sendToConsole(pattern, FALSE) } stopApp() }) observeEvent(input$cancel, { stopApp() }) } viewer <- shiny::paneViewer(700) runGadget(ui, server, viewer = viewer) } # ---- Gadget Helper Functions and Variables ---- sanitize_text_input <- function(x) { if (is.null(x) || !nchar(x)) return(x) if (grepl("\\u|\\x|\\N|\\a|\\o", x)) { try({ y <- stringi::stri_unescape_unicode(x) }, silent = TRUE) if (!is.na(y)) x <- y } # x <- gsub("\u201C|\u201D", '"', x) # x <- gsub("\u2018|\u2019", "'", x) x } toHTML <- function(...) { x <- paste(..., collapse = "") x <- gsub("\n", "\\\\n", x) x <- gsub("\t", "\\\\t", x) x <- gsub("\r", "\\\\r", x) HTML(x) } regexFn_choices <- list( "Choose a function" = "", base = c( "grep", "grepl", "sub", #<< "gsub", #<< "regexpr", "gregexpr", "regexec" ), stringr = c( "str_detect", "str_locate", "str_locate_all", "str_extract", "str_extract_all", "str_match", "str_match_all", "str_replace", #<< "str_replace_all", #<< "str_split" ) ) regexFn_substitute <- c( paste0(c("", "g"), "sub"), paste0("str_replace", c("", "_all")) ) get_pkg_namespace <- function(fn) { x <- names(purrr::keep(regexFn_choices, ~ (fn %in% .))) if (length(x) > 1) warning(fn, " matches multiple functions in regexFn_choices, please review.") x }