build-cran-binaries/shiny/app.R

library(shiny)
library(DBI)
library(RPostgres)
library(DT)
library(bslib)
library(dplyr)
library(bincraftR)
library(data.table)

light <- bs_theme(
  preset = "bootstrap",
  base_font = font_google("Inter")
) |>
  bslib::bs_add_rules(rules = "
.navbar.navbar-inverse {
background-color: #151b23 !important;
} .navbar-brand {
color: #d1d7e0;}
  .navbar-nav .nav-link.active {
color: #d1d7e0; }
")
dark <- bs_theme(
  preset = "bootstrap",
  bg = "#212830", fg = "white", primary = "#FF9B00",
  base_font = font_google("Inter")
) |>
  bslib::bs_add_rules(rules = "
.navbar.navbar-inverse {
background-color: #151b23 !important;
} .navbar-brand {
color: #d1d7e0;}
  .navbar-nav .nav-link.active {
color: #d1d7e0; }")

ui <- page_navbar(
  theme = light,
  id = "nav",
  title = "Binary Package Build Metadata",
  nav_spacer(),
  nav_panel("Metadata Query", layout_column_wrap(
    max_height = "200px",
    col_widths = c(3, 9),
    value_box(
      title = "Total binary count",
      value = textOutput("totalEntries"),
      showcase = bsicons::bs_icon("box"),
      #   fill = FALSE,
    ),
    value_box(
      title = "SQL Query",
      #   value = textOutput("query"),
      value = htmlOutput("query"),
      showcase = bsicons::bs_icon("search"),
      class = "text-sm"
      #   fill = FALSE,
      #   max_height = 5
    )
  ), card(
    full_screen = TRUE,
    DTOutput("table")
  )),
  nav_panel(
    "Statistics",
    layout_column_wrap(
      # card(card_header(paste0("Distinct package binary count by OS/Arch of", textOutput("total_cran_pkgs"), "possible")),
      card(card_header("Number of processed packages by OS/Arch"),
        full_screen = TRUE,
        DTOutput("processed")
      ),
      card(card_header("Successful distinct binary builds (n >=1) by OS/Arch"),
        full_screen = TRUE,
        DTOutput("distinct_success")
      ),
      card(card_header("Total successful builds (incl. historic versions)"),
        full_screen = TRUE,
        DTOutput("successful_perc")
      )
    )
  ),
  nav_panel(
    "Packages without binaries",
    card(
      full_screen = TRUE,
      DTOutput("pkgs_missing")
    )
  ),
  sidebar = sidebar(
    conditionalPanel(
      "input.nav === 'Metadata Query'",
      width = 12,
      textInput("name", "Package Name:", "ggplot2"),
      selectInput("arch", "Architecture:", c("amd64", "arm64", "any"), selected = "amd64"),
      selectInput("platform", "Platform:", c("ubuntu-2404", "ubuntu-2204", "redhat-8", "redhat-9", "alpine-320", "any"), selected = "ubuntu-2404"),
      textInput("tag", "Tag:", ""),
      dateRangeInput("timestamp", "Build Date Range:", start = Sys.Date() - 365, end = Sys.Date()),
      input_switch("error_occurred", "Error during build", value = FALSE, width = NULL),
      input_switch("removed", "Removed from CRAN", value = FALSE, width = NULL),
    ),
    checkboxInput("dark_mode", "Dark mode")
  )
)

# Define server logic
server <- function(input, output, session) {
  observe(session$setCurrentTheme(
    if (isTRUE(input$dark_mode)) dark else light
  ))

  # Connect to PostgreSQL database
  con <- dbConnect(
    RPostgres::Postgres(),
    dbname = "build_metadata",
    host = "r-binaries.devxy.io",
    port = 15432,
    user = "r_binaries",
    password = Sys.getenv("PGPASS")
  )

  # Query to get the total count of entries
  output$totalEntries <- renderText({
    total_query <- "SELECT COUNT(*) AS total_entries FROM single_builds WHERE error_occurred = 'false'"
    total_count <- dbGetQuery(con, total_query)
    pretty_count <- format(as.numeric(total_count$total_entries), big.mark = ".", small.mark = ",", scientific = FALSE)
    paste(pretty_count)
  })


  # Query and render the filtered data
  output$table <- renderDT({
    query <- paste0(
      "SELECT * FROM single_builds WHERE 1=1 ",
      if (input$name != "") paste0("AND name = '", input$name, "' "),
      if (!is.null(input$timestamp)) paste0("AND timestamp BETWEEN '", input$timestamp[1], "' AND '", input$timestamp[2], "' "),
      if (input$arch != "" && input$arch != "any") paste0("AND arch = '", input$arch, "' "),
      if (input$platform != "" && input$platform != "any") paste0("AND platform = '", input$platform, "' "),
      if (input$tag != "") paste0("AND tag = '%", input$tag, "%' "),
      if (input$error_occurred != "" && input$error_occurred != "any") paste0("AND error_occurred = '", input$error_occurred, "' "),
      if (input$removed != "" && input$removed != "any") paste0("AND removed = '", input$removed, "' ")
    )
    output$query <- renderUI({
      tagList(
        tags$script(src = "prism.js"),
        shiny::p(query,
          style = "font-size: 15px;"
        )
      )
      #   shiny::p(paste0("<code>", query, "</code"),
      #     style = "font-size: 16px;"
      #   )
      #   paste(query)
    })

    df <- dbGetQuery(con, query)
    df <- df[order(df$tag, decreasing = TRUE), ]
    colnames(df) <- c("Name", "Tag", "Platform", "Error occurred", "Error", "Size (MB)", "Build Timestamp", "Build Duration (s)", "Architecture", "Removed")
    datatable(df)
  })

  output$pkgs_missing <- renderDT({
    query <- paste0("SELECT name,platform,arch FROM single_builds group by name,platform,arch HAVING COUNT(*) = SUM(CASE WHEN error_occurred = 'TRUE' THEN 1 ELSE 0 END);")

    df <- dbGetQuery(con, query)
    df <- df[order(df$name), ]
    colnames(df) <- c("Name", "Platform", "Architecture")
    datatable(df, rownames = FALSE)
  })

  cachedData <- reactiveVal(NULL)
  total_pkgs <- length(tools::CRAN_package_db()$Package)

  observeEvent(input, {
    if (is.null(cachedData())) {
      result <- as.data.table(query_metadata_table())
      cachedData(result)
    }
  })

  # data = as.data.table(query_metadata_table())

  output$processed <- renderDT({
    out <- cachedData() |>
      filter(removed == FALSE) |>
      group_by(platform, arch) |>
      distinct(name) |>
      count() |>
      arrange(platform) |>
      as_tibble()

    out <- out |>
      mutate("%" = round((n / total_pkgs) * 100, 1))
  })

  output$distinct_success <- renderDT({
    out <- cachedData() |>
      filter(removed == FALSE) |>
      group_by(platform, arch) |>
      filter(error_occurred == FALSE) |>
      distinct(name) |>
      count() |>
      arrange(platform) |>
      as_tibble()

    out <- out |>
      mutate("%" = round((n / total_pkgs) * 100, 1))
  })

  output$successful_perc <- renderDT({
    out <- cachedData() |>
      filter(removed == FALSE) |>
      group_by(platform, arch) |>
      count(error_occurred) |>
      mutate("%" = round(n / sum(n) * 100), 2) |>
      filter(error_occurred == FALSE) |>
      select(platform, arch, "%") |>
      as_tibble()
  })

  # output$total_cran_pkgs <- renderText(paste("Number of processed packages by OS/Arch of", length(tools::CRAN_package_db()$Package), "(total number of CRAN packages) possible"))
  #   output$total_cran_pkgs = renderText("20000")

  #   bs_themer()

  # Disconnect on app stop
  onStop(function() {
    dbDisconnect(con)
  })
}

# Run the application
shinyApp(ui = ui, server = server)