diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index e72c471..97bb98d 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -5,18 +5,15 @@ variables:
before_script:
- apk update
- apk --no-cache add py3-pip python3 curl
- - pip3 install pyyaml --break-system-packages
+ - python3 -m venv $HOME/.venv
+ - export PATH=$HOME/.venv/bin:$PATH
+ - pip3 install pyyaml
- curl -O https://raw.githubusercontent.com/FredHutch/swarm-build-helper/main/build_helper.py
# below is from https://stackoverflow.com/a/65810302/470769
- mkdir -p $HOME/.docker
- echo $DOCKER_AUTH_CONFIG > $HOME/.docker/config.json
- set -x
-stages:
- - build
- - test
- - deploy
-
stages:
- build
- test
@@ -27,7 +24,7 @@ build:
script: |
python3 build_helper.py docker-compose.yml --fluentd-logging > /dev/null
echo $DB_CONFIG | base64 -d > .my.cnf
- docker build \
+ docker build --no-cache \
-t sc-registry.fredhutch.org/shiny-cromwell:test \
--build-arg CI_COMMIT_BRANCH=${CI_COMMIT_BRANCH} \
--build-arg CI_COMMIT_SHA=${CI_COMMIT_SHA} \
@@ -54,6 +51,25 @@ test:
curl -sI http://shiny-cromwell:3838 | head -1 | grep -q "200 OK"
docker run -w /srv/shiny-server --rm sc-registry.fredhutch.org/shiny-cromwell:test R -q -e 'testthat::test_dir("tests")'
+deploy_review_image:
+ stage: deploy
+ except:
+ refs:
+ - main
+ - dev
+ script:
+ - docker tag sc-registry.fredhutch.org/shiny-cromwell:test nexus-registry.fredhutch.org/scicomp-nexus/${CI_PROJECT_NAME}:${CI_COMMIT_BRANCH}
+ - docker push nexus-registry.fredhutch.org/scicomp-nexus/${CI_PROJECT_NAME}:${CI_COMMIT_BRANCH}
+
+deploy_review_image:
+ stage: deploy
+ except:
+ refs:
+ - main
+ - dev
+ script:
+ - docker tag sc-registry.fredhutch.org/shiny-cromwell:test nexus-registry.fredhutch.org/scicomp-nexus/${CI_PROJECT_NAME}:${CI_COMMIT_BRANCH}
+ - docker push nexus-registry.fredhutch.org/scicomp-nexus/${CI_PROJECT_NAME}:${CI_COMMIT_BRANCH}
deploy_preview:
stage: deploy
diff --git a/Dockerfile b/Dockerfile
index 9df22f2..50154f5 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -1,14 +1,21 @@
FROM fredhutch/r-shiny-server-base:4.3.2
-RUN apt-get update -y && apt-get install -y libssh-dev
+RUN apt-get update -y && apt-get install -y libssh-dev python3-pip git libmariadb-dev
RUN R -q -e 'install.packages(c("ellipsis"), repos="https://cran.rstudio.com/")'
RUN R -q -e 'install.packages(c("shiny"), repos="https://cran.rstudio.com/")'
-RUN R -q -e 'install.packages(c("shinyFeedback", "shinyWidgets", "shinydashboard", "shinydashboardPlus", "ssh", "remotes", "markdown", "lubridate", "jsonlite", "dplyr", "DT", "glue", "httr", "purrr", "RColorBrewer", "rlang", "shinyBS", "shinyjs", "tidyverse", "uuid", "memoise", "rclipboard", "shinyvalidate", "shinylogs", "testhat"), repos="https://cran.r-project.org")'
+RUN R -q -e 'install.packages(c("shinyFeedback", "shinyWidgets", "shinydashboard", "shinydashboardPlus", "ssh", "remotes", "markdown", "lubridate", "jsonlite", "dplyr", "DT", "glue", "httr", "purrr", "RColorBrewer", "rlang", "shinyBS", "shinyjs", "tidyverse", "uuid", "memoise", "rclipboard", "shinyvalidate", "shinylogs", "testhat", "bsicons", "listviewer", "cookies", "RMariaDB", "DBI"), repos="https://cran.r-project.org")'
-RUN R -q -e "remotes::install_github('getwilds/proofr@v0.2')"
+RUN R -q -e "remotes::install_github('getwilds/proofr@v0.3.0')"
-RUN R -q -e "remotes::install_github('getwilds/rcromwell@v3.2.1')"
+RUN R -q -e "remotes::install_github('getwilds/rcromwell@v3.3.0')"
+
+ADD .my.cnf /root/
+
+# python wdl2mermaid setup:
+RUN pip install git+https://github.com/chanzuckerberg/miniwdl-viz.git
+
+RUN R -q -e "remotes::install_github('timelyportfolio/reactR')"
RUN rm -rf /srv/shiny-server/
COPY app/ /srv/shiny-server/
diff --git a/Makefile b/Makefile
index 0cc1453..4133ccb 100644
--- a/Makefile
+++ b/Makefile
@@ -1,6 +1,6 @@
RSCRIPT = Rscript --no-init-file
FILE_TARGET := "${FILE}"
-DEPS := $(shell ${RSCRIPT} -e 'invisible(lapply(c("glue", "cli"), require, character.only = TRUE, quiet = TRUE))' -e 'deps = renv::dependencies(quiet = TRUE)' -e 'uniq_pkgs = sort(unique(deps$$Package))' -e 'uniq_pkgs = uniq_pkgs[!grepl("^proofr$$|^rcromwell$$", uniq_pkgs)]' -e 'cat(c("getwilds/proofr@v0.2", "getwilds/rcromwell@v3.2.1", uniq_pkgs), file="deps.txt", sep="\n")')
+DEPS := $(shell ${RSCRIPT} -e 'invisible(lapply(c("glue", "cli"), require, character.only = TRUE, quiet = TRUE))' -e 'deps = renv::dependencies(quiet = TRUE)' -e 'uniq_pkgs = sort(unique(deps$$Package))' -e 'uniq_pkgs = uniq_pkgs[!grepl("^proofr$$|^rcromwell$$", uniq_pkgs)]' -e 'cat(c("getwilds/proofr@v0.3.0", "getwilds/rcromwell@v3.3.0", uniq_pkgs), file="deps.txt", sep="\n")')
run:
${RSCRIPT} -e "options(shiny.autoreload = TRUE)" \
@@ -10,6 +10,11 @@ run_docker:
docker build --platform linux/amd64 -t shiny-cromwell:app .
docker run --rm -it -p 3838:3838 shiny-cromwell:app
+# use: `make branch=inputs-viewer run_branch`
+run_branch:
+ docker pull nexus-registry.fredhutch.org/scicomp-nexus/shiny-cromwell:$(branch)
+ docker run --rm -it -p 3838:3838 nexus-registry.fredhutch.org/scicomp-nexus/shiny-cromwell:$(branch)
+
# use: `make style_file FILE=stuff.R`
# accepts 1 file only
style_file:
diff --git a/README.md b/README.md
index 160bf0f..2998a56 100644
--- a/README.md
+++ b/README.md
@@ -15,7 +15,7 @@ You can run this Shiny app locally. First you'll need to install required packag
(note: run `make pkg_deps_cmd` to update the below code block)
```r
-pak::pak(c("getwilds/proofr@v0.2", "getwilds/rcromwell@v3.2.1", "dplyr", "DT", "ggplot2", "glue", "httr", "jsonlite", "lubridate", "magrittr", "memoise", "purrr", "rclipboard", "RColorBrewer", "rlang", "shiny", "shinyBS", "shinydashboard", "shinydashboardPlus", "shinyFeedback", "shinyjs", "shinylogs", "shinyvalidate", "shinyWidgets", "testthat", "tibble", "uuid"))
+pak::pak(c("getwilds/proofr@v0.3.0", "getwilds/rcromwell@v3.3.0", "dplyr", "DT", "ggplot2", "glue", "httr", "jsonlite", "lubridate", "magrittr", "memoise", "purrr", "rclipboard", "RColorBrewer", "rlang", "shiny", "shinyBS", "shinydashboard", "shinydashboardPlus", "shinyFeedback", "shinyjs", "shinylogs", "shinyvalidate", "shinyWidgets", "testthat", "tibble", "uuid"))
```
And the above yourself in R.
@@ -38,6 +38,20 @@ Note that CTRL+C doesn't work to kill the container after running `make run_dock
Also note that docker commands can be specific to the host operating system, so if you run into errors you may need to modify the docker commands.
+#### Run a feature branch locally
+
+The make command `make run_branch` will run a remote branch locally on your machine. Whereas `make run_docker` runs the current branch you're on, `make run_branch` pulls down a docker image of the remote branch specified and runs that.
+
+Make sure to run `docker login nexus-registry.fredhutch.org` before you try this make command. You only need to run this once.
+Contact `scicomp` to get the username and password for this step.
+
+A full example: `make branch=inputs-viewer run_branch`
+
+Note that the branch specification has to be before the target name (`run_branch`).
+
+You must be on FH campus or be on a VPN to use this make command.
+
+
### Debugging
- Use print statements as needed ...
diff --git a/app/cookies-db.R b/app/cookies-db.R
new file mode 100644
index 0000000..df3d267
--- /dev/null
+++ b/app/cookies-db.R
@@ -0,0 +1,67 @@
+library(RMariaDB)
+library(DBI)
+
+COOKIE_EXPIRY_DAYS <- 14
+
+to_base64 <- function(x) {
+ base64enc::base64encode(charToRaw(x))
+}
+from_base64 <- function(x) {
+ rawToChar(base64enc::base64decode(x))
+}
+
+db <- dbConnect(RMariaDB::MariaDB(), group = "shinycromwell")
+if (!dbExistsTable(db, "users")) {
+ db_columns <- c(
+ user = "TEXT",
+ proof_token = "TEXT",
+ cromwell_url = "TEXT",
+ login_time = "TEXT"
+ )
+ dbCreateTable(db, "users", db_columns)
+}
+dbDisconnect(db)
+
+make_db_con <- function() {
+ dbConnect(RMariaDB::MariaDB(), group = "shinycromwell")
+}
+
+user_from_db <- function(user, conn = make_db_con(), expiry = COOKIE_EXPIRY_DAYS) {
+ on.exit(dbDisconnect(conn))
+ dbReadTable(conn, "users") %>%
+ as_tibble() %>%
+ filter(
+ # !! needed to get the value of the variable
+ user == !!user,
+ login_time > now() - days(expiry)
+ ) %>%
+ arrange(desc(login_time))
+}
+user_to_db <- function(user, token, url, drop_existing = FALSE, conn = make_db_con()) {
+ on.exit(dbDisconnect(conn))
+ # drop before inserting so we only have 1 row/user
+ if (drop_existing) {
+ # don't drop if user is empty
+ if (nzchar(user)) {
+ # don't disconnect from within drop fun
+ user_drop_from_db(user, disconnect = FALSE, conn = conn)
+ }
+ }
+ tibble(
+ user = user,
+ proof_token = token,
+ cromwell_url = url,
+ login_time = as.character(now())
+ ) %>%
+ dbWriteTable(conn, "users", ., append = TRUE)
+}
+user_drop_from_db <- function(user, disconnect = TRUE, conn = make_db_con()) {
+ if (disconnect) {
+ on.exit(dbDisconnect(conn))
+ }
+ sql_delete <- glue::glue_sql("
+ DELETE from users
+ WHERE user = {user}
+ ", .con = conn)
+ dbExecute(conn, sql_delete)
+}
diff --git a/app/server.R b/app/server.R
index 2cc8b69..58d439c 100644
--- a/app/server.R
+++ b/app/server.R
@@ -28,6 +28,9 @@ library(rcromwell)
library(rclipboard)
+library(cookies)
+library(listviewer)
+
source("sidebar.R")
source("modals.R")
source("proof.R")
@@ -37,6 +40,7 @@ source("tab-servers.R")
source("tab-welcome.R")
source("validators.R")
source("inputs_utils.R")
+source("cookies-db.R")
SANITIZE_ERRORS <- FALSE
PROOF_TIMEOUT <- 20
@@ -66,7 +70,7 @@ server <- function(input, output, session) {
')
})
- rv <- reactiveValues(token = "", url = "", validateFilepath="", own = FALSE)
+ rv <- reactiveValues(token = "", url = "", validateFilepath="", own = FALSE, user = "")
rv_file <- reactiveValues(
validatewdlFile_state = NULL,
@@ -84,8 +88,29 @@ server <- function(input, output, session) {
showModal(loginModal())
})
+ observeEvent(cookies::get_cookie("user"), {
+ rv$user <- cookies::get_cookie("user")
+ # print(glue("in observeEvent(cookies::get_cookie(user) -----> {rv$user}"))
+ if (!is.null(rv$user)) {
+ user_df <- user_from_db(rv$user) %>% top_n(1)
+ if (nrow(user_df)) {
+ # print(user_df)
+ rv$url <- from_base64(user_df$cromwell_url)
+ rv$token <- from_base64(user_df$proof_token)
+ } else {
+ # force reload b/c no data from the user in the DB, so need to re-login
+ # cookies::remove_cookie("user")
+ # session$reload()
+ }
+ }
+ })
+
output$userName <- renderText({
- input$username
+ if (is.null(input$username)) {
+ rv$user
+ } else {
+ input$username
+ }
})
observe({
@@ -125,6 +150,8 @@ server <- function(input, output, session) {
showModal(loginModal(failed = TRUE, error = try_auth$message))
} else {
rv$token <- try_auth
+ rv$user <- input$username
+
cromwell_up <- tryCatch(
proof_status(token = rv$token)$jobStatus,
error = function(e) e
@@ -135,6 +162,22 @@ server <- function(input, output, session) {
rv$url <- proof_wait_for_up(rv$token)
}
}
+
+ user_to_db(
+ user = rv$user,
+ token = to_base64(rv$token),
+ url = to_base64(rv$url),
+ drop_existing = TRUE
+ )
+
+ cookies::set_cookie(
+ cookie_name = "user",
+ cookie_value = rv$user,
+ expiration = COOKIE_EXPIRY_DAYS,
+ secure_only = TRUE,
+ same_site = "strict"
+ )
+
removeModal()
}
} else {
@@ -194,6 +237,8 @@ server <- function(input, output, session) {
# Handle logout for both buttons
observeEvent(input$proofAuthLogout, {
+ user_drop_from_db(rv$user)
+ cookies::remove_cookie("user")
session$reload()
})
@@ -540,8 +585,27 @@ server <- function(input, output, session) {
)
)
- # reorder columns
- workflowDat <- dplyr::relocate(workflowDat, copyId, .after = workflow_id)
+ # Add go to WDL viewer button
+ workflowDat <- workflowDat %>%
+ rowwise() %>%
+ mutate(
+ wdl = make_wdlbtn(workflow_id)
+ ) %>%
+ ungroup()
+
+ # Add workflow labels
+ ## Get labels data
+ labels_df <- lapply(workflowDat$workflow_id, \(x) {
+ as_tibble_row(cromwell_labels(x, url = rv$url, token = rv$token)) %>%
+ mutate(workflow_id = sub("cromwell-", "", workflow_id))
+ }) %>%
+ bind_rows()
+ workflowDat <- left_join(workflowDat, labels_df, by = "workflow_id")
+ ## Then reorder columns
+ workflowDat <- dplyr::relocate(workflowDat, wdl, .after = workflow_id)
+ workflowDat <- dplyr::relocate(workflowDat, copyId, .after = wdl)
+ workflowDat <- dplyr::relocate(workflowDat, Label, .after = copyId)
+ workflowDat <- dplyr::relocate(workflowDat, secondaryLabel, .after = Label)
}
} else {
workflowDat <- data.frame(
@@ -556,6 +620,24 @@ server <- function(input, output, session) {
ignoreNULL = TRUE
)
+ observeEvent(input$wdlview_btn, {
+ mermaid_file <- wdl_to_file(
+ workflow_id = strsplit(input$wdlview_btn, "_")[[1]][2],
+ url = rv$url,
+ token = rv$token
+ )
+ mermaid_str <- wdl2mermaid(mermaid_file)
+ output$mermaid_diagram <- renderUI({
+ mermaid_container(mermaid_str)
+ })
+ updateTabItems(session, "tabs", "wdl")
+ })
+
+ ### go back to tracking tab from wdl tab
+ observeEvent(input$linkToTrackingTab, {
+ updateTabsetPanel(session, "tabs", "tracking")
+ })
+
callDurationUpdate <- eventReactive(input$trackingUpdate,
{
stop_safe_loggedin_serverup(rv$url, rv$token, rv$own)
@@ -716,20 +798,39 @@ server <- function(input, output, session) {
workflowInputs <- eventReactive(input$joblistCromwell_rows_selected, {
print("find inputs")
data <- workflowUpdate()
+
FOCUS_ID <- data[input$joblistCromwell_rows_selected, ]$workflow_id
- as.data.frame(jsonlite::fromJSON(
- cromwell_workflow(FOCUS_ID,
- url = rv$url,
- token = rv$token
- )$inputs
- ))
+ output$currentWorkflowId <- renderText({
+ paste("Workflow ID: ", FOCUS_ID)
+ })
+
+ cromwell_workflow(FOCUS_ID,
+ url = rv$url,
+ token = rv$token
+ )$inputs
})
- output$workflowInp <- renderDT(
- data <- workflowInputs(),
- class = "compact",
- filter = "top",
- options = list(scrollX = TRUE), selection = "single", rownames = FALSE
- )
+ ### inputs json javascript viewer
+ output$workflowInp <- renderReactjson({
+ reactjson(workflowInputs())
+ })
+ ### edit json viewer
+ observeEvent(input$workflowInp_edit, {
+ str(input$workflowInp_edit, max.level=2)
+ })
+ ### go to viewer tab when clicked from Tracking tab
+ observeEvent(input$linkToViewerTab, {
+ updateTabItems(session, "tabs", "viewer")
+ })
+ ### go back to tracking tab from viewer tab
+ observeEvent(input$linkToTrackingTab, {
+ updateTabsetPanel(session, "tabs", "tracking")
+ })
+ ### set workflow id display in viewer tab back to none
+ ### when nothing selected in the Workflows Run table
+ observeEvent(input$joblistCromwell_rows_selected, {
+ output$currentWorkflowId <- renderText({"Workflow ID: "})
+ }, ignoreNULL = FALSE)
+
## Render a list of jobs in a table for a workflow
output$joblistCromwell <- renderDT({
datatable(
diff --git a/app/sidebar.R b/app/sidebar.R
index 9f63023..562298b 100644
--- a/app/sidebar.R
+++ b/app/sidebar.R
@@ -23,6 +23,14 @@ menu_item_trouble <- menuItem("Troubleshoot",
tabName = "troubleshoot", icon = icon("wrench"),
badgeLabel = "troubleshoot", badgeColor = "red"
)
+menu_item_viewer <- menuItem("Viewer",
+ tabName = "viewer", icon = icon("wrench"),
+ badgeLabel = "viewer", badgeColor = "purple"
+)
+menu_item_wdl <- menuItem("WDL",
+ tabName = "wdl", icon = icon("wrench"),
+ badgeLabel = "wdl", badgeColor = "light-blue"
+)
proofSidebar <- function() {
sidebarMenu(
@@ -32,7 +40,9 @@ proofSidebar <- function() {
menu_item_validate,
menu_item_submit,
menu_item_track,
- menu_item_trouble
+ menu_item_trouble,
+ menu_item_viewer,
+ menu_item_wdl
)
}
@@ -43,6 +53,8 @@ nonProofSidebar <- function() {
menu_item_validate,
menu_item_submit,
menu_item_track,
- menu_item_trouble
+ menu_item_trouble,
+ menu_item_viewer,
+ menu_item_wdl
)
}
diff --git a/app/tab-tracking.R b/app/tab-tracking.R
index e8f66e4..60e8be8 100644
--- a/app/tab-tracking.R
+++ b/app/tab-tracking.R
@@ -1,4 +1,5 @@
source("ui_components.R")
+library(bsicons)
tab_tracking <- tabItem(
tabName = "tracking",
@@ -84,12 +85,15 @@ tab_tracking <- tabItem(
box(
width = 6,
title = "Workflow Options",
+ actionButton(inputId = "wdlview",
+ label = bsicons::bs_icon("search"),
+ class = "btn-sm"),
DTOutput("workflowOpt")
),
box(
width = 6,
title = "Workflow Inputs",
- DTOutput("workflowInp")
+ actionButton("linkToViewerTab", "View list")
)
),
fluidRow(
diff --git a/app/tab-viewer.R b/app/tab-viewer.R
new file mode 100644
index 0000000..e3c1f48
--- /dev/null
+++ b/app/tab-viewer.R
@@ -0,0 +1,16 @@
+library(listviewer)
+
+tab_viewer <- tabItem(
+ tabName = "viewer",
+ fluidRow(
+ box(
+ title = "View Workflow Inputs",
+ width = 12,
+ textOutput("currentWorkflowId"),
+ p(""),
+ actionButton("linkToTrackingTab", "Back to Track Jobs Tab"),
+ p(""),
+ reactjsonOutput("workflowInp", height = "100%")
+ )
+ )
+)
diff --git a/app/tab-wdl.R b/app/tab-wdl.R
new file mode 100644
index 0000000..88b968b
--- /dev/null
+++ b/app/tab-wdl.R
@@ -0,0 +1,7 @@
+tab_wdl <- tabItem(
+ tabName = "wdl",
+ fluidPage(
+ actionButton("linkToTrackingTab", "Back to Track Jobs Tab"),
+ uiOutput("mermaid_diagram")
+ )
+)
diff --git a/app/ui.R b/app/ui.R
index cd14f8d..936537c 100644
--- a/app/ui.R
+++ b/app/ui.R
@@ -13,6 +13,8 @@ library(lubridate)
library(rclipboard)
+library(cookies)
+
source("ui_components.R")
source("tab-welcome.R")
source("tab-servers.R")
@@ -20,39 +22,48 @@ source("tab-validate.R")
source("tab-submission.R")
source("tab-tracking.R")
source("tab-troubleshoot.R")
+source("tab-viewer.R")
+source("tab-wdl.R")
source("sidebar.R")
-ui <- dashboardPage(
- skin = "black",
- dashboardHeader(
- title = tagList(
- span(class = "logo-lg", h4(HTML("Fred Hutch
PROOF Dashboard"))),
- img(src = "fred-hutch.svg")
+ui <- cookies::add_cookie_handlers(
+ dashboardPage(
+ skin = "black",
+ dashboardHeader(
+ title = tagList(
+ span(class = "logo-lg", h4(HTML("Fred Hutch
PROOF Dashboard"))),
+ img(src = "fred-hutch.svg")
+ ),
+ dropdown_user_name,
+ dropdown_own_cromwell,
+ dropdown_loginout,
+ dropdown_help,
+ dropdown_src
+ ),
+ dashboardSidebar(
+ sidebarMenuOutput("uiSideBar")
),
- dropdown_user_name,
- dropdown_own_cromwell,
- dropdown_loginout,
- dropdown_help,
- dropdown_src
- ),
- dashboardSidebar(
- sidebarMenuOutput("uiSideBar")
- ),
- dashboardBody(
- tags$head(tags$title("PROOF")),
- tags$script("document.title = 'PROOF';"),
- shinyjs::useShinyjs(),
- rclipboard::rclipboardSetup(),
- enter_to_click,
- tooltip_style,
- google_analytics,
- tabItems(
- tab_welcome,
- tab_servers,
- tab_validate,
- tab_submission,
- tab_tracking,
- tab_troublehsoot
+ dashboardBody(
+ tags$head(tags$title("PROOF")),
+ tags$script("document.title = 'PROOF';"),
+ shinyjs::useShinyjs(),
+ rclipboard::rclipboardSetup(),
+ tags$head(
+ tags$script(src = "https://cdn.jsdelivr.net/npm/mermaid@10.9.1/dist/mermaid.min.js")
+ ),
+ enter_to_click,
+ tooltip_style,
+ google_analytics,
+ tabItems(
+ tab_welcome,
+ tab_servers,
+ tab_validate,
+ tab_submission,
+ tab_tracking,
+ tab_troublehsoot,
+ tab_viewer,
+ tab_wdl
+ )
)
)
-)
+)
\ No newline at end of file
diff --git a/app/ui_components.R b/app/ui_components.R
index 04af4d6..0bfcc81 100644
--- a/app/ui_components.R
+++ b/app/ui_components.R
@@ -1,15 +1,15 @@
help_html <- helpText(
- HTML('Need Help?:
+ HTML('Need Help?
- Problem? Bug? Send an email to scicomp@fredhutch.org
+ Problem? Bug? Open an issue
Discussion/Questions
- Slack #workflow-managers channel
+ Slack #workflow-managers channel
- Email wilds@fredhutch.org
+ Email wilds@fredhutch.org
') diff --git a/app/utils.R b/app/utils.R index 790f430..2f762fb 100644 --- a/app/utils.R +++ b/app/utils.R @@ -1,4 +1,5 @@ library(memoise) +library(bsicons) # coerce dates to PT from UTC as_pt <- function(x) { @@ -66,7 +67,49 @@ make_copybtn <- function(x, clip_prefix, tooltip) { ) } +make_wdlbtn <- function(workflow_id) { + as.character( + actionButton( + inputId = glue("wdlview_{workflow_id}"), + label = bsicons::bs_icon("search"), + class = "btn-sm", + onclick = 'Shiny.setInputValue(\"wdlview_btn\", this.id, {priority: \"event\"})' + ) + ) +} + abbreviate <- function(x, last = 100) { if (nchar(x) < 100) return(x) paste0(substring(x, 1, last), " ...") } + +wdl_to_file <- function(workflow_id, url, token) { + glob <- cromwell_glob(workflow_id, url = url, token = token) + wdl_str <- glob$submittedFiles$workflow + tfile <- tempfile(pattern = "wdlize_wdl", fileext = ".wdl") + cat(wdl_str, "\n", file = tfile) + return(tfile) +} + +wdl2mermaid <- function(wdlFileName) { + outfile <- tempfile(pattern = "wdl2mermaid", fileext = ".mermaid") + system2( + "wdl_to_mermaid", + args = c(shQuote(wdlFileName), "--print-flowchart"), + stdout = outfile + ) + ret <- readLines(outfile) + unlink(outfile) + paste(ret, collapse = "\n") +} + +mermaid_container <- function(code) { + tags$div( + id = "mermaid-container", + tags$div(id = "mermaid-diagram", `class` = "mermaid", width = "auto", height = "auto", HTML(code)), + tags$script(HTML(" + mermaid.initialize({ startOnLoad: true }); + mermaid.init(undefined, '#mermaid-diagram'); + ")) + ) +}