check fbapp errors, fbapp2json

Merge branch 'master' of https://github.com/CIP-RIU/fbcheck

# Conflicts:
#	DESCRIPTION

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: fbcheck
 Title: Web Interface for Data Quality and Processing
-Version: 2.0.4
+Version: 2.0.5
 Authors@R: c(
         person("Omar","Benites",,"[email protected]",c("aut","cre"))
         )
@@ -23,7 +23,10 @@ Imports:
     date,
     purrr,
     tidyr,
-    dplyr
+    dplyr,
+    httr,
+    RMySQL,
+    DT
 License: MIT + file LICENSE
 LazyData: true
 RoxygenNote: 6.0.1

R/fbcheck_server_sbase.R

@@ -9,6 +9,14 @@
 #' @export
 
 fbcheck_server_sbase <- function(input, output, session, values) {
+
+  ################################ R. ARIAS###############################################
+  # db <- reactiveValues()
+  # db$constUserDB <- "hidap_sbase"
+  # db$constPassDB <- "cKqrrEhTHLh3V2Fm70719"
+  # db$constDBName <- "hidap_sbase"
+  # db$constDBHost <- "176.34.248.121"
+  ################################ R. ARIAS###############################################
 
   #Catch the file path for reading fieldbook sheets
   volumes <- shinyFiles::getVolumes()
@@ -60,12 +68,15 @@ fbcheck_server_sbase <- function(input, output, session, values) {
     file_fbapp <- input$file_fbapp_sbase
     #print(file_fbapp)
     if (is.null(file_fbapp)) {
+      #shinyjs::disable("saveData")  # Codigo R.ARIAS  SAVE
       return(NULL)
     } else {  
-      dt <- readr::read_csv(file_fbapp$datapath)
+      dt <- readr::read_csv(file_fbapp$datapath)  # Codigo R.ARIAS SAVE
+      #shinyjs::enable("saveData")
     }
 
     ####### Show Warnings to users   #######
+    #ToDo: Include plot_id
     if(!is.element("plot_name", names(dt))){ 
       shinysky::showshinyalert(session, "alert_fbapp_warning_sbase", paste("ERROR: The file imported does not has 'plot_name' header."), styleclass = "danger")  
     } else if(nrow(dt)==1){
@@ -157,16 +168,31 @@ fbcheck_server_sbase <- function(input, output, session, values) {
     },
     content = function(con) {
       path <- fbglobal::get_base_dir()
-      #print(path)
-      shiny::withProgress(message = 'Downloading file', value = 0, {
 
-      incProgress(1/6, detail = paste("Reading HIDAP data..."))
+      shiny::withProgress(message = 'Downloading file', value = 0, {
+      incProgress(1/6, detail = paste("Reading table data..."))
+
       path <-  file.path(path,"hot_fieldbook_sbase.rds")
 
       DF <- hot_to_r(input$hot_btable_fbapp_sbase) # Important note: run server
+
       incProgress(2/6, detail = paste("Formatting hidap file..."))
       fb<- DF #hidap2fbApp(fieldbook = DF)
 
+      exportFormat <- input$fbcheck_fbapp_ExportFormat_sbase
+      if(exportFormat=="Simple"){
+        names(fb)[1] <-  "observationunit_name"
+        #Remove unncesary columns for simple format
+        #ToDo: ask if user need 'plot_id' column in 'simple' format for sweetpotatobase
+        fb$accession_name <- fb$plot_id <- 	fb$plot_number <- fb$block_number <- 	fb$is_a_control	<- fb$rep_number	<- fb$row_number <- 	fb$col_number <- NULL
+        fb <- fb
+
+      } else {
+        fb
+      }
+
+
+
       incProgress(3/6, detail = paste("Downloading FieldBookApp-SPBase file..."))
       incProgress(4/6, detail = paste("Refreshing HIDAP..."))
       Sys.sleep(3)
@@ -180,7 +206,140 @@ fbcheck_server_sbase <- function(input, output, session, values) {
       })
     }
   )
+  ################################## R .ARIAS ################
+  # observeEvent(input$saveData,{
+  #   if(!session$userData$logged){
+  #     showModal(modalShowMessage("You must log in to save your data"))
+  #     return()
+  #   }
+  #   showModal(modalEnterFileName())
+  # })
+
+  # observeEvent(input$btSaveModal, {
+  #   saveFile()
+  # })
+  ################################## R .ARIAS ################
 
+  # modalEnterFileName <- function(){
+  #   modalDialog(
+  #     title = HTML("<center><font color='#f7941d'><h2> Saving Study </h2></font></center>"),
+  #     div(
+  #       textInput("fileName", "File name:"),
+  #       textInput("breederName", "Breeder Name:")
+  #     ),
+  #     
+  #     easyClose = T,
+  #     footer = tagList(
+  #       modalButton("Cancel"),
+  #       actionButton("btSaveModal", "Save", width = 120, icon = icon("save")),
+  #       actionButton("btModalSaveNUpdload", "Save & Upload", width = 120, icon=icon("upload"))
+  #       )
+  #   )
+  # } 
+  # 
+  # modalShowMessage <- function(str){
+  #   modalDialog(
+  #     title = HTML("<center><font color='#f7941d'><h2> HiDAP says: </h2></font></center>"),
+  #     div(
+  #       HTML(paste0("<h5>",str, "<h5>"))
+  #     ),
+  #     easyClose = T,
+  #     footer = tagList(
+  #       modalButton("Ok")
+  #     )
+  #   )
+  # } 
+  #   
+  # ### to chek if name is correct and available
+  # ### for testing, we will asume correct and no duplicate names are entered
+  # checkNewFileName <- function (fname){
+  #   
+  #   ### TO DO ###
+  #   
+  #   return(T)
+  # }
+  # 
+  # saveFile <- function(){
+  #   
+  #   fileName <- trimws(input$fileName)
+  #   breederName <- trimws(input$breederName)
+  #   removeModal()
+  #   
+  #   message <- ""
+  #   
+  #   xdate <- Sys.time()
+  #   
+  #   v_study <- input$file_fbapp_sbase$name
+  #   v_study <- gsub(".csv", "", v_study)
+  #   
+  #   uploadDate  <- as.character(xdate, "%Y%m%d%H%M%S")
+  #   uploadDate_s <- as.character(xdate, "%Y-%m-%d %H:%M:%S")
+  #   ranStr <-  stri_rand_strings(1, 15,  '[a-zA-Z0-9]')
+  #   servName <- paste(uploadDate, ranStr , sep= "-") #nombre sin extensions!!!!
+  #   servName <- paste0(servName, ".csv")
+  #   
+  # 
+  #   
+  #   shiny::withProgress(message = 'Saving file', value = 0, {
+  #     incProgress(1/4, detail = paste("Reading table data..."))
+  #     
+  #     
+  #     DF <- hot_to_r(input$hot_btable_fbapp_sbase) # Important note: run server
+  #     
+  #     
+  #     incProgress(2/4, detail = paste("Generating file..."))
+  #     
+  #     pathGlobal <- fbglobal::get_base_dir()
+  #     servPath <-  file.path(pathGlobal,servName)
+  #     
+  #     write.csv(DF, file=servPath)
+  #     
+  #     incProgress(3/4, detail = paste("Saving into database"))
+  #     Sys.sleep(3)
+  #     
+  #     params <- list(
+  #       dataRequest = "uploadFile",
+  #       fileServerName = servName,
+  #       filedata=upload_file(servPath, "text/csv")
+  #     )
+  #     
+  #     var <- POST("https://research.cip.cgiar.org/gtdms/hidap/script/hidap_sbase/getFileUpload.php", body=params)
+  #     code <- content(var, "text")
+  #     
+  #    
+  #   
+  #     if (file.exists(servPath)) file.remove(servPath)
+  #     
+  #     if (code == "200"){
+  #       
+  #       message <- paste0(message, fileName, " was successfully saved <br>")
+  #       saveFileToDb("Sweetpotato", servName, paste0(fileName, ".csv"), breederName, v_study ,uploadDate_s )
+  #       
+  #       # saveFileToDB <- function(crop, server_book_name, book_name, breeder_name, study, upload_date){
+  #         
+  #     }
+  #     else{
+  #       message = paste0( message, "Error while sharing ", fileName , ". Please Try again. <br>")
+  #     }
+  #     incProgress(4/4, detail = paste("Finishing"))
+  #     Sys.sleep(5)
+  #     
+  #   })
+  #   
+  #   shinyalert("Success", message, type = "success")
+  #     
+  # }
+  # 
+  # saveFileToDb <- function(crop, server_book_name, book_name, breeder_name, study, upload_date){
+  #   
+  #   mydb = dbConnect(MySQL(), user=db$constUserDB, password=db$constPassDB, dbname=db$constDBName, host=db$constDBHost)
+  #   strQry <- paste0("insert into files (owner_id, crop, breeder_name, book_name, server_book_name, study, status, date_created) values(", session$userData$userId, ",")
+  #   strQry <- paste0(strQry, "'",crop ,"','",breeder_name,"','",book_name,"','", server_book_name, "','", study, "','", "In review", "','",upload_date,"')")
+  #   qryUser = dbSendQuery(mydb, strQry)
+  #   dbDisconnect(mydb)
+  #   
+  # }
+  ################################## R .ARIAS ################
 
 }
 

R/fbcheck_ui_sbase.R

@@ -44,16 +44,35 @@ fbcheck_ui_sbase <- function(type="tab", title="Data Quality and Processing", na
                             #   
                             # ),
 
+
                             #conditionalPanel(
                             #  condition = "input.fbdesign_dsource_sbase == 'FieldBookApp-SPBase'",
+                            column(6, 
+                                   shiny::fileInput(inputId = "file_fbapp_sbase", label = "Choose CSV File", multiple = FALSE,
+                                                    accept = c("text/csv","text/comma-separated-values,text/plain", ".csv")),
+
+                                   selectInput(inputId = "fbcheck_fbapp_ExportFormat_sbase",label = "Spreadsheet format download",choices = c("Simple","Standard"), selected = 2)
+
+
+                                   ),
+                            column(6, 
+                                   # HTML('<div style="float: right; margin: 0 5px 5px 10px;">'),
+                                   HTML('<div style="float: right;">'),
+                                   br(),
+                                   shiny::downloadButton('downloadData', 'Download', class = "btn-primary",style="color: #fff;"),
+
+                                   ################## HIDAP REGISTRY #########################################
+                                   #actionButton('saveData', 'Save', icon=icon("save"), width = 100),
+                                   ######################################### ##################################
+
+                                   HTML('</div>')
+
+                                   ),
 
-                                shiny::fileInput(inputId = "file_fbapp_sbase", label = "Choose CSV File", multiple = FALSE,
-                                                 accept = c("text/csv","text/comma-separated-values,text/plain", ".csv")),
+
                                 #actionButton('reset', 'Reset Input'),
 
-                                HTML('<div style="float: right; margin: 0 5px 5px 10px;">'),
-                                shiny::downloadLink('downloadData', 'Download'),
-                                HTML('</div>'),
+
                              # )
                             #),