R/mod_file_imports.R

In MarieEtienne/quizin: Rentrez vos questions sur Moodle

# Module UI
  
#' @title   mod_file_imports_ui and mod_file_imports_server
#' @description  A shiny Module.
#'
#' @param id shiny id
#' @param input internal
#' @param output internal
#' @param session internal
#'
#' @rdname mod_file_imports
#'
#' @keywords internal
#' @export 
#' @importFrom graphics plot
#' @importFrom readr read_file
#' @importFrom shiny fileInput h2 hr NS plotOutput renderPlot tagList
#' verbatimTextOutput
#' @importFrom shinyWidgets actionBttn downloadBttn
#' @importFrom stats rnorm
#' @importFrom stringi stri_enc_toutf8
#' @importFrom utils head
mod_file_imports_ui <- function(id){
  ns <- NS(id)
  tagList(
    
    p(strong("Quizin"), 
      "s'adresse aux enseignants rédacteurs de questions sur une plateforme de cours ", 
      strong("Moodle"), ".", br(), 
      "Elle permet de transformer un fichier texte structuré contenant les questions en un fichier ", 
      code("xml"), " accepté par ", strong("Moodle"), ".", br(), 
      "Pour connaître la marche à suivre, reportez-vous à la rubrique ",
      em("Instruction"), "."),
    
    h2("Convertir un fichier des questions"),
    fluidRow(
      column(width = 6,
             h4("Téléverser ici votre fichier de questions :"))
    ),
    
    fluidRow(
      column(width = 3,
             fileInput(ns("id_file_questions"), label = NULL,
                       multiple = FALSE, accept = c("txt", "Rmd"), 
                       buttonLabel = "Parcourir")
             ),
      column(width = 3, offset = 0,
             uiOutput(ns("OKButton"))
             ),
      column(width = 3, offset = 0,
             uiOutput(ns("downloadDataButton"))
             )
      ),
    # hr(),
    h4(textOutput(ns("error_or_not"))),
    verbatimTextOutput(ns("error_message")),
    br(),
    h4(textOutput(ns("apercu_text"))),
    verbatimTextOutput(ns("firstlines")),
    br(),
    #
    # # Informations de contrôle
    #
    # h4(textOutput(ns("control_text"))),
    # verbatimTextOutput(ns("print_input_file")),
    # verbatimTextOutput(ns("print_files_subdir")),
    # verbatimTextOutput(ns("print_splited")),
    # verbatimTextOutput(ns("xml_output")),
    br()
  )
}
    
# Module Server
    
#' @rdname mod_file_imports
#' @export
#' @importFrom withr with_dir
#' @keywords internal
    
