get_informant_report.R

#------------------------------------------------------------------------------#
# 
#                 _         _    _      _                _    
#                (_)       | |  | |    | |              | |   
#   _ __    ___   _  _ __  | |_ | |__  | |  __ _  _ __  | | __
#  | '_ \  / _ \ | || '_ \ | __|| '_ \ | | / _` || '_ \ | |/ /
#  | |_) || (_) || || | | || |_ | |_) || || (_| || | | ||   < 
#  | .__/  \___/ |_||_| |_| \__||_.__/ |_| \__,_||_| |_||_|\_\
#  | |                                                        
#  |_|                                                        
#  
#  This file is part of the 'rstudio/pointblank' project.
#  
#  Copyright (c) 2017-2024 pointblank authors
#  
#  For full copyright and license information, please look at
#  https://rstudio.github.io/pointblank/LICENSE.html
# 
#------------------------------------------------------------------------------#


#' Get a table information report from an *informant* object
#' 
#' @description 
#' 
#' We can get a table information report from an informant object that's
#' generated by the [create_informant()] function. The report is provided as a
#' **gt** based display table. The amount of information shown depends on the
#' extent of that added via the use of the `info_*()` functions or through
#' direct editing of a **pointblank** YAML file (an informant can be written
#' to **pointblank** YAML with `yaml_write(informant = <informant>, ...)`).
#' 
#' @param informant *The pointblank informant object*
#' 
#'   `obj:<ptblank_informant>` // **required**
#' 
#'   A **pointblank** *informant* object that is commonly created through the
#'   use of the [create_informant()] function.
#' 
#' @param size *Size option for display-table report*
#' 
#'   `scalar<character>` // *default:* `"standard"`
#' 
#'   The size of the display table, which can be either `"standard"` (the
#'   default, with a width of 875px), `"small"` (width of 575px), or, a pixel-
#'   or percent-based width of your choosing (supply an integer value for the
#'   width in pixels, or values with `"px"` or `"%"` appended, like `"75%"`,
#'   `"500px"`, etc.).
#'   
#' @param title *Title customization options*
#' 
#'   `scalar<character>` // *default:* `":default:"`
#' 
#'   Options for customizing the title of the report. The default is the keyword
#'   `":default:"` which produces generic title text that refers to the
#'   **pointblank** package in the language governed by the `lang` option.
#'   Another keyword option is `":tbl_name:"`, and that presents the name of the
#'   table as the title for the report. If no title is wanted, then the
#'   `":none:"` keyword option can be used. Aside from keyword options, text can
#'   be provided for the title and `glue::glue()` calls can be used to construct
#'   the text string. If providing text, it will be interpreted as Markdown text
#'   and transformed internally to HTML. To circumvent such a transformation,
#'   use text in [I()] to explicitly state that the supplied text should not be
#'   transformed.
#'   
#' @param lang *Reporting language*
#' 
#'   `scalar<character>` // *default:* `NULL` (`optional`)
#' 
#'   The language to use for the *information report*. By default, `NULL` will
#'   create English (`"en"`) text. Other options include French (`"fr"`), German
#'   (`"de"`), Italian (`"it"`), Spanish (`"es"`), Portuguese (`"pt"`), Turkish
#'   (`"tr"`), Chinese (`"zh"`), Russian (`"ru"`), Polish (`"pl"`), Danish
#'   (`"da"`), Swedish (`"sv"`), and Dutch (`"nl"`). This `lang` option will
#'   override any previously set language setting (e.g., by the
#'   [create_informant()] call).
#'   
#' @param locale *Locale for value formatting*
#' 
#'   `scalar<character>` // *default:* `NULL` (`optional`)
#' 
#'   An optional locale ID to use for formatting values in the
#'   *information report* summary table according the locale's rules. Examples
#'   include `"en_US"` for English (United States) and `"fr_FR"` for French
#'   (France); more simply, this can be a language identifier without a country
#'   designation, like `"es"` for Spanish (Spain, same as `"es_ES"`). This
#'   `locale` option will override any previously set locale value (e.g., by the
#'   [create_informant()] call).
#' 
#' @return A **gt** table object.
#' 
#' @examples
#' # Generate an informant object using
#' # the `small_table` dataset
#' informant <- create_informant(small_table)
#' 
#' # This function creates some information
#' # without any extra help by profiling
#' # the supplied table object; it adds
#' # the sections 'table' and columns' and
#' # we can print the object to see the
#' # table information report
#' 
#' # Alternatively, we can get the same report
#' # by using `get_informant_report()`
#' report <- get_informant_report(informant)
#' class(report)
#' 
#' @family Incorporate and Report
#' @section Function ID:
#' 7-2
#' 
#' @export
get_informant_report <- function(
    informant,
    size = "standard",
    title = ":default:",
    lang = NULL,
    locale = NULL
) {
  
  # nocov start
  time_start <- Sys.time()
  
  if (is.null(lang)) {
    
    lang <- informant$lang
    if (is.null(locale)) locale <- informant$locale
    
  } else {
    
    normalize_reporting_language(lang = lang)
    
    # Set the `locale` to the `lang` value if `locale` isn't set
    if (is.null(locale)) locale <- lang
  }
  
  if ("metadata_rev" %in% names(informant)) {
    y <- informant$metadata_rev
  } else {
    y <- informant$metadata
    # Hide private metadata from report
    y[["_private"]] <- NULL
  }
  
  if ("info_label" %in% names(informant)) {
    info_label <- informant[["info_label"]]
  } else {
    info_label <- paste0("[", gsub(" ", "|", strftime(Sys.time())), "]")
  }
  info_label <- make_info_label_html(info_label = info_label)
  
  meta_columns <- NULL
  meta_rows <- NULL
  
  y_names <- names(y)
  
  priority_items <- c("table",  "columns")
  
  names_ordered <- 
    sort(base::intersect(y_names, priority_items), decreasing = TRUE)
  
  names_others <- base::setdiff(y_names, priority_items)
  
  y <- y[c(names_ordered, names_others)]
  
  # Create empty table  
  tbl <- dplyr::tibble(group = character(0), item = character(0))
  
  if ("table" %in% y_names) {
    
    section <- y[["table"]]
    section_names <- names(section)
    
    if ("name" %in% section_names ||
        "_type" %in% section_names ||
        "type" %in% section_names) {
      
      if ("type" %in% section_names || "_type" %in% section_names) {
        if ("_type" %in% section_names) tbl_src <- section[["_type"]]
        if ("type" %in% section_names) tbl_src <- section[["type"]]
      } else {
        tbl_src <- NA_character_
      }
      
      if ("name" %in% section_names) {
        tbl_name <- section[["name"]]
      } else {
        tbl_name <- NA_character_
      }
      
      table_type_html <-  
        create_table_type_html(
          tbl_src = tbl_src,
          tbl_name = tbl_name
        )
      
      # Remove `name`, `type`, and `_type` from `section_names`
      section_names <- 
        section_names[!(section_names %in% c("name", "type", "_type"))]
      
    } else {
      table_type_html <- ""
    }
    
    if ("columns" %in% section_names) {
      meta_columns <- as.numeric(section[["columns"]][1])
    }
    
    if ("_columns" %in% section_names) {
      meta_columns <- as.numeric(section[["_columns"]][1])
    }
    
    if ("rows" %in% section_names) {
      meta_rows <- as.numeric(section[["rows"]][1])
    }
    
    if ("_rows" %in% section_names) {
      meta_rows <- as.numeric(section[["_rows"]][1])
    }
    
    section_names <- 
      section_names[
        !(section_names %in% c("columns", "_columns", "rows", "_rows"))
      ]
    
    if (length(section_names) > 0) {
      
      for (s_name in section_names) {
        
        tbl <- 
          add_to_tbl(
            tbl = tbl,
            item = title_text_md(section[s_name], elements = "vertical"),
            group = "Table"
          )
      }
    }
    
  } else {
    table_type_html <- ""
  }
  
  if ("columns" %in% y_names) {
    
    section <- y[["columns"]]
    column_names <- names(section)
    
    if (length(column_names) > 0) {
      
      for (column in column_names) {
        
        col_meta <- section[[column]]
        col_meta_names <- names(col_meta)
        miniheader_vec <- c()
        
        if (inherits(col_meta, "character")) {
          
          list_item <- 
            list(
              a = paste0(
                "<strong class=\"pb_sub_label\">INFO</strong> ",
                unlist(col_meta)
              )
            )
          
          names(list_item) <- column
          
          tbl <- 
            add_to_tbl(
              tbl = tbl,
              item = title_text_md(
                item = list_item,
                elements = "vertical",
                title_code = TRUE
              ),
              group = "Columns"
            )
          
        } else {
          
          if ("_type" %in% col_meta_names ||
              "type" %in% col_meta_names) {
            
            col_type_vec <- c("type", "_type", "sql_type", "_sql_type")
            
            col_type <- NULL
            
            if ("_type" %in% col_meta_names) {
              col_type <- col_meta[["_type"]][1]
            }
            if ("type" %in% col_meta_names) {
              col_type <- col_meta[["type"]][1]
            }
            
            if ("_sql_type" %in% col_meta_names ||
                "sql_type" %in% col_meta_names) {
              
              if ("_sql_type" %in% col_meta_names) {
                sql_col_type <- col_meta[["_sql_type"]][1]
              }
              if ("sql_type" %in% col_meta_names) {
                sql_col_type <- col_meta[["sql_type"]][1]
              }
              
              # Fashion the `col_type` text to show the SQL
              # column type (LHS) and then the column type in R (RHS)
              col_type <- 
                paste(
                  sql_col_type,
                  htmltools::tags$span(
                    style = htmltools::css(
                      `font-family` = "initial",
                      `font-size` = "large"
                    ),
                    htmltools::HTML("&rarr;")
                  ) %>%
                    as.character(),
                  col_type
                )
            }
            
            col_meta <- col_meta[!(col_meta_names %in% col_type_vec)]
            miniheader_vec <- c(miniheader_vec, col_type = col_type)
          }
          
          col_meta <- 
            lapply(col_meta, FUN = function(x) {
              if (length(x) > 1) {
                x <- paste0("\n", paste0("- ", x, "\n", collapse = ""))
              }
              x
            })
          
          list_item <- 
            list(
              a = paste0(
                "<strong class=\"pb_sub_label\">",
                toupper(names(col_meta)),
                "</strong> ", unlist(col_meta)
              )
            )
          
          names(list_item) <- column
          
          tbl <- 
            add_to_tbl(
              tbl = tbl,
              item = title_text_md(
                item = list_item,
                elements = "vertical", 
                title_code = TRUE
              ),
              group = "Columns"
            )
          
          column_escaped <-
            column %>% 
            gsub("(\\(|\\)|\\[|\\]|\\||\\.|\\^|\\?|\\+|\\$|\\*)", "\\\\\\1", .)
          
          row_idx <- 
            which(grepl(paste0("^<code.*?>", column_escaped, "<.*?"), tbl$item))
          
          if (length(miniheader_vec) > 0) {
            tbl$item[[row_idx]] <-
              gsub(
                "(^.*?</code>)(.*)", 
                paste0(
                  "\\1&nbsp;&nbsp;<code class=\"pb_col_type\">",
                  miniheader_vec, "</code>\\2"
                ),
                tbl$item[[row_idx]]
              )
          }
        }
      }
    }
  }
  
  # Modify `tbl` so that `group` values correspond to the set `lang`
  tbl <-
    tbl %>%
    dplyr::mutate(group = dplyr::case_when(
      group == "Table" ~ get_lsv(text = c(
        "informant_report", "pointblank_table_text"
      ))[[lang]],
      group == "Columns" ~ get_lsv(text = c(
        "table_scan", "tbl_lab_columns"
      ))[[lang]],
      TRUE ~ group
    ))
  
  if (length(names_others) > 0) {
    
    for (o_name in names_others) {
      
      o_section <- y[[o_name]]
      section_names <- names(o_section)
      
      if (is.null(section_names) &&
          is.character(o_section) &&
          length(o_section) > 0) {
        
        list_item <- 
          list(
            a = paste0("- ", unlist(o_section))
          )
        
        names(list_item) <- o_name
        
        tbl <- 
          add_to_tbl(
            tbl = tbl,
            item = title_text_md(
              item = list_item,
              elements = "vertical",
              use_title = FALSE
            ),
            group = o_name
          )
      }
      
      for (section in section_names) {
        
        section_meta <- o_section[section]
        
        if (inherits(section_meta, "character")) {
          
          list_item <- 
            list(
              a = paste0("<strong>INFO</strong> ", unlist(section_meta))
            )
          
          names(list_item) <- column
          
          tbl <- 
            add_to_tbl(
              tbl = tbl,
              item = title_text_md(
                item = list_item,
                elements = "vertical",
                title_code = TRUE
              ),
              group = o_name
            )
          
        } else {
          
          tbl <- 
            add_to_tbl(
              tbl = tbl,
              item = title_text_md(
                item = section_meta,
                elements = "vertical",
                use_title = TRUE
              ),
              group = o_name
            )
        }
      }
    }
  }
  
  # Generate table dimensions HTML
  table_dims <- 
    make_table_dims_html(
      columns = meta_columns,
      rows = meta_rows,
      lang = lang,
      locale = locale
    )
  
  # Combine label, table type, and table dimensions into
  # a table subtitle <div>
  combined_subtitle <-
    htmltools::tagList(
      htmltools::HTML(info_label),
      htmltools::tags$div(
        style = htmltools::css(
          height = "25px",
          `margin-top` = "10px"
        ),
        htmltools::HTML(paste0(table_type_html, table_dims))
      ) 
    ) %>% as.character()
  
  time_end <- Sys.time()
  
  # Generate table execution start/end time (and duration)
  # as a table source note
  # TODO: Add outer div with top and bottom margins set (3px and 5px), then,
  # the `#pb_information .gt_sourcenote` CSS can be removed
  table_time <- 
    create_table_time_html(
      time_start = time_start,
      time_end = time_end,
      size = size,
      locale = locale 
    )

  # Generate the report title with the `title` option
  title_text <- 
    process_title_text(
      title = title,
      tbl_name = tbl_name,
      report_type = "informant",
      lang = lang
    )
  
  # Generate a gt table
  gt_informant_report <- 
    gt::gt(
      tbl,
      groupname_col = "group",
      id = "pb_information"
    ) %>%
    gt::tab_header(
      title = title_text,
      subtitle = gt::md(combined_subtitle)
    ) %>%
    gt::tab_source_note(source_note = gt::md(table_time)) %>%
    gt::fmt_markdown(columns = "item") %>%
    gt::tab_options(
      column_labels.hidden = TRUE
    ) %>%
    gt::tab_style(
      style = gt::cell_text(
        size = gt::px(28),
        weight = 500,
        align = "left",
        color = "#444444"
      ),
      locations = gt::cells_title("title")
    ) %>%
    gt::tab_style(
      style = gt::cell_text(
        size = gt::px(12),
        align = "left"
      ),
      locations = gt::cells_title("subtitle")
    ) %>%
    gt::tab_style(
      style = list(
        gt::cell_text(
          color = "#444444",
          weight = 500,
          transform = "uppercase" 
        ),
        gt::cell_fill(color = "#FCFCFC"),
        gt::cell_borders(
          sides = "bottom",
          color = "#EFEFEF",
          weight = 1
        )
      ),
      locations = gt::cells_row_groups(groups = TRUE)
    ) %>%
    gt::tab_style(
      style = list(
        gt::cell_text(
          color = "#666666",
          size = "smaller"
        ),
        gt::cell_borders(
          sides = "top",
          style = "solid",
          color = "#EFEFEF",
          weight = 1
        )
      ),
      locations = gt::cells_body(columns = gt::everything())
    )
  
  if (size == "small") {
    
    gt_informant_report <-
      gt_informant_report %>% 
      gt::cols_width(gt::everything() ~ gt::px(575))
  }
  
  if (size != "small") {
    
    if (size == "standard") {
      width_px <- 650
    } else {
      width_px <- size
    }
    
    gt_informant_report <-
      gt_informant_report %>%
      gt::tab_options(
        table.width = width_px,
        table.font.size = gt::pct(130)
      ) %>%
      gt::opt_table_font(font = gt::google_font("IBM Plex Sans")) %>%
      gt::opt_css(
        css = "
          #pb_information {
            -webkit-font-smoothing: antialiased;
            letter-spacing: .15px;
          }
          #pb_information a {
            color: #375F84;
            text-decoration: none;
          }
          #pb_information a:hover {
            color: #375F84;
            text-decoration: underline;
          }
          #pb_information p {
            overflow: visible;
            margin-top: 2px;
            margin-left: 0;
            margin-right: 0;
            margin-bottom: 5px;
          }
          #pb_information ul {
            list-style-type: square;
            padding-left: 25px;
            margin-top: -4px;
            margin-bottom: 6px;
          }
          #pb_information li {
            text-indent: -1px;
          }
          #pb_information h4 {
            font-weight: 500;
            color: #444444;
          }
          #pb_information code {
            font-family: 'IBM Plex Mono', monospace, courier;
            font-size: 90%;
            font-weight: 500;
            color: #666666;
            background-color: transparent;
            padding: 0;
          }
          #pb_information .pb_date {
            text-decoration-style: solid;
            text-decoration-color: #9933CC;
            text-decoration-line: underline;
            text-underline-position: under;
            font-variant-numeric: tabular-nums;
            margin-right: 4px;
          }
          #pb_information .pb_label {
            border: solid 1px;
            border-color: inherit;
            padding: 0px 3px 0px 3px;
          }
          #pb_information .pb_label_rounded {
            border: solid 1px;
            border-color: inherit;
            border-radius: 8px;
            padding: 0px 8px 0px 8px;
          }
          #pb_information .pb_sub_label {
            font-size: smaller;
            color: #777777;
          }
          #pb_information .pb_col_type {
            font-size: 75%;
          }
          #pb_information .gt_sourcenote {
            height: 35px;
            font-size: 60%;
            padding: 0;
          }
          #pb_information .gt_group_heading {
            text-indent: -3px;
          }
        "
      )
  }
  
  class(gt_informant_report) <- 
    c("ptblank_informant_report", class(gt_informant_report))
  
  # nocov end
  
  # Quarto rendering workaround
  if (check_quarto()) {
    gt_informant_report <- gt::fmt(gt_informant_report, fns = identity)
  }
  
  gt_informant_report
}

