Merge pull request #15 from NorwegianVeterinaryInstitute/trish-nav

Resolves #6
NorwegianVeterinaryInstitute · Sep 26, 2024 · e0e3734 · e0e3734
2 parents 1d09dcd + 2f7b636
commit e0e3734
Show file tree

Hide file tree

Showing 2 changed files with 103 additions and 5 deletions.
diff --git a/app.R b/app.R
@@ -44,9 +44,20 @@ ui <- fluidPage(
     h1('VI Cake Planner'), uiOutput('subtitle')
   )),
 
-  sidebarLayout(sidebarPanel(# Call sidebar module UI
-    sidebarUI('sidebar1')), mainPanel(# Call main panel module UI
-      mainPanelUI('mainpanel1')))
+  sidebarLayout(
+    sidebarPanel(
+      sidebarUI('sidebar1') # Call sidebar module UI
+    ), 
+    mainPanel(
+      # Split the main panel into 3 separate tabs using navset_card_underline()
+      navset_card_underline(
+        title = "When do you want cake? Are you a time traveller (Click Historic then!)?",
+        nav_panel("Today", mainPanelUI('mainpanel2')), # Call main panel module UI for Today tab
+        nav_panel("Upcoming", mainPanelUI('mainpanel3')), # Call main panel module UI for Upcoming tab
+        nav_panel("Historic (All)", mainPanelUI('mainpanel1')), # Call main panel module UI for Historic(All) tab
+      )
+    )
+  )
 )
 
 # Define server logic
@@ -66,6 +77,8 @@ server <- function(input, output, session) {
   # Call the modules
   input_data <- sidebarServer('sidebar1', board)  # Call sidebar module server
   mainPanelServer('mainpanel1', board)           # Call main panel module server
+  mainPanelServer_today('mainpanel2', board)     # Call main panel module server
+  mainPanelServer_up('mainpanel3', board)        # Call main panel module server
 }
 
 # Run the application

diff --git a/mod_mainPanel.R b/mod_mainPanel.R
@@ -2,18 +2,20 @@
 mainPanelUI <- function(id) {
   ns <- NS(id)
 
-  tagList(DTOutput(ns('dataTable')))
+  tagList(DTOutput(ns('dataTable'))) # This is going to be a DT output
 }
 
 # Main Panel Server Module
 mainPanelServer <- function(id, board) {
   moduleServer(id, function(input, output, session) {
+    # Render a datatable
     output$dataTable <- renderDT({
       # Read the pinned data frame from the pin board
       pinned_cakes <-
         pin_reactive_read(
           board,
-          name = paste0(Sys.getenv("USER_NAME"), '/cake_user_inputs'),
+          #name = paste0(Sys.getenv("USER_NAME"), '/cake_user_inputs'),
+          name = "vi2313/cake_user_inputs",
           interval = 1000
         )
       # Hide secret ingredient
@@ -42,3 +44,86 @@ mainPanelServer <- function(id, board) {
     })
   })
 }
+
+# server function for upcoming events
+mainPanelServer_up <- function(id, board) {
+  moduleServer(id, function(input, output, session) {
+    # Render a data table
+    output$dataTable <- renderDT({
+      # Read the pinned data frame from the pin board
+      pinned_cakes <-
+        pin_reactive_read(
+          board,
+          #name = paste0(Sys.getenv("USER_NAME"), '/cake_user_inputs'),
+          name = "vi2313/cake_user_inputs",
+          interval = 1000
+        )
+      # Remove the secret ingredient column
+      pinned_cakes <- pinned_cakes()[,c(1:5,7)]
+
+      # Filter entries after "today" date
+      pinned_cakes_up <- pinned_cakes |>
+        dplyr::filter(Date > Sys.Date())
+
+      datatable(
+        pinned_cakes_up,   
+        rownames = FALSE,   # Do not display row names
+        colnames = c(
+          "Date",
+          "Hour",
+          "Room",
+          "Section",
+          "Person Name",
+          "Cake Description"
+        ),
+        filter = "top",     # Add a column filter
+        options = list(
+          order = list(list(0, 'asc'), list(1, 'asc')),    # Orders the table by ascending order of date and then time
+          columnDefs = list(
+            list(targets = '_all', className = 'dt-center')
+          ))
+      )
+    })
+  })
+}
+
+# Main Panel Server Module for today's events
+mainPanelServer_today <- function(id, board) {
+  moduleServer(id, function(input, output, session) {
+    # Render a data table
+    output$dataTable <- renderDT({
+      # Read the pinned data frame from the pin board
+      pinned_cakes <-
+        pin_reactive_read(
+          board,
+          #name = paste0(Sys.getenv("USER_NAME"), '/cake_user_inputs'),
+          name = "vi2313/cake_user_inputs",
+          interval = 1000
+        )
+      # Remove the secret ingredient column
+      pinned_cakes <- pinned_cakes()[,c(1:5,7)]
+
+      # Filter entries on "today" date
+      pinned_cakes_today <- pinned_cakes |>
+        dplyr::filter(Date == Sys.Date())
+      datatable(
+        pinned_cakes_today,   
+        rownames = FALSE,   # Do not display row names
+        colnames = c(
+          "Date",
+          "Hour",
+          "Room",
+          "Section",
+          "Person Name",
+          "Cake Description"
+        ),
+        filter = "top",     # Add a column filter
+        options = list(
+          order = list(list(0, 'asc'), list(1, 'asc')),    # Orders the table by ascending order of date and then time
+          columnDefs = list(
+            list(targets = '_all', className = 'dt-center')
+          ))
+      )
+    })
+  })
+}