 
In test.assessr: Assessing Package Test Reliability and Quality

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.path = "man/figures/",
  out.width = "100%"
)

# Suppress package loading messages
suppressMessages({
  library(dplyr)
  library(kableExtra)
  library(knitr)
})

suppressWarnings({
  library(htmltools)
  library(htmlwidgets)
})

Package Test Report for `r get('pkg_name', envir = report_env)` version `r get('pkg_version', envir = report_env)`

library(knitr)
library(kableExtra)

test_summary_output <- get("test_pkg_summary_output", envir = report_env)

# Render the table using knitr and kableExtra
test_summary_output_html <- knitr::kable(test_summary_output,
                                         col.names = c("Type", "Values"),
                                         format = "html") %>%
  kableExtra::kable_styling("striped", 
                            position = "left", 
                            font_size = 12) %>%
  kableExtra::row_spec(0, 
                       bold = TRUE,
                       italic = TRUE,
                       background = "green") %>%
  kableExtra::add_header_above(c("Test Assessment Summary" = 2), 
                               bold = TRUE, 
                               background = "green", 
                               color = "black")

# Apply conditional formatting based on Risk Profile values
test_summary_output_html <- test_summary_output_html %>%
  kableExtra::row_spec(which(test_summary_output$Value == "Low"), background = "green") %>%
  kableExtra::row_spec(which(test_summary_output$Value == "Medium"), background = "yellow") %>%
  kableExtra::row_spec(which(test_summary_output$Value == "High"), background = "red")


# Display the table
test_summary_output_html

library(knitr)
library(kableExtra)
library(dplyr)
test_details_output <- get("test_details_output", envir = report_env)

# Select only the columns to display in the table
test_details_output_display <- test_details_output %>%
  select(Metric, Value)

# Display df
test_details_output_html <- knitr::kable((test_details_output_display),
                               col.names = c(
                                 "Type",
                                 "Details"),
                          "html")
kableExtra::kable_styling(test_details_output_html, 
                          "striped", 
                          position = "left", 
                          font_size = 12) %>%
  kableExtra::row_spec(0, 
                       bold = TRUE,
                       italic = TRUE,
                       background = "green"
                               ) %>%
  kableExtra::add_header_above(c("Test Assessment Run Details" = 2), bold = TRUE, background = "green", color = "black")

library(knitr)
library(kableExtra)

coverage_output <- get("coverage_output", envir = report_env)

colnames(coverage_output) <- c("Function", "Coverage", "Errors", "Notes")


# Get the column indices based on the column names
errors_col <- which(names(coverage_output) == "Errors")
notes_col <- which(names(coverage_output) == "Notes")

# Render the table using knitr and kableExtra
# Display df
coverage_output_html_DT <- DT::datatable(coverage_output, 
                                         rownames = FALSE, 
                                         colnames = c("Function", "Coverage", "Errors", "Notes"),
                                         options = list(
                                           pageLength = 10,  # Number of rows to display per page
                                           lengthMenu = c(10, 20, 50),  # Options for number of rows per page
                                           search = list(search = ""),  # Enable search functionality
                                           dom = 'Bfrtip',  # Include buttons, filter, and pagination
                                           buttons = c('copy', 'csv', 'excel', 'pdf', 'print')  # Export buttons
                                         ))

# Apply styling
coverage_output_html_DT <- coverage_output_html_DT %>%
  DT::formatStyle(
    columns = 'Errors',
    backgroundColor = DT::styleEqual(
      levels = c("No testthat or testit configuration", "No test coverage errors", "Other Value"),
      values = c("red", "green", "red")

    )
  ) %>%
  DT::formatStyle(
    columns = 'Notes',
    backgroundColor = DT::styleEqual(
      levels = c("No test coverage notes", "Other Value"),
      values = c("green", "yellow")
    )
  )

# Render the datatable with a custom header
htmltools::tagList(
  htmltools::tags$h2("Test Coverage", style = "font-weight: bold; background-color: green; color: black; text-align: center;"),
  coverage_output_html_DT
)

# Render the datatable
# coverage_output_html_DT

