R/form_schema.R

In dbca-wa/ruODK: An R Client for the ODK Central API

#' Show the schema of one form.
#'
#' `r lifecycle::badge("stable")`
#'
#' @details ODK Central has introduced a new API endpoint in version 0.8 which
#' returns a parsed and flattened list of fields. This replaces the nested
#' form schema which is challenging to parse.
#'
#' While users of newer ODK Central versions (> 0.8) can ignore the legacy
#' support for ODK Central's earlier form schema API, users of ODK Central
#' version < 0.8 can set an environment variable \code{ODKC_VERSION} to their
#' ODKC's version in format \code{<major>.<minor>} e.g. \code{0.7}.
#' This variable caters for future breaking changes.
#'
#' Either way, \code{\link{form_schema}} will always return a tibble with
#' columns \code{name}, \code{type}, \code{path} and \code{ruodk_name}.
#'
#' @param flatten Whether to flatten the resulting list of lists (TRUE) or not
#'   (FALSE, default). Only applies to ODK Central version < 0.8.
#' @param odata Whether to sanitise the field names to match the way they will
#'   be outputted for OData. While the original field names as given in the
#'   XForms definition may be used as-is for CSV output, OData has some
#'   restrictions related to the domain-qualified identifier syntax it uses.
#'   Only applies to ODK Central version < 0.8.
#'   Default: FALSE.
#' @param parse Whether to parse the form schema into a tibble of form field
#'   type and name. This uses \code{\link{form_schema_parse}} internally.
#'   If used together with `flatten=TRUE`, \code{\link{form_schema}} will raise
#'   a warning and return the unparsed, flattened form schema.
#'   Only applies to ODK Central version < 0.8.
#'   Default: TRUE.
#' @param draft Whether the form is published (FALSE) or a draft (TRUE).
#'   Default: TRUE.
#' @template param-pid
#' @template param-fid
#' @template param-url
#' @template param-auth
#' @template param-retries
#' @template param-odkcv
#' @template param-verbose
#' @return A tibble or nested list (v0.7) containing the form definition.
#'   At the lowest nesting level, each form field consists of a list of two
#'   nodes, `name` (the underlying field name) and `type` (the XForms field
#'   type, as in "string", "select1", "geopoint", "binary" and so on).
#'   These fields are nested in lists of tuples `name` (the XForms screen name),
#'   `children` (the fields as described above), `type` ("structure" for non-
#'   repeating screens, "repeat" for repeating screens).
#'   A list with `name` "meta" may precede the structure, if several metadata
#'   fields are captured (e.g. "instanceId", form start datetimes etc.).
#'   In all cases for ODK Central 0.8, and with default parameters
#'   (\code{parse=TRUE}) for ODK Central 0.7, \code{\link{form_schema}} returns
#'   a tibble with the columns:
#'
#'   \itemize{
#'   \item \code{name} The field name as given in the form schema.
#'   \item \code{type} The field type, e.g. "string", "select1", etc.
#'   \item \code{path} The XForms path of the field,
#'   \item \code{selectMultiple} Whether a field of type "select" is
#'     a select multiple (\code{TRUE}). Any other types are \code{NA}.
#'   \item \code{ruodk_name} The predicted field name as generated by
#'     \code{\link{odata_submission_get}}, prefixed by the path, additionally
#'     cleaned with \code{\link[janitor]{make_clean_names}} to match the
#'     cleaned column names from \code{\link{odata_submission_rectangle}}.
#'   }
# nolint start
#' @seealso \url{https://docs.getodk.org/central-api-form-management/#getting-form-schema-fields}
# nolint end
#' @family form-management
#' @export
#' @examples
#' \dontrun{
#' # See vignette("setup") for setup and authentication options
#' # ruODK::ru_setup(svc = "....svc", un = "me@email.com", pw = "...")
#'
#' # With explicit pid and fid
#' fs_defaults <- form_schema(pid = 1, fid = "build_xformsId")
#'
#' # With current ODK Central (v0.8)
#' fs <- form_schema()
#'
#' # With defaults, ODK Central v0.7
#' fs_nested <- form_schema(
#'   flatten = FALSE,
#'   odata = FALSE,
#'   parse = FALSE,
#'   odkc_version = 0.7
#' )
#' listviewer::jsonedit(fs_nested)
#'
#' fs_flattened <- form_schema(
#'   flatten = TRUE,
#'   odata = FALSE,
#'   parse = FALSE,
#'   odkc_version = 0.7
#' )
#' listviewer::jsonedit(fs_flattened)
#'
#' # form_schema returns a nested list. There's nothing to change about that.
#' class(fs_nested)
#' # > "list"
#'
#' class(fs_flattened)
#' # > "list"
#'
#' # This assumes knowledge of that exact form being tested.
#' # First node: type "structure" (a field group) named "meta".
#' fs_nested[[1]]$type
#' # > "structure"
#'
#' fs_nested[[1]]$name
#' # > "meta"
#'
#' # The first node contains children, which means it's an XForms field group.
#' names(fs_nested[[1]])
#' # > "name" "children" "type"
#'
#' # Next node: a "meta" field of type "string" capturing the  "instanceId".
#' # First child node of "meta": type "string", name "instanceId".
#' fs_nested[[1]]$children[[1]]$type
#' # > "string"
#' fs_nested[[1]]$children[[1]]$name
#' # > "instanceID"
#'
#' # In the flattened version, the field's and it's ancestors' names are the
#' # components of "path".
#' fs_flattened[[1]]$path
#' # > "meta". "instanceId"
#'
#' fs_flattened[[1]]$type
#' # > "string"
#'
#' # Last node: a "meta" field capturing the datetime of form completion
#' fs_flattened[[length(fs_flattened)]]$type
#' # > "dateTime"
#' fs_nested[[length(fs_nested)]]$type
#' # > "dateTime"
#'
#' # Parsed into a tibble of form field type/name:
#' # Useful to inform further parsing of submission data (attachments, dates)
#' fs <- form_schema(parse = TRUE, odkc_version = 0.7)
#' fs <- form_schema(odkc_version = 0.8)
#'
#' # Attachments: used by handle_ru_attachments
#' fs %>% dplyr::filter(type == "binary")
#'
#' # dateTime: used by handle_ru_datetimes
#' fs %>% dplyr::filter(type == "dateTime")
#'
#' # Point location: used by handle_ru_geopoints
#' fs %>% dplyr::filter(type == "geopoint")
#' }
form_schema <- function(flatten = FALSE,
                        odata = FALSE,
                        parse = TRUE,
                        draft = FALSE,
                        pid = get_default_pid(),
                        fid = get_default_fid(),
                        url = get_default_url(),
                        un = get_default_un(),
                        pw = get_default_pw(),
                        odkc_version = get_default_odkc_version(),
                        retries = get_retries(),
                        verbose = get_ru_verbose()) {
  yell_if_missing(url, un, pw, pid = pid, fid = fid)
  ru_msg_info(glue::glue("Form schema v{odkc_version}"), verbose = verbose)

  if (semver_lt(odkc_version, "0.8.0")) {
    # nocov start
    fs <- httr::RETRY(
      "GET",
      httr::modify_url(
        url,
        path = glue::glue(
          "v1/projects/{pid}/forms/",
          "{URLencode(fid, reserved = TRUE)}.schema.json"
        )
      ),
      httr::add_headers("Accept" = "application/json"),
      httr::authenticate(un, pw),
      query = list(flatten = flatten, odata = odata),
      times = retries
    ) %>%
      yell_if_error(., url, un, pw) %>%
      httr::content(.)

    if (parse == TRUE) {
      if (flatten == TRUE) {
        ru_msg_warn(
          "Cannot parse flattened form schema, returning unparsed and flattened.
           Use flatten=FALSE with parse=TRUE for a parsed form_schema.",
          verbose = verbose
        )
        return(fs)
      }
      fsp <- form_schema_parse(fs, verbose = verbose) %>%
        dplyr::mutate(ruodk_name = predict_ruodk_name(name, path))
      return(fsp)
    }
    return(fs)
  } else {
    # nocov end
    if (draft == FALSE) {
      pth <- glue::glue(
        "v1/projects/{pid}/forms/{URLencode(fid, reserved = TRUE)}/fields"
      )
    } else {
      pth <- glue::glue(
        "v1/projects/{pid}/forms/{URLencode(fid, reserved = TRUE)}/draft/fields"
      )
    }

    fs <- httr::RETRY(
      "GET",
      httr::modify_url(url, path = pth),
      httr::add_headers("Accept" = "application/json"),
      httr::authenticate(un, pw),
      query = list(flatten = flatten, odata = odata),
      times = retries
    ) %>%
      yell_if_error(., url, un, pw) %>%
      httr::content(.) %>%
      tibble::tibble(xx = .) %>%
      tidyr::unnest_wider(xx) %>%
      { # nolint
        if ("path" %in% names(.)) {
          dplyr::mutate(
            .,
            ruodk_name = path %>%
              stringr::str_remove("/") %>%
              stringr::str_replace_all("/", "_") %>%
              janitor::make_clean_names()
          )
        } else {
          .
        }
      }

    # If the form is a draft form, fs is an empty tibble.
    # In this case, fall back to the draft form schema API path.
    if (nrow(fs) == 0) {
      # Recursion stop
      if (draft == TRUE) {
        ru_msg_warn("This form is a draft without any fields.")
        return(NULL)
      }

      "The form \"{fid}\" is an unpublished draft form." %>%
        glue::glue() %>%
        ru_msg_info(verbose = verbose)

      fs <- form_schema(
        flatten = flatten,
        odata = odata,
        parse = parse,
        draft = TRUE,
        pid = pid,
        fid = fid,
        url = url,
        un = un,
        pw = pw,
        odkc_version = odkc_version,
        retries = retries,
        verbose = verbose
      )
      # fs <- httr::RETRY(
      #   "GET",
      #   httr::modify_url(
      #     url,
      #     path = glue::glue(
      #       "v1/projects/{pid}/forms/{URLencode(fid, reserved = TRUE)}",
      #       "/draft/fields"
      #     )
      #   ),
      #   httr::add_headers("Accept" = "application/json"),
      #   httr::authenticate(un, pw),
      #   query = list(flatten = flatten, odata = odata),
      #   times = retries
      # ) %>%
      #   yell_if_error(., url, un, pw) %>%
      #   httr::content(.) %>%
      #   tibble::tibble(xx = .) %>%
      #   tidyr::unnest_wider(xx) %>%
      #   dplyr::mutate(
      #     ruodk_name = path %>%
      #       stringr::str_remove("/") %>%
      #       stringr::str_replace_all("/", "_") %>%
      #       janitor::make_clean_names()
      #   )
    }

    fs
  }
}

# usethis::use_test("form_schema") # nolint