# Create a shorter version of `mtcars`
mtcars_short <- mtcars[1:5, ]

# Function to skip tests if Suggested packages not available on system
check_suggests <- function() {
  skip_if_not_installed("rvest")
  skip_if_not_installed("xml2")
}

# Gets the HTML attr value from a single key
selection_value <- function(html, key) {
  selection <- paste0("[", key, "]")
  rvest::html_attr(rvest::html_nodes(html, selection), key)
}

# Gets the inner HTML text from a single value
selection_text <- function(html, selection) {
  rvest::html_text(rvest::html_nodes(html, selection))
}

test_that("The `text_transform()` function works correctly", {

  # Check that specific suggested packages are available
  check_suggests()

  # Create a `tbl_html` object with `gt()` and transform
  # all values in the `mpg` column
  tbl_html <-
    mtcars_short %>%
    gt() %>%
    text_transform(
      locations = cells_body(columns = mpg),
      fn = function(x) paste0(x, " mpg")
    )

  # Expect that all data values in the `mpg` column have 'mpg'
  # at the end
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr td:first-child") %>%
    expect_match(".* mpg$")

  # Create a `tbl_html` object with `gt()` and transform
  # all values in the `mpg` column with a slightly more
  # complex function
  tbl_html <-
    mtcars_short %>%
    gt() %>%
    text_transform(
      locations = cells_body(columns = mpg),
      fn = function(x) {
        paste0(x, " ", ifelse(x >= 20, "(good)", "(bad)"))
      }
    )

  # Expect that all data values in the `mpg` column
  # have either '(good)' or '(bad)' at the end
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr td:first-child") %>%
    expect_match(".*(\\(good\\)|\\(bad\\))$")

  # Create a `tbl_html` object with `gt()` and transform
  # all values in the `mpg` column with a function that
  # returns a single numeric value
  tbl_html <-
    mtcars_short %>%
    gt() %>%
    text_transform(
      locations = cells_body(columns = mpg),
      fn = function(x) {
        ifelse(x >= 20, 25, 15)
      }
    )

  # Expect that all data values in the `mpg` column
  # are either '15' or '25'
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr td:first-child") %>%
    unique() %>%
    expect_equal(c("25", "15"))

  # Create a `tbl_html` object with `gt()`, format `mpg` values
  # with `fmt_number()` (using a pattern) and further transform
  # all values in the `mpg` column; this shows that `text_transform()`
  # takes `x` that has gone through all formatting functions first
  tbl_html <-
    mtcars_short %>%
    gt() %>%
    fmt_number(
      columns = mpg,
      decimals = 4,
      pattern = "{x} miles") %>%
    text_transform(
      locations = cells_body(columns = mpg),
      fn = function(x) {
        paste(x, "per gallon")
      }
    )

  # Expect that all data values in the `mpg` column have 'mpg'
  # at the end
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr td:first-child") %>%
    expect_match(".*miles per gallon$")

  # Call two `text_transform()`s and expect them to be later
  # executed in the correct order
  tbl_html <-
    mtcars_short %>%
    gt() %>%
    text_transform(
      locations = cells_body(columns = mpg),
      fn = function(x) {
        paste(x, "miles")
      }
    ) %>%
    text_transform(
      locations = cells_body(columns = mpg),
      fn = function(x) {
        paste(x, "per gallon")
      }
    )

  # Expect that all data values in the `mpg` column have 'mpg'
  # at the end
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr td:first-child") %>%
    expect_match(".*miles per gallon$")

  # Extract the internal `transforms` attr
  transforms <- dt_transforms_get(data = tbl_html)

  # Expect two components to be held within `transforms`
  transforms %>% expect_length(2)

  # Expect that each component of `transforms` has the names
  # `resolved` and `fn`
  transforms[[1]] %>% expect_named(c("resolved", "fn"))
  transforms[[2]] %>% expect_named(c("resolved", "fn"))

  # Expect that `resolved` subcomponent of `transforms` has the names
  # `columns` and `rows`
  transforms[[1]]$resolved %>% expect_named(c("columns", "rows", "colnames"))
  transforms[[2]]$resolved %>% expect_named(c("columns", "rows", "colnames"))

  # Expect that `resolved` subcomponent of `transforms` has the class
  # names and `resolved`, `cells_body`, `location_cells`
  transforms[[1]]$resolved %>%
    expect_s3_class(c("resolved", "cells_body", "location_cells"))

  transforms[[2]]$resolved %>%
    expect_s3_class(c("resolved", "cells_body", "location_cells"))

  # Expect that `fn` subcomponent of `transforms` is a function
  expect_true(is.function(transforms[[1]]$fn))
  expect_true(is.function(transforms[[2]]$fn))

  # Define a function that converts vector of `x` to numeric
  # and rounds values to a specific multiple
  round_mult <- function(x, multiple = 0.25) {
    x <- as.numeric(x)
    format(multiple * round(x / multiple))
  }

  # Call `text_transform()` with the custom function `round_mult()`
  # as input to `fn`
  tbl_html <-
    mtcars_short %>%
    gt() %>%
    text_transform(
      locations = cells_body(columns = mpg),
      fn = round_mult
    )

  # Expect values rounded to the default `0.25` interval
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr td:first-child") %>%
    expect_match(".*\\.(00|25|50|75)$")
})

