markers_data = tryCatch({
res <- read.csv(system.file("apps/brapi/data/markers.csv", package = "brapiTS"),
stringsAsFactors = FALSE)
}, error = function(e) {
NULL
}
)
markers_list = function(markersDbId = NA, name = "none",
matchMethod = "exact", include = "synonyms", type = "all",
page = 0, pageSize = 1000){
#message(paste("Marker:", markersDbId))
name = ifelse(is.character(name), name, "none")
matchMethod = ifelse(matchMethod %in% c("exact", "case_insensitive", "wildcard"),
matchMethod, "exact")
#include = ifelse(include, include, "synonyms")
type = ifelse(is.character(type), type, "all")
page = ifelse(is.integer(page), as.integer(page), 0)
pageSize = ifelse(is.integer(pageSize), as.integer(pageSize), 1000)
if (is.na(markersDbId)){
if (matchMethod == 'exact') {
markers_data = markers_data[markers_data$defaultDisplayName == name, ]
if(nrow(markers_data) == 0) return(NULL)
}
if (matchMethod == 'wildcard') {
name = stringr::str_replace(name, "\\%", "\\*")
#message(name)
markers_data = markers_data[grep(name, markers_data$defaultDisplayName), ]
#message(markers_data$defaultDisplayName)
if(nrow(markers_data) == 0) return(NULL)
}
if (matchMethod == 'case_insensitive') {
name = toupper(name)
markers_data = markers_data[toupper(markers_data$defaultDisplayName) == name, ]
if(nrow(markers_data) == 0) return(NULL)
}
if(type != "all"){
markers_data = markers_data[stringr::str_detect(markers_data$type, type), ]
if(nrow(markers_data) == 0) return(NULL)
}
if(include != "synonyms") {
markers_data = markers_data[, !names(markers_data) %in% "synonyms"]
if(nrow(markers_data) == 0) return(NULL)
}
# paging here after filtering
} else {
markers_data = markers_data[markersDbId, ]
if (nrow(markers_data) == 0) return(NULL)
}
pg = paging(markers_data, page, pageSize)
markers_data <- markers_data[pg$recStart:pg$recEnd, ]
n = nrow(markers_data)
#message(n)
out = list(n)
for (i in 1:n){
out[[i]] <- as.list(markers_data[i, ])
if(include == "synonyms") out[[i]]$synonyms = out[[i]]$synonyms %>% safe_split()
out[[i]]$refAlt = out[[i]]$refAlt %>% safe_split()
out[[i]]$analysisMethods = out[[i]]$analysisMethods %>% safe_split()
}
attr(out, "pagination") = pg$pagination
out
}
markers = list(
metadata = list(
pagination = list(
pageSize = 1000,
currentPage = 0,
totalCount = nrow(markers_data),
totalPages = 1
),
status = list(),
datafiles = list()
),
result = list(data = markers_list())
)
process_markers <- function(req, res, err){
prms <- names(req$params)
name = ifelse('name' %in% prms, req$params$name, "none")
matchMethod = ifelse('matchMethod' %in% prms,
req$params$matchMethod, "exact")
include = ifelse('include' %in% prms, req$params$include, "synonyms")
type = ifelse('type' %in% prms, req$params$type, "all")
page = ifelse('page' %in% prms, as.integer(req$params$page), 0)
pageSize = ifelse('pageSize' %in% prms, as.integer(req$params$pageSize), 100)
markers$result$data = markers_list(NA,
name, matchMethod, include, type, page, pageSize)
markers$metadata$pagination = attr(markers$result$data, "pagination")
if(is.null(markers$result$data)){
res$set_status(404)
markers$metadata <- brapi_status(100, "No matching results!")
}
res$set_header("Access-Control-Allow-Methods", "GET")
res$json(markers)
}
process_single_marker <- function(req, res, err){
#message(is.integer(basename(req$path)))
markersDbId <- as.integer(basename(req$path))
#message(paste("prm: ", markersDbId))
if(markersDbId <= nrow(markers_data)){
markers$result$data = markers_list(markersDbId)
markers$metadata$pagination = NULL
} else {
markers$result$data = NULL
}
if(is.null(markers$result$data)){
res$set_status(404)
markers$metadata <- brapi_status(100, "No matching results!")
}
res$set_header("Access-Control-Allow-Methods", "GET")
res$json(markers)
}
mw_markers <<-
collector() %>%
get("/brapi/v1/markers[/]?", function(req, res, err){
process_markers(req, res, err)
}) %>%
put("/brapi/v1/markers[/]?", function(req, res, err){
res$set_status(405)
}) %>%
post("/brapi/v1/markers[/]?", function(req, res, err){
res$set_status(405)
}) %>%
delete("/brapi/v1/markers[/]?", function(req, res, err){
res$set_status(405)
}) %>%
#collector() %>%
get("/brapi/v1/markers/[0-9]{1,12}[/]?", function(req, res, err){
process_single_marker(req, res, err)
}) %>%
put("/brapi/v1/markers/[0-9]{1,12}[/]?", function(req, res, err){
res$set_status(405)
}) %>%
post("/brapi/v1/markers/[0-9]{1,12}[/]?", function(req, res, err){
res$set_status(405)
}) %>%
delete("/brapi/v1/markers/[0-9]{1,12}[/]?", function(req, res, err){
res$set_status(405)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.