#' Create Author and Publication Webpages
#'
#' @description Create a webpage for each author and each publication, listing the
#'   author's publications or the publication's details. Each webpage is written as
#'   an [R Markdown](https://rmarkdown.rstudio.com/) (`.Rmd`) file.
#'
#' @param authors 'author' data frame.
#'   Contributing authors to the INLPO publications; see the [`authors`] dataset for
#'   the expected data format. When `NULL`, author webpages are not written.
#'
#' @param pubs 'pub' data frame.
#'   Publications of the INLPO; see the [`pubs`] dataset for the expected data format.
#'   When `NULL`, publication webpages are not written.
#'
#' @param destdir 'character' string.
#'   Destination directory for the written files, with tilde-expansion performed.
#'   Created if it does not exist. Defaults to a temporary directory.
#'
#' @param coverdir 'character' string.
#'   Directory searched for publication cover images named `pub-<id>.jpg`.
#'   Defaults to `"vignettes"`.
#'
#' @param quiet 'logical' flag.
#'   Whether to suppress progress messages. Defaults to `FALSE`.
#'
#' @return Invisibly returns `NULL`. Called for its side effect of writing files.
#'
#' @author J.C. Fisher, U.S. Geological Survey, Idaho Water Science Center
#'
#' @export
#'
#' @keywords internal
#'
#' @examples
#' destdir <- tempfile("")
#' make_webpages(
#'   authors = inlpubs::authors,
#'   pubs = inlpubs::pubs,
#'   destdir = destdir,
#'   quiet = TRUE
#' )
#'
#' unlink(destdir, recursive = TRUE)

make_webpages <- function(
  authors = NULL,
  pubs = NULL,
  destdir = tempdir(),
  coverdir = "vignettes",
  quiet = FALSE
) {
  # check arguments
  checkmate::assert_class(authors, classes = c("author", "data.frame"), null.ok = TRUE)
  checkmate::assert_class(pubs, classes = c("pub", "data.frame"), null.ok = TRUE)
  checkmate::assert_string(destdir)
  destdir <- path.expand(destdir) |> normalizePath(winslash = "/", mustWork = FALSE)
  dir.create(destdir, recursive = TRUE, showWarnings = FALSE)
  checkmate::assert_path_for_output(destdir, overwrite = TRUE)
  checkmate::assert_string(coverdir)
  checkmate::assert_flag(quiet)

  # write author webpages
  if (!is.null(authors)) {
    make_author_webpages(authors, pubs, destdir, coverdir, quiet)
  }

  # write publication webpages
  if (!is.null(pubs)) {
    make_pub_webpages(pubs, destdir, coverdir, quiet)
  }

  invisible()
}


# Helper to assemble Rmd sections and write to disk ----
#
# Builds each file's content as a single string and writes it with writeLines(),
# replacing the sink()-based approach. This avoids leaking sink connections if an
# error occurs mid-build, and makes the output assembly explicit and testable.

write_rmd_files <- function(files, contents, quiet) {
  for (i in seq_along(files)) {
    if (!quiet) {
      message("Writing ", sQuote(basename(files[i]), q = FALSE))
    }
    writeLines(contents[i], con = files[i])
  }
  invisible()
}


# Helper to atomically replace a set of pages in the destination ----

replace_pages <- function(contents, names, pattern, destdir, quiet) {
  tmp <- tempfile(pattern = "")
  dir.create(tmp, showWarnings = FALSE)
  on.exit(unlink(tmp, recursive = TRUE), add = TRUE)

  files <- file.path(tmp, names)
  write_rmd_files(files, contents, quiet)

  # replace existing pages in the destination
  list.files(path = destdir, pattern = pattern, full.names = TRUE) |> unlink()
  file.copy(from = files, to = destdir) |> invisible()

  invisible()
}


# Function to write author webpages ----

