Uncomplicate book selector. (#113)

And fix bug when UTC week switches over.
r4ds · Nov 12, 2023 · e8c1aef · e8c1aef
1 parent f1e7508
commit e8c1aef
Show file tree

Hide file tree

Showing 3 changed files with 46 additions and 51 deletions.
diff --git a/R/book.R b/R/book.R
@@ -23,51 +23,41 @@
 .book_server <- function(id = "book") {
   book_choices <- .book_get_choices()
   moduleServer(id, function(input, output, session) {
-    query_book <- reactive({
-      query <- getQueryString()
-      query_book <- book_choices[book_choices == query$bookname]
-    })
+    # Use the initial non-reactive query string from the request.
+    query <- parseQueryString(session$request$QUERY_STRING)
+    query_book <- book_choices[book_choices == query$bookname]
 
-    # Only change use the query_string to update the input when the app
-    # initially loads. After that, the input is the source of truth.
-    observeEvent(
-      query_book(),
-      {
-        if (length(query_book()) && query_book() != input$selected_book) {
-          updateSelectInput( # nocov start (can't find a way to automate)
-            session,
-            "selected_book",
-            label = "Book Selected",
-            choices = book_choices,
-            selected = query_book()
-          ) # nocov end
-        } else {
-          updateSelectInput(
-            session,
-            "selected_book",
-            label = "Book Selected",
-            choices = book_choices,
-            selected = NULL
-          )
-        }
-      },
-      ignoreNULL = FALSE,
-      once = TRUE
-    )
+    if (length(query_book) && query_book != "") {
+      updateSelectInput( # nocov start (can't find a way to automate)
+        session,
+        "selected_book",
+        label = "Book Selected",
+        choices = book_choices,
+        selected = query_book
+      ) # nocov end
+    } else {
+      updateSelectInput(
+        session,
+        "selected_book",
+        label = "Book Selected",
+        choices = book_choices,
+        selected = NULL
+      )
+    }
 
     observeEvent(
       input$selected_book != "",
       { # nocov start (Can't find a way to automate)
-        if (!length(query_book()) || input$selected_book != query_book()) {
-          query_string <- getQueryString()
-          query_string$bookname <- input$selected_book
-          query_string <- paste0(
-            "?",
-            paste(names(query_string), query_string, sep = "="),
-            collapse = "&"
-          )
-          updateQueryString(query_string)
-        }
+        # Get the CURRENT query string, not necessarily the same as when the app
+        # loaded.
+        query_string <- getQueryString()
+        query_string$bookname <- input$selected_book
+        query_string <- paste0(
+          "?",
+          paste(names(query_string), query_string, sep = "="),
+          collapse = "&"
+        )
+        updateQueryString(query_string)
       }, # nocov end
       ignoreInit = TRUE
     )

diff --git a/R/calendar.R b/R/calendar.R
@@ -188,16 +188,18 @@
           .data$unavailable_time, user_timezone
         )
       ) |>
-      dplyr::transmute(
+      dplyr::mutate(
         day = lubridate::wday(
           .data$unavailable_time,
           week_start = 1,
           label = TRUE,
           abbr = FALSE
         ),
         hour = lubridate::hour(.data$unavailable_time),
-        unavailable = TRUE
-      )
+        .keep = "none"
+      ) |>
+      dplyr::distinct(.data$day, .data$hour) |>
+      dplyr::mutate(unavailable = TRUE)
   )
 }
 

diff --git a/tests/testthat/test-book.R b/tests/testthat/test-book.R
@@ -3,14 +3,17 @@ test_that("Book UI has expectd form", {
 })
 
 test_that("Book server returns selected book", {
-  testServer(.book_server, {
-    session$setInputs(selected_book = "R for Data Science")
-    book <- session$getReturned()
-    expect_identical(
-      book(),
-      "R for Data Science"
-    )
-  })
+  expect_warning(
+    testServer(.book_server, {
+      session$setInputs(selected_book = "R for Data Science")
+      book <- session$getReturned()
+      expect_identical(
+        book(),
+        "R for Data Science"
+      )
+    }),
+    "MockShinySession"
+  )
 })
 
 # As far as I can find through manual testing, shinytest2 can't "see" query