Respect document languageId

R/diagnostics.R

@@ -77,12 +77,12 @@ find_config <- function(filename) {
 #'
 #' Lint and diagnose problems in a file.
 #' @noRd
-diagnose_file <- function(uri, content, cache = FALSE) {
+diagnose_file <- function(uri, is_rmarkdown, content, cache = FALSE) {
     if (length(content) == 0) {
         return(list())
     }
 
-    if (is_rmarkdown(uri)) {
+    if (is_rmarkdown) {
         # make sure Rmarkdown file has at least one block
         if (!any(stringi::stri_detect_regex(content, "```\\{r[ ,\\}]"))) {
             return(list())
@@ -138,7 +138,12 @@ diagnostics_task <- function(self, uri, document, delay = 0) {
     content <- document$content
     create_task(
         target = package_call(diagnose_file),
-        args = list(uri = uri, content = content, cache = lsp_settings$get("lint_cache")),
+        args = list(
+            uri = uri,
+            is_rmarkdown = document$is_rmarkdown,
+            content = content,
+            cache = lsp_settings$get("lint_cache")
+        ),
         callback = function(result) diagnostics_callback(self, uri, version, result),
         error = function(e) {
             logger$info("diagnostics_task:", e)

R/document.R

@@ -2,6 +2,7 @@ Document <- R6::R6Class(
     "Document",
     public = list(
         uri = NULL,
+        language = NULL,
         version = NULL,
         is_open = FALSE,
         nline = 0,
@@ -10,10 +11,11 @@ Document <- R6::R6Class(
         is_rmarkdown = NULL,
         loaded_packages = NULL,
 
-        initialize = function(uri, version, content = "") {
+        initialize = function(uri, language = NULL, version = NULL, content = "") {
             self$uri <- uri
+            self$language <- language
             self$version <- version
-            self$is_rmarkdown <- is_rmarkdown(self$uri)
+            self$is_rmarkdown <- if (is.null(language)) is_rmarkdown(uri) else language == "rmd"
             self$set_content(version, content)
             self$loaded_packages <- character()
         },
@@ -399,9 +401,6 @@ parse_document <- function(uri, content) {
     if (length(content) == 0) {
         content <- ""
     }
-    if (is_rmarkdown(uri)) {
-        content <- purl(content)
-    }
     # replace tab with a space since the width of a tab is 1 in LSP but 8 in getParseData().
     content <- gsub("\t", " ", content, fixed = TRUE)
     expr <- tryCatch(parse(text = content, keep.source = TRUE), error = function(e) NULL)
@@ -468,6 +467,9 @@ parse_callback <- function(self, uri, version, parse_data) {
 parse_task <- function(self, uri, document, delay = 0) {
     version <- document$version
     content <- document$content
+    if (document$is_rmarkdown) {
+        content <- purl(content)
+    }
     create_task(
         target = package_call(parse_document),
         args = list(uri = uri, content = content),

R/handlers-textsync.R

@@ -5,6 +5,7 @@
 text_document_did_open <- function(self, params) {
     textDocument <- params$textDocument
     uri <- uri_escape_unicode(textDocument$uri)
+    language <- textDocument$languageId
     version <- textDocument$version
     text <- textDocument$text
     logger$info("did open:", list(uri = uri, version = version))
@@ -17,12 +18,10 @@ text_document_did_open <- function(self, params) {
         content <- NULL
     }
     if (self$workspace$documents$has(uri)) {
-        doc <- self$workspace$documents$get(uri)
-        doc$set_content(version, content)
-    } else {
-        doc <- Document$new(uri, version, content)
-        self$workspace$documents$set(uri, doc)
+        doc <- self$workspace$documents$remove(uri)
     }
+    doc <- Document$new(uri, language = language, version = version, content = content)
+    self$workspace$documents$set(uri, doc)
     doc$did_open()
     self$text_sync(uri, document = doc, run_lintr = TRUE, parse = TRUE)
 }
@@ -43,7 +42,7 @@ text_document_did_change <- function(self, params) {
         doc <- self$workspace$documents$get(uri)
         doc$set_content(version, content)
     } else {
-        doc <- Document$new(uri, version, content)
+        doc <- Document$new(uri, language = NULL, version = version, content = content)
         self$workspace$documents$set(uri, doc)
     }
     doc$did_open()
@@ -79,7 +78,7 @@ text_document_did_save <- function(self, params) {
         doc <- self$workspace$documents$get(uri)
         doc$set_content(doc$version, content)
     } else {
-        doc <- Document$new(uri, NULL, content)
+        doc <- Document$new(uri, language = NULL, version = NULL, content = content)
         self$workspace$documents$set(uri, doc)
     }
     doc$did_open()

R/handlers-workspace.R

@@ -65,7 +65,7 @@ workspace_did_change_watched_files <- function(self, params) {
 
             if (type == FileChangeType$Created || type == FileChangeType$Changed) {
                 logger$info("load", path)
-                doc <- Document$new(uri, NULL, stringi::stri_read_lines(path))
+                doc <- Document$new(uri, language = "r", version = NULL, content = stringi::stri_read_lines(path))
                 self$workspace$documents$set(uri, doc)
                 self$text_sync(uri, document = doc, parse = TRUE)
             } else if (type == FileChangeType$Deleted) {

R/utils.R

@@ -171,7 +171,7 @@ is_rmarkdown <- function(uri) {
 #'
 #' @noRd
 check_scope <- function(uri, document, point) {
-    if (is_rmarkdown(uri)) {
+    if (document$is_rmarkdown) {
         row <- point$row
         flags <- vapply(
             document$content[1:(row + 1)], startsWith, logical(1), "```", USE.NAMES = FALSE)

R/workspace.R

@@ -256,7 +256,7 @@ Workspace <- R6::R6Class("Workspace",
                 logger$info("load ", f)
                 path <- file.path(source_dir, f)
                 uri <- path_to_uri(path)
-                doc <- Document$new(uri, NULL, stringi::stri_read_lines(path))
+                doc <- Document$new(uri, language = "r", version = NULL, content = stringi::stri_read_lines(path))
                 self$documents$set(uri, doc)
                 # TODO: move text_sync to Workspace!?
                 langserver$text_sync(uri, document = doc, parse = TRUE)

tests/testthat/helper-utils.R

@@ -65,18 +65,23 @@ notify <- function(client, method, params = NULL) {
 }
 
 
-did_open <- function(client, path, uri = path_to_uri(path), text = NULL) {
+did_open <- function(client, path, uri = path_to_uri(path), text = NULL, languageId = NULL) {
     if (is.null(text)) {
         text <- stringi::stri_read_lines(path)
     }
     text <- paste0(text, collapse = "\n")
+
+    if (is.null(languageId)) {
+        languageId <- if (is_rmarkdown(uri)) "rmd" else "r"
+    }
+
     notify(
         client,
         "textDocument/didOpen",
         list(
             textDocument = list(
                 uri = uri,
-                languageId = "R",
+                languageId = languageId,
                 version = 1,
                 text = text
             )

tests/testthat/test-completion.R

@@ -867,3 +867,58 @@ test_that("Completion in Rmarkdown works", {
     result <- client %>% respond_completion(temp_file, c(11, 3))
     expect_length(result$items, 0)
 })
+
+test_that("Completion in Rmarkdown specified by languageId works", {
+    skip_on_cran()
+    client <- language_client()
+
+    temp_file <- withr::local_tempfile(fileext = ".md")
+    writeLines(
+        c(
+            "Title",
+            "",
+            "```{r}",
+            "str",
+            "file.c",
+            "fs::path",
+            "foo$sol",
+            ".Mac",
+            "grDev",
+            "TRU",
+            "```",
+            "str"
+        ),
+        temp_file
+    )
+
+    client %>% did_open(temp_file, languageId = "rmd")
+
+    result <- client %>% respond_completion(temp_file, c(3, 3))
+    expect_length(result$items %>% keep(~ .$label == "strsplit"), 1)
+    expect_length(result$items %>% keep(~ .$label == "strrep"), 1)
+
+    result <- client %>% respond_completion(temp_file, c(4, 6))
+    expect_length(result$items %>% keep(~ .$label == "file.choose"), 1)
+    expect_length(result$items %>% keep(~ .$label == "file.create"), 1)
+
+    result <- client %>% respond_completion(temp_file, c(5, 8))
+    expect_true("path_real" %in% (result$items %>% map_chr(~ .$label)))
+
+    result <- client %>% respond_completion(temp_file, c(6, 7))
+    expect_length(result$items %>% discard(~ .$kind == CompletionItemKind$Text), 0)
+
+    result <- client %>% respond_completion(temp_file, c(7, 4))
+    expect_length(result$items %>% keep(~ .$label == ".Machine"), 1)
+
+    result <- client %>% respond_completion(temp_file, c(8, 5))
+    expect_length(result$items %>% keep(~ .$label == "grDevices"), 1)
+
+    result <- client %>% respond_completion(temp_file, c(9, 3))
+    expect_length(result$items %>% keep(~ .$label == "TRUE"), 1)
+
+    result <- client %>% respond_completion(temp_file, c(10, 3))
+    expect_length(result$items, 0)
+
+    result <- client %>% respond_completion(temp_file, c(11, 3))
+    expect_length(result$items, 0)
+})