Remove date column; working app

asadow · Feb 15, 2024 · 4e4ba2d · 4e4ba2d
1 parent 46578aa
commit 4e4ba2d
Show file tree

Hide file tree

Showing 12 changed files with 63 additions and 185 deletions.
diff --git a/.Rproj.user/19FD65EA/pcs/files-pane.pper b/.Rproj.user/19FD65EA/pcs/files-pane.pper
@@ -5,5 +5,5 @@
             "ascending": true
         }
     ],
-    "path": "C:/Users/asadowsk/repo/police-maintenance/app/logic"
+    "path": "C:/Users/asadowsk/repo/police-maintenance/app/view"
 }
diff --git a/.Rproj.user/19FD65EA/pcs/find-replace-in-files.pper b/.Rproj.user/19FD65EA/pcs/find-replace-in-files.pper
@@ -1,6 +1,6 @@
 {
     "dialog-state": {
-        "query": "poolClose",
+        "query": "clock",
         "path": "",
         "regex": false,
         "caseSensitive": false,
@@ -9,7 +9,7 @@
         "useGitGrep": true,
         "excludeGitIgnore": true,
         "excludeFilePatterns": [],
-        "resultsCount": 2,
+        "resultsCount": 0,
         "errorCount": 0,
         "replaceErrors": "",
         "projectRelative": true

diff --git a/.Rproj.user/19FD65EA/pcs/source-pane.pper b/.Rproj.user/19FD65EA/pcs/source-pane.pper
@@ -1,3 +1,3 @@
 {
-    "activeTab": 4
+    "activeTab": 0
 }
diff --git a/.Rproj.user/19FD65EA/pcs/windowlayoutstate.pper b/.Rproj.user/19FD65EA/pcs/windowlayoutstate.pper
@@ -1,14 +1,14 @@
 {
     "left": {
-        "splitterpos": 123,
+        "splitterpos": 122,
         "topwindowstate": "MAXIMIZE",
-        "panelheight": 704,
-        "windowheight": 742
+        "panelheight": 703,
+        "windowheight": 741
     },
     "right": {
-        "splitterpos": 357,
+        "splitterpos": 502,
         "topwindowstate": "NORMAL",
-        "panelheight": 704,
-        "windowheight": 742
+        "panelheight": 703,
+        "windowheight": 741
     }
 }
diff --git a/Dockerfile b/Dockerfile
@@ -1,6 +1,6 @@
 ## Using older version of R due to rhandsontable date bug
-## renv.lock was changed to reflect 4.1.3
-FROM openanalytics/r-ver:4.1.3
+## renv.lock was changed to reflect 4.2.2
+FROM openanalytics/r-ver:4.2.2
 
 LABEL maintainer="Adam Sadowski <asadowsk@uoguelph.ca>"
 

diff --git a/app/logic/constant.R b/app/logic/constant.R
@@ -39,6 +39,7 @@ onStop(function() {
 employee <- dbReadTable(pool, "employee") |>
   mutate(name = glue("{given_names} {surname}")) |>
   as.data.frame()
+
 #' @export
 trade <- dbReadTable(pool, "trade") |>
   mutate(trade = glue("{trade} - {trade_desc}")) |>
@@ -51,8 +52,9 @@ building <- dbReadTable(pool, "workorder_building") |>
 trade_factor <- factor(NA_character_, levels = str_sort(trade$trade))
 staff_factor <- factor(NA_character_, levels = str_sort(unique(employee$name)))
 
+## Source of the initial database table
 #' @export
-DFF <- tibble(
+DF <- tibble(
   hour = NA_integer_,
   minute = NA_integer_,
   am_pm = factor(NA_character_, levels = c("am", "pm")),
@@ -78,26 +80,3 @@ DFF <- tibble(
   rename_with(\(x) x |> str_replace_all("_", " ") |> str_to_title()) |>
   rename("am/pm" = "Am Pm") |>
   add_rows(2)
-
-#' @export
-DF <- dbReadTable(pool, "police_maintenance") |>
-  rename_with(
-    \(x) str_replace_all(x, "\\.", " ") |> str_trim(),
-    everything()
-  ) |>
-  rename("am/pm" = "am pm", "Work Order #" = "Work Order")
-
-
-DF <- dbReadTable(conn, "police_maintenance") |>
-  rename_with(
-    \(x) str_replace_all(x, "\\.", " ") |> str_trim(),
-    everything()
-  ) |>
-  rename("am/pm" = "am pm", "Work Order #" = "Work Order")
-
-#' @export
-current <- function() {
-  dm <- dm_from_con(conn, "police_maintenance")
-  # dbDisconnect(conn)
-  return(dm)
-}
diff --git a/app/logic/hot_format.R b/app/logic/hot_format.R
@@ -13,7 +13,7 @@ hot_format <- function(.data) {
       allowInvalid = TRUE,
       copyable = TRUE,
       strict = FALSE,
-      colWidths = c(50, 70, 75, 100, 75, 250, 70, 200, 100,
+      colWidths = c(50, 70, 75, 100, 250, 70, 200, 100,
                     rep(200, 7), 130, 130),
       renderer = "
              function (instance, td, row, col, prop, value, cellProperties) {
@@ -25,11 +25,14 @@ hot_format <- function(.data) {
       halign = "htCenter"
     ) |>
     hot_col("Issue", halign = "htLeft") |>
+    # hot_col(col = "am/pm", type = "dropdown", source = c("am", "pm")) |>
     hot_col(
       col = c(
         "Trade Responsible",
         "Trade Attended 1", "Trade Attended 2",
-        "Staff Attended 1", "Staff Attended 2"),
+        "Staff Attended 1", "Staff Attended 2",
+        "Staff Called 1", "Staff Called 2"
+        ),
       type = "dropdown", source = str_sort(trade$trade)
     ) |>
   #   ,
@@ -38,5 +41,6 @@ hot_format <- function(.data) {
     hot_table(highlightCol = TRUE, highlightRow = TRUE) |>
     hot_validate_numeric(cols = "Work Order #", min = 100000, max = 999999) |>
     hot_validate_numeric(cols = "Hour", min = 0, max = 12) |>
-    hot_validate_numeric(cols = "Minute", min = 0, max = 60)
+    hot_validate_numeric(cols = "Minute", min = 0, max = 60) |>
+    hot_validate_character(col = "am/pm", choices = c("am", "pm"))
 }
diff --git a/app/logic/import-join-structure.R b/app/logic/import-join-structure.R
diff --git a/app/logic/read_table.R b/app/logic/read_table.R
@@ -0,0 +1,16 @@
+box::use(
+  DBI[dbConnect, dbReadTable, dbDisconnect],
+  app/logic/constant[pool, conn],
+  dplyr[...],
+  lubridate[NA_Date_],
+  stringr[...]
+)
+
+read_table <- function() {
+  dbReadTable(conn, "police_maintenance") |>
+    rename_with(
+      \(x) str_replace_all(x, "\\.", " ") |> str_trim(),
+      everything()
+    ) |>
+    rename("am/pm" = "am pm", "Work Order #" = "Work Order")
+}
diff --git a/app/main.R b/app/main.R
@@ -1,16 +1,15 @@
 box::use(
   shiny[...],
-  app/view/table,
   rhandsontable[...],
   DBI[...],
   dm[...],
   dplyr[...],
   lubridate[...],
-  stringr[...],
+  tibble[column_to_rownames, rownames_to_column],
   app/logic/add_rows[add_rows],
-  app/logic/constant[pool, conn, current],
-  # app/logic/constant[DF],
+  app/logic/constant[pool, conn],
   app/logic/hot_format[hot_format],
+  app/logic/read_table[read_table],
 )
 
 #' @export
@@ -19,76 +18,46 @@ ui <- function(id) {
   fluidPage(
     titlePanel("Grey columns are optional."),
     helpText("Right click to undo. Grey columns are optional. Changes to the table will be automatically saved to the source file."),
-    ## Uncomment line below to use action button to commit changes
-    actionButton(ns("saveBtn"), "Save"),
-    dateInput(ns("date"), "Date"),
-    numericInput(ns("minute"), "Minute", value = 2),
+    dateInput(ns("date"), "Date", value = Sys.Date()),
+    # numericInput(ns("minute"), "Minute", value = 2),
     rHandsontableOutput(ns("hot")),
   )
 }
 
-DF_read <- function() {
-  dbReadTable(conn, "police_maintenance") |>
-    rename_with(
-      \(x) str_replace_all(x, "\\.", " ") |> str_trim(),
-      everything()
-    ) |>
-    rename("am/pm" = "am pm", "Work Order #" = "Work Order")
-
-  # dbDisconnect(conn)
-}
-
 #' @export
 server <- function(id) {
   moduleServer(id, function(input, output, session) {
+
     observe({
-      ## Remove button and isolate to update file automatically
-      ## after each table change
-      # input$saveBtn
-      # hot = isolate(input$hot)
       if (!is.null(input$hot)) {
-      # if (!is.null(hot)) {
-
-        updated <- dm(police_maintenance = hot_to_r(input$hot))
-        updated <- copy_dm_to(conn, updated, temporary = TRUE)
-        final <- dm_rows_upsert(current(), updated, in_place = TRUE)
+        x <- input$hot |>
+          hot_to_r()
+        x <- x |>
+          mutate(
+            Date = input$date,
+            Id = row_number() + as.numeric(Date) * nrow(!!x)
+          )
+        dm <- dm(police_maintenance = x)
+        dm <- copy_dm_to(conn, dm, temporary = TRUE)
+        dm_db <- dm_from_con(conn, "police_maintenance")
+        final <- dm_rows_upsert(dm_db, dm, in_place = TRUE)
         print("saved")
-        # dbDisconnect(conn)
-
       }
     })
 
-    hott <- reactive({
-      # if (!is.null(input$hot)) {
-      #   x <- hot_to_r(input$hot) |>
-      #     filter(Minute == input$minute)
-      #   if (nrow(x) == 0) {
-      #     x <- x |>
-      #       add_rows(3) |>
-      #       mutate(Minute = input$minute)
-      #   }
-      #   return(x |> mutate(Id = today() |> as.integer() + row_number()+ Minute))
-      #
-      # } else {
-        ## INITIATLIZE
-        x <- DF_read() |>
-          filter(Minute == input$minute)
+    df_init <- reactive({
+        x <- read_table() |>
+          filter(Date == input$date |> as.character()) |>
+          select(- c(Date, Id))
         if (nrow(x) == 0) {
-          x <- x |>
-            add_rows(3) |>
-            mutate(Minute = input$minute,
-                   Id = today() |> as.integer() + row_number()+ Minute)
+          x <- x |> add_rows(3)
         }
         return(x)
-      # }
-      # return(x)
     }) |>
-      bindEvent(input$minute)
+      bindEvent(input$date)
 
     output$hot = renderRHandsontable({
-      # if (!is.null(hott())) {
-        hott() |> hot_format()
-      # }
+      df_init() |> hot_format()
     })
   })
 }
diff --git a/app/view/table.R b/app/view/table.R
diff --git a/renv.lock b/renv.lock
@@ -1,6 +1,6 @@
 {
   "R": {
-    "Version": "4.3.2",
+    "Version": "4.2.2",
     "Repositories": [
       {
         "Name": "CRAN",