diff --git a/R/database.R b/R/database.R index edb8884..19f3c8e 100644 --- a/R/database.R +++ b/R/database.R @@ -37,7 +37,7 @@ loadSessionIds <- function(expiry = 7) { } loadSites <- function() { - query <- "SELECT site_id, site_name, user_site_id, active_datetime, lat, lon, + query <- "SELECT site_id, site_name, user_site_id, active_datetime, lat, lon as 'long', contact_name, contact_email, landowner, equipment_desc, notes FROM site" res <- as_tibble(dbGetQuery(pool, query)) } @@ -59,6 +59,35 @@ saveSite <- function(input, coords) { dbExecute(pool, query, params) } +updateSite <- function(siteId, input) { + query <- paste0("UPDATE site SET + site_name = ?, + user_site_id = ?, + active_datetime = ?, + lat = ?, + lon = ?, + contact_name = ?, + contact_email = ?, + landowner = ?, + equipment_desc = ?, + notes = ? + WHERE site_id = ?") + params <- list(input$site_name, + input$user_site_id, + input$install_date, + input$latEntered, + input$longEntered, + input$contact_name, + input$contact_email, + input$landowner, + input$equipment, + input$notes, + siteId + ) + + dbExecute(pool, query, params) +} + saveObservations <- function(tibl, siteId, fileName, filePath) { # Make the observations' columns match database table structure quotedTibl <- tibl |> diff --git a/R/editSite.R b/R/editSite.R index 8cb0496..8d476df 100644 --- a/R/editSite.R +++ b/R/editSite.R @@ -1,12 +1,141 @@ +library(shinyFeedback) + +# US map bounds +USSouth <- 25 +USNorth <- 49 +USWest <- -125 +USEast <- -67 + editSiteUI <- function(id) { ns <- NS(id) tagList( - + h3("Edit Site"), + h6("Required fields are marked with *"), + fluidRow( + column( + width = 5, + textInput(NS(id, "user_site_id"), "*Site ID"), + shinyBS::bsTooltip(NS(id, "user_site_id"), + paste0("Site ID must be unique. ", + "For example: MI02")), + textInput(NS(id, "site_name"), "*Site Name"), + bsTooltip(NS(id, "site_name"), + paste0("Site Name is intended to be more descriptive and need", + " not be unique. For example: Mill Creek at Falls")), + textInput(NS(id, "contact_name"), "*TU Staff Contact Name"), + textInput(NS(id, "contact_email"), "*TU Staff Contact Email"), + dateInput(NS(id, "install_date"), "*Date of installation", format = "m/d/yyyy",), + textAreaInput(NS(id, "equipment"), "Equipment"), + textInput(NS(id, "landowner"), "Landowner"), + textAreaInput(NS(id, "notes"), "Notes"), + ), + column( + width = 7, + fluidRow( + column( + width = 4, + numericInput(ns("latEntered"), "*Lat:", value = ""), + ), + column( + width = 4, + numericInput(ns("longEntered"), "*Long:", value = "") + ), + ) + ) + ), + fluidRow( + column(width = 6, offset = 3, + actionButton(NS(id, "btnSave"), "Save Site", + width = "100%", class = "btn-success") + ) + ) + ) +} + +isLatValid <- function(lat) { + return( + !is.na(lat) && dplyr::between(lat, USSouth, USNorth) + ) +} + +isLongValid <- function(long) { + return( + !is.na(long) && dplyr::between(long, USWest, USEast) ) } -editSiteServer <- function(id) { +validateSite <- function(input){ + feedbackWarning("user_site_id", input$user_site_id == "", "Value is required") + feedbackWarning("site_name", input$site_name == "", "Value is required") + feedbackWarning("install_date", toString(input$install_date) == "", "Value is required") + feedbackWarning("contact_name", input$contact_name == "", + "Value is required") + feedbackWarning("contact_email", input$contact_email == "", + "Value is required") + feedbackWarning("latEntered", !isLatValid(input$latEntered), + paste0("Lat must be between ", USSouth, " and ", USNorth)) + feedbackWarning("longEntered", !isLongValid(input$longEntered), + paste0("Long must be between ", USWest, " and ", USEast)) + req( + input$user_site_id, + input$site_name, + input$install_date, + input$contact_name, + input$contact_email, + input$latEntered, + input$longEntered + ) +} + +populateFields <- function(site) { + updateTextInput(inputId = "user_site_id", value = site$user_site_id) + updateTextInput(inputId = "site_name", value = site$site_name) + updateTextInput(inputId = "contact_name", value = site$contact_name) + updateTextInput(inputId = "contact_email", value = site$contact_email) + updateDateInput(inputId = "install_date", value = site$active_datetime) + updateTextAreaInput(inputId = "equipment", value = site$equipment_desc) + updateTextInput(inputId = "landowner", value = site$landowner) + updateTextAreaInput(inputId = "notes", value = site$notes) + updateNumericInput(inputId = "latEntered", value = site$lat) + updateNumericInput(inputId = "longEntered", value = site$long) +} + +resetEditUI <- function() { + updateTextInput(inputId = "user_site_id", value = "") + updateTextInput(inputId = "site_name", value = "") + updateTextInput(inputId = "contact_name", value = "") + updateTextInput(inputId = "contact_email", value = "") + updateDateInput(inputId = "install_date", value = "") + updateTextAreaInput(inputId = "equipment", value = "") + updateTextInput(inputId = "landowner", value = "") + updateTextAreaInput(inputId = "notes", value = "") + updateNumericInput(inputId = "latEntered", value = "") + updateNumericInput(inputId = "longEntered", value = "") +} + +editSiteServer <- function(id, gageSites, selectedSite) { moduleServer(id, function(input, output, session) { + stopifnot(is.reactive(gageSites)) + stopifnot(is.reactive(selectedSite)) + + observeEvent(selectedSite(), { + populateFields(selectedSite()) + }) + observeEvent(input$btnSave, { + validateSite(input) + tryCatch({ + updateSite(selectedSite()$site_id, input) + gageSites(loadSites()) + resetEditUI() + showNotification("Site saved successfully.", type = "message") + }, + + error = function(cnd) { + showNotification(paste0("Error saving to database: ", cnd$message), + type = "error") + } + ) + }) }) } \ No newline at end of file diff --git a/R/sitePicker.R b/R/sitePicker.R index f35626a..57b6acb 100644 --- a/R/sitePicker.R +++ b/R/sitePicker.R @@ -36,7 +36,7 @@ sitePickerServer <- function(id, gageSites, selectedSite) { fitBounds(-125.1, 49, -67.1, 25.2) |> addMarkers( - lng = gageSites()$lon, lat = gageSites()$lat, + lng = gageSites()$long, lat = gageSites()$lat, label = paste0(gageSites()$user_site_id, " - ", gageSites()$site_name), layerId = gageSites()$site_id, popup = paste0( diff --git a/server.R b/server.R index 3209f2f..b2fdd07 100644 --- a/server.R +++ b/server.R @@ -30,6 +30,8 @@ server <- function(input, output, session) { updateTabsetPanel(inputId = "outerTabs", selected = "siteDataView") dataViewerServer("dataViewer", selectedSite) }) + + editSiteServer("editSite", gageSites, selectedSite) uploaderServer("uploader", selectedSite)