R/11_flow_view_shiny.R

In moodymudskipper/flow: View and Browse Code Using Flow Diagrams

#' Visualize a shiny app's dependency graph
#'
#' `r lifecycle::badge("experimental")`
#' This function displays a shiny app's module structure, assuming it is built
#' on top of module functions named a certain way (adjustable through the `pattern` argument) and
#' calling each other. If you call for instance `flow_view_shiny()` on a function that runs the app and
#' uses both the main server and ui functions, you'll display the full graph of server and ui modules.
#'
#' It is  wrapper around `flow_view_deps()` which demotes every object that is not
#' a server function, a ui function or a function calling either. What is or isn't considered as a
#' server or ui function depends on a regular expression provided through the `pattern`
#' argument. For a more general way of displaying all dependencies (not focused on modules),
#' use `flow_view_deps()`.
#'
#' @param fun The function that runs the app
#' @param pattern A regular expression used to detect ui and server functions
#' @inheritParams flow_view_deps
#' @export
#' @return A flow diagram object.
#' @examples
#' if (requireNamespace("esquisse", quietly = TRUE)) {
#'   flow_view_shiny(esquisse::esquisser, show_imports = "none")
#' }
flow_view_shiny <- function(
  fun,
  max_depth = Inf,
  trim = NULL,
  promote = NULL,
  demote = NULL,
  hide = NULL,
  show_imports = c("functions", "packages", "none"),
  out = NULL,
  lines = TRUE,
  pattern = "(_ui)|(_server)|(Ui)|(Server)|(UI)|(SERVER)") {
  show_imports <- match.arg(show_imports)
  fun_sym <- substitute(fun)
  ns <- environment(fun) # not robust
  pkg <- namespace_name(ns)
  pkg_objs <- ls(ns)
  pkg_funs <- names(Filter(is.function, mget(pkg_objs, ns)))
  pkg_non_funs <- setdiff(pkg_objs, pkg_funs)
  module_funs <- grep(pattern, pkg_funs, value = TRUE)
  # this should be recursive
  calls_ui_or_server <- sapply(
    pkg_funs,
    function (x) any(grepl(pattern, all.names(body(getFromNamespace(x, pkg))))))
  new <- pkg_funs[calls_ui_or_server]
  new <- setdiff(new, module_funs)
  module_funs <- c(module_funs, new)
  while(length(new)) {
    new <- Filter(
      function (x) any(all.names(body(getFromNamespace(x, pkg))) %in% module_funs),
      pkg_funs)
    new <- setdiff(new, module_funs)
    module_funs <- c(module_funs, new)
  }
  auto_demote <- paste0(pkg, ":::", c(setdiff(pkg_funs, module_funs), pkg_non_funs))
  # not sure about it, we should at least namespace them first
  auto_demote <- setdiff(auto_demote, promote)
  demote <- c(auto_demote, demote)

  do.call(flow_view_deps, list(fun_sym, max_depth, trim, promote, demote, hide, show_imports, out, lines))
}