make_author_webpages <- function(authors, pubs, destdir, coverdir, quiet) {
  # check arguments
  checkmate::assert_class(authors, classes = c("author", "data.frame"))
  checkmate::assert_path_for_output(destdir, overwrite = TRUE)
  checkmate::assert_string(coverdir)
  checkmate::assert_flag(quiet)

  n <- nrow(authors)

  # make yaml headers
  headers <- vapply(
    authors$person,
    FUN = function(x) {
      title <- sprintf("title: \"%s\"", format(x, include = c("given", "family")))
      paste("---", title, "---", sep = "\n")
    },
    FUN.VALUE = character(1)
  )

  # make ORCID and email icons
  icons <- vapply(
    authors$person,
    FUN = function(x) {
      orcid <- x$comment["ORCID"]
      # subscripting NULL/absent comment yields length-0, so guard on length
      # AND non-NA before building the link
      if (length(orcid) > 0 && !is.na(orcid)) {
        href <- paste0("https://orcid.org/", orcid)
        title <- "Open the author&#8217;s ORCID record in a new browser tab."
        img <- "<img alt='ORCID logo' src='orcid.svg' width='16' height='16' />"
        orcid <- sprintf(
          "<a href='%s' title='%s' target='_blank'>%s&nbsp;%s</a>",
          href,
          title,
          img,
          orcid
        )
      } else {
        orcid <- NULL
      }
      email <- x$email
      # a missing email is character(0), so test with length()
      if (length(email) > 0 && nzchar(email)) {
        href <- paste0("mailto:", email)
        title <- "Contact the author"
        img <- "<img alt='Email logo' src='email.svg' width='16' height='16' />"
        email <- sprintf("<a href='%s' title='%s'>%s&nbsp;%s</a>", href, title, img, email)
      } else {
        email <- NULL
      }
      sprintf("<span>%s</span>", paste(c(orcid, email), collapse = "&nbsp;&nbsp;&nbsp;&nbsp;"))
    },
    FUN.VALUE = character(1)
  )

  # make counts table
  row_names <- c(
    "total_pub" = "Total publications",
    "single_authored" = "Single authored",
    "multi_authored" = "Multi authored",
    "first_authored" = "First authored"
  )
  # iterate by row index rather than apply() over a data frame with list-columns,
  # which is clearer and avoids coercion surprises
  counts <- vapply(
    seq_len(n),
    FUN = function(i) {
      d <- authors[i, names(row_names), drop = FALSE] |> as.matrix() |> t()
      rownames(d) <- row_names
      knitr::kable(d, format = "html", align = "r", col.names = NULL) |>
        kableExtra::kable_styling(
          bootstrap_options = c("row-border", "condensed"),
          full_width = FALSE,
          position = "left"
        ) |>
        as.character()
    },
    FUN.VALUE = character(1)
  )

  # get citations
  refs <- sprintf("%s (%s)", pubs$text_ref, pubs$year)
  names(refs) <- pubs$pub_id
  citations <- vapply(
    authors$pub_id,
    FUN = function(ids) {
      vapply(
        ids,
        FUN = function(id) {
          href <- sprintf("pub-%s.html", id)
          ref <- sprintf("<h4><a href='%s'>%s</a></h4>", href, refs[id])
          bib <- attr(unclass(pubs[id, "bibentry"])[[1]], which = "textVersion")
          paste(ref, bib, sep = "\n\n")
        },
        FUN.VALUE = character(1)
      ) |>
        paste(collapse = "\n\n")
    },
    FUN.VALUE = character(1)
  )

  # build scrollable cover strip for each author (omit pubs without a cover)
  cover_strips <- vapply(
    authors$pub_id,
    FUN = function(ids) {
      thumbs <- vapply(
        ids,
        FUN = function(id) {
          img_file <- file.path(coverdir, sprintf("pub-%s.jpg", id))
          if (!checkmate::test_file_exists(img_file, access = "r")) {
            return("")
          }
          sprintf(
            "<a href='pub-%s.html'><img src='pub-%s.jpg' style='height:300px; margin-right:4px;' alt='Cover' /></a>",
            id,
            id
          )
        },
        FUN.VALUE = character(1)
      )
      thumbs <- thumbs[nzchar(thumbs)]
      if (length(thumbs) == 0L) {
        return("")
      }
      paste0(
        "<div style='overflow-x:auto; white-space:nowrap; padding:4px 0; margin-bottom:20px;'>",
        paste(thumbs, collapse = "\n"),
        "</div>"
      )
    },
    FUN.VALUE = character(1)
  )

  # assemble each author's Rmd content
  contents <- vapply(
    seq_len(n),
    FUN = function(i) {
      plot_chunk <- sprintf(
        '```{r echo=FALSE, fig.height=3}\ninlpubs::plot_pubs(author_id = "%s")\n```',
        authors$author_id[i]
      )
      covers_section <- if (nzchar(cover_strips[i])) {
        paste("## Covers", "", cover_strips[i], "", sep = "\n")
      } else {
        ""
      }
      paste(
        headers[i],
        "",
        icons[i],
        "",
        "## Counts",
        "",
        counts[i],
        "",
        "## Publications",
        "",
        plot_chunk,
        "",
        covers_section,
        "",
        "## Citations",
        "",
        citations[i],
        "",
        sep = "\n"
      )
    },
    FUN.VALUE = character(1)
  )

  names <- sprintf("author-%s.Rmd", authors$author_id)
  replace_pages(contents, names, pattern = "^author-.*\\.Rmd$", destdir, quiet)

  invisible()
}


# Function to write publication webpages ----

