#' @importFrom R6 R6Class
relationship <- R6Class(
  "relationship",
  public = list(
    initialize = function(
      id = character(0),
      type = character(0),
      target = character(0)
    ) {
      private$id <- id
      private$type <- type
      private$target <- target
      private$target_mode <- rep(NA_character_, length(target))
      private$ext_src <- character(length(id))
    },
    feed_from_xml = function(path) {
      doc <- read_xml(x = path)
      children <- xml_children(doc)
      ns <- xml_ns(doc)

      private$id <- c(
        private$id,
        vapply(children, xml_attr, NA_character_, attr = "Id", ns)
      )
      private$type <- c(
        private$type,
        vapply(children, xml_attr, NA_character_, attr = "Type", ns)
      )
      private$target <- c(
        private$target,
        vapply(children, xml_attr, NA_character_, attr = "Target", ns)
      )
      private$target_mode <- c(
        private$target_mode,
        vapply(children, xml_attr, NA_character_, attr = "TargetMode", ns)
      )
      private$ext_src <- c(private$ext_src, character(length(children)))
      self
    },
    write = function(path) {
      if (length(private$id)) {
        str <- paste0(
          "<Relationship Id=\"",
          private$id,
          "\" Type=\"",
          private$type,
          "\" Target=\"",
          htmlEscapeCopy(private$target),
          ifelse(
            is.na(private$target_mode),
            "",
            "\" TargetMode=\"External"
          ),
          "\"/>"
        )
      } else {
        str <- character(length = 0)
      }

      str <- c(
        "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>",
        "\n<Relationships  xmlns=\"http://schemas.openxmlformats.org/package/2006/relationships\">",
        str,
        "</Relationships>"
      )
      dir.create(dirname(path), showWarnings = FALSE, recursive = FALSE)
      writeLines(str, con = path, useBytes = TRUE)
      self
    },
    get_next_id = function() {
      max(c(0, private$get_int_id()), na.rm = TRUE) + 1
    },
    get_data = function() {
      data <- data.frame(
        id = character(0),
        int_id = integer(0),
        type = character(0),
        target = character(0),
        target_mode = character(0),
        ext_src = character(0),
        stringsAsFactors = FALSE
      )
      if (length(private$id)) {
        chr_stripped_id <- gsub("rId([0-9]+)", "\\1", private$id)
        test_id_as_num <- grepl("^rId[0-9]+$", private$id)
        if (!all(test_id_as_num)) {
          wrong_targets <- paste0(
            "invalid id(s) for {shQuote(private$target[!test_id_as_num])}"
          )
          names(wrong_targets) <- rep("*", length(wrong_targets))
          cli::cli_warn(
            c(
              "x" = "relationship file contains invalid id(s).",
              wrong_targets
            )
          )
        }
        data <- data.frame(
          id = private$id,
          int_id = as.integer(chr_stripped_id),
          type = private$type,
          target = private$target,
          target_mode = private$target_mode,
          ext_src = private$ext_src,
          stringsAsFactors = FALSE
        )

        data[order(data$id), ]
      }
      data
    },
    get_images_path = function() {
      is_img <- basename(private$type) %in% "image"
      targets <- private$target[is_img]
      names(targets) <- private$id[is_img]
      targets
    },
    add_img = function(src, root_target) {
      src <- setdiff(src, private$ext_src)
      if (!length(src)) {
        return(self)
      }

      if (any(grepl(" ", basename(src)))) {
        stop(
          paste(src, collapse = ", "),
          ": images with blanks in their basenames are not supported, please rename the file(s).",
          call. = FALSE
        )
      }

      last_id <- max(c(0, private$get_int_id()), na.rm = TRUE)

      id <- paste0("rId", seq_along(src) + last_id)
      type <- rep(
        "http://schemas.openxmlformats.org/officeDocument/2006/relationships/image",
        length(src)
      )
      target <- file.path(root_target, basename(src))

      private$id <- c(private$id, id)
      private$type <- c(private$type, type)
      private$target <- c(private$target, target)
      private$target_mode <- c(private$target_mode, rep(NA, length(id)))
      private$ext_src <- c(private$ext_src, src)

      self
    },
    add_drawing = function(src, root_target) {
      src <- setdiff(src, private$ext_src)
      if (!length(src)) {
        return(self)
      }
      last_id <- max(c(0, private$get_int_id()), na.rm = TRUE)

      id <- paste0("rId", seq_along(src) + last_id)
      type <- rep(
        "http://schemas.openxmlformats.org/officeDocument/2006/relationships/drawing",
        length(src)
      )
      target <- file.path(root_target, basename(src))

      private$id <- unlist(c(private$id, id))
      private$type <- unlist(c(private$type, type))
      private$target <- unlist(c(private$target, target))
      private$target_mode <- unlist(c(private$target_mode, rep(NA, length(id))))
      private$ext_src <- unlist(c(private$ext_src, rep(NA, length(id))))

      self
    },
    add = function(id, type, target, target_mode = NA) {
      Encoding(target) <- "UTF-8"
      if (!target %in% private$target) {
        private$id <- c(private$id, id)
        private$type <- c(private$type, type)
        private$target <- c(private$target, target)
        private$target_mode <- c(private$target_mode, target_mode)
        private$ext_src <- c(private$ext_src, "")
      }
      self
    },
    remove = function(target) {
      id <- which(basename(private$target) %in% basename(target))
      private$id <- private$id[-id]
      private$type <- private$type[-id]
      private$target <- private$target[-id]
      private$target_mode <- private$target_mode[-id]
      private$ext_src <- private$ext_src[-id]
      self
    },
    show = function() {
      print(self$get_data())
    }
  ),
  private = list(
    id = NA,
    type = NA,
    target = NA,
    target_mode = NA,
    ext_src = NA,
    get_int_id = function() {
      if (length(private$id) > 0) {
        as.integer(gsub("rId([0-9]+)", "\\1", private$id))
      } else {
        integer(0)
      }
    }
  )
)