add_to_tbl <- function(tbl, item, group) {
  dplyr::bind_rows(tbl, dplyr::tibble(group = group, item = item))
}

# Process titles and text
title_text_md <- function(
    item,
    use_title = TRUE,
    title_level = 4,
    title_code = FALSE,
    elements = "vertical"
) {
  
  title <- names(item)
  item <- unname(unlist(item))
  
  # Process item with text transformers
  for (i in seq_along(item)) {
    
    # Dates are automatically set in the `pb_date` class if they can
    # be parsed as ISO-8601 dates, and, if the date is enclosed in
    # parentheses
    if (grepl("\\([1-2][0-9][0-9][0-9]-[0-1][0-9]-[0-3][0-9]\\)", item[i])) {
      
      for (j in 1:10) {
        item[i] <- 
          gsub(
            "(.*)\\(([1-2][0-9][0-9][0-9]-[0-1][0-9]-[0-3][0-9])\\)(.*)",
            "\\1<span class=\"pb_date\">\\2</span>\\3",
            item[i]
          )
      }
    }
    
    # Rounded labels are generated when there is text surrounded by `((( )))` 
    if (grepl("\\(\\(\\(.*?\\)\\)\\)", item[i])) {
      
      for (j in 1:10) {
        item[i] <-
          gsub(
            "(.*)\\(\\(\\((.*?)\\)\\)\\)(.*)",
            "\\1<span class=\"pb_label_rounded\">\\2</span>\\3",
            item[i]
          )
      }
    }
    
    # Square labels are generated when there is text surrounded by `(( ))` 
    if (grepl("\\(\\(.*?\\)\\)", item[i])) {
      
      for (j in 1:10) {
        item[i] <-
          gsub(
            "(.*)\\(\\((.*?)\\)\\)(.*)",
            "\\1<span class=\"pb_label\">\\2</span>\\3",
            item[i]
          )
      }
    }

    # Constructions with style and class declarations when there is
    # text in this form: `[[ text ]]<< classes, styles >>` 
    if (grepl("\\[\\[.*?\\]\\](\\n?)<<.*?>>", item[i])) {

      # Strip any `\n` characters
      item[i] <- item[i] %>% gsub("\\n", "", .)
      
      for (j in 1:10) {

        text_content <-
          item[i] %>%
          gsub("(.*)(\\[\\[.*?\\]\\]<<.*?>>)(.*)", "\\2", .) %>%
          gsub("\\[\\[(.*?)\\]\\]<<(.*?)>>", "\\1", .)
        
        replace_within_anchor_chars <- function(x, left, right, what, repl) {
          
          re <- 
            paste0(
              "(?:\\G(?!^)|", left, ")[^",
              right, "]*?\\K", what, "(?=[^",
              right, "]*", right, ")"
            )
          
          gsub(re, repl, x, perl = TRUE)
        }
        
        tag_content <-
          item[i] %>%
          gsub("(.*)(\\[\\[.*?\\]\\]<<.*?>>)(.*)", "\\2", .) %>%
          gsub("\\[\\[(.*?)\\]\\]<<(.*?)>>", "\\2", .) %>%
          gsub(":\\s+?", ":", .) %>%
          gsub(";\\s+?", ";", .) %>%
          replace_within_anchor_chars(
            left = ":", right = ";", what = "\\s+", repl = "&nbsp;") %>%
          strsplit(" ")
        
        id_values <-
          vapply(
            tag_content,
            USE.NAMES = FALSE,
            FUN.VALUE = character(1),
            FUN = function(x) {
              
              if (all(!grepl("^\\#", x))) {
                return("")
              }
              
              paste0(
                "id=\"",
                paste(x[grepl("^\\#", x)], collapse = " "),
                "\""
              )
            }
          )
        
        class_values <-
          vapply(
            tag_content,
            USE.NAMES = FALSE,
            FUN.VALUE = character(1),
            FUN = function(x) {
              
              if (all(!grepl("^\\.", x))) {
                return("")
              }
              
              paste0(
                "class=\"",
                paste(x[grepl("^\\.", x)], collapse = " "),
                "\""
              )
            }
          )
        
        style_values <-
          vapply(
            tag_content,
            USE.NAMES = FALSE,
            FUN.VALUE = character(1),
            FUN = function(x) {
              
              if (all(!(grepl(":", x) & grepl(";$", x)))) {
                return("")
              }
              
              styles_idx <- which(grepl(":", x) & grepl(";$", x))
              
              paste0(
                "style=\"",
                paste(gsub("&nbsp;", " ", x[styles_idx]), collapse = " "),
                "\""
              )
            }
          )
        
        item[i] <-
          gsub(
            "(.*)(\\[\\[.*?\\]\\]<<.*?>>)(.*)",
            paste0(
              "\\1<",
              paste(
                "span", id_values, class_values, style_values, collapse = " "
              ),
              ">", text_content, "</span>\\3"
            ),
            item[i]
          ) 
      }
    }
  }
  
  if (elements == "vertical") {
    
    item <- paste(item, collapse = "\n\n")
    
    if (use_title) {
      
      if (!title_code) {
        title <- gsub("_", " ", toupper(title))
      }
      
      item <- 
        paste0(
          "<",
          ifelse(title_code, "code", "h"),
          ifelse(title_code, "", as.character(title_level)), " ",
          "style=\"margin-bottom:5px;",
          ifelse(
            title_code,
            paste0(
              "color:#555555;font-weight:500;line-height:2em;",
              "border:solid 1px #499FFE;",
              "padding:2px 8px 3px 8px;background-color:#FAFAFA;"
            ),
            ""
          ),
          "\">",
          title, "</", ifelse(title_code, "code", "h"),
          ifelse(title_code, "", as.character(title_level)), ">\n\n",
          item
        )
    }
    
  } else if (elements == "horizontal") {
    
    item <- paste(item, collapse = " &mdash; ")
    
    if (use_title) {
      
      if (!title_code) {
        title <- gsub("_", " ", toupper(title))
      }
      
      item <- 
        paste0(
          "<span style=\"font-size:1.17em;font-weight:bold;\">",
          ifelse(
            title_code,
            "<code style=\"font-weight:bold;margin-bottom:2px;\">",
            ""
          ),
          title,
          ifelse(title_code, "</code>", ""),
          "</span>&nbsp;&nbsp;",
          item
        )
    }
  }
  
  item
}

