Skip to content

Commit

Permalink
fix RIDL connection
Browse files Browse the repository at this point in the history
  • Loading branch information
@Edouard-Legoupil
Edouard-Legoupil committed Oct 25, 2023
1 parent 74bf134 commit 3e92dee
Show file tree
Hide file tree
Showing 4 changed files with 111 additions and 169 deletions.
170 changes: 70 additions & 100 deletions R/mod_configure.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,7 @@ mod_configure_ui <- function(id) {
#' @noRd
#' @import shiny
#' @import golem
#' @import riddle
#' @import tidyverse
#' @importFrom XlsFormUtil fct_xlsfrom_language
#' @keywords internal
Expand All @@ -128,9 +129,7 @@ mod_configure_server <- function(input, output, session, AppReactiveValue) {
}
})




## Case 1 -- uploading data
observeEvent(input$dataupload,{
req(input$dataupload)
message("Please upload a file")
Expand All @@ -140,6 +139,7 @@ mod_configure_server <- function(input, output, session, AppReactiveValue) {

## Create a sub folder data-raw and paste data there
dir.create(file.path(AppReactiveValue$thistempfolder, "data-raw"), showWarnings = FALSE)
## Move the data there...
file.copy( AppReactiveValue$datauploadpath,
paste0(AppReactiveValue$thistempfolder,
"/data-raw/",
Expand All @@ -148,61 +148,7 @@ mod_configure_server <- function(input, output, session, AppReactiveValue) {
overwrite = TRUE)
})



observeEvent(input$ridldata, {
AppReactiveValue$ridldata <- input$ridldata
})

observeEvent(input$pull4, {
## some message for user...
data_message <- utils::capture.output({
### So let's fetch the resource and create the corresponding reactive objects
# for the rest of the flow...

showModal(modalDialog("Please wait, pulling all the files from the server at the moment...", footer=NULL))

## now the data
req(AppReactiveValue$ridldata)
ridldata <- tempfile()
resource_fetch(url = AppReactiveValue$ridldata,
path = ridldata)
AppReactiveValue$datalist <- kobocruncher::kobo_data(datapath = ridldata)

removeModal()

}, type = "message")

if(is.null(AppReactiveValue$datalist )){
# not successful
shinyWidgets::sendSweetAlert(
session = session,
title = "Problem with Data",
text = "Please check your access rights...",
type = "warning"
)
} else {

shinyWidgets::sendSweetAlert(
session = session,
title = "You are done!",
text = paste0("Session loaded: the dataset includes ",
nrow(AppReactiveValue$datalist$main),
" records"),
type = "success" )
}
})


observeEvent(input$language, {
AppReactiveValue$language <- input$language
## if language change, regenerate the expanded form
kobo_prepare_form(xlsformpath = AppReactiveValue$xlsformpath,
label_language = AppReactiveValue$language,
xlsformpathout = AppReactiveValue$expandedform )
})

## Load Form input$xlsform
## Case 1 -- uploading xlsform
observeEvent(input$xlsform,{
req(input$xlsform)
message("Please upload a file")
Expand All @@ -227,70 +173,94 @@ mod_configure_server <- function(input, output, session, AppReactiveValue) {

## Define the path and name for the expanded version
AppReactiveValue$expandedform <- paste0( dirname(AppReactiveValue$xlsformpath) ,
"/",
AppReactiveValue$xlsformfilename,
"_expanded.xlsx")
"/",
AppReactiveValue$xlsformfilename,
"_expanded.xlsx")
## Generate expanded form
kobo_prepare_form(xlsformpath = AppReactiveValue$xlsformpath,
label_language = AppReactiveValue$language,
xlsformpathout = AppReactiveValue$expandedform )

})

## Get download ready for expanded form
output$downloadform <- downloadHandler(
filename = function(){paste0(AppReactiveValue$xlsformfilename, "_expanded.xlsx") },
content <- function(file) { file.copy( AppReactiveValue$expandedform , file)}
)

observeEvent(input$ridlform, {
AppReactiveValue$ridlform <- input$ridlform


### Case 2 - fill dropdown
observe({
req(AppReactiveValue$form)
updateSelectInput(session,
"ridlform",
choices = AppReactiveValue$form )
req(AppReactiveValue$data)
updateSelectInput(session,
"ridldata",
choices = AppReactiveValue$data )
})

observeEvent(input$pull3, {
## some message for user...
data_message <- utils::capture.output({
### Case 2 -- download data from RIDL
observeEvent(input$ridldata, {
AppReactiveValue$ridldata <- input$ridldata
})

observeEvent(input$pull4, {
### So let's fetch the resource and create the corresponding reactive objects
# for the rest of the flow...

showModal(modalDialog("Please wait, pulling all the files from the server at the moment...", footer=NULL))
## now the data
req(AppReactiveValue$ridldata)
AppReactiveValue$datauploadpath <- tempfile()
riddle::resource_fetch(url = AppReactiveValue$ridldata,
path = AppReactiveValue$datauploadpath)
AppReactiveValue$thistempfolder <- dirname(AppReactiveValue$datauploadpath)
AppReactiveValue$datauploadname <- basename(AppReactiveValue$datauploadpath)
## Create a subfolder
dir.create(file.path(AppReactiveValue$thistempfolder, "data-raw"), showWarnings = FALSE)
## Move the data there...
file.copy( AppReactiveValue$datauploadpath,
paste0(AppReactiveValue$thistempfolder,
"/data-raw/",
# fs::path_file(AppReactiveValue$datauploadpath)),
AppReactiveValue$datauploadname),
overwrite = TRUE)

req(AppReactiveValue$ridlform)
ridlformfile <- tempfile()
riddle::resource_fetch(url = AppReactiveValue$ridlform,
path = ridlformfile)

## Now let's load with koboloader
kobocruncher::kobo_prepare_form(xlsformpath = ridlformfile,
label_language = NULL,
xlsformpathout = ridlformfile )

## Let's extract the analysis plan from the xlsform - or extend the current one
AppReactiveValue$dico <- kobocruncher::kobo_dico(xlsformpath = ridlformfile)
removeModal()

})

removeModal()

}, type = "message")
### Case 2 -- download Form from RIDL
observeEvent(input$ridlform, {
AppReactiveValue$ridlform <- input$ridlform
})
observeEvent(input$pull3, {
showModal(modalDialog("Please wait, pulling all the files from the server at the moment...", footer=NULL))
req(AppReactiveValue$ridlform)
AppReactiveValue$xlsformpath <- tempfile()
riddle::resource_fetch(url = AppReactiveValue$ridlform,
path = AppReactiveValue$xlsformpath)
## Get the name for the file...
AppReactiveValue$xlsformname <- basename(AppReactiveValue$xlsformpath)

if(is.null(AppReactiveValue$dico )){
# not successful
shinyWidgets::sendSweetAlert(
## updatethe dropdown for language selection...
updateSelectInput(
session = session,
title = "Problem with Form",
text = "Please check your access rights...",
type = "warning"
inputId = "language",
choices = XlsFormUtil::fct_xlsfrom_language( xlsformpath = AppReactiveValue$xlsformpath )
)
} else {
removeModal()
})

shinyWidgets::sendSweetAlert(
session = session,
title = "You are done!",
text = paste0("Session loaded: the form includes ",
nrow(AppReactiveValue$dico$variables),
" questions"),
type = "success" )
}

### Apply form preparation...
observeEvent(input$language, {
AppReactiveValue$language <- input$language
## if language change, regenerate the expanded form
req(AppReactiveValue$xlsformpath )
kobo_prepare_form(xlsformpath = AppReactiveValue$xlsformpath,
label_language = AppReactiveValue$language,
xlsformpathout = AppReactiveValue$expandedform )
})


Expand Down
93 changes: 36 additions & 57 deletions R/mod_crunch.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,11 +27,7 @@ mod_crunch_ui <- function(id) {
and evolving analysis.")
)
) ,


fluidRow(


shinydashboard::box(
title = "Iterative Exploration ",
# status = "primary",
Expand All @@ -48,25 +44,23 @@ mod_crunch_ui <- function(id) {
"Get your exploration report",
style="color: #fff; background-color: #672D53"),
## If yes to ridlyes -


div(
id = ns("show_ridl3"),
br(),
p("All this analysis is fully reproducible and therefore re-usable.
In order to keep track of your work, record it within RIDL with predefined
attachment ressources metadata"),

## Ask a few question about the final report
## # publish = Do you want to publish the report in RIDL,
# visibility= visibility,
# stage = stage,
actionButton( inputId = ns("ridlpublish"),
label = " Record in RIDL your analysis",
icon = icon("upload"),
width = "100%" )
)

## Ask a few question about the final report
## # publish = Do you want to publish the report in RIDL,
# visibility= visibility,
# stage = stage,
),

column(
Expand Down Expand Up @@ -118,30 +112,40 @@ mod_crunch_server <- function(input, output, session, AppReactiveValue) {
})


observeEvent(input$ridlpublish, {
})

output$downloadreport <- downloadHandler(
filename = "exploration_report.html",
content = function(file) {
# Copy the report file and form to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).

tempReport <- file.path(AppReactiveValue$thistempfolder,
"report.Rmd")

## Copy the report notebook template in the tempfolder..
file.copy(system.file("rmarkdown/templates/template_A_exploration/skeleton/skeleton.Rmd",
package = "kobocruncher"),
tempReport, overwrite = TRUE)

## tweak to get here::here working - create .here file
file.create( paste0(AppReactiveValue$thistempfolder, "/.here") ,
"/.here")

## paste the form in the data-raw folder for furthere knitting
## paste the form in the data-raw folder for further knitting
file.copy( AppReactiveValue$xlsformpath,
paste0(AppReactiveValue$thistempfolder,
"/data-raw/",
AppReactiveValue$xlsformname),
overwrite = TRUE)

## tweak to get here::here working - create .here file
file.create( paste0(AppReactiveValue$thistempfolder, "/.here") ,
"/.here")
## A few check in the console...
print(paste0( "thistempfolder: ", AppReactiveValue$thistempfolder))
print(paste0( "xlsformname: ", AppReactiveValue$xlsformname))
print(paste0( "datauploadname: ", AppReactiveValue$datauploadname))



#browser()
# Set up parameters to pass to Rmd document
Expand All @@ -156,60 +160,35 @@ mod_crunch_server <- function(input, output, session, AppReactiveValue) {
# stage = stage,
language = AppReactiveValue$language )


id <- showNotification(
"Rendering report... Patience is the mother of wisdom!",
duration = NULL,
closeButton = FALSE
)
on.exit(removeNotification(id), add = TRUE)

showModal(modalDialog("Please wait, compiling the report... The more questions in your report, the more time it will take...", footer=NULL))
# Knit the document, passing in the `params` list, and eval it in a
# child of the global environment (this isolates the code in the document
# from the code in this app).
rmarkdown::render(tempReport,
output_file = file,
params = params,
envir = new.env(parent = globalenv())

)
removeModal()
}
)


# # 3 tab of the excel settings
# Form3 <- reactiveVal()
# observeEvent(
# input$form_upload,
# { filename <- tolower(input$form_upload$name)
# # this is to get the same structure of the excel form on 3 tabs
# Form(read_excel(input$form_upload$datapath, sheet = 1))
# Form2(read_excel(input$form_upload$datapath, sheet = 2))
# Form3(read_excel(input$form_upload$datapath, sheet = 3))
# write.xlsx(Form(), './form.xlsx', sheetName = 'survey',showNA=FALSE )
# write.xlsx(Form2(), './form.xlsx', sheetName = 'choices',append=TRUE,showNA=FALSE )
# write.xlsx(Form3(), './form.xlsx', sheetName = 'settings',append=TRUE,showNA=FALSE)
# showNotification("Data Processing Complete",duration = 10, type = "error")
# kobo_prepare_form('./form.xlsx', './form.xlsx', language = "") }
# )
# observeEvent(
# input$data_upload,{
# filename <- tolower(input$data_upload$name)
# Data(read_excel(input$data_upload$datapath))
# write.xlsx(Data(), './data.xlsx', showNA=FALSE)
# showNotification("Data Processing Complete",duration = 10, type = "error") })
# observeEvent(input$run_rmd,
# {rmarkdown::render(system.file("rmarkdown/templates/template_A_exploration/skeleton/skeleton.Rmd",
# package = "kobocruncher"),
# output_dir = "./")
# showNotification("Successful",
# duration = 10,
# type = "message") })
# output$download_form <- downloadHandler(filename <- function() {
# paste("form", "xlsx", sep=".") },
# content <- function(file) { file.copy("./form.xlsx", file)})
# output$download <- downloadHandler(
# filename <- function() {paste("Kobocruncher", "html", sep=".")},
# content <- function(file) { file.copy("./kobocruncher.html", file)})
### Enabling iterations ######
## Get download ready for expanded form
output$downloadform <- downloadHandler(
filename = function(){paste0(AppReactiveValue$xlsformfilename, "_expanded.xlsx") },
content <- function(file) { file.copy( AppReactiveValue$expandedform , file)}
)
## new upload...
observeEvent(input$xlsform,{
req(input$xlsform)
message("Please upload a file")
AppReactiveValue$xlsformpath <- input$xlsform$datapath
AppReactiveValue$xlsformname <- input$xlsform$name

})

}

Expand Down
Loading

0 comments on commit 3e92dee

Please sign in to comment.