R/app_ui.R

Defines functions dashboardPage_body dashboardPage_sidebar dashboardPage_header dashboardPage_ui ui_not_allowed golem_add_external_resources app_ui

#' The application User-Interface
#' 
#' @param request Internal parameter for `{shiny}`. 
#'     DO NOT REMOVE.
#'     
#' @importFrom shinydashboard dashboardPage
#' @importFrom shiny parseQueryString tagList HTML uiOutput
#' @importFrom httr oauth2.0_authorize_url 
#' 
#' @noRd
app_ui <- function(request) {
  
  glob <- readRDS('inst/app/global.rds')
  auth_conf <- glob$auth$conf
  auth_app <- glob$auth$app

  # If user is not authenticated return Authentication page
  auth_params <- parseQueryString(request$QUERY_STRING)
  if (is.null(auth_params$code)) {
    url <- httr::oauth2.0_authorize_url(
      auth_conf$endpoint, auth_app,
      scope = auth_conf$scope,
      redirect_uri = auth_conf$redirect_uri
    )
    redirect <- sprintf("location.replace(\"%s\");", url)
    tags$script(HTML(redirect))

  } else {

    tagList(
      # Leave this function for adding external resources
      golem_add_external_resources(),

      # UI
      uiOutput("ui")
    )

  }

}


#' Add external Resources to the Application
#' 
#' This function is internally used to add external 
#' resources inside the Shiny application. 
#' 
#' @import shiny
#' @importFrom shinyjs useShinyjs
# #' @importFrom golem add_resource_path activate_js favicon use_favicon bundle_resources use_external_css_file
#' @noRd
golem_add_external_resources <- function(){
  
  
  
  # add_resource_path(
  #   'www', app_sys('app/www')
  # )
  
  tags$head(
    # favicon(),
    # bundle_resources(
    #   path = app_sys('app/www'),
    #   app_title = 'Resourcefully Dashboard'
    # ),
    # Add here other external resources
    # golem::use_external_css_file("www/style.css"),
    tags$link(rel = "shortcut icon", href = "inst/app/www/favicon.ico"),
    tags$link(rel = "stylesheet", type = "text/css", href = "inst/app/www/style.css"),
    shinyjs::useShinyjs()
    # golem::activate_js()
    # for example, you can add shinyalert::useShinyalert()
  )
}


#' Rejection UI page
#'
#' @importFrom shiny wellPanel h2 h3
#'
#' @noRd
ui_not_allowed <- function() {
  wellPanel(
    h2("I'm sorry you are not allowed to be here."),
    h3("For more information contact info@resourcefully.nl")
  )
}


#' Application Dashboard Page
#'
#' @importFrom shinydashboard dashboardPage
#'
#' @noRd
dashboardPage_ui <- function() {
  dashboardPage(skin = "black", title = 'EV-NRG Dashboard',
                header = dashboardPage_header(), 
                sidebar = dashboardPage_sidebar(), 
                body = dashboardPage_body()
  )
}



# Dashboard page elements -------------------------------------------------

#' Dashboard page Header
#' 
#' @importFrom shiny span img
#' @importFrom shinydashboard dashboardHeader
#' 
#' @noRd
dashboardPage_header <- function() {
  dashboardHeader(
    title = span(img(src="www/img/logo-header.png", height='30')),
    disable = FALSE,
    titleWidth = 250
  )
}


#' Dashboard page Sidebar
#' 
#' @importFrom shinydashboard dashboardSidebar sidebarMenu menuItem box
#' @importFrom shiny HTML
#' @importFrom dygraphs dygraphOutput
#' 
#' @noRd
dashboardPage_sidebar <- function() {
  dashboardSidebar(
    width = 250,
    
    sidebarMenu(
      id = "sidebarmenu",
      HTML("&nbsp;"),
      menuItem(
        HTML("&nbspIntroduction"),
        tabName = "introduction",
        icon = icon("info")
      ),
      tags$hr(style = "width: 50%;"),
      menuItem(
        HTML("&nbspLocal data"),
        tabName = "local",
        icon = icon("area-chart")
      ),
      tags$hr(style = "width: 50%;"),
      menuItem(
        HTML("&nbspDB data"),
        tabName = "database",
        icon = icon("puzzle-piece")
      ),
      tags$hr(style = "width: 50%;"),
      menuItem(
        HTML("&nbspCloud data"),
        tabName = "cloud",
        icon = icon("cloud")
      ),
      tags$hr(style = "width: 50%;"),
      mod_dateRange_ui("dateRange_selector"),
      tags$hr(style = "width: 50%;")
    ),
    img(src="www/img/logo-sidebar.png", width = "100px", align = "left",
        style = "position: absolute; left: 65px; bottom: 40px;"),
    HTML("&nbsp;")
  )
}

#' Dashboard page Body
#' 
#' @importFrom shinydashboard dashboardBody tabItems tabItem box
#' @importFrom shiny uiOutput HTML h1 h2 h3
#' @importFrom dygraphs dygraphOutput
#' 
#' @noRd
dashboardPage_body <- function() {
  glob <- readRDS('inst/app/global.rds')
  conf <- glob$ui_conf
  dashboardBody(
    tabItems(
      tabItem("introduction",
              box(title = "", width = 12,
                  uiOutput("introduction")
              ),
              HTML("&nbsp;")
      ),
      tabItem("local",
              box(title = "", width = 12,
                  h1("Local file"),
                  dygraphOutput("solar_plot", height = conf$dygraphs$height)
              ),
              HTML("&nbsp;")
      ),
      tabItem("database",
              box(title = "", width = 12,
                  dygraphOutput("mongo_plot", height = conf$dygraphs$height)
              ),
              HTML("&nbsp;")
      ),
      tabItem("cloud",
              box(title = "", width = 12,
                  h1("Github repo file"),
                  dygraphOutput("horizon_plot", height = conf$dygraphs$height)
              ),
              HTML("&nbsp;")
      )
    )
  )
}
mcanigueral/testapp documentation built on June 30, 2020, 2:55 p.m.