Commit 4f77eb56 authored by jlopez's avatar jlopez
Browse files

Code: Update biocmanager mechanims & add asynchronous request

parent 5888d7cf
TOTO <<- 0
getPackagesWithTitle <- function() { getPackagesWithTitle <- function() {
contrib.url("https://cran.rstudio.com/", "source") contrib.url("https://cran.rstudio.com/", "source")
description <- sprintf("%s/web/packages/packages.rds", description <- sprintf("%s/web/packages/packages.rds",
...@@ -8,10 +10,9 @@ getPackagesWithTitle <- function() { ...@@ -8,10 +10,9 @@ getPackagesWithTitle <- function() {
url(description, "rb") url(description, "rb")
} }
on.exit(close(con)) on.exit(close(con))
db <- readRDS(gzcon(con)) db <- readRDS(gzcon(con))
rownames(db) <- NULL db[, c("Package", "Title", "Version")]
db[, c("Package", "Title", "Version")]
} }
......
...@@ -9,6 +9,11 @@ library(githubinstall) ...@@ -9,6 +9,11 @@ library(githubinstall)
require(stringi) require(stringi)
library(devtools) library(devtools)
library(yaml) library(yaml)
library(BiocManager)
library(promises)
library(future)
plan(multiprocess)
source("./R/helper_functions.R", local = T) source("./R/helper_functions.R", local = T)
source("./R/menugauche.R", local = T) source("./R/menugauche.R", local = T)
...@@ -41,17 +46,14 @@ UI <- dashboardPage( ...@@ -41,17 +46,14 @@ UI <- dashboardPage(
) )
server <- function( input, output, session) { server <- function( input, output, session) {
source("https://bioconductor.org/biocLite.R")
session$userData <- c() session$userData <- c()
disable("rcranpackagelist") disable("rcranpackagelist")
#allCRAN <<- as.data.frame(available.packages(repo = "http://cran.us.r-project.org")[, c("Package")]) allCRAN <<- c()
allCRAN <<- as.data.frame(getPackagesWithTitle()) allBIO <<- c()
allBIO <<- as.data.frame(available.packages(repo = biocinstallRepos()[1])[, c("Package", "Version")])
allGITHUB <<- data.frame(Package=character(), Version=character()) allGITHUB <<- data.frame(Package=character(), Version=character())
TMP <<- yaml.load_file("container.yaml")$containers TMP <<- yaml.load_file("container.yaml")$containers
i = 1 i = 1
j = 1 j = 1
......
output$dtrcranpackage <- DT::renderDataTable({ output$dtrcranpackage <- DT::renderDataTable({
future({
cran <- as.data.frame(getPackagesWithTitle())
result <- allCRAN cran
}) %...>% (function(result) {
return(result) allCRAN <<- result
return(result)
})
}, filter='top', escape = FALSE, rownames= FALSE,server = TRUE) }, filter='top', escape = FALSE, rownames= FALSE,server = TRUE)
output$dtrbioconductorpackage <- DT::renderDataTable({ output$dtrbioconductorpackage <- DT::renderDataTable({
result <- allBIO future({
bioc <- as.data.frame(available.packages(repo = BiocManager::repositories()[1])[, c("Package", "Version")])
return(result) bioc
}) %...>% (function(result) {
allBIO <<- result
return(result)
})
}, filter='top', escape = FALSE, rownames= FALSE,server = TRUE) }, filter='top', escape = FALSE, rownames= FALSE,server = TRUE)
output$dtrgithubpackage <- DT::renderDataTable({ output$dtrgithubpackage <- DT::renderDataTable({
...@@ -31,8 +37,6 @@ output$dtbiocontainer <- DT::renderDataTable({ ...@@ -31,8 +37,6 @@ output$dtbiocontainer <- DT::renderDataTable({
return(result) return(result)
}, filter='top', escape = FALSE, rownames= FALSE,server = TRUE) }, filter='top', escape = FALSE, rownames= FALSE,server = TRUE)
getWorkflows
output$dtWorkflows <- DT::renderDataTable({ output$dtWorkflows <- DT::renderDataTable({
result <- data.frame(Workflow=character(), result <- data.frame(Workflow=character(),
Author=character(), Author=character(),
...@@ -909,16 +913,19 @@ observeEvent(input$findGithub, { ...@@ -909,16 +913,19 @@ observeEvent(input$findGithub, {
name <- input$inputGithub name <- input$inputGithub
if(!stri_isempty(name)) { if(!stri_isempty(name)) {
allGITHUB <<- data.frame(Package = gh_suggest(name, keep_title = FALSE), Title = attr(gh_suggest(name, keep_title = TRUE), "title")) future({
github <- data.frame(Package = gh_suggest(name, keep_title = FALSE), Title = attr(gh_suggest(name, keep_title = TRUE), "title"))
if(length(allGITHUB) >= 1 ) { github
output$dtrgithubpackage <- DT::renderDataTable({ }) %...>% (function(result) {
result <- allGITHUB allGITHUB <<- result
return(result) if(length(allGITHUB) >= 1 ) {
}, filter='top', escape = FALSE, rownames= FALSE,server = TRUE) output$dtrgithubpackage <- DT::renderDataTable({
} result <- allGITHUB
return(result)
}, filter='top', escape = FALSE, rownames= FALSE,server = TRUE)
}
})
} }
}) })
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment