Skip to content

Sync back to CRAN branch #116

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
cb4ds merged 1 commit into from
Sep 5, 2025
Merged

Sync back to CRAN branch #116

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
5 changes: 4 additions & 1 deletion .circleci/config.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,8 @@ jobs:
R -e 'install.packages("bs4Dash", repos = "https://cran.rstudio.com/")'
R -e 'install.packages(c("shinyWidgets", "yaml", "DT", "writexl", "fresh", "miniUI", "shinyFeedback"))'
R -e 'install.packages(c("canvasXpress", "waiter", "shinyjs", "openxlsx", "spelling", "colourpicker", "lifecycle"))'
R -e 'install.packages("reactable")'
R -e 'install.packages("openxlsx2", repos = "https://cloud.r-project.org")'

- run:
name: Session information and installed package versions
Expand Down Expand Up @@ -80,8 +82,9 @@ jobs:
name: Install R dependencies
command: |
R -e 'install.packages(c("bs4Dash", "shinyWidgets", "yaml", "DT", "writexl", "fresh", "miniUI", "shinyFeedback"))'
R -e 'install.packages(c("canvasXpress", "waiter", "shinyjs", "openxlsx", "spelling", "colourpicker", "lifecycle"))'
R -e 'install.packages(c("canvasXpress", "waiter", "shinyjs", "openxlsx", "openxlsx2", "spelling", "colourpicker", "lifecycle"))'
R -e 'install.packages("covr")'
R -e 'install.packages("reactable")'

