Merge pull request #13 from mbarneytu/simple-editSite

Simple edit site with textual editing of coordinates, no map

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 |> 

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")
+      }
+      )
+    })
   })
 }

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(

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)