Merge pull request #183 from Appsilon/182-bug-analytics-app-doesnt-di…

…splay-aggregate-data-with-sqlite-backend

182 bug analytics app doesnt display aggregate data with sqlite backend

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: shiny.telemetry
 Title: 'Shiny' App Usage Telemetry
-Version: 0.2.0.9013
+Version: 0.2.0.9014
 Authors@R: c(
     person("André", "Veríssimo", , "[email protected]", role = c("aut", "cre")),
     person("Kamil", "Żyła", , "[email protected]", role = "aut"),

NEWS.md

@@ -17,6 +17,7 @@
 ### Bug Fixes
 
 - Fixed Analytics app not being able to access data by Instrumentation app (#164).
+- Fixed SQLite data storage backend when reading date column (#182).
 
 # shiny.telemetry 0.2.0
 

R/data-storage-sqlite.R

@@ -56,6 +56,11 @@ DataStorageSQLite <- R6::R6Class( # nolint object_name.
     connect = function(db_path) {
       # Initialize connection with sqlite database
       private$db_con <- odbc::dbConnect(RSQLite::SQLite(), dbname = db_path)
+    },
+
+    read_data = function(date_from, date_to, bucket) {
+      super$read_data(date_from, date_to, bucket) %>%
+        dplyr::mutate(time = lubridate::as_datetime(time))
     }
   )
 )

inst/examples/sqlite/.gitignore

@@ -0,0 +1,2 @@
+*.sqlite
+*.db

inst/examples/sqlite/README.md

@@ -0,0 +1,5 @@
+# Instrumented app with SQLite backend
+
+This example application uses SQLite as a provider for data storage.
+
+It will create a local SQLite database file _telemetry.sqlite_ which is ignored by git.

inst/examples/sqlite/sqlite_analytics.R

@@ -0,0 +1,21 @@
+library(shiny)
+library(shiny.semantic)
+library(semantic.dashboard)
+library(shinyjs)
+library(tidyr)
+library(dplyr)
+library(purrr)
+library(plotly)
+library(timevis)
+library(ggplot2)
+library(mgcv)
+library(config)
+library(DT)
+
+# Please install shiny.telemetry with all dependencies
+library(shiny.telemetry)
+
+# Default storage backend using SQLite
+data_storage <- DataStorageSQLite$new(db_path = "telemetry.sqlite")
+
+analytics_app(data_storage = data_storage)

inst/examples/sqlite/sqlite_app.R

@@ -0,0 +1,116 @@
+library(shiny)
+library(semantic.dashboard)
+library(shiny.semantic)
+library(shiny.telemetry)
+library(dplyr)
+library(config)
+
+counter_ui <- function(id, label = "Counter") {
+  ns <- NS(id)
+  div(
+    h2(class = "ui header primary", "Widgets tab content", style = "margin: 2rem"),
+    box(
+      title = label,
+      action_button(ns("button"), "Click me!", class = "red"),
+      verbatimTextOutput(ns("out")),
+      width = 4, color = "teal"
+    )
+  )
+}
+
+ui <- dashboardPage(
+  dashboardHeader(title = "Basic dashboard"),
+  dashboardSidebar(
+    sidebarMenu(
+      menuItem(tabName = "dashboard", text = "Home", icon = icon("home")),
+      menuItem(tabName = "widgets", text = "Another Tab", icon = icon("heart")),
+      menuItem(tabName = "another-widgets", text = "Yet Another Tab", icon = icon("heart")),
+      id = "uisidebar"
+    )
+  ),
+  dashboardBody(
+    use_telemetry(),
+    tabItems(
+      # First tab content
+      tabItem(
+        tabName = "dashboard",
+        box(
+          title = "Controls",
+          sliderInput("bins", "Number of observations:", 1, 50, 30),
+          action_button("apply_slider", "Apply", class = "green"),
+          width = 4, color = "teal"
+        ),
+        box(
+          title = "Old Faithful Geyser Histogram",
+          plotOutput("plot1", height = 400),
+          width = 11, color = "blue"
+        ),
+        segment(
+          class = "basic",
+          h3("Sample application instrumented by Shiny.telemetry"),
+          p(glue::glue("Note: using SQLite as data backend.")),
+          p("Information logged:"),
+          tags$ul(
+            tags$li("Start of session"),
+            tags$li("Every time slider changes"),
+            tags$li("Click of 'Apply' button"),
+            tags$li("Tab navigation when clicking on the links in the left sidebar")
+          )
+        )
+      ),
+
+      # Second tab content
+      tabItem(
+        tabName = "widgets",
+        counter_ui("widgets", "Counter 1")
+      ),
+
+      # Third tab content
+      tabItem(
+        tabName = "another-widgets",
+        counter_ui("another-widgets", "Counter 2")
+      )
+    )
+  )
+)
+
+# Default Telemetry with data storage backend using SQLite
+telemetry <- Telemetry$new(
+  app_name = "demo",
+  data_storage = DataStorageSQLite$new(db_path = "telemetry.sqlite")
+)
+
+# Define the server logic for a module
+counter_server <- function(id) {
+  moduleServer(
+    id,
+    function(input, output, session) {
+      count <- reactiveVal(0)
+      observeEvent(input$button, {
+        count(count() + 1)
+      })
+      output$out <- renderText(count())
+      count
+    }
+  )
+}
+
+shinyApp(ui = ui, server = function(input, output, session) {
+  telemetry$start_session(
+    track_values = TRUE,
+    navigation_input_id = "uisidebar"
+  )
+
+  # server code
+  output$plot1 <- renderPlot({
+    input$apply_slider
+    x <- faithful[, 2]
+    bins <- seq(min(x), max(x), length.out = isolate(input$bins) + 1)
+    hist(x, breaks = bins, col = "#0099F9", border = "white")
+  })
+
+  counter_server("widgets")
+  counter_server("another-widgets")
+})
+
+# shiny::shinyAppFile(system.file("examples", "sqlite", "sqlite_app.R", package = "shiny.telemetry")) # nolint: commented_code, line_length.

tests/testthat/helper-data_storage.R

@@ -60,6 +60,34 @@ test_that_common_data_storage <- function(init_fun, provider_name) {
       test_common_len_gt_1_alt(data_storage, dashboard_name)
     }
   )
+
+  testthat::test_that(
+    glue::glue(
+      .sep = " ",
+      provider_name,
+      "Time column is writen / read correctly"
+    ),
+    {
+      data_storage <- init_fun()
+      dashboard_name <- paste0("dashboard-", rlang::hash(Sys.time()))
+
+      test_common_read_date(data_storage, dashboard_name)
+    }
+  )
+
+  testthat::test_that(
+    glue::glue(
+      .sep = " ",
+      provider_name,
+      "Date colimn is writen / read correctly"
+    ),
+    {
+      data_storage <- init_fun()
+      dashboard_name <- paste0("dashboard-", rlang::hash(Sys.time()))
+
+      test_common_read_date(data_storage, dashboard_name)
+    }
+  )
 }
 
 test_common_data_storage <- function(data_storage, dashboard_name = "test_dashboard") {
@@ -199,6 +227,45 @@ test_common_len_gt_1 <- function(data_storage, dashboard_name = "test_dashboard"
     expect_equal(format(paste(1:10, collapse = ", ")))
 }
 
+test_common_read_time <- function(data_storage, dashboard_name = "test_dashboard") {
+  require(testthat)
+  withr::defer(data_storage$close())
+
+  # Mock the `lubridate::now` to compare exact datetime
+  manual_time <- lubridate::now(tzone = "UTC")
+
+  data_storage$insert(
+    app_name = dashboard_name,
+    type = "without_session",
+    time = manual_time
+  )
+
+  result <- data_storage$read_event_data(app_name = dashboard_name)
+
+  result %>%
+    purrr::pluck("time") %>%
+    expect_equal(manual_time)
+}
+
+test_common_read_date <- function(data_storage, dashboard_name = "test_dashboard") {
+  require(testthat)
+  withr::defer(data_storage$close())
+
+  manual_time <- lubridate::now(tzone = "UTC")
+
+  data_storage$insert(
+    app_name = dashboard_name,
+    type = "without_session",
+    time = manual_time
+  )
+
+  result <- data_storage$read_event_data(app_name = dashboard_name)
+
+  result %>%
+    purrr::pluck("date") %>%
+    expect_equal(as.Date(manual_time))
+}
+
 test_common_len_gt_1_alt <- function(data_storage, dashboard_name = "test_dashboard") {
   require(testthat)
   withr::defer(data_storage$close())