R/topics.R

In roxygen2: In-Line Documentation for R

# Manage a list of topics, indexed by file name.
# Adding a topic with an existing file name merges it with the existing topic
RoxyTopics <- R6::R6Class("RoxyTopics", public = list(
  topics = list(),

  add = function(topic, block) {
    if (is.null(topic))
      return()
    stopifnot(inherits(topic, "RoxyTopic"))

    filename <- topic$filename
    if (filename %in% names(self$topics)) {
      self$topics[[filename]]$add(topic, block)
    } else {
      self$topics[[filename]] <- topic
    }

    invisible()
  },

  # Drop any topics that don't have a title
  drop_invalid = function() {
    for (topic in names(self$topics)) {
      if (!self$topics[[topic]]$is_valid()) {
        cli::cli_warn(c(
          "Skipping {.path {topic}}",
          i = "File lacks name and/or title"
        ))
        self$topics[[topic]] <- NULL
      }
    }

    invisible()
  },

  get = function(filename) {
    self$topics[[filename]]
  },

  # Given a topic name, find its file name.
  find_filename = function(name) {
    for (i in seq_along(self$topics)) {
      if (name %in% self$topics[[i]]$get_value("name")) {
        return(names(self$topics)[[i]])
      }
    }
    NA_character_
  },

  # Topologically sort the topics.
  #
  # @param deps A function. Is passed RoxyTopic, and should return a character
  #   vector of topic names
  topo_order = function(dependencies) {
    topo <- TopoSort$new()

    for (i in seq_along(self$topics)) {
      name <- names(self$topics)[[i]]
      topo$add(name)

      dep_topics <- dependencies(self$topics[[i]])
      for (dep_topic in dep_topics) {
        dep_rd <- self$find_filename(dep_topic)
        if (!is.na(dep_rd))
          topo$add_ancestor(name, dep_rd)
      }
    }

    topo$sort()
  },

  # Call fun in topological order defined by dep.
  topo_apply = function(dep, fun, ...) {
    topics_topo <- self$topo_order(dep)
    for (topic_name in topics_topo) {
      topic <- self$get(topic_name)
      fun(topic, self, ...)
    }

    invisible()
  },

  apply = function(fun, ...) {
    for (topic in self$topics) {
      fun(topic, self, ...)
    }
    invisible()
  },

  # Extract values for simple fields
  simple_values = function(field) {
    fields <- lapply(self$topics, function(rd) rd$get_section(field))
    lapply(compact(fields), "[[", "value")
  }

))