Skip to content

Development #16

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

Open
Cristianetaniguti wants to merge 2 commits into
base: main
Choose a base branch
from
Open

Development #16

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
0349121
SAT-108 Viewpoly added
Cristianetaniguti Jul 8, 2026
76a95e3
CMD check okay
Cristianetaniguti Jul 8, 2026
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
20 changes: 10 additions & 10 deletions DESCRIPTION
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: Breedverse
Title: Collection of R Shiny Packages From Breeding Insight
Version: 0.3.1
Version: 0.4.0
Authors@R: c(person(given='Cristiane',
family='Taniguti',
email = 'ctaniguti@ufl.edu',
Expand All @@ -18,8 +18,8 @@ Authors@R: c(person(given='Cristiane',
family='Insight',
role = 'aut')
)
Description: Provides an interface for users to add modules from BIGapp, Qploidy, familia, GenoBrew and AlloMate packages.
License: Apache License 2.0
Description: Provides an interface for users to add modules from BIGapp, familia, GenoBrew, AlloMate, and VIEWpoly packages.
License: Apache License 2.0 | file LICENSE
Depends: R (>= 3.6.0)
biocViews:
Imports:
Expand All @@ -28,7 +28,6 @@ Imports:
config,
golem,
shinyWidgets,
shinydisconnect,
curl,
httr,
utils
Expand All @@ -40,16 +39,17 @@ Suggests:
rmarkdown,
testthat (>= 3.0.0),
remotes,
Qploidy,
AlloMate,
BIGapp,
familia,
GenoBrew
Familia,
GenoBrew,
viewpoly
Remotes:
Cristianetaniguti/Qploidy,
Breeding-Insight/AlloMate@development,
Breeding-Insight/BIGapp,
Breeding-Insight/familia,
Breeding-Insight/AlloMate@development,
Breeding-Insight/GenoBrew@development
Breeding-Insight/GenoBrew@development,
Breeding-Insight/viewpoly
URL: https://github.com/Breeding-Insight/Breedverse
BugReports: https://github.com/Breeding-Insight/Breedverse/issues
LazyData: true
Expand Down
1 change: 0 additions & 1 deletion NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,6 @@ importFrom(shiny,NS)
importFrom(shiny,includeMarkdown)
importFrom(shiny,shinyApp)
importFrom(shiny,tagList)
importFrom(shinydisconnect,disconnectMessage)
importFrom(stats,dbinom)
importFrom(utils,capture.output)
importFrom(utils,getFromNamespace)
Expand Down
6 changes: 6 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,11 @@
# breedverse NEWS

## breedverse 0.4.0

* Add VIEWpoly
* Add VIEWpoly and GenoBrew help materials
* Update CSS style file

## breedverse 0.3.2

* Add styles to CSS
Expand Down
187 changes: 120 additions & 67 deletions R/app_server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,20 +10,16 @@
app_server <- function(input, output, session) {
# Your application server logic

##Add server configurations
options(shiny.maxRequestSize = 1000000 * 1024^2) # Set maximum upload size to 1000GB
#shiny.maxRequestSize = 10000 * 1024^2; # 10 GB <- This is for a future limit when using BI's server remotely

# output$qploidyInstalled <- reactive({
# "Qploidy" %in% rownames(installed.packages())
# })
## Add server configurations
options(shiny.maxRequestSize = 1000000 * 1024^2) # Set maximum upload size to 1000GB
# shiny.maxRequestSize = 10000 * 1024^2; # 10 GB <- This is for a future limit when using BI's server remotely

output$BIGappInstalled <- reactive({
"BIGapp" %in% rownames(installed.packages())
})

output$familiaInstalled <- reactive({
"familia" %in% rownames(installed.packages())
output$FamiliaInstalled <- reactive({
"Familia" %in% rownames(installed.packages())
})

output$allomateInstalled <- reactive({
Expand All @@ -34,78 +30,86 @@ app_server <- function(input, output, session) {
"GenoBrew" %in% rownames(installed.packages())
})

output$viewpolyInstalled <- reactive({
"viewpoly" %in% rownames(installed.packages())
})

# Expose the value to JS even when panel is hidden
# outputOptions(output, "qploidyInstalled", suspendWhenHidden = FALSE)
outputOptions(output, "BIGappInstalled", suspendWhenHidden = FALSE)
outputOptions(output, "familiaInstalled", suspendWhenHidden = FALSE)
outputOptions(output, "FamiliaInstalled", suspendWhenHidden = FALSE)
outputOptions(output, "allomateInstalled", suspendWhenHidden = FALSE)
outputOptions(output, "genobrewInstalled", suspendWhenHidden = FALSE)

outputOptions(output, "viewpolyInstalled", suspendWhenHidden = FALSE)

## Modules

## Home Module
callModule(mod_Home_server,
"Home_1",
parent_session = session)
"Home_1",
parent_session = session
)

## Install Module
callModule(mod_install_server,
"install_1",
parent_session = session)

## Qploidy
# if(isTRUE(requireNamespace("Qploidy", quietly = TRUE))) {
# do.call("library", list("Qploidy"))
# callModule(getFromNamespace("mod_qploidy_server", "Qploidy"),
# "qploidy_1",
# parent_session = session)
# }
"install_1",
parent_session = session
)

## BIGapp

if(isTRUE(requireNamespace("BIGapp", quietly = TRUE))) {
if (isTRUE(requireNamespace("BIGapp", quietly = TRUE))) {
do.call("library", list("BIGapp"))
callModule(getFromNamespace("mod_DosageCall_server", "BIGapp"),
"DosageCall_1",
parent_session = session)
"DosageCall_1",
parent_session = session
)
callModule(getFromNamespace("mod_dosage2vcf_server", "BIGapp"),
"dosage2vcf_1",
parent_session = session)
"dosage2vcf_1",
parent_session = session
)
callModule(getFromNamespace("mod_PCA_server", "BIGapp"),
"PCA_1",
parent_session = session)
"PCA_1",
parent_session = session
)
callModule(getFromNamespace("mod_dapc_server", "BIGapp"),
"dapc_1",
parent_session = session)
"dapc_1",
parent_session = session
)
callModule(getFromNamespace("mod_gwas_server", "BIGapp"),
"gwas_1",
parent_session = session)
"gwas_1",
parent_session = session
)
callModule(getFromNamespace("mod_diversity_server", "BIGapp"),
"diversity_1",
parent_session = session)
"diversity_1",
parent_session = session
)
callModule(getFromNamespace("mod_GSAcc_server", "BIGapp"),
"GSAcc_1",
parent_session = session)
"GSAcc_1",
parent_session = session
)
callModule(getFromNamespace("mod_GS_server", "BIGapp"),
"GS_1",
parent_session = session)
"GS_1",
parent_session = session
)
}