test_that("`text_transform()` works in the body even when rows/columns are reordered", {

  # Use `tab_row_group()` to create new row groups (this reorders
  # the data table) and use `text_transform()` in two separate calls
  # to modify various cells in the `mpg` column
  tbl_html <-
    mtcars_short %>%
    gt(rownames_to_stub = TRUE) %>%
    tab_row_group(
      label = md("**Mazda**"),
      rows = starts_with("Maz"),
      id = "Mazda"
    ) %>%
    tab_row_group(
      label = md("**2 Hornets + a Datsun**"),
      rows = matches("Datsun|Hornet"),
      id = "DatsunHornet"
    ) %>%
    text_transform(
      locations = cells_body(columns = mpg, rows = "Datsun 710"),
      fn = function(x) paste0(x, "!")
    ) %>%
    text_transform(
      locations = cells_body(columns = mpg, rows = starts_with("Mazda")),
      fn = function(x) round(as.numeric(x), 0)
    )

  # Expect that certain cells are transformed in the `mpg` column
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr td:nth-child(2)") %>%
    expect_equal(c("22.8!", "21.4", "18.7", "21", "21"))

  # Reorder the groups with the `row_group_order()` function
  tbl_html <-
    tbl_html %>%
    row_group_order(groups = c("Mazda", "DatsunHornet"))

  # Expect that the transformed cells in the `mpg` column are
  # reordered to match the new group order
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr th:nth-child(1)") %>%
    expect_equal(
      c(
        "", "Mazda", "Mazda RX4", "Mazda RX4 Wag", "2 Hornets + a Datsun",
        "Datsun 710", "Hornet 4 Drive", "Hornet Sportabout"
      )
    )

  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr td:nth-child(2)") %>%
    expect_equal(c("21", "21", "22.8!", "21.4", "18.7"))

  # Move the `mpg` column to the right of `cyl`
  tbl_html <-
    tbl_html %>%
    cols_move(columns = mpg, after = cyl)

  # Expect that the transformed cells in the `mpg` column in its
  # new position are still transformed properly
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr td:nth-child(3)") %>%
    expect_equal(c("21", "21", "22.8!", "21.4", "18.7"))
})