cat('
<div style="margin-bottom: 20px;">
  <label for="matrixSelector" style="
    background-color: purple;
    color: white;
    font-size: 20px;
    font-weight: bold;
    padding: 10px;
    border-radius: 5px;
    display: inline-block;
    margin-bottom: 10px;
  ">
    Select Non-Standard Test Type:
  </label>
  <select id="matrixSelector" onchange="toggleMatrix(this.value)" style="
    margin-left: 10px;
    padding: 6px;
    font-size: 18px;
    border-radius: 4px;
  ">
    <option value="no">No Tests</option>
    <option value="skipped">Tests Skipped</option>
    <option value="passing">Tests Passing</option>
  </select>
</div>

<script>
  function toggleMatrix(value) {
    document.getElementById("no_tests").style.display = (value === "no") ? "block" : "none";
    document.getElementById("tests_skipped").style.display = (value === "skipped") ? "block" : "none";
    document.getElementById("tests_passing").style.display = (value === "passing") ? "block" : "none";
  }

  document.addEventListener("DOMContentLoaded", function() {
    toggleMatrix("no");
  });
</script>
')

library(knitr)
library(kableExtra)
library(DT)
library(htmlwidgets)
library(htmltools)
library(stringr)

functions_no_tests <- get("functions_no_tests", envir = report_env)



is_valid_df <- is.data.frame(functions_no_tests) && nrow(functions_no_tests) > 0

if (!is_valid_df) {
  # Fallback message if data is missing or empty
  tags$div(
    id = "no_tests",
    style = "display:block; padding: 8px; background:#fff3cd; border:1px solid #ffeeba; border-radius:6px;",
    tags$strong("No data to display: "),
    "The 'functions_no_tests' data frame is missing or has zero rows."
  )
} else {
  # Optional: clean column names for display
  colnames(functions_no_tests) <- gsub("_", " ", colnames(functions_no_tests))

  # Build the datatable widget
  fn_no_tests_tbl <- DT::datatable(
    functions_no_tests,
    options = list(
      pageLength = 10,
      lengthMenu = c(10, 20, 50),
      dom = 'Bfrtip'
    ),
    caption = htmltools::tags$caption(
        style = "caption-side: top; text-align: left;",
        htmltools::tags$strong(
        htmltools::tags$u("Functions with No Tests")
      )
    ),
    rownames = FALSE
  )

  # Wrap in a div for JS toggling and render inline
  tagAppendChild(
    tags$div(id = "no_tests", style = "display:block;"),
    fn_no_tests_tbl
  )
}

library(knitr)
library(kableExtra)
library(DT)
library(htmlwidgets)
library(htmltools)
library(stringr)

tests_skipped_df <- get("tests_skipped_df", envir = report_env)

tests_skipped_tbl <- DT::datatable(
  tests_skipped_df,
  options = list(pageLength = 10, 
                 lengthMenu = c(10, 20, 50), 
                 dom = 'Bfrtip'
                 ),
    colnames = c(
      "R function"
    ),
    caption = htmltools::tags$caption(
        style = "caption-side: top; text-align: left;",
        htmltools::tags$strong(
        htmltools::tags$u("Skipped Tests")
      )
    )
  )

# Print the datatable inside a div for toggling
htmltools::tags$div(
  id = "tests_skipped",  
  tests_skipped_tbl 
)

library(knitr)
library(kableExtra)
library(DT)
library(htmlwidgets)
library(htmltools)
library(stringr)

tests_passing_df <- get("tests_passing_df", envir = report_env)

tests_passing_tbl <- DT::datatable(
  tests_passing_df,
  options = list(pageLength = 10, 
                 lengthMenu = c(10, 20, 50), 
                 dom = 'Bfrtip'),
  colnames = c(
    "R function"
  ),
  caption = htmltools::tags$caption(
      style = "caption-side: top; text-align: left;",
      htmltools::tags$strong(
        htmltools::tags$u("Passing Tests")
      )
  ),
)

# Print the datatable inside a div for toggling
htmltools::tags$div(
  id = "tests_passing",  
  tests_passing_tbl 
)