anndataR/R/known_issues.R at 52eb61265a06f212cc0495ebe14239cec90aa30e · scverse/anndataR · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
# This file contains the known issues that are currently present in the package.
# It can be used to generate documentation, but also throw warnings instead of errors
# in tests.
read_known_issues <- function() {
  check_requires("Reading known issues", "yaml")

  data <- yaml::read_yaml(system.file(
    "known_issues.yaml",
    package = "anndataR"
  ))

  map_dfr(
    data$known_issues,
    function(row) {
      expected_names <- c(
        "backend",
        "slot",
        "dtype",
        "process",
        "error_message",
        "description",
        "proposed_solution",
        "to_investigate",
        "to_fix"
      )
      if (!all(expected_names %in% names(row))) {
        cli_abort(c(
          "Unexpected columns in {.file known_issues.yaml}",
          "i" = "Expected columns: {.val {expected_names}}",
          "i" = "Actual columns: {.val {names(row)}}"
        ))
      }

      expand.grid(row)
    }
  )
}

is_known <- function(backend, slot, dtype, process, known_issues = NULL) {
  if (is.null(known_issues)) {
    known_issues <- read_known_issues()
  }

  # Handle empty known_issues data frame
  if (nrow(known_issues) == 0) {
    return(logical(0))
  }

  filt <- rep(TRUE, nrow(known_issues))

  if (!is.null(backend)) {
    filt <- filt & known_issues$backend %in% backend
  }
  if (!is.null(slot)) {
    filt <- filt & known_issues$slot %in% slot
  }
  if (!is.null(dtype)) {
    filt <- filt & known_issues$dtype %in% dtype
  }
  if (!is.null(process)) {
    filt <- filt & known_issues$process %in% process
  }

  filt
}

message_if_known <- function(
  backend,
  slot,
  dtype,
  process,
  known_issues = NULL
) {
  if (is.null(known_issues)) {
    known_issues <- read_known_issues()
  }

  filt <- is_known(backend, slot, dtype, process, known_issues)

  if (any(filt)) {
    # take first
    row <- known_issues[which(filt)[[1]], ]

    paste0(
      "Known issue for backend '",
      row$backend,
      "', slot '",
      row$slot,
      "', dtype '",
      row$dtype,
      "', process '",
      row$process,
      "': ",
      row$description
    )
  } else {
    NULL
  }
}