shiny app moved to app folder and seperate files for possible shinylive deploy

DESCRIPTION

@@ -37,7 +37,8 @@ Suggests:
     styler,
     devtools,
     roxygen2,
-    openxlsx2
+    openxlsx2,
+    rsconnect
 License: GPL (>= 3)
 Encoding: UTF-8
 LazyData: true

R/shiny_cast.R

@@ -3,114 +3,9 @@
 #' @return shiny server
 #' @export
 server_factory <- function() {
-  function(input, output, session) {
+  source(here::here("app/server.R"))
-    require(REDCapCAST)
+  server
-
-
-    ## Trial and error testing
-    # dat <- read_input(file = here::here("data/mtcars_redcap.csv"))
-    #
-    # dd <- ds2dd_detailed(data = dat)
-    #
-    # write.csv(purrr::pluck(dd, "meta"),file = "dd_test.csv",row.names = FALSE,na = "")
-    #
-    # View(as.data.frame(purrr::pluck(dd, "meta")))
-    #
-    # REDCapR::redcap_metadata_write(
-    #   ds = as.data.frame(purrr::pluck(dd, "meta")),
-    #   redcap_uri = "https://redcap.au.dk/api/",
-    #   token = "21CF2C17EA1CA4F3688DF991C8FE3EBF"
-    # )
-    #
-    # REDCapR::redcap_write(
-    #   ds = as.data.frame(purrr::pluck(dd, "data")),
-    #   redcap_uri = "https://redcap.au.dk/api/",
-    #   token = "21CF2C17EA1CA4F3688DF991C8FE3EBF"
-    # )
-
-    dat <- shiny::reactive({
-      shiny::req(input$ds)
-
-      read_input(input$ds$datapath)
-    })
-
-    dd <- shiny::reactive({
-      ds2dd_detailed(data = dat())
-    })
-
-
-    output$data.tbl <- shiny::renderTable({
-      dd() |>
-        purrr::pluck("data") |>
-        head(20) |>
-        dplyr::tibble()
-    })
-
-    output$meta.tbl <- shiny::renderTable({
-      dd() |>
-        purrr::pluck("meta") |>
-        dplyr::tibble()
-    })
-
-    # Downloadable csv of dataset ----
-    output$downloadData <- shiny::downloadHandler(
-      filename = "data_ready.csv",
-      content = function(file) {
-        write.csv(purrr::pluck(dd(), "data"), file, row.names = FALSE)
 }
-    )
-
-    # Downloadable csv of data dictionary ----
-    output$downloadMeta <- shiny::downloadHandler(
-      filename = "dictionary_ready.csv",
-      content = function(file) {
-        write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE)
-      }
-    )
-
-    output_staging <- shiny::reactiveValues()
-    output_staging$meta <- output_staging$data <- NA
-
-    shiny::observeEvent(input$upload.meta,{  upload_meta()  })
-
-    shiny::observeEvent(input$upload.data,{  upload_data()  })
-
-    upload_meta <- function(){
-      # output_staging$title <- paste0("random number ",runif(1))
-
-      shiny::req(input$uri)
-
-      shiny::req(input$api)
-
-      output_staging$meta <- REDCapR::redcap_metadata_write(
-        ds = purrr::pluck(dd(), "meta"),
-        redcap_uri = input$uri,
-        token = input$api
-      )|> purrr::pluck("success")
-    }
-
-    upload_data <- function(){
-      # output_staging$title <- paste0("random number ",runif(1))
-
-      shiny::req(input$uri)
-
-      shiny::req(input$api)
-
-      output_staging$data <- REDCapR::redcap_write(
-        ds = purrr::pluck(dd(), "data"),
-        redcap_uri = input$uri,
-        token = input$api
-      ) |> purrr::pluck("success")
-    }
-
-    output$upload.meta.print <- renderText(output_staging$meta)
-
-    output$upload.data.print <- renderText(output_staging$data)
-
-  }
-}
-
-
 
 #' UI factory for shiny app
 #'
