1# Manage a list of topics, indexed by file name. 2# Adding a topic with an existing file name merges it with the existing topic 3RoxyTopics <- R6::R6Class("RoxyTopics", public = list( 4 topics = list(), 5 6 add = function(topic) { 7 if (is.null(topic)) 8 return() 9 stopifnot(inherits(topic, "RoxyTopic")) 10 11 filename <- topic$filename 12 if (filename %in% names(self$topics)) { 13 self$topics[[filename]]$add(topic) 14 } else { 15 self$topics[[filename]] <- topic 16 } 17 18 invisible() 19 }, 20 21 # Drop any topics that don't have a title 22 drop_invalid = function() { 23 for (topic in names(self$topics)) { 24 if (!self$topics[[topic]]$is_valid()) { 25 warning(topic, " is missing name/title. Skipping", call. = FALSE) 26 self$topics[[topic]] <- NULL 27 } 28 } 29 30 invisible() 31 }, 32 33 get = function(filename) { 34 self$topics[[filename]] 35 }, 36 37 # Given a topic name, find its file name. 38 find_filename = function(name) { 39 for (i in seq_along(self$topics)) { 40 if (name %in% self$topics[[i]]$get_value("name")) { 41 return(names(self$topics)[[i]]) 42 } 43 } 44 NA_character_ 45 }, 46 47 # Topologically sort the topics. 48 # 49 # @param deps A function. Is passed RoxyTopic, and should return a character 50 # vector of topic names 51 topo_order = function(dependencies) { 52 topo <- TopoSort$new() 53 54 for (i in seq_along(self$topics)) { 55 name <- names(self$topics)[[i]] 56 topo$add(name) 57 58 dep_topics <- dependencies(self$topics[[i]]) 59 for (dep_topic in dep_topics) { 60 dep_rd <- self$find_filename(dep_topic) 61 if (!is.na(dep_rd)) 62 topo$add_ancestor(name, dep_rd) 63 } 64 } 65 66 topo$sort() 67 }, 68 69 # Call fun in topological order defined by dep. 70 topo_apply = function(dep, fun, ...) { 71 topics_topo <- self$topo_order(dep) 72 for (topic_name in topics_topo) { 73 topic <- self$get(topic_name) 74 fun(topic, self, ...) 75 } 76 77 invisible() 78 }, 79 80 apply = function(fun, ...) { 81 for (topic in self$topics) { 82 fun(topic, self, ...) 83 } 84 invisible() 85 }, 86 87 # Extract values for simple fields 88 simple_values = function(field) { 89 fields <- lapply(self$topics, function(rd) rd$get_section(field)) 90 lapply(compact(fields), "[[", "value") 91 } 92 93)) 94