make_info_label_html <- function(info_label) {
  
  htmltools::tags$span(
    info_label,
    style = htmltools::css(
      `text-decoration-style` = "solid",
      `text-decoration-color` = "#ADD8E6",
      `text-decoration-line` = "underline",
      `text-underline-position` = "under",
      color = "#333333",
      `font-variant-numeric` = "tabular-nums",
      `padding-left` = "4px",
      `margin-right` = "5px",
      `padding-right` = "2px"
    )
  ) %>% as.character()
}

make_table_dims_html <- function(
    columns = NULL,
    rows = NULL,
    lang = NULL,
    locale = NULL
) {
  
  if (is.null(columns) && is.null(rows)) {
    return("")
  }
  
  columns <- columns %||% "&mdash;"
  
  if (is.null(columns)) {
    columns <- "&mdash;"
  } else {
    columns <- pb_fmt_number(columns, decimals = 0, locale = locale)
  }
  
  if (is.null(rows)) {
    rows <- "&mdash;"
  } else {
    rows <- pb_fmt_number(rows, decimals = 0, locale = locale)
  }
  
  as.character(
    htmltools::tagList(
      htmltools::tags$span(
        style = htmltools::css(
          `background-color` = "#eecbff",
          color = "#333333",
          padding = "0.5em 0.5em",
          position = "inherit",
          `text-transform` = "uppercase",
          margin = "5px 0px 5px 5px",
          `font-weight` = "bold",
          border = paste0("solid 1px #eecbff"),
          padding = "2px 15px 2px 15px",
          `font-size` = "smaller"
        ),
        get_lsv("table_scan/tbl_lab_rows")[[lang]]
      ),
      htmltools::tags$span(
        style = htmltools::css(
          `background-color` = "none",
          color = "#333333",
          padding = "0.5em 0.5em",
          position = "inherit",
          margin = "5px 0px 5px -4px",
          `font-weight` = "bold",
          border = paste0("solid 1px #eecbff"),
          padding = "2px 15px 2px 15px",
          `font-size` = "smaller"
        ),
        htmltools::HTML(rows)
      ),
      htmltools::tags$span(
        style = htmltools::css(
          `background-color` = "#BDE7B4",
          color = "#333333",
          padding = "0.5em 0.5em",
          position = "inherit",
          `text-transform` = "uppercase",
          margin = "5px 0px 5px 1px",
          `font-weight` = "bold",
          border = paste0("solid 1px #BDE7B4"),
          padding = "2px 15px 2px 15px",
          `font-size` = "smaller"
        ),
        get_lsv("table_scan/tbl_lab_columns")[[lang]]
      ),
      htmltools::tags$span(
        style = htmltools::css(
          `background-color` = "none",
          color = "#333333",
          padding = "0.5em 0.5em",
          position = "inherit",
          margin = "5px 0px 5px -4px",
          `font-weight` = "bold",
          border = paste0("solid 1px #BDE7B4"),
          padding = "2px 15px 2px 15px",
          `font-size` = "smaller"
        ),
        htmltools::HTML(columns)
      )
    )
  )
}