# rmarkdown.R
# Copyright (C) 2020-2022 Posit Software, PBC

# main
.main <- function() {

  # execute knitr::spin
  spin <- function(input) {

    if (utils::packageVersion("knitr") < "1.44") {
      stop(
        "knitr >= 1.44 is required for rendering with Quarto from `.R` files. ",
        "Please update knitr.", call. = FALSE)
    }

    # read file
    text <- xfun::read_utf8(input)

    # spin and return
    knitr::spin(text = text, knit = FALSE, format = "qmd")

  }

  # dependencies (convert knit_meta to includes)
  dependencies <- function(input, format, output, tempDir, libDir, data, quiet) {
    
    # unserialize knit_meta
    knit_meta <- lapply(data, jsonlite::unserializeJSON)

    # determine files_dir
    files_dir <- if (!is.null(libDir)) libDir else rmarkdown:::knitr_files_dir(output)

    # yield pandoc format
    list(
      includes = pandoc_includes(input, format, output, files_dir, knit_meta, tempDir)
    )
  }

  # postprocess (restore preserved)
  postprocess <- function(input, format, output, preserved_chunks) {

    # check for html output
    isHTML <-  knitr::is_html_output(
      format$pandoc$to, 
      c("markdown", "epub", "gfm", "commonmark", "commonmark_x", "markua")
    )

    # bail if we don't have any perserved chunks and aren't doing code linking
    code_link <- isHTML && isTRUE(format$render$`code-link`)
    if (length(preserved_chunks) == 0 && code_link == FALSE)
      return()

    # change to input dir and make input relative
    oldwd <- setwd(dirname(rmarkdown:::abs_path(input)))
    on.exit(setwd(oldwd), add = TRUE)
    input <- basename(input)

    # apply r-options (if any)
    r_options <- format$metadata$`r-options`
    if (!is.null(r_options)) {
      do.call(options, r_options)
    }
    
    # read output and initialize output_res to no-op
    output_str <- xfun::read_utf8(output)
    output_res <- output_str
    
    # perform code linking if requested
    if (isTRUE(code_link)) {
      has_annotations <- function(input) {
        # Check to see if there are annotations in the file
        inputLines <- readLines(input)
        chunkStarts <- grep(knitr::all_patterns$md$chunk.begin, inputLines)
        chunkEnds <- grep(knitr::all_patterns$md$chunk.end, inputLines)
        annotations <- grep(".*\\Q#\\E\\s*<[0-9]+>\\s*", inputLines)
        hasAnnotations <- FALSE
        if (length(chunkStarts) > 0 && length(annotations) > 0) {
          lastLine <- max(max(chunkEnds), max(chunkStarts), max(annotations))

          # the chunk is a vector with a position for each line, indicating
          # whether that line is within a code chunk
          chunkMap <- rep(FALSE, lastLine)

          # Update the chunk mapt to mark lines that are
          # within a code chunk
            for (x in seq_along(chunkStarts)) {
            start <- chunkStarts[x]
            end <- chunkEnds[x]
            for (y in start:end) {
              if (y > start && y < end) {
                chunkMap[y] <- TRUE
              }
            }
          }

          # look for at least one annotations that is in a code chunk
          for (a in annotations) {
            if (chunkMap[a] == TRUE) {
              hasAnnotations <- TRUE
              break
            }
          }
        }
        hasAnnotations
      }

      if (!has_annotations(input)) {
        if (requireNamespace("downlit", quietly = TRUE) && requireNamespace("xml2", quietly = TRUE)) {
          # run downlit
          downlit::downlit_html_path(output, output)

          # fix xml2 induced whitespace problems that break revealjs columns
          # (b/c they depend on inline-block behavior) then reset output_res
          downlit_output <- paste(xfun::read_utf8(output), collapse = "\n")
          downlit_output <- gsub('(</div>)\n(<div class="column")', "\\1\\2", downlit_output)
          output_res <- strsplit(downlit_output, "\n", fixed = TRUE)[[1]]
        } else {
          warning("The downlit and xml2 packages are required for code linking", call. = FALSE)
        }
      } else {
        warning("Since code annotations are present, code-linking has been disabled", call. = FALSE)
      }
    }
   
    # restore preserved chunks if requested
    if (length(preserved_chunks) > 0) {
      # convert preserved chunks to named character vector
      names <- names(preserved_chunks)
      preserved_chunks <- as.character(preserved_chunks)
      names(preserved_chunks) <- names


      if (isHTML) {
        # Pandoc adds an empty <p></p> around the IDs of preserved chunks, and we
        # need to remove these empty tags, otherwise we may have invalid HTML like
        # <p><div>...</div></p>. For the reason of the second gsub(), see
        # https://github.com/rstudio/rmarkdown/issues/133.
        for (i in names(preserved_chunks)) {
          output_res <- gsub(paste0("<p>", i, "</p>"), i, output_res,
                            fixed = TRUE, useBytes = TRUE)
          output_res <- gsub(paste0(' id="[^"]*?', i, '[^"]*?" '), ' ', output_res,
                            useBytes = TRUE)
        }
        output_res <- htmltools::restorePreserveChunks(output_res, preserved_chunks)

      } else {

        output_res <- knitr::restore_raw_output(output_str, preserved_chunks)
      }
    }
    
    # re-write output if necessary
    if (!identical(output_str, output_res)) {
      xfun::write_utf8(output_res, output)  
    }
  }

  run <- function(input, port, host) {
    shiny_args <- list()
    if (!is.null(port))
      shiny_args$port <- port
    if (!is.null(host))
      shiny_args$host <- host

    # we already ran quarto render before the call to run
    Sys.setenv(RMARKDOWN_RUN_PRERENDER = "0")

    # run the doc
    rmarkdown::run(input, shiny_args = shiny_args)
  }

  # read request from stdin
  stdin <- file("stdin", "r", encoding = "")
  input <- readLines(stdin, warn = FALSE, encoding = "UTF-8")
  close(stdin)

  # parse request and params
  request <- jsonlite::parse_json(input, simplifyVector = TRUE)
  params <- request$params

  # Ensuring expected working dir for Quarto
  # R process workding may be changed by some workflows (in  ~/.Rprofile)
  # https://github.com/quarto-dev/quarto-cli/issues/2646
  setwd(request$wd) # no need to reset it as R process is closed by R

  # source in helper functions if we have a resourceDir
  if (!is.null(params$resourceDir)) {
    res_dir <- file.path(params$resourceDir, "rmd")
    source(file.path(res_dir, "patch.R"), local = TRUE)
    source(file.path(res_dir, "execute.R"), local = TRUE)
    source(file.path(res_dir, "hooks.R"), local = TRUE)
  }

  # print execute-debug message ("spin" and "run" don't pass format option)
  debug <- (!request$action %in% c("spin", "run")) &&
            isTRUE(params$format$execute[["debug"]])
  if (debug)
    message("[knitr engine]: ", request$action)

  # dispatch request
  if (request$action == "spin") {
    result <- spin(params$input)
    result <- paste(result, collapse = '\n')
  } else if (request$action == "execute") {
    result <- execute(params$input, params$format, params$tempDir,  params$libDir, params$dependencies, params$cwd, params$params, params$resourceDir, params$handledLanguages, params$markdown)
  } else if (request$action == "dependencies") {
    result <- dependencies(params$input, params$format, params$output, params$tempDir, params$libDir, params$dependencies, params$quiet)
  } else if (request$action == "postprocess") {
    result <- postprocess(params$input, params$format, params$output, params$preserve)
  } else if (request$action == "run") {
    result <- run(params$input, params$port, params$host)
  }

  # write results
  if (debug)
    message("[knitr engine]: writing results")
  resultJson <- jsonlite::toJSON(auto_unbox = TRUE, result)
  xfun:::write_utf8(paste(resultJson, collapse = "\n"), request[["results"]])
  if (debug)
    message("[knitr engine]: exiting")
}

if (!rmarkdown::pandoc_available(error = FALSE)) {
  # When FALSE, this means no Pandoc is found by rmarkdown, not even on PATH
  # In that case we configure rmarkdown to use Quarto bundled version
  quarto_bin_path <- Sys.getenv("QUARTO_BIN_PATH", NA_character_)
  # Checking env var to be safe, but should always set by Quarto
  if (!is.na(quarto_bin_path)) {
    pandoc_dir <- normalizePath(file.path(quarto_bin_path, "tools"))
    invisible(rmarkdown::find_pandoc(dir = pandoc_dir))
  }
}

# run main
.main()










