#' 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 <- 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")),
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.")
)
)
),
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')
)
)
)
),
miniTabPanel(
"Output", icon = icon("table"),
miniContentPanel(
fillCol(
flex = c(1, 3),
inputPanel(
width = "100%;",
selectInput('regexFn', label = 'Apply Function',
choices = regexFn_choices)
),
# verbatimTextOutput('output_result', placeholder = TRUE)
tags$pre(
id = "output_result",
class = "shiny-text-output",
style = "overflow-y: scroll; height: 100%;"
)
)
)
),
miniTabPanel(
"Help", icon = icon("support"),
help_ui("help")
)
)
)
server <- function(input, output, session) {
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 = "
"),
"")
}
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), 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)) }) output$output_result <- renderPrint({ req(input$regexFn) regexPkg <- get_pkg_namespace(input$regexFn) regexFn <- getFromNamespace(input$regexFn, regexPkg) x <- if (regexPkg == "base") { regexFn(pattern(), rtext()) } else if (regexPkg == "stringr") { regexFn(rtext(), pattern()) } else { "Um. Not sure how I got here." } print(x) }) # ---- Help Section ---- # help_text <- callModule(help_server, "help") 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) } sanitize_text_input <- function(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", "regexpr", "gregexpr", "regexec" ), stringr = c( "str_detect", "str_locate", "str_locate_all", "str_extract", "str_extract_all", "str_match", "str_match_all", "str_split" ) ) 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 }