test_that("`text_transform()` works in column labels", {

  # Create a gt table and modify two different column names
  # with the `text_transform()` function
  tbl_html <-
    mtcars_short %>%
    gt(rownames_to_stub = TRUE) %>%
    tab_row_group(
      label = md("**Mazda**"),
      rows = starts_with("Maz"),
      id = "Mazda"
    ) %>%
    tab_row_group(
      label = md("**2 Hornets + a Datsun**"),
      rows = matches("Datsun|Hornet"),
      id = "DatsunHornet"
    ) %>%
    cols_move_to_end(columns = cyl) %>%
    text_transform(
      locations = cells_column_labels(columns = c(mpg, cyl)),
      fn = toupper
    )

  # Expect column labels to be transformed correctly
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("tr:first-child th") %>%
    expect_equal(
      c(
        "", "MPG", "disp", "hp", "drat", "wt", "qsec", "vs", "am",
        "gear", "carb", "CYL", "2 Hornets + a Datsun"
      )
    )
})

test_that("`text_transform()` works on row labels in the stub", {

  # Create a gt table and modify two different column names
  # with the `text_transform()` function
  tbl_html <-
    mtcars_short %>%
    gt(rownames_to_stub = TRUE) %>%
    tab_row_group(
      label = md("**Mazda**"),
      rows = starts_with("Maz"),
      id = "Mazda"
    ) %>%
    tab_row_group(
      label = md("**2 Hornets + a Datsun**"),
      rows = matches("Datsun|Hornet"),
      id = "DatsunHornet"
    ) %>%
    cols_move_to_end(columns = cyl) %>%
    text_transform(
      locations = cells_stub(rows = c("Mazda RX4 Wag", "Hornet Sportabout")),
      fn = toupper
    )

  # Expect column labels to be transformed correctly
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("[class='gt_row gt_left gt_stub']") %>%
    expect_equal(
      c(
        "Datsun 710", "Hornet 4 Drive", "HORNET SPORTABOUT",
        "Mazda RX4", "MAZDA RX4 WAG"
      )
    )
})

test_that("`text_transform()` works on row group labels", {

  # Create a gt table and modify the two different row group labels
  # with the `text_transform()` function
  tbl_html <-
    exibble %>%
    gt(rowname_col = "row", groupname_col = "group") %>%
    text_transform(
      locations = cells_row_groups(),
      fn = toupper
    )

  # Expect row group labels to be transformed correctly
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("[class='gt_group_heading']") %>%
    expect_equal(c("GRP_A", "GRP_B"))


  # Create a gt table and modify the first row group label
  # with the `text_transform()` function
  tbl_html <-
    exibble %>%
    gt(rowname_col = "row", groupname_col = "group") %>%
    text_transform(
      locations = cells_row_groups(groups = "grp_a"),
      fn = toupper
    )

  # Expect row group labels to be transformed correctly
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("[class='gt_group_heading']") %>%
    expect_equal(c("GRP_A", "grp_b"))

  # Create a new gt table for further testing
  tbl_gt <-
    gtcars %>%
    dplyr::select(model, year, hp, trq) %>%
    gt(rowname_col = "model") %>%
    tab_row_group(
      label = "powerful",
      rows = hp >= 400 & hp < 600
    ) %>%
    tab_row_group(
      label = "super powerful",
      rows = hp > 600
    )

  # Modify the first row group label with
  # the `text_transform()` function
  tbl_html <-
    tbl_gt %>%
    text_transform(
      locations = cells_row_groups(groups = "powerful"),
      fn = toupper
    )

  # Expect row group labels to be transformed correctly
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("[class='gt_group_heading']") %>%
    expect_equal(c("super powerful", "POWERFUL"))

  # Modify all group labels with the `text_transform()` function
  tbl_html <-
    tbl_gt %>%
    text_transform(
      locations = cells_row_groups(),
      fn = function(x) ""
    )

  # Expect row group labels to be transformed correctly
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("[class='gt_group_heading']") %>%
    expect_equal(character(0))

  # Modify all group labels with the `text_transform()` function
  tbl_html <-
    tbl_gt %>%
    text_transform(
      locations = cells_row_groups(),
      fn = toupper
    )

  # Expect row group labels to be transformed correctly
  tbl_html %>%
    render_as_html() %>%
    xml2::read_html() %>%
    selection_text("[class='gt_group_heading']") %>%
    expect_equal(c("SUPER POWERFUL", "POWERFUL"))
})
