diff --git a/DESCRIPTION b/DESCRIPTION index a47d31e..97c6778 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,7 +17,8 @@ Imports: retry, stringi, jsonlite, - processx + processx, + dplyr Language: fr Encoding: UTF-8 LazyData: true diff --git a/NAMESPACE b/NAMESPACE index 1b37b29..e398f52 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,3 +6,4 @@ import(retry) import(stringi) import(jsonlite) import(processx) +import(dplyr) diff --git a/R/client.R b/R/client.R index 60a25ee..60cfd40 100644 --- a/R/client.R +++ b/R/client.R @@ -5,7 +5,15 @@ #' @returns Soit les paramètres eux-mêmes, soit, s'ils sont vides, un `data.frame` vide #' préparerParamsFoncMessage <- function(paramètres) { - return(if (is.null(paramètres)) data.frame() else paramètres) + if (is.null(paramètres)) { + return(data.frame()) + } + # Important d'effacer les paramètres NULL, qui seront sinon formatés en `{}` dans json + if (length(paramètres)) { + paramètres[sapply(paramètres, is.null)] <- NULL + } + + return(paramètres) } #' Prépare le nom d'une fonction Constellation à être envoyé par WebSocket @@ -33,7 +41,6 @@ Client <- R6Class( écouteurs = list(), envoyerMessage = function(m) { messageJSON <- jsonlite::toJSON(m, auto_unbox=TRUE, dataframe = "columns") - private$ws$send(messageJSON) }, ws = NULL @@ -120,7 +127,7 @@ Client <- R6Class( private$ws$connect() Sys.sleep(2) - retry::wait_until(isTRUE(ouvert), timeout = 15) + retry::wait_until(isTRUE(ouvert), timeout = 30) Sys.sleep(1) }, @@ -149,7 +156,7 @@ Client <- R6Class( private$envoyerMessage(messageAction) - retry::wait_until(isTRUE(résultatReçu), timeout = 15) + retry::wait_until(isTRUE(résultatReçu), timeout = 30) return(résultat) }, @@ -187,12 +194,12 @@ Client <- R6Class( ) private$envoyerMessage(messageSuivi) - retry::wait_until(!is.null(fOublier), timeout = 15) + retry::wait_until(!is.null(fOublier), timeout = 30) if (appelléAvecFonction) { return(fOublier) } else { - retry::wait_until(condition(résultatSuivi), timeout = 15) + retry::wait_until(condition(résultatSuivi), timeout = 30) fOublier() return(résultatSuivi) } @@ -232,12 +239,12 @@ Client <- R6Class( ) private$envoyerMessage(messageSuivi) - retry::wait_until(!is.null(retour), timeout = 15) + retry::wait_until(!is.null(retour), timeout = 30) if (appelléAvecFonction) { return(retour) } else { - retry::wait_until(!is.null(résultatRecherche), timeout = 15) + retry::wait_until(!is.null(résultatRecherche), timeout = 30) retour$fOublier() return(résultatRecherche) } @@ -269,6 +276,24 @@ Client <- R6Class( private$écouteurs[[id]] <- list(résoudre=résoudre, rejeter=rejeter, f=f) }, + obtDonnéesTableau = function(idTableau, langues=NULL) { + données <- self$suivre( + "tableaux.suivreDonnéesExportation", + paramètres = list(idTableau=idTableau, langues=langues) + ) + + colonnes <- unique(unlist(sapply(données["données"][[1]], function (x) names(x)))) + nRangées <- length(données["données"][[1]]) + + tableau_données <- data.frame(matrix(nrow=nRangées, ncol=length(colonnes))) + colnames(tableau_données) <- colonnes + for (colonne in colonnes) { + tableau_données[[colonne]] <- sapply(données["données"][[1]], function (x) x[[colonne]]) + } + tableau_données <- tableau_données %>% replace(.=="NULL", NA) + return(tableau_données) + }, + fermer = function() { private$ws$close() } diff --git a/tests/testthat/test-client.R b/tests/testthat/test-client.R index 08dc502..3fbd2b3 100644 --- a/tests/testthat/test-client.R +++ b/tests/testthat/test-client.R @@ -132,7 +132,35 @@ avecClientEtServeurTest( }) testthat::test_that("Obtenir données tableau", { + idBd <- client$appeler( + "bds.créerBd", + list(licence="ODbl-1_0") + ) + idTableau <- client$appeler( + "bds.ajouterTableauBd", + list(idBd=idBd) + ) + idVar <- client$appeler( + "variables.créerVariable", + list(catégorie="numérique") + ) + idCol <- client$appeler( + "tableaux.ajouterColonneTableau", + list(idTableau=idTableau, idVariable=idVar) + ) + vals <- list() + vals[[idCol]] <- 123 + él <- client$appeler( + "tableaux.ajouterÉlément", + list(idTableau=idTableau, vals=vals) + ) + + donnéesTableau <- client$obtDonnéesTableau(idTableau = idTableau) + + référence <- data.frame(colNumérique=123) + names(référence)[names(référence) == "colNumérique"] <- idCol + testthat::expect_equal(donnéesTableau, référence) }) testthat::test_that("Obtenir données nuée", {