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