- run:
name: Session information and installed package versions
Expand Down
4 changes: 3 additions & 1 deletion DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: periscope2
Type: Package
Title: Enterprise Streamlined 'shiny' Application Framework Using 'bs4Dash'
Version: 0.2.4
Version: 0.3.0
Authors@R: c(
person("Mohammed", "Ali", role = c("aut", "cre"), email = "mohammed@aggregate-genius.com"),
person("Constance", "Brett", role = c("ctb")),
Expand All @@ -27,6 +27,7 @@ Imports:
grDevices,
lubridate,
methods,
reactable,
shinyFeedback,
shinyWidgets,
utils,
Expand All @@ -43,6 +44,7 @@ Suggests:
lattice,
miniUI,
openxlsx,
openxlsx2,
rmarkdown,
shinyjs,
spelling,
Expand Down
2 changes: 2 additions & 0 deletions NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,8 @@ export(downloadFile_AvailableTypes)
export(downloadFile_ValidateTypes)
export(downloadablePlot)
export(downloadablePlotUI)
export(downloadableReactTable)
export(downloadableReactTableUI)
export(downloadableTable)
export(downloadableTableUI)
export(get_url_parameters)
Expand Down
13 changes: 13 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,16 @@
# periscope2 0.3.0

## New Features
- Added new module *?downloadableReactTable* based on reactable package and downloadFile module

## Enhancements
- Added openxlsx2 support while keeping openxlsx to support legacy apps and backwards compatibility. writexl package is used as last resort.
- Updated *?logViewerOutput* module to display log data using *?downloadableReactTable*.
- Added loglevel filtering according to level chosen- Added loglevel filtering according to level chosen
- Added new feature to *?downloadFile* module to control whether row names are to be written for tabular data.

-----

# periscope2 0.2.4

## Enhancements
Expand Down
102 changes: 77 additions & 25 deletions R/downloadFile.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@
#' logger = "",
#' filenameroot = "mydownload1",
#' datafxns = list(csv = reactiveVal(iris)),
#' aspectratio = 1)
#' row_names = FALSE)
#' # multiple download types
#' downloadFile(id = "object_id2",
#' logger = "",
Expand Down Expand Up @@ -119,6 +119,14 @@ downloadFileButton <- function(id,
file_button_ui
}

check_openxlsx2_availability <- function() {
length(find.package("openxlsx2", quiet = TRUE)) > 0
}

check_openxlsx_availability <- function() {
length(find.package("openxlsx", quiet = TRUE)) > 0
}


#' downloadFile module server function
#'
Expand All @@ -137,6 +145,8 @@ downloadFileButton <- function(id,
#' @param aspectratio the downloaded chart image width:height ratio (ex:
#' 1 = square, 1.3 = 4:3, 0.5 = 1:2). Where not applicable for a download type
#' it is ignored (e.g. data downloads).
#' @param row_names logical value indicating whether row names are to be written
#' for tabular data. Where not applicable for a download type it is ignored.
#'
#' @return no return value, called for downloading selected file type
#'
Expand Down Expand Up @@ -174,7 +184,7 @@ downloadFileButton <- function(id,
#' logger = "",
#' filenameroot = "mydownload1",
#' datafxns = list(csv = reactiveVal(iris)),
#' aspectratio = 1)
#' row_names = FALSE)
#' # multiple download types
#' downloadFile(id = "object_id2",
#' logger = "",
Expand All @@ -189,7 +199,8 @@ downloadFile <- function(id,
logger = NULL,
filenameroot = "download",
datafxns = NULL,
aspectratio = 1) {
aspectratio = 1,
row_names = TRUE) {
shiny::moduleServer(
id,
function(input, output, session) {
Expand All @@ -204,44 +215,70 @@ downloadFile <- function(id,
filename = shiny::reactive({paste(rootname(), "csv", sep = ".")}),
content = function(file) {
if (!is.null(datafxns)) {
writeFile("csv", datafxns$csv(), file, logger,
shiny::reactive({paste(rootname(), "csv", sep = ".")}))
writeFile(type = "csv",
data = datafxns$csv(),
file = file,
show_rownames = row_names,
logger = logger,
filename = shiny::reactive({paste(rootname(), "csv", sep = ".")}))
}
})

output$xlsx <- shiny::downloadHandler(
filename = shiny::reactive({paste(rootname(), "xlsx", sep = ".")}),
content = function(file) {
if (!is.null(datafxns)) {
writeFile("xlsx", datafxns$xlsx(), file, logger,
shiny::reactive({paste(rootname(), "xlsx", sep = ".")}))
writeFile(type = "xlsx",
data = datafxns$xlsx(),
file = file,
show_rownames = row_names,
logger = logger,
filename = shiny::reactive({paste(rootname(), "xlsx", sep = ".")}))
}
})

output$tsv <- shiny::downloadHandler(
filename = shiny::reactive({paste(rootname(), "tsv", sep = ".")}),
content = function(file) {
if (!is.null(datafxns)) {
writeFile("tsv", datafxns$tsv(), file, logger,
shiny::reactive({paste(rootname(), "tsv", sep = ".")}))
writeFile(type = "tsv",
data = datafxns$tsv(),
file = file,
show_rownames = row_names,
logger = logger,
filename = shiny::reactive({paste(rootname(), "tsv", sep = ".")}))
}
})

output$txt <- shiny::downloadHandler(
filename = shiny::reactive({paste(rootname(), "txt", sep = ".")}),
content = function(file) {
if (!is.null(datafxns)) {
writeFile("txt", datafxns$txt(), file, logger,
shiny::reactive({paste(rootname(), "txt", sep = ".")}))
writeFile(type = "txt",
data = datafxns$txt(),
file = file,
show_rownames = row_names,
logger = logger,
filename = shiny::reactive({paste(rootname(), "txt", sep = ".")}))
}
})

# filename is expected to be a reactive expression
writeFile <- function(type, data, file, logger, filename) {

## writeFile
##
## @param type type of file to write
## @param data data to write
## @param file file path to write to
## @param show_rownames if TRUE, row names are written for tabular data
## @param logger logger to use
## @param filename name of downloaded file, expected to be a reactive expression
##
## @returns no return value
writeFile <- function(type, data, file, show_rownames, logger, filename) {
show_rownames <- isTRUE(show_rownames)

# tabular values
if ((type == "csv") || (type == "tsv")) {
show_rownames <- attr(data, "show_rownames")
show_rownames <- !is.null(show_rownames) && show_rownames
show_colnames <- TRUE
if (show_rownames) {
show_colnames <- NA
Expand All @@ -256,25 +293,40 @@ downloadFile <- function(id,
}
# excel file
else if (type == "xlsx") {
if (length(find.package("openxlsx", quiet = TRUE) > 0)) {
if ((inherits(data, "Workbook")) && ("openxlsx" %in% attributes(class(data)))) {
openxlsx::saveWorkbook(data, file)

if (inherits(data, "wbWorkbook") && check_openxlsx2_availability()) {
openxlsx2::wb_save(data, file)
} else if (inherits(data, "Workbook") &&
("openxlsx" %in% attributes(class(data))) &&
check_openxlsx_availability()) {
openxlsx::saveWorkbook(data, file)
} else {
# tabular data
if (check_openxlsx2_availability()) {
openxlsx2::write_xlsx(data,
file,
as_table = TRUE,
row_names = show_rownames)
} else if (check_openxlsx_availability()) {
openxlsx::write.xlsx(data,
file,
asTable = TRUE,
rowNames = show_rownames)
} else {
show_rownames <- attr(data, "show_rownames")
openxlsx::write.xlsx(data, file,
asTable = TRUE,
rowNames = !is.null(show_rownames) && show_rownames)
if (show_rownames) {
logwarn("Downloading with 'writexl', row names are not included",
logger = logger)
}
writexl::write_xlsx(data, file)
}
} else {
writexl::write_xlsx(data, file)
}
}
# text file processing
else if (type == "txt") {
if (inherits(data, "character")) {
writeLines(data, file)
} else if (is.data.frame(data) || is.matrix(data)) {
utils::write.table(data, file)
utils::write.table(data, file, row.names = show_rownames)
} else {
msg <- paste(type, "could not be processed")
logwarn(msg)
Expand Down
26 changes: 7 additions & 19 deletions R/downloadablePlot.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -74,9 +74,9 @@
#' download_plot <- function() {
#' ggplot(data = mtcars, aes(x = wt, y = mpg)) +
#' geom_point(aes(color = cyl)) +
#' theme(legend.justification = c(1, 1),
#' legend.position = c(1, 1),
#' legend.title = element_blank()) +
#' theme(legend.justification = c(1, 1),
#' legend.position.inside = c(1, 1),
#' legend.title = element_blank()) +
#' ggtitle("GGPlot Example ") +
#' xlab("wt") +
#' ylab("mpg")
Expand Down Expand Up @@ -217,9 +217,9 @@ downloadablePlotUI <- function(id,
#' download_plot <- function() {
#' ggplot(data = mtcars, aes(x = wt, y = mpg)) +
#' geom_point(aes(color = cyl)) +
#' theme(legend.justification = c(1, 1),
#' legend.position = c(1, 1),
#' legend.title = element_blank()) +
#' theme(legend.justification = c(1, 1),
#' legend.position.inside = c(1, 1),
#' legend.title = element_blank()) +
#' ggtitle("GGPlot Example ") +
#' xlab("wt") +
#' ylab("mpg")
Expand All @@ -244,13 +244,10 @@ downloadablePlot <- function(id,
id,
function(input, output, session) {
downloadFile("dplotButtonID", logger, filenameroot, downloadfxns, aspectratio)
dpInfo <- shiny::reactiveValues(visibleplot = NULL,
downloadfxns = NULL)

shiny::observe({
dpInfo$visibleplot <- visibleplot()
output$dplotOutputID <- shiny::renderPlot({
plot <- dpInfo$visibleplot
plot <- visibleplot()
if (inherits(plot, "grob")) {
plot <- grid::grid.draw(plot)
}
Expand All @@ -259,15 +256,6 @@ downloadablePlot <- function(id,
})

shiny::observe({
if (length(downloadfxns) > 0) {
dpInfo$downloadfxns <- lapply(downloadfxns, do.call, list())
rowct <- lapply(dpInfo$downloadfxns, is.null)
session$sendCustomMessage(
"downloadbutton_toggle",
message = list(btn = session$ns("dplotButtonDiv"),
rows = sum(unlist(rowct) == FALSE)) )
}

output$displayButton <- shiny::reactive(length(downloadfxns) > 0)
shiny::outputOptions(output, "displayButton", suspendWhenHidden = FALSE)
})
Expand Down
Loading
Loading