updated interface

updated interface

DESCRIPTION

@@ -36,6 +36,7 @@ Imports:
     shinydashboard,
     shinyWidgets,
     SqlRender,
+    stringi,
     stringr,
     tibble,
     tidyr,

NAMESPACE

@@ -56,6 +56,7 @@ export(cohortOverlapView)
 export(compareCohortCharacterizationView)
 export(conceptsInDataSourceView)
 export(createCdDatabaseDataSource)
+export(createCustomColDefList)
 export(dataDiagnosticDrillServer)
 export(dataDiagnosticDrillViewer)
 export(dataDiagnosticHelperFile)
@@ -64,6 +65,9 @@ export(dataDiagnosticSummaryServer)
 export(dataDiagnosticSummaryViewer)
 export(dataDiagnosticViewer)
 export(databaseInformationView)
+export(datasourcesHelperFile)
+export(datasourcesServer)
+export(datasourcesViewer)
 export(evidenceSynthesisHelperFile)
 export(evidenceSynthesisServer)
 export(evidenceSynthesisViewer)
@@ -72,6 +76,7 @@ export(getLogoImage)
 export(incidenceRatesView)
 export(inclusionRulesView)
 export(indexEventBreakdownView)
+export(makeButtonLabel)
 export(orpahanConceptsView)
 export(patientLevelPredictionCalibrationServer)
 export(patientLevelPredictionCalibrationViewer)

R/components-data-viewer.R

@@ -7,11 +7,15 @@
 #' Result Table Viewer
 #'
 #' @param id string
+#' @param downloadedFileName string, desired name of downloaded data file. can use the name from the module that is being used
 #'
 #' @return shiny module UI
 #' @export
 #'
-resultTableViewer <- function(id = "result-table") {
+resultTableViewer <- function(
+    id = "result-table",
+    downloadedFileName = NULL
+    ) {
   ns <- shiny::NS(id)
   shiny::div(# UI
     shinydashboard::box(
@@ -41,6 +45,7 @@ resultTableViewer <- function(id = "result-table") {
                 "Reactable.downloadDataCSV('",
                 ns('resultData'),
                 "', 'result-data-filtered-",
+                downloadedFileName,
                 Sys.Date(),
                 ".csv')"
               )
@@ -142,6 +147,7 @@ ohdsiReactableTheme <- reactable::reactableTheme(
 #' @param colDefsInput named list of reactable::colDefs
 #' @param addActions add a button row selector column to the table to a column called 'actions'.  
 #'                   actions must be a column in df
+#' @param downloadedFileName string, desired name of downloaded data file. can use the name from the module that is being used
 #'
 #' @return shiny module server
 #' @export
@@ -150,7 +156,8 @@ resultTableServer <- function(
     id, #string
     df, #data.frame
     colDefsInput,
-    addActions = NULL
+    addActions = NULL,
+    downloadedFileName = NULL
 ) #list of colDefs, can use checkmate::assertList, need a check that makes sure names = columns) {
   shiny::moduleServer(
     id,
@@ -249,7 +256,7 @@ resultTableServer <- function(
       # download full data button
       output$downloadDataFull <- shiny::downloadHandler(
         filename = function() {
-          paste('data-full-', Sys.Date(), '.csv', sep = '')
+          paste('result-data-full-', downloadedFileName, Sys.Date(), '.csv', sep = '')
         },
         content = function(con) {
           utils::write.csv(

R/helpers-componentsCreateCustomColDefList.R

@@ -0,0 +1,92 @@
+#' Creating a list of custom column definitions for use in reactables
+#'
+#' @param rawColNames The raw column names taken directly from the source
+#'  data table that are to be overwritten in the reactable
+#' @param niceColNames The formatted column names that will appear as-specified in 
+#' the reactable
+#' @param tooltipText The text to be displayed in a toolTip when hovering over the 
+#' column in the reactable
+#' @param case Optional argument to convert raw column names to snake or camel case. Defaults to NULL and preserves
+#' whatever raw column names are passed in
+#' @param customColDefOptions A list of lists, where the inner lists are any custom options from
+#' reactable::colDef for each column 
+#'
+#' @return A named list of reactable::colDef objects
+#' @export 
+#' 
+createCustomColDefList <- function(rawColNames, niceColNames = NULL,
+                                   tooltipText = NULL, case = NULL,
+                                   customColDefOptions = NULL) {
+  withTooltip <- function(value, tooltip, ...) {
+    shiny::div(style = "text-decoration: underline; text-decoration-style: dotted; cursor: help",
+               tippy::tippy(value, tooltip, ...))
+  }
+
+  if (is.null(niceColNames)) {
+    niceColNames <- rawColNames
+  }
+
+  if (is.null(tooltipText)) {
+    tooltipText <- rep("", length(rawColNames))
+  }
+
+  if (!is.null(case)) {
+    if (case == "snakeCaseToCamelCase") {
+      rawColNames <- SqlRender::snakeCaseToCamelCase(rawColNames)
+    } else if (case == "camelCaseToSnakeCase") {
+      rawColNames <- SqlRender::camelCaseToSnakeCase(rawColNames)
+    }
+  }
+
+  result <- vector("list", length(rawColNames))
+
+  if (is.null(customColDefOptions)) {
+    customColDefOptions <- vector("list", length(rawColNames))
+    for (i in seq_along(rawColNames)) {
+      customColDefOptions[[i]] <- list()
+    }
+  }
+
+  for (i in seq_along(rawColNames)) {
+    colDefOptions <- c(
+      list(name = rawColNames[[i]], header = withTooltip(niceColNames[[i]], tooltipText[[i]])),
+      customColDefOptions[[i]]
+    )
+
+    result[[i]] <- do.call(reactable::colDef, colDefOptions)
+  }
+
+  names(result) <- rawColNames
+
+  return(result)
+}
+
+
+# examples
+# Define custom column definitions
+# customColDefs <- createCustomColDefList(
+#   rawColNames = mydf$raw,
+#   niceColNames = c("Name", "Age", "Country"),
+#   tooltipText = c("Person's Name", "Person's Age", "Country"),
+#   customColDefOptions = list(
+#     list(NULL),  # No aggregation for "Name" column
+#     list(aggregate = "mean"),  # Aggregate "Age" column using mean
+#     list(NULL)  # No aggregation for "Country" column
+#   )
+# )
+
+# use the below as a guide to save named colDef list as JSON then read it back!
+# test <- ParallelLogger::saveSettingsToJson(colDefs, "./inst/components-columnInformation/test.json")
+#loadTest <- ParallelLogger::loadSettingsFromJson("./inst/components-columnInformation/test.json")
+
+
+#' Make a label for an html button
+#'
+#' @param label The desired label for hte button
+#'
+#' @return html code to make a button label
+#' @export
+#'
+makeButtonLabel <- function(label) {
+  as.character(htmltools::tags$div(htmltools::tags$button(paste(label))))
+}