Merge pull request #10 from microbiome/errcatch

Implemented system to catch unexpected errors
microbiome · Dec 11, 2024 · 08cc76e · 08cc76e
2 parents 744818a + 1e8e381
commit 08cc76e
Show file tree

Hide file tree

Showing 10 changed files with 59 additions and 39 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: miaDash
-Version: 0.99.4
+Version: 0.99.5
 Authors@R: 
     c(person(given = "Giulio", family = "Benedetti", role = c("aut", "cre"),
            email = "[email protected]",

diff --git a/NAMESPACE b/NAMESPACE
@@ -46,6 +46,7 @@ importFrom(rintrojs,introjs)
 importFrom(scater,runMDS)
 importFrom(scater,runPCA)
 importFrom(shiny,actionButton)
+importFrom(shiny,addResourcePath)
 importFrom(shiny,checkboxInput)
 importFrom(shiny,conditionalPanel)
 importFrom(shiny,downloadButton)

diff --git a/NEWS b/NEWS
@@ -14,4 +14,8 @@ Changes in version 0.99.2
 Changes in version 0.99.3
 * Added tree import option
 * Fixed bugs with RDS and unifrac
-* Added clickable title box
+* Added clickable title box
+
+Changes in version 0.99.5
+* Implemented error check system
+* Added mia logo
diff --git a/R/miaDash.R b/R/miaDash.R
@@ -22,17 +22,21 @@
 #' @export
 #' @rdname miaDash
 #' @importFrom iSEE iSEE
+#' @importFrom shiny addResourcePath
 #' @importFrom utils packageVersion
 #' @importFrom htmltools tags
 miaDash <- function() {
-
+
+    addResourcePath("assets", system.file("assets", package = "miaDash"))
+
     iSEE(
         landingPage = .landing_page,
         appTitle = tags$div(
+            paste0("Microbiome Analysis Dashboard - v", packageVersion("miaDash")),
+            tags$img(src = "assets/mia_logo.png", height = "40px", style = "margin-left: 10px"),
             style = "cursor: pointer; font-weight: 500",
-            onclick = "window.location='https://miadash-microbiome.2.rahtiapp.fi/'", 
-            paste0("Microbiome Analysis Dashboard - v",
-                packageVersion("miaDash"), " \U0001f9a0"))
+            onclick = "window.location='https://miadash-microbiome.2.rahtiapp.fi/'") 
+
     )
 
 }

diff --git a/R/observers.R b/R/observers.R
@@ -63,7 +63,10 @@
                 fun_args <- list(assays = assay_list, colData = coldata,
                     rowData = rowdata, rowTree = row.tree, colTree = col.tree)
 
-                rObjects$tse <- .update_tse(TreeSummarizedExperiment, fun_args)
+                rObjects$tse <- .update_tse(
+                     rObjects$tse, TreeSummarizedExperiment, fun_args
+                )
+
             })
 
         }else if( input$format == "foreign" ){
@@ -72,14 +75,16 @@
                 req(input$main.file)
 
                 if( input$ftype == "biom" ){
-              
+
                     biom_object <- read_biom(input$main.file$datapath)
 
                     fun_args <- list(x = biom_object,
                         removeTaxaPrefixes = input$rm.tax.pref,
                         rankFromPrefix = input$rank.from.pref)
-
-                    rObjects$tse <- .update_tse(convertFromBIOM, fun_args)
+
+                    rObjects$tse <- .update_tse(
+                        rObjects$tse, convertFromBIOM, fun_args
+                    )
 
                 } else if( input$ftype == "MetaPhlAn" ){
 
@@ -91,7 +96,9 @@
                     fun_args <- list(file = input$main.file$datapath,
                         col.data = coldata, tree.file = treefile)
 
-                    rObjects$tse <- .update_tse(importMetaPhlAn, fun_args) 
+                    rObjects$tse <- .update_tse(
+                         rObjects$tse, importMetaPhlAn, fun_args
+                    ) 
 
                 }
 
@@ -129,7 +136,7 @@
                 fun_args <- list(x = rObjects$tse, assay.type = input$subassay,
                     prevalence = input$prevalence, detection = input$detection)
 
-                rObjects$tse <- .update_tse(subset_fun, fun_args)
+                rObjects$tse <- .update_tse(rObjects$tse, subset_fun, fun_args)
 
             })
 
