Fix different URI locations (see #42)

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rols
 Type: Package
 Title: An R interface to the Ontology Lookup Service
-Version: 2.99.1
+Version: 2.99.2
 Authors@R: c(person(given = "Laurent", family = "Gatto",
                     email = "[email protected]",
                     role = c("aut","cre")),

NEWS.md

@@ -1,5 +1,9 @@
 # rols 2.99
 
+## CHANGES IN VERSION 2.99.2
+
+- Fix different URI locations (see #42)
+
 ## CHANGES IN VERSION 2.99.1
 
 - Fix logical syntax in url.

R/OlsSearch.R

@@ -192,7 +192,6 @@ OlsSearch <- function(q,
     searchUrl <- "http://www.ebi.ac.uk/ols4/api/search?"
     url <- paste0(searchUrl,
                   paste(params, collapse = "&"))
-    message(url)
     x <- request(url) |>
         req_perform() |>
         resp_body_json()

R/Terms.R

@@ -184,24 +184,33 @@ setMethod("Terms", "Ontology",
 ##'
 ##' @param id `character(1)` with the term's identifier.
 setMethod("Term", "character",
+          function(object, id) Term(Ontology(object), id))
+
+##' @export
+##' @rdname Terms
+setMethod("Term", "Ontology",
           function(object, id) {
               ## See https://github.com/EBISPOT/ols4/issues/621
               url <- paste0(
                   "https://www.ebi.ac.uk/ols4/api/ontologies/",
-                  object,
-                  "/terms/http%253A%252F%252Fpurl.obolibrary.org%252Fobo%252F")
-              url <- paste0(url, sub(":", "_", id))
+                  olsNamespace(object),
+                  "/terms/")
+              loc <- object@config$fileLocation
+              if (grepl("ebi.ac.uk", loc)) {
+                  uri <- sub("/[a-zA-z]+\\.owl$", "", loc)
+              }
+              else if (grepl("purl.obolibrary.org", loc)) {
+                  uri <- "http://purl.obolibrary.org/obo"
+              } else stop("Unknown fileLocation")
+              uri <- paste0(uri, "/", sub(":", "_", id))
+              uri <- gsub("%", "%25", URLencode(uri, TRUE))
+              url <- paste0(url, uri)
               request(url) |>
                   req_perform() |>
                   resp_body_json() |>
                   termFromJson()
           })
 
-##' @export
-##' @rdname Terms
-setMethod("Term", "Ontology",
-          function(object, id)
-              Term(olsNamespace(object), id))
 
 ##' @export
 ##' @rdname Terms

tests/testthat/test_Terms.R

@@ -35,6 +35,13 @@ test_that("constructors", {
                      descendants(trm)@x[nms])
 })
 
+test_that("constructors different URIs (issue 42)", {
+    ## See https://github.com/lgatto/rols/issues/42
+    expect_is(Term("ado", "ADO:0000090"), "Term")
+    expect_is(Term("efo", "EFO:0001200"), "Term")
+    expect_is(Term("go", "GO:0005802"), "Term")
+})
+
 test_that("show methods", {
     expect_null(show(trms))
     ## expect_null(show(trms[1]))