|
| 1 | +library(shiny) |
| 2 | +library(bslib) |
| 3 | +library(dplyr) |
| 4 | +library(DT) |
| 5 | + |
| 6 | +source_base <- "https://cran.r-project.org/web/packages/" |
| 7 | +contrib_base <- "https://repo.r-wasm.org/bin/emscripten/contrib/" |
| 8 | +versions <- c("4.2.x" = "4.2", "4.3.x" = "4.3", "4.3.3" = "4.3.3", "4.4.x" = "4.4") |
| 9 | + |
| 10 | +ui <- page_sidebar( |
| 11 | + title = h1("WebR binary R package repository"), |
| 12 | + sidebar = sidebar( |
| 13 | + title = "Options", |
| 14 | + open = FALSE, |
| 15 | + selectInput("version", "Select R version", |
| 16 | + choices = versions, |
| 17 | + selected = versions[[length(versions)]] |
| 18 | + ), |
| 19 | + ), |
| 20 | + p( |
| 21 | + class = "lead", |
| 22 | + "This CRAN-like repository contains R packages compiled to WebAssembly for use with webR. Set this page's URL as the named", |
| 23 | + code("repos"), "argument when using the", code("webr::install()"), |
| 24 | + "command to use this repository as the source for downloading binary R packages." |
| 25 | + ), |
| 26 | + p( |
| 27 | + "By default, ", code("webr::install()"), "will use the public repository hosted at", |
| 28 | + a(href = "https://repo.r-wasm.org/", "https://repo.r-wasm.org/"), |
| 29 | + ". See the", a(href = "https://docs.r-wasm.org/webr/latest/packages.html", "webR documentation"), |
| 30 | + "for further information about webR." |
| 31 | + ), |
| 32 | + h2("Repository statistics"), |
| 33 | + layout_columns( |
| 34 | + fill = FALSE, |
| 35 | + value_box( |
| 36 | + title = h2("Built R packages"), |
| 37 | + value = textOutput("built"), |
| 38 | + showcase = bsicons::bs_icon("hammer"), |
| 39 | + "Packages that have been built for WebAssembly and are available for download from this repository." |
| 40 | + ), |
| 41 | + value_box( |
| 42 | + title = "Available R packages", |
| 43 | + value = textOutput("available"), |
| 44 | + showcase = bsicons::bs_icon("check-circle"), |
| 45 | + "Packages for which all of the package dependencies have also been built for WebAssembly and are available for download from this repo." |
| 46 | + ), |
| 47 | + ), |
| 48 | + h2("Packages"), |
| 49 | + DTOutput("webr_pkgs") |
| 50 | +) |
| 51 | + |
| 52 | +server <- function(input, output) { |
| 53 | + res <- reactive({ |
| 54 | + withProgress( |
| 55 | + { |
| 56 | + repo_info <- as.data.frame(available.packages( |
| 57 | + contriburl = paste0(contrib_base, input$version), |
| 58 | + filters = c("OS_type", "subarch", "duplicates") |
| 59 | + )) |
| 60 | + avail_pkgs <- c( |
| 61 | + rownames(repo_info), |
| 62 | + c( |
| 63 | + "base", "compiler", "datasets", "graphics", "grDevices", |
| 64 | + "grid", "methods", "splines", "stats", "stats4", |
| 65 | + "tools", "utils", "parallel", "webr" |
| 66 | + ) |
| 67 | + ) |
| 68 | + incProgress(2 / 5) |
| 69 | + |
| 70 | + deps <- tools::package_dependencies( |
| 71 | + packages = rownames(repo_info), |
| 72 | + db = repo_info, recursive = TRUE |
| 73 | + ) |
| 74 | + incProgress(2 / 5) |
| 75 | + |
| 76 | + deps <- tibble( |
| 77 | + Package = names(deps), |
| 78 | + Available = deps |> purrr::map(\(x) all(x %in% avail_pkgs)), |
| 79 | + Depends = deps, |
| 80 | + Missing = deps |> purrr::map(\(x) x[!(x %in% avail_pkgs)]), |
| 81 | + ) |
| 82 | + incProgress(1 / 5) |
| 83 | + |
| 84 | + package_table <- repo_info |> |
| 85 | + select(c("Package", "Version", "Repository")) |> |
| 86 | + left_join(deps, by = "Package") |> |
| 87 | + arrange(Package) |
| 88 | + |
| 89 | + list( |
| 90 | + table = package_table, |
| 91 | + n_built = dim(package_table)[1], |
| 92 | + n_avail = sum(as.numeric(deps$Available)) |
| 93 | + ) |
| 94 | + }, |
| 95 | + message = "Loading package lists and crunching dependencies", |
| 96 | + detail = "This may take a little while...", |
| 97 | + value = 0 |
| 98 | + ) |
| 99 | + }) |
| 100 | + |
| 101 | + output$built <- renderText(res()$n_built) |
| 102 | + output$available <- renderText(res()$n_avail) |
| 103 | + output$webr_pkgs <- renderDT( |
| 104 | + datatable( |
| 105 | + res()$table, |
| 106 | + rownames = FALSE, |
| 107 | + selection = "none", |
| 108 | + options = list( |
| 109 | + ordering = FALSE, |
| 110 | + search = list(regex = TRUE), |
| 111 | + columns = JS("[ |
| 112 | + null, |
| 113 | + null, |
| 114 | + { searchable: false, visible: false }, |
| 115 | + { title: 'All depends available?' }, |
| 116 | + { |
| 117 | + searchable: false, |
| 118 | + title: 'Depends<br><small>Missing dependencies are shown in bold.</small>', |
| 119 | + }, |
| 120 | + { searchable: false, visible: false }, |
| 121 | + ]"), |
| 122 | + rowCallback = JS(paste0( |
| 123 | + " |
| 124 | + function(row, data) { |
| 125 | + if (data[3][0]) { |
| 126 | + $('td:eq(2)', row).html('Yes'); |
| 127 | + } else { |
| 128 | + $('td:eq(2)', row).html('<b>No</b>'); |
| 129 | + } |
| 130 | + $('td:eq(0)', row).html( |
| 131 | + ", |
| 132 | + if (is.null(source_base)) { |
| 133 | + "data[0]" |
| 134 | + } else { |
| 135 | + paste0("`<a target=\"_blank\" href=\"", source_base, "${data[0]}/\">${data[0]}</a>`") |
| 136 | + }, |
| 137 | + " |
| 138 | + ); |
| 139 | + $('td:eq(3)', row).html(data[4].map((v) => { |
| 140 | + if (data[5].includes(v)) |
| 141 | + return '<b>' + v + '</b>'; |
| 142 | + return v; |
| 143 | + }).join(', ')); |
| 144 | + } |
| 145 | + " |
| 146 | + )) |
| 147 | + ) |
| 148 | + ) |
| 149 | + ) |
| 150 | +} |
| 151 | + |
| 152 | +shinyApp(ui = ui, server = server) |
0 commit comments