@@ -140,7 +147,9 @@
             isolate({
 
                 fun_args <- list(x = rObjects$tse, rank = input$taxrank)
-                rObjects$tse <- .update_tse(agglomerateByRank, fun_args)
+                rObjects$tse <- .update_tse(
+                     rObjects$tse, agglomerateByRank, fun_args
+                )
 
             })
 
@@ -170,7 +179,9 @@
                     method = input$trans.method, assay.type = input$assay.type,
                     MARGIN = input$margin, pseudocount = input$pseudocount)
 
-                rObjects$tse <- .update_tse(transformAssay, fun_args)
+                rObjects$tse <- .update_tse(
+                     rObjects$tse, transformAssay, fun_args
+                )
 
             })
 
@@ -213,7 +224,7 @@
                 fun_args <- list(x = rObjects$tse, name = name,
                     assay.type = input$estimate.assay, index = input$alpha.index)
 
-                rObjects$tse <- .update_tse(addAlpha, fun_args)
+                rObjects$tse <- .update_tse(rObjects$tse, addAlpha, fun_args)
 
             })
 
@@ -274,11 +285,10 @@
                         formula = as.formula(input$rda.formula))
 
                 }
-                print(beta_args)
+
                 beta_fun <- eval(parse(text = paste0("run", input$bmethod)))
-                print(beta_fun)
-                rObjects$tse <- .update_tse(beta_fun, beta_args)
-
+
+                rObjects$tse <- .update_tse(rObjects$tse, beta_fun, beta_args)
             })
 
         }

diff --git a/R/utils.R b/R/utils.R
@@ -17,24 +17,25 @@
 
 #' @rdname utils
 #' @importFrom shiny showNotification
-.update_tse <- function(fun, fun_args) {
-
-    messages <- c()
-
-    withCallingHandlers({
-
-        tse <- do.call(fun, fun_args)
+.update_tse <- function(tse, fun, fun_args) {
+
+    tse <- tryCatch({withCallingHandlers({
+
+        do.call(fun, fun_args)
 
-    }, message = function(m) {
+        # nocov start
+        }, message = function(m) {
+
+            showNotification(conditionMessage(m))
+            invokeRestart("muffleMessage")
+
+        })}, error = function(e) {
 
-        messages <<- c(messages, conditionMessage(m))
-        invokeRestart("muffleMessage")
-
-    })
-
-    # nocov start
-    lapply(messages, showNotification)
-    # nocov end
+            .print_message(e, title = "Unexpected error:")
+            return(tse)
+
+        })
+        # nocov end
 
     return(tse)
 }

diff --git a/README.md b/README.md
@@ -1,4 +1,4 @@
-# miaDash
+# miaDash <img src="inst/assets/mia_logo.png" align="right" width="120" />
 
 [![issues](https://img.shields.io/github/issues/microbiome/miaDash)](https://github.com/microbiome/miaDash/issues)
 [![pulls](https://img.shields.io/github/issues-pr/microbiome/miaDash)](https://github.com/microbiome/miaDash/pulls)

diff --git a/inst/assets/mia_logo.png b/inst/assets/mia_logo.png
diff --git a/man/utils.Rd b/man/utils.Rd
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
@@ -8,8 +8,8 @@ test_that("utils", {
         data(package = "mia")$results[idx, "Item"])
 
     expect_no_error(
-        tse <- .update_tse(transformAssay, list(x = tse, assay.type = "counts",
-            method = "relabundance"))
+        tse <- .update_tse(tse, transformAssay,
+            list(x = tse, assay.type = "counts", method = "relabundance"))
     )
 
     item <- NULL