New logic for generate_query_template() && Bug fixes

Author: mckeea

R/client.R

@@ -22,8 +22,6 @@ Client <- R6::R6Class("Client",
     #' @return An instance of the `Client` class.
     #' @export
     initialize = function(user, password, save_credentials = FALSE) {
-
-
       private$credentials_file_path <- "~/.hdarc"
 
       if (missing(user) || missing(password)) {
@@ -343,7 +341,8 @@ Client <- R6::R6Class("Client",
       resp <- self$send_request(req)$data
 
       if (to_json) {
-        resp <- jsonlite::toJSON(resp, pretty = TRUE, auto_unbox = TRUE)
+        resp <- jsonlite::toJSON(resp, pretty = TRUE, auto_unbox = TRUE, digits = 17)
+        print(resp)
       }
       resp
     },
@@ -364,7 +363,6 @@ Client <- R6::R6Class("Client",
     auth = NULL,
     credentials_file_path = NULL,
     read_credentials_from_file = function() {
-
       if (!file.exists(private$credentials_file_path)) {
         return(c("", ""))
       }
@@ -408,8 +406,14 @@ Client <- R6::R6Class("Client",
       for (param in names(data))
       {
         if (param == "dataset_id") next
-        if (param == "itemsPerPage") next
-        if (param == "startIndex") next
+        if (param == "itemsPerPage") {
+          obj$itemsPerPage <- 11
+          next
+        }
+        if (param == "startIndex") {
+          obj$startIndex <- 0
+          next
+        }
         if (is.null(data[[param]])) next
 
         if (grepl("bbox", param, fixed = TRUE)) {
@@ -423,22 +427,15 @@ Client <- R6::R6Class("Client",
           next
         }
 
-        pValue <- extract_template_param_default_value(data[[param]])
-        if (is.null(pValue)) {
-          switch(param,
-            "itemsPerPage" = {
-              pValue <- 11
-            },
-            "startIndex" = {
-              pValue <- 0
-            },
-            next
-          )
+        param_meta <- extract_param_metadata(data[[param]])
+        obj <- c(obj, setNames(param_meta$value, param))
+        if (!is.na(param_meta$comment)) {
+          obj <- c(obj, setNames(param_meta$comment, paste0("_comment_", param)))
         }
-        obj <- c(obj, setNames(pValue, param))
       }
+
       if (to_json) {
-        jsonlite::toJSON(obj, pretty = TRUE, auto_unbox = TRUE)
+        jsonlite::toJSON(obj, pretty = TRUE, auto_unbox = TRUE, digits = 17)
       } else {
         obj
       }
@@ -508,7 +505,7 @@ Client <- R6::R6Class("Client",
       if (grepl("application/json", content_type)) {
         resp %>%
           httr2::resp_body_json() %>%
-          jsonlite::toJSON(pretty = TRUE, auto_unbox = TRUE)
+          jsonlite::toJSON(pretty = TRUE, auto_unbox = TRUE, digits = 17)
       } else {
         # For other content types (e.g., text)
         resp %>% httr2::resp_body_string()

R/paginator.R

@@ -26,7 +26,7 @@ Paginator <- R6::R6Class("Paginator",
               }
             }
 
-            if ((!is.null(limit) && length(results) >= limit) ||
+            if ((!is.null(limit) && length(results) > limit) ||
               length(results) >= resp$properties$totalResults || length(results) == 0) {
               break
             }

R/search_results.R

@@ -34,7 +34,7 @@ SearchResults <- R6::R6Class("SearchResults",
         x$id
       }))
       if (self$total_count > 0) {
-        self$total_size <- sum(sapply(results, function(x) if (!is.null(x$properties$size)) x$properties$size else 0))
+        self$total_size <- sum(sapply(results, function(x) if (!is.null(x$properties$size) && is.numeric(x$properties$size)) x$properties$size else 0))
       } else {
         self$total_size <- 0
       }

R/utils.R

@@ -9,45 +9,92 @@ is_placeholder <- function(value) {
   is_single_string(value) && stringr::str_detect(value, paste0("^", PLACEHOLDER_TAG))
 }
 
-extract_template_param_string_default_value <- function(meta) {
+extract_param_meta_for_string <- function(meta) {
   value <- NULL
+  comment <- NA
 
   if (exists("default", where = meta)) {
     value <- meta$default
   }
 
-  if ((is.null(value) || value == "") && exists("type", where = meta)) {
+  description <- NA
+  if (exists("type", where = meta)) {
+    description <- paste("Value of", meta$type)
+
     if (exists("pattern", where = meta)) {
-      value <- paste(PLACEHOLDER_TAG, "Value of", meta$type, "type with pattern:", meta$pattern)
-    } else {
-      value <- paste(PLACEHOLDER_TAG, "Value of", meta$type)
+      description <- paste(description, "type with pattern:", meta$pattern)
+    }
+    if (exists("format", where = meta)) {
+      description <- paste(description, "type with format:", meta$format)
     }
   }
 
+  if (is.null(value) || nchar(value) == 0) {
+    value <- paste(PLACEHOLDER_TAG, description)
+  } else {
+    comment <- description
+  }
+
   if (exists("oneOf", where = meta) && length(meta$oneOf) > 0) {
     value <- meta$oneOf[[1]]$const
+
+    possible_values <- sapply(meta$oneOf, function(x) x$const)
+    comment <- paste0("One of: ", paste(possible_values, collapse = ","))
   }
 
-  if (is.null(value) || nchar(value) == 0) NULL else value
+  data.frame(value = value, comment = comment)
 }
 
-extract_template_param_array_default_value <- function(meta) {
+extract_param_meta_for_number <- function(meta) {
+  value <- NULL
+  comment <- NA
+
+  if (exists("default", where = meta)) {
+    value <- meta$default
+  }
+
+  description <- ""
+
+  if (exists("minimum", where = meta)) {
+    description <- paste0(description, "Min: ", meta$minimum, " ")
+  }
+  if (exists("maximum", where = meta)) {
+    description <- paste0(description, "Max: ", meta$maximum, " ")
+  }
+
+  if (is.null(value) || nchar(value) == 0) {
+    value <- paste(PLACEHOLDER_TAG, description)
+  } else {
+    comment <- description
+  }
+
+  data.frame(value = value, comment = comment)
+}
+
+extract_param_meta_for_array <- function(meta) {
+  value <- NULL
+
   if (exists("items", where = meta)) {
     if (exists("oneOf", meta$items) && length(meta$items$oneOf) > 0) {
       value <- sapply(meta$items$oneOf, function(x) {
         x$const
       })
-      return(I(list(value)))
+      if (length(value) == 1) {
+        value <- I(list(list(value)))
+      } else {
+        value <- I(list(value))
+      }
     }
   }
 
-  NULL
+  data.frame(value = I(value), comment = NA)
 }
 
-extract_template_param_default_value <- function(meta) {
+extract_param_metadata <- function(meta) {
   switch(meta$type,
-    "string" = extract_template_param_string_default_value(meta),
-    "array"  = extract_template_param_array_default_value(meta)
+    "string" = extract_param_meta_for_string(meta),
+    "number" = extract_param_meta_for_number(meta),
+    "array" = extract_param_meta_for_array(meta),
   )
 }
 
@@ -57,12 +104,13 @@ strip_off_template_placeholders <- function(template) {
   t <- jsonlite::fromJSON(template, simplifyVector = FALSE)
   for (param in names(t))
   {
+    if (startsWith(param, "_comment_")) next
     value <- t[[param]]
     if (!is_placeholder(value)) {
       output[[param]] <- value
     }
   }
-  jsonlite::toJSON(output, pretty = TRUE, auto_unbox = TRUE)
+  jsonlite::toJSON(output, pretty = TRUE, auto_unbox = TRUE, digits = 17)
 }
 
 is_single_string <- function(input) {

vignettes/hdar.Rmd

@@ -10,7 +10,6 @@ vignette: >
   %\VignetteEncoding{UTF-8}
 ---
 
-
 # Introduction
 
 The `hdar` R package provides seamless access to the WEkEO Harmonised Data Access (HDA) API, enabling users to programmatically query and download data from within R.
@@ -76,12 +75,16 @@ client$get_token()
 ```
 
 # Copernicus Terms and Conditions (T&C)
+
 Copernicus data is free to use and modify, still T&Cs must be accepted in order to download the data. `hdarc` offers a confortable functionality to read and accept/reject T&C of the individual Copernicus service:
+
 ```{r,eval=FALSE}
 client$show_terms()
 ```
+
 Will open a browser where you can read all the available T&Cs.
 To accept/reject individual T&Cs or all at once use:
+
 ```{r,eval=FALSE}
 client$terms_and_conditions()
 
@@ -111,6 +114,7 @@ client$terms_and_conditions(term_id = 'all')
 10                        CNES_Open_2.0_ETALAB_Licence     TRUE
 
 ```
+
 # Finding Datasets
 
 WEkEO offers a vast amount of different products. To find what you need the Client class provides a method called `datasets` that lists available datasets, optionally filtered by a text pattern.
@@ -138,37 +142,38 @@ filtered_datasets <- client$datasets("Seasonal Trajectories")
 
 # list dataset IDs
 sapply(filtered_datasets,FUN = function(x){x$dataset_id})
-[1] "EO:EEA:DAT:CLMS_HRVPP_VPP-LAEA" "EO:EEA:DAT:CLMS_HRVPP_ST"       "EO:EEA:DAT:CLMS_HRVPP_ST-LAEA" 
-[4] "EO:EEA:DAT:CLMS_HRVPP_VPP" 
+[1] "EO:EEA:DAT:CLMS_HRVPP_VPP-LAEA" "EO:EEA:DAT:CLMS_HRVPP_ST"       "EO:EEA:DAT:CLMS_HRVPP_ST-LAEA"
+[4] "EO:EEA:DAT:CLMS_HRVPP_VPP"
 
 
 filtered_datasets <- client$datasets("Baltic")
 
 # list dataset IDs
 sapply(filtered_datasets,FUN = function(x){x$dataset_id})
- [1] "EO:MO:DAT:BALTICSEA_ANALYSISFORECAST_BGC_003_007:cmems_mod_bal_bgc-pp_anfc_P1D-i_202311"               
- [2] "EO:MO:DAT:NWSHELF_MULTIYEAR_PHY_004_009:cmems_mod_nws_phy-sst_my_7km-2D_PT1H-i_202112"                 
- [3] "EO:MO:DAT:OCEANCOLOUR_BAL_BGC_L4_MY_009_134:cmems_obs-oc_bal_bgc-plankton_my_l4-multi-1km_P1M_202211"  
- [4] "EO:MO:DAT:SST_BAL_PHY_SUBSKIN_L4_NRT_010_034:cmems_obs-sst_bal_phy-subskin_nrt_l4_PT1H-m_202211"       
- [5] "EO:MO:DAT:BALTICSEA_MULTIYEAR_PHY_003_011:cmems_mod_bal_phy_my_P1Y-m_202303"                           
- [6] "EO:MO:DAT:OCEANCOLOUR_BAL_BGC_L3_NRT_009_131:cmems_obs-oc_bal_bgc-transp_nrt_l3-olci-300m_P1D_202207"  
- [7] "EO:MO:DAT:BALTICSEA_MULTIYEAR_BGC_003_012:cmems_mod_bal_bgc_my_P1Y-m_202303"                           
- [8] "EO:MO:DAT:SST_BAL_SST_L4_REP_OBSERVATIONS_010_016:DMI_BAL_SST_L4_REP_OBSERVATIONS_010_016_202012"      
- [9] "EO:MO:DAT:BALTICSEA_ANALYSISFORECAST_PHY_003_006:cmems_mod_bal_phy_anfc_PT15M-i_202311"                
-[10] "EO:MO:DAT:OCEANCOLOUR_BAL_BGC_L3_MY_009_133:cmems_obs-oc_bal_bgc-plankton_my_l3-multi-1km_P1D_202207"  
-[11] "EO:MO:DAT:SST_BAL_PHY_L3S_MY_010_040:cmems_obs-sst_bal_phy_my_l3s_P1D-m_202211"                        
-[12] "EO:MO:DAT:SEAICE_BAL_SEAICE_L4_NRT_OBSERVATIONS_011_004:FMI-BAL-SEAICE_THICK-L4-NRT-OBS"               
-[13] "EO:MO:DAT:SEAICE_BAL_PHY_L4_MY_011_019:cmems_obs-si_bal_seaice-conc_my_1km_202112"                     
-[14] "EO:MO:DAT:BALTICSEA_ANALYSISFORECAST_WAV_003_010:cmems_mod_bal_wav_anfc_PT1H-i_202311"                 
-[15] "EO:MO:DAT:BALTICSEA_REANALYSIS_WAV_003_015:dataset-bal-reanalysis-wav-hourly_202003"                   
+ [1] "EO:MO:DAT:BALTICSEA_ANALYSISFORECAST_BGC_003_007:cmems_mod_bal_bgc-pp_anfc_P1D-i_202311"
+ [2] "EO:MO:DAT:NWSHELF_MULTIYEAR_PHY_004_009:cmems_mod_nws_phy-sst_my_7km-2D_PT1H-i_202112"
+ [3] "EO:MO:DAT:OCEANCOLOUR_BAL_BGC_L4_MY_009_134:cmems_obs-oc_bal_bgc-plankton_my_l4-multi-1km_P1M_202211"
+ [4] "EO:MO:DAT:SST_BAL_PHY_SUBSKIN_L4_NRT_010_034:cmems_obs-sst_bal_phy-subskin_nrt_l4_PT1H-m_202211"
+ [5] "EO:MO:DAT:BALTICSEA_MULTIYEAR_PHY_003_011:cmems_mod_bal_phy_my_P1Y-m_202303"
+ [6] "EO:MO:DAT:OCEANCOLOUR_BAL_BGC_L3_NRT_009_131:cmems_obs-oc_bal_bgc-transp_nrt_l3-olci-300m_P1D_202207"
+ [7] "EO:MO:DAT:BALTICSEA_MULTIYEAR_BGC_003_012:cmems_mod_bal_bgc_my_P1Y-m_202303"
+ [8] "EO:MO:DAT:SST_BAL_SST_L4_REP_OBSERVATIONS_010_016:DMI_BAL_SST_L4_REP_OBSERVATIONS_010_016_202012"
+ [9] "EO:MO:DAT:BALTICSEA_ANALYSISFORECAST_PHY_003_006:cmems_mod_bal_phy_anfc_PT15M-i_202311"
+[10] "EO:MO:DAT:OCEANCOLOUR_BAL_BGC_L3_MY_009_133:cmems_obs-oc_bal_bgc-plankton_my_l3-multi-1km_P1D_202207"
+[11] "EO:MO:DAT:SST_BAL_PHY_L3S_MY_010_040:cmems_obs-sst_bal_phy_my_l3s_P1D-m_202211"
+[12] "EO:MO:DAT:SEAICE_BAL_SEAICE_L4_NRT_OBSERVATIONS_011_004:FMI-BAL-SEAICE_THICK-L4-NRT-OBS"
+[13] "EO:MO:DAT:SEAICE_BAL_PHY_L4_MY_011_019:cmems_obs-si_bal_seaice-conc_my_1km_202112"
+[14] "EO:MO:DAT:BALTICSEA_ANALYSISFORECAST_WAV_003_010:cmems_mod_bal_wav_anfc_PT1H-i_202311"
+[15] "EO:MO:DAT:BALTICSEA_REANALYSIS_WAV_003_015:dataset-bal-reanalysis-wav-hourly_202003"
 [16] "EO:MO:DAT:OCEANCOLOUR_BAL_BGC_L4_NRT_009_132:cmems_obs-oc_bal_bgc-plankton_nrt_l4-olci-300m_P1M_202207"
-[17] "EO:MO:DAT:SST_BAL_SST_L3S_NRT_OBSERVATIONS_010_032:DMI-BALTIC-SST-L3S-NRT-OBS_FULL_TIME_SERIE_201904" 
+[17] "EO:MO:DAT:SST_BAL_SST_L3S_NRT_OBSERVATIONS_010_032:DMI-BALTIC-SST-L3S-NRT-OBS_FULL_TIME_SERIE_201904"
 
 ```
 
 ## Understanding the Results
 
 The datasets method returns a list containing datasets and associated information. This information may include dataset names, descriptions, and other metadata.
+
 ```{r, eval=FALSE}
 client$datasets("EO:ECMWF:DAT:DERIVED_NEAR_SURFACE_METEOROLOGICAL_VARIABLES")
 [[1]]
@@ -201,6 +206,7 @@ To search for a specific product, you need to create a query template. You can e
 knitr::include_graphics(c("WEkEO_UI_JSON_1.png","WEkEO_UI_JSON_2.png"))
 
 ```
+
 ```{r,echo=TRUE}
 query <- '{
   "dataset_id": "EO:ECMWF:DAT:CEMS_GLOFAS_HISTORICAL",
@@ -253,15 +259,20 @@ query_template <- client$generate_query_template("EO:EEA:DAT:CLMS_HRVPP_ST")
 query_template
 {
   "dataset_id": "EO:EEA:DAT:CLMS_HRVPP_ST",
+  "itemsPerPage": 11,
+  "startIndex": 0,
   "uid": "__### Value of string type with pattern: [\\w-]+",
   "productType": "PPI",
+  "_comment_productType": "One of: PPI,QFLAG",
   "platformSerialIdentifier": "S2A, S2B",
+  "_comment_platformSerialIdentifier": "One of: S2A, S2B",
   "tileId": "__### Value of string type with pattern: [\\w-]+",
   "productVersion": "__### Value of string type with pattern: [\\w-]+",
   "resolution": "10",
-  "processingDate": "__### Value of string",
-  "start": "__### Value of string",
-  "end": "__### Value of string",
+  "_comment_resolution": "One of: 10",
+  "processingDate": "__### Value of string type with format: date-time",
+  "start": "__### Value of string type with format: date-time",
+  "end": "__### Value of string type with format: date-time",
   "bbox": [
     -180,
     -90,
@@ -271,10 +282,11 @@ query_template
 }
 ```
 
-
 ## Modify and use the generated Query Template
 
-You can and should customize the generated query template to fit your specific needs. Fields starting with `__###` are placeholders indicating possible values. If these placeholders are left unchanged, they will be automatically removed before sending the query to the HDA service.
+You can and should customize the generated query template to fit your specific needs. Fields starting with `__###` are placeholders indicating possible values. If these placeholders are left unchanged, they will be automatically removed before sending the query to the HDA service. Additionally, fields with the prefix `_comment_` provide relevant information regarding the specified field, such as possible values, format, or data patterns. Like the placeholders, these comment fields will also be automatically removed before the query is sent.
+
+Placeholders are used when there is no way to derive the value from the metadata endpoint, while comment fields appear when the field has a value already defined, offering additional context for customizing the query.
 
 To modify the query, it is often easier to transform the JSON into an R list using the `jsonlite::fromJSON()` function:
 
@@ -365,7 +377,7 @@ Once you have made the necessary modifications, you can convert the list back to
 
 ```{r, eval = FALSE}
 # convert to JSON format
-query_template <- toJSON(query_template, auto_unbox = TRUE) # don't forget to put auto_unbox = TRUE
+query_template <- toJSON(query_template, auto_unbox = TRUE, digits = 17) # don't forget to put auto_unbox = TRUE
 ```
 
 # Searching and Downloading Data