Create a R script to look up shiny examples in a package

DESCRIPTION

@@ -176,6 +176,7 @@ Collate:
     'render-cached-plot.R'
     'render-plot.R'
     'render-table.R'
+    'run-example.R'
     'run-url.R'
     'runapp.R'
     'serializers.R'

NAMESPACE

@@ -43,11 +43,13 @@ S3method(bindEvent,reactiveExpr)
 S3method(bindEvent,shiny.render.function)
 S3method(format,reactiveExpr)
 S3method(format,reactiveVal)
+S3method(format,shiny_available_examples)
 S3method(names,reactivevalues)
 S3method(print,reactive)
 S3method(print,reactivevalues)
 S3method(print,shiny.appobj)
 S3method(print,shiny.render.function)
+S3method(print,shiny_available_examples)
 S3method(print,shiny_runtests)
 S3method(str,reactivevalues)
 export("conditionStackTrace<-")
@@ -65,6 +67,7 @@ export(addResourcePath)
 export(animationOptions)
 export(appendTab)
 export(as.shiny.appobj)
+export(availableExamples)
 export(basicPage)
 export(bindCache)
 export(bindEvent)

R/run-example.R

@@ -0,0 +1,174 @@
+#' Function to get the path of a Shiny example in a package
+#'
+#' @param package A character string specifying the name of the package
+#' @param name A character string specifying the name of the example
+#'
+#' @return A character string specifying the path of the example
+#' OR a data frame containing information about all available Shiny examples
+#'
+#' @noRd
+runExampleAppDir <- function(package = NULL, name = NULL) {
+    # arg checking
+    if (is.null(package)) {
+        if (is.null(name)) {
+            # neither package nor name is specified
+            return(availableExamples(package = NULL))
+        } else {
+            stop("Please provide a package name
+            when specifying an example name.")
+        }
+    } else {
+        stopifnot(length(package) == 1 && is.character(package))
+        # Search for a Shiny example with a given name in a package
+        if (!is.null(name)) {
+            examples <- availableExamples(package = package)
+            example_path <- examples[examples$name == name, "source_directory"]
+            if (length(example_path) > 0) {
+                return(example_path)
+            } else {
+                stop("No matching example found within the package")
+            }
+        }
+        # only package is specified
+        return(availableExamples(package = package))
+    }
+}
+
+#' Function to get a data frame of all available Shiny examples
+#'
+#' @param package A character string specifying the name of the package
+#'
+#' @return A data frame containing information
+#' about all available Shiny examples
+#'
+#' @export
+availableExamples <- function(package = NULL) {
+    info <-
+        if (is.null(package)) {
+            allAvailableExamples()
+        } else {
+            availableExamplesForPackage(package)
+        }
+    if (!is.null(info$error)) {
+        stop(info$error, call. = FALSE)
+    }
+    examples <- info$examples
+    return(examples)
+}
+
+#' Function to get a data frame of all available Shiny examples for a package
+#'
+#' @param package A character string specifying the name of the package
+#'
+#' @return A data frame containing information about all
+#'  available Shiny examples for the package
+#' @noRd
+availableExamplesForPackage <- function(package) {
+    an_error <- function(...) {
+        list(
+            examples = NULL,
+            error = paste0(...)
+        )
+    }
+
+    if (!nzchar(system.file(package = package))) {
+        return(an_error(
+            "No package found with name: \"", package, "\""
+        ))
+    }
+
+    examples_dir <- system.file("shiny-examples", package = package)
+    if (!nzchar(examples_dir)) {
+        return(an_error(
+            "No Shiny examples found for package: \"", package, "\""
+        ))
+    }
+
+    example_folders <- list.dirs(
+        examples_dir,
+        full.names = TRUE,
+        recursive = FALSE
+    )
+    names(example_folders) <- basename(example_folders)
+
+    example_info <- lapply(example_folders, function(example_dir) {
+        data.frame(
+            package = package,
+            name = basename(example_dir),
+            source_directory = example_dir,
+            stringsAsFactors = FALSE,
+            row.names = FALSE
+        )
+    })
+
+    examples <- do.call(rbind, example_info)
+    class(examples) <- c("shiny_available_examples", class(examples))
+
+    list(
+        examples = examples,
+        error = NULL
+    )
+}
+
+#' Function to get a data frame of all available Shiny examples
+#'  for all installed packages
+#'
+#' @return A data frame containing information about
+#'  all available Shiny examples for all installed packages
+#' @noRd
+allAvailableExamples <- function() {
+    ret <- list()
+    all_pkgs <- installed.packages()[, "Package"]
+
+    for (pkg in all_pkgs) {
+        info <- availableExamplesForPackage(pkg)
+        if (!is.null(info$examples)) {
+            ret[[length(ret) + 1]] <- info$examples
+        }
+    }
+
+    # combines the data frames into a single data frame
+    examples <- do.call(rbind, ret)
+
+    list(
+        examples = examples, # will maintain class
+        error = NULL
+    )
+}
+
+#' @export
+format.shiny_available_examples <- function(x, ...) {
+    examples <- x
+    split_examples <- split(examples, examples$package)
+
+    pkg_examples <- vapply(
+        split_examples,
+        function(examples_sub) {
+            paste0(
+                "* ", examples_sub$package[1], "\n",
+                paste0("  - ", examples_sub$name, collapse = "\n")
+            )
+        },
+        character(1)
+    )
+
+    paste0(
+        "Available Shiny examples:\n",
+        paste0(pkg_examples, collapse = "\n")
+    )
+}
+
+#' @export
+print.shiny_available_examples <- function(x, ...) {
+    cat(format(x, ...), "\n", sep = "")
+}
+
+# runExampleAppDir()
+# runExampleAppDir(package = "shiny")
+# runExampleAppDir(package = "tidyverse")
+
+# runExampleAppDir(package = c("shiny", "tidyverse"))
+# runExampleAppDir(package = "shuny")
+# runExampleAppDir(name = "01_hello")
+# runExampleAppDir(package = "shiny", name = "01_hello")
+# runExampleAppDir(package = "shiny", name = "05_hello")

tools/documentation/pkgdown.yml

@@ -144,6 +144,7 @@ reference:
       - viewer
       - isRunning
       - loadSupport
+      - availableExamples
   - title: Bookmarking state
     desc: Functions that are used for bookmarking and restoring state.
     contents: