AVSDevR.ShinyApplication/R/frameApplication.R

#' Basic R shiny application
#'
#' @export
# nolint next: object_name_linter. R6Class
FrameApplication <- R6::R6Class(
  "FrameApplication",
  public = list(
    #' @description Creates a new R Shiny application
    #' @param appPage <module> An application module (attempts to load
    #'     pages/application.R if not supplied)
    #' @param language <character> The language to use for the HTML page
    #'     (defaults to "en")
    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)
    },
    #' @description Binds the application to a session logger
    #' @param sessionLogger The session logger instance to use
    withSessionLogger = function(sessionLogger) {
      if (!inherits(sessionLogger, "SessionLogger")) {
        rlang::abort("sessionLogger is not an instance of SessionLogger class")
      }
      private$sessionLogger <- sessionLogger
      invisible(self)
    },
    #' @description Loads with the Bootstrap 4 shim CSS file
    withBootstrap4Shim = function() {
      private$withBS4 <- TRUE
      invisible(self)
    },
    #' @description Returns a DBClient instance for the current session
    #' @param session An R Shiny session
    #' @param db_config The database configuration to use (will attempt to find
    #'     and load a global.R or .env.R file if not supploed)
    #' @param allowFailure If a configuration cannot be loaded or a connection
    #'     to the database cannot be made, do not abort
    #' @returns A DBClient instance which is useable for the session
    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)
    },
    #' @description Creates the UI component for an R Shiny application
    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 <- "css/bootstrap-4-shim.min.css"
        } else {
          css <- "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)
    },
    #' @description Creates the server component for an R Shiny application
    #' @param input The UI inputs bound for the session
    #' @param output The UI outputs bound for the session
    #' @param session The current session
    #' @param ... Parameters passed into the inner application
    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),
        ...
      )
    },
    #' @description Instantiates an R Shiny application
    #' @returns An R Shiny application suitable for \link[shiny]{runApp}
    app = function() {
      shiny::shinyApp(self$ui(), self$server)
    }
  ),
  private = list(
    appPage = NULL,
    language = "en",
    sessionLogger = NULL,
    withBS4 = FALSE
  )
)