make_pub_webpages <- function(pubs, destdir, coverdir, quiet) {
  # check arguments
  checkmate::assert_class(pubs, classes = c("pub", "data.frame"))
  checkmate::assert_path_for_output(destdir, overwrite = TRUE)
  checkmate::assert_string(coverdir)
  checkmate::assert_flag(quiet)

  n <- nrow(pubs)

  # get text references
  refs <- sprintf("%s (%s)", pubs$text_ref, pubs$year)
  names(refs) <- pubs$pub_id

  # make yaml headers
  headers <- vapply(
    seq_len(n),
    FUN = function(i) {
      # access the single bibentry with [[ ]] so $doi dispatches correctly
      doi_id <- pubs$bibentry[[i]]$doi

      # only build a DOI link when an identifier is present
      if (length(doi_id) > 0 && nzchar(doi_id)) {
        href <- paste0("https://doi.org/", doi_id)
        title <- "Launch the external DOI link, which leads to the publication content, in a separate browser tab."
        img <- "<img alt='DOI link' align='right' src='doi.svg' width='20' height='20' />"
        doi <- sprintf("<a href='%s' title='%s' target='_blank'>%s</a>", href, title, img)
      } else {
        doi <- ""
      }
      title <- sprintf("title: \"%s%s\"", refs[i], doi)
      paste("---", title, "---", sep = "\n")
    },
    FUN.VALUE = character(1)
  )

  # make cover images (only when the image file exists)
  covers <- vapply(
    pubs$pub_id,
    FUN = function(x) {
      file <- file.path(coverdir, sprintf("pub-%s.jpg", x))
      if (checkmate::test_file_exists(file, access = "r")) {
        sprintf(
          "<img class='cover-image' src='%s' alt='Cover image' align='right' style='width:300px;' />",
          basename(file)
        )
      } else {
        character(1)
      }
    },
    FUN.VALUE = character(1)
  )

  # get publication titles
  titles <- pubs$title

  # build linked author lists
  authors <- vapply(
    pubs$bibentry,
    FUN = function(x) {
      author <- format(x$author, include = c("given", "family"))
      author <- gsub(" ", "&nbsp;", author)
      ids <- names(x$author)
      for (i in seq_along(ids)) {
        href <- sprintf("author-%s.html", ids[i])
        author[i] <- sprintf("<a href='%s'>%s</a>", href, author[i])
      }
      n_auth <- length(author)
      if (n_auth > 2) {
        author[-n_auth] <- paste0(author[-n_auth], ",")
      }
      if (n_auth > 1) {
        author[n_auth] <- paste("and", author[n_auth])
      }
      paste(author, collapse = " ")
    },
    FUN.VALUE = character(1)
  )

  # get citations
  citations <- vapply(
    pubs$bibentry,
    FUN = function(x) {
      attr(unclass(x)[[1]], which = "textVersion")
    },
    FUN.VALUE = character(1)
  )

  # build collapsible BibTeX entries
  bibtexs <- vapply(
    pubs$bibentry,
    FUN = function(bib) {
      bibtex <- utils::toBibtex(bib) |> paste(collapse = "\n")
      template <- paste(
        "<a href='#bibtex' class='btn btn-default btn-xs' data-toggle='collapse' title='%s'>BibTeX</a>",
        "<div id='bibtex' class='collapse'><pre><code>%s</code></pre></div>",
        sep = "\n"
      )
      sprintf(template, "Switch between displaying and hiding the BibTeX citation.", bibtex)
    },
    FUN.VALUE = character(1)
  )

  # get abstracts and annotations
  abstracts <- pubs$abstract |> stringi::stri_unescape_unicode()
  annotations <- pubs$annotation |> stringi::stri_unescape_unicode()

  # build annotation source links
  txt <- refs[pubs$annotation_src]
  hrefs <- sprintf("pub-%s.html", names(txt))
  annotation_srcs <- sprintf("<a href='%s'>%s</a>", hrefs, txt)
  annotation_srcs[is.na(txt)] <- NA_character_

  # assemble each publication's Rmd content
  contents <- vapply(
    seq_len(n),
    FUN = function(i) {
      parts <- c(
        headers[i],
        "",
        paste("## Title", covers[i]),
        "",
        titles[i],
        "",
        "## Authors",
        "",
        authors[i],
        "",
        "## Citation",
        "",
        citations[i],
        "",
        bibtexs[i],
        ""
      )
      if (!is.na(abstracts[i])) {
        parts <- c(parts, "## Abstract", "", abstracts[i], "")
      }
      if (!is.na(annotations[i])) {
        parts <- c(
          parts,
          "## Annotation",
          "",
          annotations[i],
          "",
          paste("--- From", annotation_srcs[i]),
          ""
        )
      }
      paste(parts, collapse = "\n")
    },
    FUN.VALUE = character(1)
  )

  names <- sprintf("pub-%s.Rmd", pubs$pub_id)
  replace_pages(contents, names, pattern = "^pub-.*\\.Rmd$", destdir, quiet)

  invisible()
}