mod_file_imports_server <- function(input, output, session){
  ns <- session$ns
  
  output$intro <- renderUI({
    display_html_body_from_rmd("intro.Rmd")
  })

  #### Creation des chemins et dossiers temporaires ####
  
  temp_dir <- tempdir()
  temp_dir <- gsub("\\\\", "/", temp_dir)
  
  time <- eventReactive(input$load, {
    return(gsub("[^0-9]", "", as.character(Sys.time())))
  })
  
  temp_subdir <- reactive({
    create_temp_subdir(temp_dir, time())
  })
  
  
  #### Bouton OK ####
  
  output$OKButton <- renderUI(
    # si la compilation a bien eu lieu, le bouton de téléchargement apparaît
    if (is.null(input$id_file_questions)) {
      return(
      actionBttn(inputId = ns("void"), label = "OK", style = "bordered", 
                 color = "success", icon = icon("check"))
      )
    } else {
      actionBttn(inputId = ns("load"), label = "OK", style = "simple", 
                 color = "success", icon = icon("check"))
    })
  
  
  #### Informations sur le fichier d'entrée ####
  
  file_path <- eventReactive(input$load, {
    # cat("Fichier d'entrée :", input$id_file_questions$datapath, "\n")
    return(input$id_file_questions$datapath)
  })
  
  filename_input <- eventReactive(input$load, {
    name <- input$id_file_questions$name
    name <- str_remove(name, pattern = "\\..{3}$")
    return(name)
  })
  
  
  #### Aperçu du fichier d'entrée ####
  
  texte_apercu <- eventReactive(input$load, {
    return("Aperçu du fichier :")
  })
  
  output$apercu_text <- renderText({
    return(texte_apercu())
  })
  
  output$firstlines <- renderPrint({
    N <- 50
    text <- readLines(file_path())
    cat_txt(text, nlines = N)
  })
  
  
  #### Séparation des questions ####
  
  splitted_questions <- reactive({
    file <- read_file(file_path())
    file <- stri_enc_toutf8(file)
    return(split_txt(file))
  })

  
  #### Compilation #### 
  
  path_to_xml <- reactive({
    xmlfile_w_ext <- paste0(filename_input(), ".xml")
    path <- file.path(temp_dir, xmlfile_w_ext)
    gsub("\\\\", "/", path)
  })
  
  safe_write <- reactive({
    # On écrit les questions dans des fichiers séparés
    # path_splitted_files <- write_multiple_files(splitted_questions(), temp_subdir())
    write_multiple_files(splitted_questions(), temp_subdir())
    # On récupère la liste des fichiers écrits
    # list.files(temp_subdir(), full.names = TRUE)
    # On récumère le nom du fichier xml à partir du chemin
    # xmlname <- create_xml_filename(time())
    xmlname <- str_remove(basename(path_to_xml()), ".xml")
    # On écrit le xml et on stocke la sortie dans une liste prudente
    safe_list <- with_dir(temp_subdir(), {
      safe_exams(file = list.files(), dir = temp_dir, 
                 name = xmlname)})
    # safe_list <- write_xml(temp_subdir(), time())
    return(safe_list)
  })
  
  #### Éventuels messages d'erreur ####
  
  output$error_or_not <- renderText({
    txt_error_or_not(safe_write())
  })
  
  output$error_message <- renderPrint({
    cat_error(safe_write())
  })
  
  #### Téléchargement des données

  lines_xml <- reactive({
    readLines(path_to_xml())
  })

  output$downloadDataButton <- renderUI(
    # si la compilation a bien eu lieu, le bouton de téléchargement apparaît
    if (is.null(safe_write()$error)) {
      return(
        downloadBttn(outputId = ns("downloadData"), label = "Télécharger",
                     style = "simple", color = "success")
      )
    } else {
    return(NULL)
  })
  
  output$downloadData <- downloadHandler(
    filename = function() {
      paste0(filename_input(), ".xml")
    },
    content = function(file) {
      writeLines(lines_xml(), file)
      }
    )
    
  
  #### Informations de contrôle ####
  
  # texte_control <- eventReactive(input$load, {
  #   return("Informations de contrôle :")
  # })
  # 
  # output$control_text <- renderText({
  #   return(texte_control())
  # })
  # 
  # output$print_input_file <- renderPrint({
  #   cat("Nom du fichier d'entrée :", filename_input(), "\n")
  #   cat("Chemin du fichier d'entrée :", file_path())
  # })
  # 
  # output$print_files_subdir <- renderPrint({
  #   cat("Nom des fichiers séparés dans le répertoire ", temp_subdir(), " :\n",
  #       paste0(list.files(temp_subdir()), collapse = "\n"), sep = "")
  # })
  # 
  # output$print_splited <- renderPrint({
  # 
  #   cat("Aperçu des fichiers séparés :\n")
  #   questions <- splitted_questions()
  # 
  #   for (q in questions) {
  #     cat_txt(unlist(strsplit(q, "\n")))
  #     cat("\n\n\n")
  #   }
  # })
  # 
  # output$xml_output <- renderPrint({
  #   N <- 50
  #   cat("Aperçu du fichier XML situé ")
  #   cat(path_to_xml(), ":\n\n")
  #   cat("Result:\n")
  #   cat(purrr::safely(readLines)(path_to_xml())$result, sep = "\n")
  #   cat("Error:\n")
  #   cat(as.character(purrr::safely(readLines)(path_to_xml())$error), sep = "\n")
  #   # cat(lines_xml())
  #   # cat_txt(lines_xml(), nlines = N)
  #   cat("Files in tempdir:\n")
  #   cat(list.files(temp_dir, recursive = TRUE, full.names = TRUE), sep = "\n")
  #   cat("\nFiles in xlmpath/..:\n")
  #   cat(list.files(dirname(path_to_xml())))
  #   cat("\nSafe write result\n")
  #   cat(as.character(safe_write()$result), sep = "\n")
  #   cat("\nSafe write error\n")
  #   cat(as.character(safe_write()$error), sep = "\n")
  # })
  
}
    
## To be copied in the UI
# mod_file_imports_ui("file_imports_ui_1")
    
## To be copied in the server
# callModule(mod_file_imports_server, "file_imports_ui_1")