Merge pull request #22 from NorwegianVeterinaryInstitute/trish-filter

Add navigation panel

app.R

@@ -43,10 +43,26 @@ ui <- fluidPage(
   )), div(
     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(
+      # Add a navigation panel
+      navset_card_underline(
+        # Add a title for the panel
+        title = "When do you want cake? Are you a time traveller (Click Historic then!)?",
+        # Create 3 panels, today, upcoming and Historic(All)
+        # All of these panels will call mainpanelUI() module
+        nav_panel("Today", mainPanelUI('mainpanel2')),
+        nav_panel("Upcoming", mainPanelUI('mainpanel3')),
+        nav_panel("Historic (All)", mainPanelUI('mainpanel1')),
+
+      )
+    )
+  ) 
+
 )
 
 # Define server logic
@@ -66,6 +82,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

mod_mainPanel.R

@@ -1,11 +1,12 @@
 # Main Panel UI Module
 mainPanelUI <- function(id) {
   ns <- NS(id)
-
+  # We want to output a datatable
   tagList(DTOutput(ns('dataTable')))
 }
 
 # Main Panel Server Module
+# This module will display the Historic table
 mainPanelServer <- function(id, board) {
   moduleServer(id, function(input, output, session) {
     output$dataTable <- renderDT({
@@ -42,3 +43,85 @@ mainPanelServer <- function(id, board) {
     })
   })
 }
+
+# This module will display the upcoming table
+mainPanelServer_up <- function(id, board) {
+  moduleServer(id, function(input, output, session) {
+    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'),
+          interval = 1000
+        )
+      # Hide secret ingredient
+      pinned_cakes <- pinned_cakes()[,c(1:5,7)]
+      # Filter all the entries that are occurring after today
+      pinned_cakes_up <- pinned_cakes |>
+        dplyr::filter(Date > Sys.Date())
+      datatable(
+        pinned_cakes_up,
+        # Do not show row names
+        rownames = FALSE,
+        # Add filters for each column
+        filter = "top",
+        colnames = c(
+          "Date",
+          "Hour",
+          "Room",
+          "Section",
+          "Person Name",
+          "Cake Description"
+        ),
+        options = list(
+          # order table by date and then time
+          order = list(list(0, 'asc'), list(1, 'asc')),
+          columnDefs = list(
+            list(targets = '_all', className = 'dt-center')
+          ))
+      )
+    })
+  })
+}
+
+# This module will display the today table
+mainPanelServer_today <- function(id, board) {
+  moduleServer(id, function(input, output, session) {
+    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'),
+          interval = 1000
+        )
+      # Hide secret ingredient
+      pinned_cakes <- pinned_cakes()[,c(1:5,7)]
+      # Filter all the entries that are occurring today
+      pinned_cakes_today <- pinned_cakes |>
+        dplyr::filter(Date == Sys.Date())
+      datatable(
+        pinned_cakes_today,
+        # Do not show row names
+        rownames = FALSE,
+        # Add filters for each column
+        filter = "top",
+        colnames = c(
+          "Date",
+          "Hour",
+          "Room",
+          "Section",
+          "Person Name",
+          "Cake Description"
+        ),
+        options = list(
+          # order table by date and then time
+          order = list(list(0, 'asc'), list(1, 'asc')),
+          columnDefs = list(
+            list(targets = '_all', className = 'dt-center')
+          ))
+      )
+    })
+  })
+}

mod_sidebar.R

@@ -54,6 +54,7 @@ sidebarUI <- function(id) {
       "Virologi, immunologi og parasittologi" 
     )),
     textInput(ns('person'), 'Person Name:'),
+    textInput(ns('sec_in'), 'Secret Ingredient:'),
     textAreaInput(ns('cake_desc'), 'Cake Description:', rows = 3),
     actionButton(ns('submit'), 'Submit')
   )
@@ -70,8 +71,9 @@ sidebarServer <- function(id, board) {
         `Hour` = input$hour,
         `Room` = input$room,
         `Section` = input$section,
-        `Person Name` = input$person,
-        `Cake Description` = input$cake_desc,
+        `Person.Name` = input$person,
+        `Secret.Ingredient` = input$sec_in,
+        `Cake.Description` = input$cake_desc,
         stringsAsFactors = FALSE
       )
     })
@@ -85,7 +87,8 @@ sidebarServer <- function(id, board) {
         input$person,
         input$cake_desc
       )
-      pinned_cakes <- pin_read(board, name = paste0('cake_user_inputs'))
+      pinned_cakes <- pin_read(board,
+                               name = paste0(Sys.getenv("USER_NAME"), '/cake_user_inputs'))
 
       updated_cakes <- rbind(pinned_cakes, input_data())
 
@@ -103,6 +106,7 @@ sidebarServer <- function(id, board) {
       updateSelectInput(session, "room", selected = NULL)
       updateSelectInput(session, "section", selected = NULL)
       updateTextInput(session, "person", value = "")
+      updateTextInput(session, "sec_in", value = "")
       updateTextAreaInput(session, "cake_desc", value = "")
     })