##familia
## Familia

if(isTRUE(requireNamespace("familia", quietly = TRUE))) {
do.call("library", list("familia"))
callModule(getFromNamespace("mod_SNMF_server", "familia"),
"SNMF_1",
parent_session = session)
callModule(getFromNamespace("mod_polybreedtools_server", "familia"),
"PolyBreedTools_1",
parent_session = session)
if (isTRUE(requireNamespace("Familia", quietly = TRUE))) {
do.call("library", list("Familia"))
callModule(getFromNamespace("mod_SNMF_server", "Familia"),
"SNMF_1",
parent_session = session
)
callModule(getFromNamespace("mod_polybreedtools_server", "Familia"),
"PolyBreedTools_1",
parent_session = session
)
}

## AlloMate
if(isTRUE(requireNamespace("AlloMate", quietly = TRUE))) {
if (isTRUE(requireNamespace("AlloMate", quietly = TRUE))) {
do.call("library", list("AlloMate"))
getFromNamespace("mod_allomate_server", "AlloMate")(
"allomate_1",
Expand All @@ -114,17 +118,64 @@ app_server <- function(input, output, session) {
}

## GenoBrew
if(isTRUE(requireNamespace("GenoBrew", quietly = TRUE))) {
if (isTRUE(requireNamespace("GenoBrew", quietly = TRUE))) {
do.call("library", list("GenoBrew"))
callModule(getFromNamespace("mod_mk_select_server", "GenoBrew"),
"mk_select_1",
parent_session = session)
"mk_select_1",
parent_session = session
)
callModule(getFromNamespace("mod_cnv_server", "GenoBrew"),
"cnv_1",
parent_session = session)
"cnv_1",
parent_session = session
)
}

## VIEWpoly
if (isTRUE(requireNamespace("viewpoly", quietly = TRUE))) {
do.call("library", list("viewpoly"))
datas <- callModule(getFromNamespace("mod_upload_server", "viewpoly"),
"upload_1",
parent_session = session
)

# QTL view
callModule(getFromNamespace("mod_qtl_view_server", "viewpoly"),
"qtl_1",
loadMap = datas$loadMap,
loadQTL = datas$loadQTL,
parent_session = session
)

# Genes view
callModule(getFromNamespace("mod_genes_view_server", "viewpoly"),
"genes_1",
loadMap = datas$loadMap,
loadQTL = datas$loadQTL,
loadJBrowse_fasta = datas$loadJBrowse_fasta,
loadJBrowse_gff3 = datas$loadJBrowse_gff3,
loadJBrowse_vcf = datas$loadJBrowse_vcf,
loadJBrowse_align = datas$loadJBrowse_align,
loadJBrowse_wig = datas$loadJBrowse_wig,
parent_session = session
)

# Map view
callModule(getFromNamespace("mod_map_view_server", "viewpoly"),
"map_1",
loadMap = datas$loadMap,
loadQTL = datas$loadQTL,
parent_session = session
)

# Hidecan view
callModule(getFromNamespace("mod_hidecan_view_server", "viewpoly"),
"hidecan_1",
loadHidecan = datas$loadHidecan,
parent_session = session
)
}

#Session info popup
# Session info popup
observeEvent(input$session_info_button, {
showModal(modalDialog(
title = "Session Information",
Expand All @@ -140,7 +191,7 @@ app_server <- function(input, output, session) {
))
})

#Check for updates from GitHub for Breedverse
# Check for updates from GitHub for Breedverse
get_latest_github_commit <- function(repo, owner) {
url <- paste0("https://api.github.com/repos/", owner, "/", repo, "/releases/latest")
response <- GET(url)
Expand All @@ -158,12 +209,15 @@ app_server <- function(input, output, session) {

is_internet_connected <- function() {
handle <- new_handle()
success <- tryCatch({
curl_fetch_memory("https://www.google.com", handle = handle)
TRUE
}, error = function(e) {
FALSE
})
success <- tryCatch(
{
curl_fetch_memory("https://www.google.com", handle = handle)
TRUE
},
error = function(e) {
FALSE
}
)
return(success)
}

Expand Down Expand Up @@ -198,7 +252,7 @@ app_server <- function(input, output, session) {
# Prepare styled HTML text for the modal
message_html <- paste(
"Installed version:", installed_version, "<br>",
#"Latest version commit SHA:", latest_commit, "<br>",
# "Latest version commit SHA:", latest_commit, "<br>",
"<span>A new version is available on GitHub!</span><br>",
"<span style='color: red;'>Please update your package.</span>"
)
Expand All @@ -207,7 +261,7 @@ app_server <- function(input, output, session) {
# Prepare non-styled text for no update needed
message_html <- paste(
"Installed version:", installed_version, "<br>",
#"Latest version commit SHA:", latest_commit, "<br>",
# "Latest version commit SHA:", latest_commit, "<br>",
update_status
)
}
Expand All @@ -225,7 +279,7 @@ app_server <- function(input, output, session) {
))
})

#Download Session Info
# Download Session Info
output$download_session_info <- downloadHandler(
filename = function() {
paste("session_info_", Sys.Date(), ".txt", sep = "")
Expand All @@ -234,5 +288,4 @@ app_server <- function(input, output, session) {
writeLines(paste(capture.output(sessionInfo()), collapse = "\n"), file)
}
)

}
Loading
Loading