#' Create a dashboard-table from a report summary
#'
#' @param repsum a report summary from `summary(report)`
#' @param folder_of_report a named vector with the location of variable and
#'                         `call_names`
#'
#' @family html
#' @concept process
#' @noRd
util_dashboard_table <- function(repsum, folder_of_report = NULL) {
  this <- attr(repsum, "this")
  bigTable <- this$result
  tb <- suppressWarnings(
    bigTable[!is.na(as.numeric(bigTable$values_raw)), , FALSE])
  label_col <- this$label_col
  meta_data <- this$meta_data

  rowmaxes <- this$rowmaxes
  var_classes <- setNames(util_as_integer_cat(
    rowmaxes$rowmax), nm = rowmaxes$VAR_NAMES)
  var_classes <- ordered(var_classes,
                         levels = names(util_get_labels_grading_class()),
                         labels = util_get_labels_grading_class())

  tb[[label_col]] <-
    prep_map_labels(tb$VAR_NAMES, meta_data = meta_data, to = label_col)

  indicator_metric <- NULL # to make R CMD check happy

  if (length(tb) > 0 && prod(dim(tb)) > 0) {
    tb <- subset(tb,
                 !startsWith(indicator_metric, "CAT_") &
                   !startsWith(indicator_metric, "MSG_")
    )
  }

  tb$var_class <- var_classes[tb$VAR_NAMES]

  cols <- util_get_colors()[tb$class]
  labs <- util_get_labels_grading_class()[tb$class]
  fg_cols <- util_get_fg_color(cols)

  tb$`Class` <- ifelse(is.na(labs), "", paste0( # TODO: Find out, if we can remove this safely, when we have factors in datatables always working
    labs
  ))

  tb$`Metric` <- util_translate_indicator_metrics(tb$indicator_metric)
  tb$`Call` <- vapply(tb$call, util_alias2caption, long = TRUE,
                      FUN.VALUE = character(1))
  tb$n_classes <- NULL

  meta_data$STUDY_SEGMENT <- NULL # delete, it is already in tb

  tb <- merge(tb, meta_data, by = intersect(intersect(colnames(tb),
                                                      colnames(meta_data)),
                                            c(VAR_NAMES, label_col)))

  tb$class <- ordered(tb$class,
                      levels = names(util_get_labels_grading_class()),
                      labels = util_get_labels_grading_class())

  my_order1 <- c(
    label_col,
    VAR_NAMES,
    STUDY_SEGMENT,
    "Call",
    "Metric",
    "value",
    "Class",
    "call_names",
    "values_raw",
    "function_name",
    "indicator_metric",
    "class",
    "var_class",
    LABEL,
    DATA_TYPE,
    SCALE_LEVEL
  )

  my_order2 <- c(
    STANDARDIZED_VOCABULARY_TABLE,
    MISSING_LIST_TABLE,
    HARD_LIMITS,
    DETECTION_LIMITS,
    SOFT_LIMITS,
    DISTRIBUTION,
    DECIMALS,
    GROUP_VAR_OBSERVER,
    GROUP_VAR_DEVICE,
    TIME_VAR,
    PART_VAR,
    VARIABLE_ROLE,
    VARIABLE_ORDER,
    LONG_LABEL,
    "ELEMENT_HOMOGENITY_CHECKTYPE",
    UNIVARIATE_OUTLIER_CHECKTYPE,
    N_RULES,
    LOCATION_METRIC,
    LOCATION_RANGE,
    PROPORTION_RANGE,
    "REPEATED_MEASURES_VARS",
    "REPEATED_MEASURES_GOLDSTANDARD",
    CO_VARS,
    END_DIGIT_CHECK,
    VALUE_LABEL_TABLE,
    MISSING_LIST,
    JUMP_LIST
  )

  my_order <- unique(c(intersect(my_order1, colnames(tb)),
                sort(setdiff(colnames(tb), union(my_order1, my_order2))),
                intersect(my_order2, colnames(tb))))

  tb <- tb[, my_order, FALSE]

  tb <- util_add_links_to_summary_table(tb,
                                        this,
                                        folder_of_report = folder_of_report)

  return(util_attach_attr(tb,
                          label_col = label_col))
}

util_add_links_to_summary_table <- function(tb, this, folder_of_report = NULL) {
  label_col <- this$label_col
  while (!is.null(attr(label_col, "orig_label_col"))) {
    label_col <- attr(label_col, "orig_label_col")
  }
  tb[[label_col]] <-
    prep_map_labels(tb$VAR_NAMES,
                    meta_data = this$meta_data,
                    to = label_col)
  tb[[this$label_col]] <-
    prep_map_labels(tb$VAR_NAMES,
                    meta_data = this$meta_data,
                    to = this$label_col)
  if (nrow(tb) == 0) {
    tb$href <- character(0)
    tb$popup_href <- character(0)
    tb$title <- character(0)
  } else {
    tb$href <-
      paste0("VAR_", prep_link_escape(tb[[label_col]],
                                      html = TRUE),
             ".html#",
             prep_link_escape(as.character(tb[[label_col]])),
             ".", tb[["call_names"]])

    # showDataquieRResult("VAR_AGE0.html#nm=acc_distributions_only.AGE_0", "VAR_AGE0.html#v00003: Age B/L", "Gemüsesuppe")
    tb$popup_href <-
      paste0("VAR_", prep_link_escape(tb[[label_col]],
                                      html = TRUE),
             ".html#nm=", tb$call_names, ".",
             as.character(tb[[label_col]]))

    tb$title <- paste0(tb[[this$label_col]],
                       ": ",
                       vapply(tb$call_names, util_alias2caption, long = TRUE, FUN.VALUE = character(1)),
                       ifelse(!is.na(tb$title_ind), paste0(" (",
                       tb$title_ind,
                       ")"), ""))
  }

  if (!is.null(folder_of_report)) { # TODO: Use utility function util_add_links_to_summary_table
    tb$href <-
      paste0(folder_of_report[gsub("\\s+", "", paste0(tb[[this$label_col]], ".", tb[["call_names"]]))],
             "/.report/",
             tb$href)
    tb$popup_href <-
      paste0(folder_of_report[gsub("\\s+", "", paste0(tb[[this$label_col]], ".", tb[["call_names"]]))],
             "/.report/",
             tb$popup_href)
  }

  util_attach_attr(tb, orig_label_col = tb[[this$label_col]])
}
