R/mod_get_model.R

In fBedecarrats/SchoolMealForecastShinyClient: A Shiny Client for Nantes Metropole School Meal Forecast Model

#' get_model UI Function
#'
#' @description A shiny Module.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @noRd 
#'
#' @importFrom shiny NS tagList 
#' @importFrom stringr str_remove
#' @importFrom dplyr %>%
mod_get_model_ui <- function(id, label = "Mettre à jour le modèle"){
  ns <- NS(id)
  tagList(
    actionButton(ns("button"), label = label),
    verbatimTextOutput(ns("out"))
  )
}
    
#' get_model Server Function
#'
#' @noRd 
mod_get_model_server <- function(input, output, session){
  ns <- session$ns
  observeEvent(input$button, {
    download.file("https://codeload.github.com/nantesmetropole/school_meal_forecast_xgboost/zip/main",
                  destfile = "model.zip")
    unzip("model.zip")
    if (dir.exists("app")) {
      unlink("app", recursive = TRUE)
    }
    file.rename(from = "school_meal_forecast_xgboost-main/app/", 
                to = "app")
    file.rename(from = "school_meal_forecast_xgboost-main/requirements.txt",
                to = "requirements.txt")
    readLines("school_meal_forecast_xgboost-main/main.py") %>%
      stringr::str_remove("if __name__ == '__main__':|    main\\(\\)") %>%
      writeLines(con = "main.py")
    file.remove("model.zip")
    unlink("school_meal_forecast_xgboost-main", recursive = TRUE)
    timestamp <- paste(
      "Modèle mis à jour à partir de Github le",
      date()
    )
    output$out <- renderText({
      timestamp
    })
  })
}
    
## To be copied in the UI
# mod_get_model_ui("get_model_ui_1")
    
## To be copied in the server
# callModule(mod_get_model_server, "get_model_ui_1")