@@ -118,96 +13,8 @@ server_factory <- function() {
 #' @export
 ui_factory <- function() {
   # require(ggplot2)
+source(here::here("app/ui.R"))
 
-  shiny::fluidPage(
-
-    ## -----------------------------------------------------------------------------
-    ## Application title
-    ## -----------------------------------------------------------------------------
-    shiny::titlePanel("Simple REDCap data base creation and data upload from data set file via API",
-      windowTitle = "REDCap databse creator"
-    ),
-    shiny::h5("Please note, that this tool serves as a demonstration of some of the functionality
-       of the REDCapCAST package. No responsibility for data loss or any other
-       problems will be taken."),
-
-    ## -----------------------------------------------------------------------------
-    ## Side panel
-    ## -----------------------------------------------------------------------------
-
-    shiny::sidebarPanel(
-      shiny::h4("REDCap database and dataset"),
-      shiny::fileInput("ds", "Choose data file",
-        multiple = FALSE,
-        accept = c(
-          ".csv",
-          ".xls",
-          ".xlsx",
-          ".dta"
-        )
-      ),
-      shiny::h6("Below you can download the dataset formatted for upload and the
-         corresponding data dictionary for a new data base."),
-      # Button
-      shiny::downloadButton("downloadData", "Download data"),
-
-      # Button
-      shiny::downloadButton("downloadMeta", "Download dictionary"),
-
-
-      # Horizontal line ----
-      shiny::tags$hr(),
-      shiny::h4("REDCap upload"),
-      shiny::textInput(
-        inputId = "uri",
-        label = "URI",
-        value = "https://redcap.au.dk/api/"
-      ),
-      shiny::textInput(
-        inputId = "api",
-        label = "API key",
-        value = "21CF2C17EA1CA4F3688DF991C8FE3EBF"
-      ),
-      shiny::actionButton(
-        inputId = "upload.meta",
-        label = "Upload dictionary", icon = shiny::icon("book-bookmark")
-      ),
-      shiny::h6("Please note, that before uploading any real data, put your project
-         into production mode."),
-      shiny::actionButton(
-        inputId = "upload.data",
-        label = "Upload data", icon = shiny::icon("upload")
-      ),
-
-      # Horizontal line ----
-      shiny::tags$hr()
-    ),
-    shiny::mainPanel(
-      shiny::tabsetPanel(
-
-        ## -----------------------------------------------------------------------------
-        ## Summary tab
-        ## -----------------------------------------------------------------------------
-        shiny::tabPanel(
-          "Summary",
-          shiny::h3("Data overview (first 20)"),
-          shiny::htmlOutput("data.tbl", container = shiny::span),
-          shiny::h3("Dictionary overview"),
-          shiny::htmlOutput("meta.tbl", container = shiny::span)
-        ),
-        ## -----------------------------------------------------------------------------
-        ## Upload tab
-        ## -----------------------------------------------------------------------------
-        shiny::tabPanel(
-          "Upload",
-          shiny::h3("Meta upload overview"),
-          shiny::htmlOutput("upload.meta.print", container = shiny::span),
-          shiny::h3("Data upload overview"),
-          shiny::htmlOutput("upload.data.print", container = shiny::span)
-        )
-      )
-    )
-  )
 }
 
 #' Launch the included Shiny-app for database casting and upload
@@ -227,6 +34,25 @@ shiny_cast <- function() {
   )
 }
 
-shiny_cast()
+#' Deploy the Shiny app with rsconnect
-# ds <- REDCapR::redcap_metadata_read(redcap_uri = "https://redcap.au.dk/api/",
+#'
-#                                     token = "21CF2C17EA1CA4F3688DF991C8FE3EBF")
+#' @return deploy
+#' @export
+#'
+#' @examples
+#' # deploy_shiny
+#'
+deploy_shiny <- function(path=here::here("app/"), name.app="shiny_cast"){
+  # Ensure to install latest package version
+  renv::install("agdamsbo/REDCapCAST")
+
+  # Connecting
+  rsconnect::setAccountInfo(
+    name = "cognitiveindex",
+    token = keyring::key_get(service = "rsconnect_cognitiveindex_token"),
+    secret = keyring::key_get(service = "rsconnect_cognitiveindex_secret")
+  )
+
+  # Deploying
+  rsconnect::deployApp(appDir = path,lint = TRUE,appName = name.app,)
+}

app/server.R

@@ -0,0 +1,81 @@
+server <- function(input, output, session) {
+  require(REDCapCAST)
+
+  dat <- shiny::reactive({
+    shiny::req(input$ds)
+
+    read_input(input$ds$datapath)
+  })
+
+  dd <- shiny::reactive({
+    ds2dd_detailed(data = dat())
+  })
+
+
+  output$data.tbl <- shiny::renderTable({
+    dd() |>
+      purrr::pluck("data") |>
+      head(20) |>
+      dplyr::tibble()
+  })
+
+  output$meta.tbl <- shiny::renderTable({
+    dd() |>
+      purrr::pluck("meta") |>
+      dplyr::tibble()
+  })
+
+  # Downloadable csv of dataset ----
+  output$downloadData <- shiny::downloadHandler(
+    filename = "data_ready.csv",
+    content = function(file) {
+      write.csv(purrr::pluck(dd(), "data"), file, row.names = FALSE)
+    }
+  )
+
+  # Downloadable csv of data dictionary ----
+  output$downloadMeta <- shiny::downloadHandler(
+    filename = "dictionary_ready.csv",
+    content = function(file) {
+      write.csv(purrr::pluck(dd(), "meta"), file, row.names = FALSE)
+    }
+  )
+
+  output_staging <- shiny::reactiveValues()
+  output_staging$meta <- output_staging$data <- NA
+
+  shiny::observeEvent(input$upload.meta,{  upload_meta()  })
+
+  shiny::observeEvent(input$upload.data,{  upload_data()  })
+
+  upload_meta <- function(){
+
+    shiny::req(input$uri)
+
+    shiny::req(input$api)
+
+    output_staging$meta <- REDCapR::redcap_metadata_write(
+      ds = purrr::pluck(dd(), "meta"),
+      redcap_uri = input$uri,
+      token = input$api
+    )|> purrr::pluck("success")
+  }
+
+  upload_data <- function(){
+
+    shiny::req(input$uri)
+
+    shiny::req(input$api)
+
+    output_staging$data <- REDCapR::redcap_write(
+      ds = purrr::pluck(dd(), "data"),
+      redcap_uri = input$uri,
+      token = input$api
+    ) |> purrr::pluck("success")
+  }
+
+  output$upload.meta.print <- renderText(output_staging$meta)
+
+  output$upload.data.print <- renderText(output_staging$data)
+
+}

app/ui.R

@@ -0,0 +1,89 @@
+ui <- shiny::fluidPage(
+
+  ## -----------------------------------------------------------------------------
+  ## Application title
+  ## -----------------------------------------------------------------------------
+  shiny::titlePanel("Simple REDCap data base creation and data upload from data set file via API",
+                    windowTitle = "REDCap databse creator"
+  ),
+  shiny::h5("Please note, that this tool serves as a demonstration of some of the functionality
+       of the REDCapCAST package. No responsibility for data loss or any other
+       problems will be taken."),
+
+  ## -----------------------------------------------------------------------------
+  ## Side panel
+  ## -----------------------------------------------------------------------------
+
+  shiny::sidebarPanel(
+    shiny::h4("REDCap database and dataset"),
+    shiny::fileInput("ds", "Choose data file",
+                     multiple = FALSE,
+                     accept = c(
+                       ".csv",
+                       ".xls",
+                       ".xlsx",
+                       ".dta"
+                     )
+    ),
+    shiny::h6("Below you can download the dataset formatted for upload and the
+         corresponding data dictionary for a new data base."),
+    # Button
+    shiny::downloadButton("downloadData", "Download data"),
+
+    # Button
+    shiny::downloadButton("downloadMeta", "Download dictionary"),
+
+
+    # Horizontal line ----
+    shiny::tags$hr(),
+    shiny::h4("REDCap upload"),
+    shiny::textInput(
+      inputId = "uri",
+      label = "URI",
+      value = "https://redcap.au.dk/api/"
+    ),
+    shiny::textInput(
+      inputId = "api",
+      label = "API key",
+      value = "21CF2C17EA1CA4F3688DF991C8FE3EBF"
+    ),
+    shiny::actionButton(
+      inputId = "upload.meta",
+      label = "Upload dictionary", icon = shiny::icon("book-bookmark")
+    ),
+    shiny::h6("Please note, that before uploading any real data, put your project
+         into production mode."),
+    shiny::actionButton(
+      inputId = "upload.data",
+      label = "Upload data", icon = shiny::icon("upload")
+    ),
+
+    # Horizontal line ----
+    shiny::tags$hr()
+  ),
+  shiny::mainPanel(
+    shiny::tabsetPanel(
+
+      ## -----------------------------------------------------------------------------
+      ## Summary tab
+      ## -----------------------------------------------------------------------------
+      shiny::tabPanel(
+        "Summary",
+        shiny::h3("Data overview (first 20)"),
+        shiny::htmlOutput("data.tbl", container = shiny::span),
+        shiny::h3("Dictionary overview"),
+        shiny::htmlOutput("meta.tbl", container = shiny::span)
+      ),
+      ## -----------------------------------------------------------------------------
+      ## Upload tab
+      ## -----------------------------------------------------------------------------
+      shiny::tabPanel(
+        "Upload",
+        shiny::h3("Meta upload overview"),
+        shiny::htmlOutput("upload.meta.print", container = shiny::span),
+        shiny::h3("Data upload overview"),
+        shiny::htmlOutput("upload.data.print", container = shiny::span)
+      )
+    )
+  )
+)

renv.lock

@@ -428,13 +428,13 @@
     },
     "renv": {
       "Package": "renv",
-      "Version": "1.0.3",
+      "Version": "1.0.4",
       "Source": "Repository",
       "Repository": "CRAN",
       "Requirements": [
         "utils"
       ],
-      "Hash": "41b847654f567341725473431dd0d5ab"
+      "Hash": "11abaf7c540ff33f94514d50f929bfd1"
     },
     "rlang": {
       "Package": "rlang",

renv/activate.R

@@ -2,7 +2,7 @@
 local({
 
   # the requested version of renv
-  version <- "1.0.3"
+  version <- "1.0.4"
   attr(version, "sha") <- NULL
 
   # the project directory
@@ -31,6 +31,14 @@ local({
     if (!is.null(override))
       return(override)
 
+    # if we're being run in a context where R_LIBS is already set,
+    # don't load -- presumably we're being run as a sub-process and
+    # the parent process has already set up library paths for us
+    rcmd <- Sys.getenv("R_CMD", unset = NA)
+    rlibs <- Sys.getenv("R_LIBS", unset = NA)
+    if (!is.na(rlibs) && !is.na(rcmd))
+      return(FALSE)
+
     # next, check environment variables
     # TODO: prefer using the configuration one in the future
     envvars <- c(
@@ -50,9 +58,22 @@ local({
 
   })
 
-  if (!enabled)
+  # bail if we're not enabled
+  if (!enabled) {
+
+    # if we're not enabled, we might still need to manually load
+    # the user profile here
+    profile <- Sys.getenv("R_PROFILE_USER", unset = "~/.Rprofile")
+    if (file.exists(profile)) {
+      cfg <- Sys.getenv("RENV_CONFIG_USER_PROFILE", unset = "TRUE")
+      if (tolower(cfg) %in% c("true", "t", "1"))
+        sys.source(profile, envir = globalenv())
+    }
+
     return(FALSE)
 
+  }
+
   # avoid recursion
   if (identical(getOption("renv.autoloader.running"), TRUE)) {
     warning("ignoring recursive attempt to run renv autoloader")
@@ -1041,7 +1062,7 @@ local({
     # if jsonlite is loaded, use that instead
     if ("jsonlite" %in% loadedNamespaces()) {
   
-      json <- catch(renv_json_read_jsonlite(file, text))
+      json <- tryCatch(renv_json_read_jsonlite(file, text), error = identity)
       if (!inherits(json, "error"))
         return(json)
   
@@ -1050,7 +1071,7 @@ local({
     }
   
     # otherwise, fall back to the default JSON reader
-    json <- catch(renv_json_read_default(file, text))
+    json <- tryCatch(renv_json_read_default(file, text), error = identity)
     if (!inherits(json, "error"))
       return(json)
   
@@ -1063,14 +1084,14 @@ local({
   }
   
   renv_json_read_jsonlite <- function(file = NULL, text = NULL) {
-    text <- paste(text %||% read(file), collapse = "\n")
+    text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
     jsonlite::fromJSON(txt = text, simplifyVector = FALSE)
   }
   
   renv_json_read_default <- function(file = NULL, text = NULL) {
   
     # find strings in the JSON
-    text <- paste(text %||% read(file), collapse = "\n")
+    text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n")
     pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]'
     locs <- gregexpr(pattern, text, perl = TRUE)[[1]]
   
@@ -1118,14 +1139,14 @@ local({
     map <- as.list(map)
   
     # remap strings in object
-    remapped <- renv_json_remap(json, map)
+    remapped <- renv_json_read_remap(json, map)
   
     # evaluate
     eval(remapped, envir = baseenv())
   
   }
   
-  renv_json_remap <- function(json, map) {
+  renv_json_read_remap <- function(json, map) {
   
     # fix names
     if (!is.null(names(json))) {
@@ -1152,7 +1173,7 @@ local({
     # recurse
     if (is.recursive(json)) {
       for (i in seq_along(json)) {
-        json[i] <- list(renv_json_remap(json[[i]], map))
+        json[i] <- list(renv_json_read_remap(json[[i]], map))
       }
     }