1 2idesc_set_dep <- function(self, private, package, type, version) { 3 stopifnot(is_string(package), is_string(version)) 4 deps <- self$get_deps() 5 has <- which(deps$package == package & deps$type == type) 6 7 if (length(has)) { 8 deps[ has, "version" ] <- version 9 } else { 10 row <- data.frame( 11 stringsAsFactors = FALSE, 12 type = type, package = package, version = version 13 ) 14 others <- deps$package[deps$type == type] 15 sorted <- !is.unsorted(tolower(others)) && length(others) > 0 16 17 if (sorted) { 18 # find first row it should come after 19 idx <- which(deps$type == type & tolower(package) > tolower(deps$package)) 20 if (length(idx) == 0) { 21 # must be first 22 idx <- which(deps$type == type)[[1]] 23 } else { 24 idx <- length(idx) + 1 25 } 26 } else { 27 idx <- nrow(deps) + 1 28 } 29 30 deps <- insert_row(deps, row, where = idx) 31 } 32 33 idesc_set_deps(self, private, deps) 34} 35 36 37idesc_set_deps <- function(self, private, deps) { 38 stopifnot(is_deps_df(deps)) 39 depdeps <- deparse_deps(deps) 40 for (d in names(depdeps)) { 41 if (! same_deps(depdeps[[d]], private$data[[d]]$value)) { 42 self$set(d, depdeps[[d]]) 43 } 44 } 45 46 deldeps <- setdiff(dep_types, names(depdeps)) 47 self$del(deldeps) 48 49 invisible(self) 50} 51 52 53same_deps <- function(d1, d2) { 54 if (is.null(d1) + is.null(d2) == 1) return(FALSE) 55 56 d1 <- parse_deps("foo", d1) 57 d2 <- parse_deps("foo", d2) 58 59 d1 <- d1[ order(d1$type, d1$package, d1$version), ] 60 d2 <- d2[ order(d2$type, d2$package, d2$version), ] 61 nrow(d1) == nrow(d2) && 62 all(d1$type == d2$type) && 63 all(d1$package == d2$package) && 64 all(d1$version == d2$version) 65} 66 67#' Get dependencies 68#' 69#' In case the package has no dependencies at all, we `rbind` the 70#' list of data frames with the various dependency types, with an 71#' empty data frame. This ensures that we don't get `NULL` for the edge 72#' case, but a nice data frame with zero rows. 73#' 74#' @param self self 75#' @param private private self 76#' @return data frame of dependencies 77#' 78#' @keywords internal 79#' @noRd 80 81idesc_get_deps <- function(self, private) { 82 types <- intersect(names(private$data), dep_types) 83 res <- lapply(types, function(type) 84 parse_deps(type, private$data[[type]]$value)) 85 empty <- data.frame( 86 stringsAsFactors = FALSE, 87 type = character(), 88 package = character(), 89 version = character() 90 ) 91 do.call(rbind, c(list(empty), res)) 92} 93 94 95parse_deps <- function(type, deps) { 96 deps <- str_trim(strsplit(deps, ",")[[1]]) 97 deps <- lapply(strsplit(deps, "\\("), str_trim) 98 deps <- lapply(deps, sub, pattern = "\\)$", replacement = "") 99 res <- data.frame( 100 stringsAsFactors = FALSE, 101 type = if (length(deps)) type else character(), 102 package = vapply(deps, "[", "", 1), 103 version = vapply(deps, "[", "", 2) 104 ) 105 res$version <- gsub("\\s+", " ", res$version) 106 res$version [ is.na(res$version) ] <- "*" 107 res 108} 109 110 111deparse_deps <- function(deps) { 112 tapply(seq_len(nrow(deps)), deps$type, function(x) { 113 pkgs <- paste0( 114 " ", 115 deps$package[x], 116 ifelse( 117 deps$version[x] == "*", 118 "", 119 paste0(" (", deps$version[x], ")") 120 ), 121 collapse = ",\n" 122 ) 123 paste0("\n", pkgs) 124 }) 125} 126 127 128idesc_del_dep <- function(self, private, package, type) { 129 stopifnot(is_string(package)) 130 deps <- self$get_deps() 131 132 if (type == "all") { 133 has <- which(deps$package == package) 134 } else { 135 has <- which(deps$package == package & deps$type == type) 136 } 137 138 if (length(has)) { 139 deps <- deps[-has, ] 140 idesc_set_deps(self, private, deps) 141 142 } else { 143 invisible(self) 144 } 145} 146 147 148idesc_del_deps <- function(self, private) { 149 self$del(dep_types) 150} 151 152 153idesc_has_dep <- function(self, private, package, type) { 154 stopifnot(is_string(package)) 155 156 deps <- self$get_deps() 157 if (type == "any") { 158 package %in% deps$package 159 160 } else { 161 any(deps$package == package & deps$type == type) 162 } 163} 164 165insert_row <- function(x, y, where = 1L) { 166 if (where == 1L) { 167 rbind(y, x) 168 } else if (where > nrow(x)) { 169 rbind(x, y) 170 } else { 171 top <- 1:(where - 1) 172 rbind(x[top, , drop = FALSE], y, x[-top, , drop = FALSE]) 173 } 174} 175 176