Required classes for our style of building/running shiny applications (no documentation)

2026-02-03 13:12:25 +00:00
parent 7c619d6543
commit fa9a4dd82e
11 changed files with 3414 additions and 0 deletions
--- a/R/frameApplication.R
+++ b/R/frameApplication.R
@@ -0,0 +1,143 @@
+
+#' @export
+FrameApplication <- R6::R6Class(
+  "FrameApplication",
+  public = list(
+    initialize = function(appPage = NULL, language = NULL) {
+      if (!is.null(appPage)) {
+        private$appPage <- appPage
+      } else {
+        private$appPage <- modules::use("pages/application.R")
+      }
+      if (!is.null(language)) {
+        private$language <- language
+      }
+      invisible(self)
+    },
+    withSessionLogger = function(sessionLogger) {
+      if (!inherits(sessionLogger, "SessionLogger")) {
+        rlang::abort("sessionLogger is not an instance of SessionLogger class")
+      }
+      private$sessionLogger <- sessionLogger
+      invisible(self)
+    },
+    withBootstrap4Shim = function() {
+      private$withBS4 <- TRUE
+      invisible(self)
+    },
+    getSessionDBClient = function(
+      session, db_config = NULL, allowFailure = FALSE
+    ) {
+      # Check DBClient package is installed
+      if (!rlang::is_installed("AVSDevR.DBClient")) {
+        return(NULL)
+      }
+
+      # Check connection configuration is available
+      db_conn <- AVSDevR.DBClient::DBConnection$new()
+      if (is.null(db_config)) {
+        if (!db_conn$loadConfiguration(TRUE)) {
+          return(NULL)
+        }
+      } else {
+        db_conn$configure(db_config)
+      }
+
+      # Try and connect
+      if (!db_conn$connect()) {
+        if (allowFailure) {
+          rlang::abort(
+            "Failed to connect to database - database not available or not \
+            created"
+          )
+        }
+        return(NULL)
+      }
+      db_conn$disconnectOnSessionEnd(session)
+
+      # Create the client instance
+      AVSDevR.DBClient::DBClient$new(db_conn)
+    },
+    ui = function() {
+      if (file.exists("widgets/menu.R")) {
+        # Multi-frame application
+        frame <- do.call(tabItems, private$appPage$tabs("application"))
+        frame_tabs <- sapply(frame$children, function(tab) {
+          tab$attr$`data-tabName`
+        })
+
+        menu <- modules::use("widgets/menu.R")
+        menu_tabs <- unname(sapply(
+          menu$ui, function(ti) {
+            ti$children[[1]]$attr$`data-value`
+          }
+        ))
+
+        if (!identical(sort(menu_tabs), sort(frame_tabs))) {
+          rlang::abort(
+            "Tab names in widgets/menu.R do not match tab names in \
+            pages/application.R!"
+          )
+        }
+      } else {
+        # Single frame application
+        frame <- shiny::fluidPage(
+          title = private$appPage$title(),
+          private$appPage$ui("application")
+        )
+      }
+
+      ui <- shiny::tagList(
+        shiny::tags$head(
+          shiny::singleton(
+            shinyjs::useShinyjs(debug = getOption("debug.shinyjs", FALSE))
+          )
+        ),
+        frame,
+        if (rlang::is_installed("AVSDevR.ShinyDisconnectHandler")) {
+          AVSDevR.ShinyDisconnectHandler::useBannerDisconnectHandler()
+        }
+      )
+
+      if (private$withBS4) {
+        # Attach boostrap 4 css shim
+        if (getOption("shiny.minified", TRUE)) {
+          css <- "bootstrap-4-shim.min.css"
+        } else {
+          css <- "bootstrap-4-shim.css"
+        }
+        uiDeps <- htmltools::htmlDependency(
+          "AVSDevR.ShinyApplication",
+          as.character(utils::packageVersion("AVSDevR.ShinyApplication")),
+          c(file = system.file(package = "AVSDevR.ShinyApplication")),
+          stylesheet = css
+        )
+        ui <- htmltools::attachDependencies(ui, uiDeps)
+      }
+
+      # Set the language
+      shiny:::setLang(ui, private$language)
+    },
+    server = function(input, output, session, ...) {
+      if (!is.null(private$sessionLogger)) {
+        private$sessionLogger$attachSession(session)
+      }
+
+      shiny::callModule(
+        private$appPage$server,
+        "application",
+        db_client = self$getSessionDBClient(session),
+        ...
+      )
+    },
+    app = function() {
+      shiny::shinyApp(self$ui(), self$server)
+    }
+  ),
+  private = list(
+    appPage = NULL,
+    language = "en",
+    sessionLogger = NULL,
+    withBS4 = FALSE
+  )
+)