diff --git a/inst/eDISH_app/global.R b/inst/eDISH_app/global.R index 2d4f75f9..afd6781c 100644 --- a/inst/eDISH_app/global.R +++ b/inst/eDISH_app/global.R @@ -1,5 +1,6 @@ library(safetyGraphics) library(shiny) +library(shinyWidgets) library(shinyjs) library(dplyr) library(purrr) diff --git a/inst/eDISH_app/modules/renderSettings/renderSettings.R b/inst/eDISH_app/modules/renderSettings/renderSettings.R index 998cf506..014d686c 100644 --- a/inst/eDISH_app/modules/renderSettings/renderSettings.R +++ b/inst/eDISH_app/modules/renderSettings/renderSettings.R @@ -1,4 +1,5 @@ # Functions to include +source("modules/renderSettings/util/createSettingsSection.R") source("modules/renderSettings/util/createSettingLabel.R") source("modules/renderSettings/util/createControl.R") source("modules/renderSettings/util/createSettingsUI.R") @@ -223,13 +224,14 @@ renderSettings <- function(input, output, session, data, settings, status){ status_new()$checks %>% group_by(text_key) %>% mutate(num_fail = sum(valid==FALSE)) %>% + mutate(icon = ifelse(num_fail==0, "",""))%>% mutate(message_long = paste(message, collapse = " ") %>% trimws(), message_short = case_when( num_fail==0 ~ "OK", num_fail==1 ~ "1 failed check.", TRUE ~ paste(num_fail, "failed checks.") )) %>% - select(text_key, message_long, message_short, num_fail) %>% + select(text_key, icon, message_long, message_short, num_fail) %>% unique }) @@ -246,8 +248,8 @@ renderSettings <- function(input, output, session, data, settings, status){ status_short <- status_df()[status_df()$text_key==key, "message_short"] status_long <- status_df()[status_df()$text_key==key, "message_long"] - - updateSettingStatus(ns=ns, key=key, status_short=status_short, status_long=status_long) + icon <- status_df()[status_df()$text_key==key, "icon"] + updateSettingStatus(ns=ns, key=key, status_short=status_short, status_long=status_long, icon=icon) } } diff --git a/inst/eDISH_app/modules/renderSettings/renderSettingsUI.R b/inst/eDISH_app/modules/renderSettings/renderSettingsUI.R index e2a34290..83a3f4c3 100644 --- a/inst/eDISH_app/modules/renderSettings/renderSettingsUI.R +++ b/inst/eDISH_app/modules/renderSettings/renderSettingsUI.R @@ -1,97 +1,23 @@ -#' Render Settings module - UI code -#' -#' This module creates the Settings tab for the Shiny app. The UI is dynamically populated from the server side. -#' -#' The UI contains: -#' - Chart selector -#' - Settings customizations for the selected charts: -#' - Data mapping -#' - Measure settings -#' - Appearance settings -#' -#' @param id The module-specific ID that will get pre-pended to all element IDs -#' -#' @return The UI for the Settings tab -#' + renderSettingsUI <- function(id){ - ns <- NS(id) - tagList( - verticalLayout( - fluidRow( - column(4, - wellPanel( - div( - span(h2(tags$strong("Select Chart(s):"))), - checkboxGroupInput(ns("charts"),"", - choices = c("e-DISH" = "edish"), - selected="edish")) - ) + fluidRow( + column(12, + class="chartSelect section", + checkboxGroupInput( + ns("charts"), + "Select Chart(s):", + choices = c("e-DISH" = "edish"), + selected="edish" ) - ), - fluidRow( - column(4, - tags$hr() - ) - ), - fluidRow( - column(4, - h2(tags$strong("Customize Settings:")) - ) - ), - fluidRow( - column(4, - div( - div(style="display: inline-block;", h3(tags$i("Data Mapping"))), - div(style="display: inline-block;", checkboxInput(ns("show_data_mapping"), "show", TRUE)) - ) - ) - ), - conditionalPanel(condition="input.show_data_mapping", ns=ns, - fluidRow( - column(4, - wellPanel( - uiOutput(ns("data_mapping_ui")) - )) - - ) - ), - - fluidRow( - column(4, - div( - div(style="display: inline-block;", h3(tags$i("Measure Settings"))), - div(style="display: inline-block;", checkboxInput(ns("show_measure_settings"), "show", TRUE)) - ) - ) - ), - conditionalPanel(condition="input.show_measure_settings", ns=ns, - fluidRow( - column(4, - wellPanel( - uiOutput(ns("measure_settings_ui")) - - ) - ) - ) - ), - fluidRow( - column(6, - div( - div(style="display: inline-block;", h3(tags$i("Appearance Settings"))), - div(style="display: inline-block;", checkboxInput(ns("show_appearance_settings"), "show", TRUE)) - ) - ) - ), - conditionalPanel(condition="input.show_appearance_settings", ns=ns, - fluidRow( - column(4, - wellPanel( - uiOutput(ns("appearance_settings_ui")) - ) - ) - ) ) - )) + ), + #TODO - make this a loop based on metadata + fluidRow( + createSettingsSection("data_mapping", "Data Mappings",6,ns), + createSettingsSection("measure_settings", "Measure Settings",6,ns), + createSettingsSection("appearance_settings", "Appearance Settings",6,ns) + ) + ) } diff --git a/inst/eDISH_app/modules/renderSettings/util/createControl.R b/inst/eDISH_app/modules/renderSettings/util/createControl.R index b958f647..11b418a2 100644 --- a/inst/eDISH_app/modules/renderSettings/util/createControl.R +++ b/inst/eDISH_app/modules/renderSettings/util/createControl.R @@ -19,7 +19,7 @@ createControl <- function(key, metadata, data, settings, ns){ sm_key <- filter(metadata, text_key==key) - + ctl_id <- paste0("ctl_", key) tt_msg <- paste0("tt_msg_", key) msg <- paste0("msg_", key) @@ -28,6 +28,7 @@ createControl <- function(key, metadata, data, settings, ns){ setting_value <- safetyGraphics:::getSettingValue(key=setting_key, settings=settings) setting_label <- createSettingLabel(key) setting_description <- getSettingsMetadata(text_keys=key, cols="description") + setting_required <- ifelse(getSettingsMetadata(text_keys=key, cols="setting_required"),"\nSetting Required","\nSetting Optional") ### if a field-level input, get metadata about the parent column-level input field_column <- NULL @@ -37,69 +38,53 @@ createControl <- function(key, metadata, data, settings, ns){ field_column_label <- getSettingsMetadata(text_key = sm_key$field_column_key, cols = "label") } - ### get the choices for the selectors value <- NULL choices <- NULL placeholder <- NULL - if(sm_key$column_mapping==TRUE){ - if(is.null(setting_value)){ + + if(sm_key$column_mapping==TRUE & is.null(setting_value)){ #column mapping - no value specified choices <- colnames(data) - placeholder <- list( - onInitialize = I('function() { - this.setValue("");}')) - } else{ - choices <- unique(c(setting_value, colnames(data))) - placeholder <- list (onInitialize = I('function() { }')) - } - } else if (sm_key$field_mapping==TRUE){ - if(is.null(field_column)){ ## if there is NOT a column specified in settings + placeholder <- list(onInitialize = I('function() {this.setValue("");}')) + } else if(sm_key$column_mapping==TRUE & !is.null(setting_value)) { #column mapping - value specified + choices <- unique(c(setting_value, colnames(data))) + placeholder <- list (onInitialize = I('function() { }')) + } else if (sm_key$field_mapping==TRUE & is.null(field_column)){ ## if there is NOT a column specified in settings placeholder <- list( placeholder = paste0("Please select a ", field_column_label), onInitialize = I('function() { - this.setValue("");}')) - } else{ ## if there is a column specified in settings + this.setValue("");}') + ) + } else if (sm_key$field_mapping==TRUE & !is.null(field_column)){ ## if there is NOT a column specified in settings choices <- unique(c(setting_value, as.character(data[,field_column]))) %>% unlist placeholder <- list (onInitialize = I('function() { }')) - } } else if (sm_key$setting_type=="vector"){ choices <- setting_value ### this is meant to cover the scenario for x_options/y_options } - - ### create code for the UI + multiple <- (sm_key$setting_type=="vector") + if (sm_key$column_mapping==TRUE | sm_key$field_mapping==TRUE){ - - multiple <- (sm_key$setting_type=="vector") - - div( - span(title = setting_description, tags$label(HTML(setting_label))), - span(id = ns(tt_msg), title = "", tags$label(id = ns(msg), "")), - selectizeInput(inputId = ns(key), label = NULL, choices = choices, options = placeholder, multiple = multiple) - ) + input <- selectizeInput(inputId = ns(key), label = NULL, choices = choices, options = placeholder, multiple = multiple) } else if (sm_key$setting_type=="vector"){ - - div( - span(title = setting_description, tags$label(HTML(setting_label))), - span(id = ns(tt_msg), title = "", tags$label(id = ns(msg), "")), - selectizeInput(inputId = ns(key), label = NULL, choices = choices, selected = choices, multiple = TRUE) - ) - + input <- selectizeInput(inputId = ns(key), label = NULL, choices = choices, selected = choices, multiple = TRUE) } else if (sm_key$setting_type=="numeric"){ - div( - div(title = setting_description, tags$label(HTML(setting_label))), - sliderInput(inputId = ns(key), label = NULL, value=setting_value, min=0, max=50) - ) + input <- sliderInput(inputId = ns(key), label = NULL, value=setting_value, min=0, max=50) } else if (sm_key$setting_type=="logical"){ - div( - div(title = setting_description, tags$label(HTML(setting_label))), - checkboxInput(inputId = ns(key), label = NULL, value=setting_value) - ) + input <- checkboxInput(inputId = ns(key), label = NULL, value=setting_value) } else if (sm_key$setting_type=="character"){ + input <-textAreaInput(inputId = ns(key), label = NULL, value = setting_value) + } + + div( + class="control-wrap", + id=ns(ctl_id), + span(title = paste0(setting_description," ",setting_required), tags$label(HTML(setting_label))), div( - div(title = setting_description, tags$label(HTML(setting_label))), - textAreaInput(inputId = ns(key), label = NULL, value = setting_value) + class="select-wrap", + input, + div(id = ns(tt_msg), title = "", tags$label(id = ns(msg), ""), class="status") ) - } + ) } \ No newline at end of file diff --git a/inst/eDISH_app/modules/renderSettings/util/createSettingLabel.R b/inst/eDISH_app/modules/renderSettings/util/createSettingLabel.R index c496ae53..5f162221 100644 --- a/inst/eDISH_app/modules/renderSettings/util/createSettingLabel.R +++ b/inst/eDISH_app/modules/renderSettings/util/createSettingLabel.R @@ -9,10 +9,5 @@ createSettingLabel <- function(key){ sm <- getSettingsMetadata(text_keys=key) setting_label <- sm$label required <- sm$setting_required - - if (required){ - paste0(" ", setting_label, "*") - } else { - paste0(" ", setting_label) - } + paste0(setting_label)#, " " ) } diff --git a/inst/eDISH_app/modules/renderSettings/util/createSettingsSection.R b/inst/eDISH_app/modules/renderSettings/util/createSettingsSection.R new file mode 100644 index 00000000..eca0959e --- /dev/null +++ b/inst/eDISH_app/modules/renderSettings/util/createSettingsSection.R @@ -0,0 +1,24 @@ +createSettingsSection <- function(class, label,cols,ns){ + section <- + column(cols, + wellPanel( + class=paste0(class," section"), + h3( + label, + materialSwitch( + ns(paste0("show_",class)), + label = "", + right=TRUE, + value = TRUE, + status = "primary" + ) + ), + conditionalPanel( + condition=paste0("input.show_",class), + ns=ns, + uiOutput(ns(paste0(class,"_ui"))) + ) + ) + ) + return(section) +} \ No newline at end of file diff --git a/inst/eDISH_app/modules/renderSettings/util/updateSettingStatus.R b/inst/eDISH_app/modules/renderSettings/util/updateSettingStatus.R index ed3d49e2..a3003b57 100644 --- a/inst/eDISH_app/modules/renderSettings/util/updateSettingStatus.R +++ b/inst/eDISH_app/modules/renderSettings/util/updateSettingStatus.R @@ -9,24 +9,21 @@ #' @param status_short Abbreviated validation message #' @param status_long Detailed validation message -updateSettingStatus<-function(ns, key, status_short, status_long){ +updateSettingStatus<-function(ns, key, status_short, status_long, icon){ + ctl_id<-paste0("ctl_", key) + #TODO: get msg_ and tooltip_ selectors using relative position to control id msg_id <- paste0("msg_", key) tooltip_id <- paste0("tt_msg_", key) - - if (status_short=="OK"){ - shinyjs::html(id = msg_id, - html = paste(" ", status_short,"", - "")) - - shinyjs::runjs(paste0('$("#',ns(tooltip_id), '").attr("title", "Selection is valid")')) - - } else { - shinyjs::html(id = msg_id, - html = paste(" ", status_short,"", - "")) - - shinyjs::runjs(paste0('$("#',ns(tooltip_id), '").attr("title", "', status_long, '")')) + if(status_short=="OK"){ + shinyjs::addClass(id=ctl_id, class="valid") + shinyjs::removeClass(id=ctl_id, class="invalid") + }else{ + shinyjs::removeClass(id=ctl_id, class="valid") + shinyjs::addClass(id=ctl_id, class="invalid") + } + shinyjs::html(id = msg_id, html = paste(icon)) + if(nchar(status_long)>0){ + shinyjs::runjs(paste0('$("#',ns(tooltip_id), '").attr("title", "',status_long,'").addClass("details")')) } - } diff --git a/inst/eDISH_app/ui.R b/inst/eDISH_app/ui.R index 35f49691..27aa19ee 100644 --- a/inst/eDISH_app/ui.R +++ b/inst/eDISH_app/ui.R @@ -2,9 +2,9 @@ tagList( useShinyjs(), - tags$style(HTML(" - .ok { color:#008000;} - .notok {color: #FF0000;}")), + tags$head( + tags$link(rel = "stylesheet", type = "text/css", href = "index.css") + ), navbarPage("eDISH Shiny app", tabPanel(title = htmlOutput("data_tab_title"), dataUploadUI("datatab") diff --git a/inst/eDISH_app/www/index.css b/inst/eDISH_app/www/index.css new file mode 100644 index 00000000..1f292331 --- /dev/null +++ b/inst/eDISH_app/www/index.css @@ -0,0 +1,81 @@ +/* --- hide the chartSelect div until we're ready to implement multiple charts --- */ +.chartSelect{ + display:none; +} +/* ------------------------------------------------------------------------------- */ + +.section{ + min-width:400px; +} + +.control-wrap{ + margin-top:1em; +} + +.control-wrap span label{ + font-weight:normal; + color:#444; + cursor:help; +} + +.control-wrap .select-wrap .form-group{ + width:90%; /* TODO: don't love this ... update eventually */ + display:inline-block; + margin-bottom:0; +} + +.control-wrap .select-wrap .form-group .form-control{ + margin-bottom:0; +} + +.control-wrap .select-wrap .status{ + display:inline-block; + margin-top:.5em; + padding-left:0.5em; + vertical-align:top; +} + +.control-wrap .select-wrap .status.details label i { + cursor:help; +} + + +/* Validation Coloring */ + +.control-wrap.valid .select-wrap .status{ + color:green; +} + +.control-wrap.valid .select-wrap div .selectize-control .selectize-input{ + border-color:green; +} + +.control-wrap.invalid .select-wrap .status{ + color:red; +} + +.control-wrap.invalid .select-wrap div .selectize-control .selectize-input{ + border-color:red; +} + +/* Settings - header tweaks */ +.section h3 { + margin:0; +} + +.section h3 .form-group { + display:inline; +} + +.section h3 .form-group .material-switch{ + float:right; +} + + +.ok { + color:#008000; +} + +.notok { + color: #FF0000; +} \ No newline at end of file