Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -21,3 +21,5 @@
^depends\.Rds$
^revdep$
^CRAN-SUBMISSION$
^[\.]?air\.toml$
^\.vscode$
5 changes: 5 additions & 0 deletions .vscode/extensions.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
{
"recommendations": [
"Posit.air-vscode"
]
}
6 changes: 6 additions & 0 deletions .vscode/settings.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,6 @@
{
"[r]": {
"editor.formatOnSave": true,
"editor.defaultFormatter": "Posit.air-vscode"
}
}
3 changes: 1 addition & 2 deletions R/bcdata-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and limitations under the License.


#' @keywords internal
#'
"_PACKAGE"
Expand All @@ -21,7 +20,7 @@ NULL

release_bullets <- function() {
c(
"Run test and check with internet turned off",
"Run test and check with internet turned off",
"Precompile vignettes"
)
}
15 changes: 6 additions & 9 deletions R/bcdc-get-citation.R
Original file line number Diff line number Diff line change
Expand Up @@ -51,30 +51,29 @@ bcdc_get_citation <- function(record) {

#' @export
bcdc_get_citation.default <- function(record) {
stop("No bcdc_get_citation method for an object of class ", class(record),
call. = FALSE)
stop(
"No bcdc_get_citation method for an object of class ",
class(record),
call. = FALSE
)
}

#' @export
bcdc_get_citation.character <- function(record) {

if (grepl("/resource/", record)) {
# A full url was passed including record and resource compenents.
# Grab the resource id and strip it off the url
resource <- slug_from_url(record)
record <- gsub("/resource/.+", "", record)
}


rec <- bcdc_get_record(record)

bcdc_get_citation(rec)

}

#' @export
bcdc_get_citation.bcdc_record <- function(record) {

bib_rec <- utils::bibentry(
bibtype = "techreport",
title = record$title,
Expand All @@ -87,9 +86,7 @@ bcdc_get_citation.bcdc_record <- function(record) {
note = record$license_title
)

structure(bib_rec,
class = c("citation", setdiff(class(bib_rec), "citation"))
)
structure(bib_rec, class = c("citation", setdiff(class(bib_rec), "citation")))
}

clean_org_name <- function(rec) {
Expand Down
80 changes: 50 additions & 30 deletions R/bcdc-web-services.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and limitations under the License.


#' Query data from the B.C. Web Feature Service
#'
#' Queries features from the B.C. Web Feature Service. See
Expand Down Expand Up @@ -60,7 +59,7 @@
#' res <- bcdc_query_geodata("bc-airports") %>%
#' filter(PHYSICAL_ADDRESS %LIKE% 'Vict%')
#' )
#'
#'
#' # To query using %IN%
#' try(
#' res <- bcdc_query_geodata("bc-airports") %>%
Expand Down Expand Up @@ -111,13 +110,15 @@ bcdc_query_geodata <- function(record, crs = 3005) {

#' @export
bcdc_query_geodata.default <- function(record, crs = 3005) {
stop("No bcdc_query_geodata method for an object of class ", class(record),
call. = FALSE)
stop(
"No bcdc_query_geodata method for an object of class ",
class(record),
call. = FALSE
)
}

#' @export
bcdc_query_geodata.character <- function(record, crs = 3005) {

if (length(record) != 1) {
stop("Only one record my be queried at a time.", call. = FALSE)
}
Expand All @@ -137,8 +138,12 @@ bcdc_query_geodata.character <- function(record, crs = 3005) {
cols_df <- feature_helper(record)

return(
as.bcdc_promise(list(query_list = query_list, cli = cli, record = NULL,
cols_df = cols_df))
as.bcdc_promise(list(
query_list = query_list,
cli = cli,
record = NULL,
cols_df = cols_df
))
)
}

Expand All @@ -156,8 +161,9 @@ bcdc_query_geodata.character <- function(record, crs = 3005) {
#' @export
bcdc_query_geodata.bcdc_record <- function(record, crs = 3005) {
if (!any(wfs_available(record$resource_df))) {
stop("No Web Feature Service resource available for this data set.",
call. = FALSE
stop(
"No Web Feature Service resource available for this data set.",
call. = FALSE
)
}

Expand All @@ -170,7 +176,9 @@ bcdc_query_geodata.bcdc_record <- function(record, crs = 3005) {
))

if (grepl("_SP?G$", layer_name)) {
message("You are accessing a simplified view of the data - see the catalogue record for details.")
message(
"You are accessing a simplified view of the data - see the catalogue record for details."
)
}

## Parameters for the API call
Expand All @@ -184,8 +192,12 @@ bcdc_query_geodata.bcdc_record <- function(record, crs = 3005) {

cols_df <- feature_helper(query_list$typeNames)

as.bcdc_promise(list(query_list = query_list, cli = cli, record = record,
cols_df = cols_df))
as.bcdc_promise(list(
query_list = query_list,
cli = cli,
record = record,
cols_df = cols_df
))
}

#' Get preview map from the B.C. Web Map Service
Expand Down Expand Up @@ -213,20 +225,23 @@ bcdc_query_geodata.bcdc_record <- function(record, crs = 3005) {
#' )
#' }
#' @export
bcdc_preview <- function(record) { # nocov start
bcdc_preview <- function(record) {
# nocov start
if (!has_internet()) stop("No access to internet", call. = FALSE)
UseMethod("bcdc_preview")
}

#' @export
bcdc_preview.default <- function(record) {
stop("No bcdc_preview method for an object of class ", class(record),
call. = FALSE)
stop(
"No bcdc_preview method for an object of class ",
class(record),
call. = FALSE
)
}

#' @export
bcdc_preview.character <- function(record) {

if (is_whse_object_name(record)) {
make_wms(record)
} else {
Expand All @@ -236,30 +251,36 @@ bcdc_preview.character <- function(record) {

#' @export
bcdc_preview.bcdc_record <- function(record) {

wfs_resource <- get_wfs_resource_from_record(record)

make_wms(basename(dirname(wfs_resource$url)))

}

make_wms <- function(x){
make_wms <- function(x) {
wms_url <- wms_base_url()
wms_options <- leaflet::WMSTileOptions(format = "image/png",
transparent = TRUE,
attribution = "BC Data Catalogue (https://catalogue.data.gov.bc.ca/)")
wms_legend <- glue::glue("{wms_url}?request=GetLegendGraphic&
wms_options <- leaflet::WMSTileOptions(
format = "image/png",
transparent = TRUE,
attribution = "BC Data Catalogue (https://catalogue.data.gov.bc.ca/)"
)
wms_legend <- glue::glue(
"{wms_url}?request=GetLegendGraphic&
format=image%2Fpng&
width=20&
height=20&
layer=pub%3A{x}")
layer=pub%3A{x}"
)

leaflet::leaflet() %>%
leaflet::addProviderTiles(leaflet::providers$CartoDB.Positron,
options = leaflet::providerTileOptions(noWrap = TRUE)) %>%
leaflet::addWMSTiles(wms_url,
layers=glue::glue("pub:{x}"),
options = wms_options) %>%
leaflet::addProviderTiles(
leaflet::providers$CartoDB.Positron,
options = leaflet::providerTileOptions(noWrap = TRUE)
) %>%
leaflet::addWMSTiles(
wms_url,
layers = glue::glue("pub:{x}"),
options = wms_options
) %>%
leaflet.extras::addWMSLegend(uri = wms_legend) %>%
leaflet::setView(lng = -126.5, lat = 54.5, zoom = 5)
} # nocov end
Expand All @@ -275,4 +296,3 @@ make_query_list <- function(layer_name, crs) {
SRSNAME = paste0("EPSG:", crs)
)
}

25 changes: 14 additions & 11 deletions R/bcdc_browse.R
Original file line number Diff line number Diff line change
Expand Up @@ -44,23 +44,25 @@
#' bcdc_browse("76b1b7a3-2112-4444-857a-afccf7b20da8")
#' )
#' }
bcdc_browse <- function(query = NULL, browser = getOption("browser"),
encodeIfNeeded = FALSE) {
if(!has_internet()) stop("No access to internet", call. = FALSE) # nocov
bcdc_browse <- function(
query = NULL,
browser = getOption("browser"),
encodeIfNeeded = FALSE
) {
if (!has_internet()) stop("No access to internet", call. = FALSE) # nocov

base_url <- catalogue_base_url()

if (is.null(query)) {
if (is.null(query)) {
url <- base_url
} else {

## Check if the record is valid, if not return a query.
# Need to check via HEAD request to the api as the catalogue
# doesn't return a 404 status code.
cli <- bcdc_catalogue_client("action/package_show")
res <- cli$head(query = list(id = query))

if(res$status_code == 404){
if (res$status_code == 404) {
stop("The specified record does not exist in the catalogue")
## NB - previous version would show a catalogue search in the
## browser, but with new catalogue it doesn't seem possible
Expand All @@ -73,14 +75,15 @@ bcdc_browse <- function(query = NULL, browser = getOption("browser"),
}

## Facilitates testing
if(interactive()){
if (interactive()) {
# nocov start
utils::browseURL(url = url, browser = browser,
encodeIfNeeded = encodeIfNeeded)
utils::browseURL(
url = url,
browser = browser,
encodeIfNeeded = encodeIfNeeded
)
# nocov end
}

invisible(url)
}


Loading
Loading