WIP

.github/workflows/R-CMD-check.yaml

@@ -25,7 +25,7 @@ jobs:
           - {os: ubuntu-latest,   r: 'oldrel-1'}
 
     env:
-      MEGAMATION_KEY: ${{ secrets.MEGAMATION_KEY }}
+      HTTR2_KEY_MEGAMATION: ${{ secrets.HTTR2_KEY_MEGAMATION }}
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
       R_KEEP_PKG_SOURCE: yes
 

.github/workflows/pkgdown.yaml

@@ -19,6 +19,7 @@ jobs:
       group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+      HTTR2_KEY_MEGAMATION: ${{ secrets.HTTR2_KEY_MEGAMATION }}
     permissions:
       contents: write
     steps:

.github/workflows/test-coverage.yaml

@@ -13,7 +13,7 @@ jobs:
     runs-on: ubuntu-latest
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
-
+      HTTR2_KEY_MEGAMATION: ${{ secrets.HTTR2_KEY_MEGAMATION }}
     steps:
       - uses: actions/checkout@v3
 

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: megamation
-Title: Access `DirectLine` Data Using the `Megamation API`
+Title: Access 'DirectLine' Data Using the 'Megamation API'
 Version: 0.1.0
 Authors@R: c( 
     person(
@@ -10,9 +10,9 @@ Authors@R: c(
       ),
     person("University of Guelph", role = c("cph", "fnd"))
     )
-Description: Tools for accessing and handling `DirectLine` data using the 
-    `Megamation API` <https://apidocs.megamation.com/>. The API allows users to 
-    interact with data programmatically, instead of via the `DirectLine` 
+Description: Tools for accessing and handling 'DirectLine' data using the 
+    'Megamation API' <https://apidocs.megamation.com/>. The API allows users to 
+    interact with data programmatically, instead of via the 'DirectLine' 
     software. This package is community-maintained and is not officially 
     supported by Megamation <https://megamation.com/about-megamation/>.
 License: GPL (>= 3)

NAMESPACE

@@ -1,29 +1,17 @@
 # Generated by roxygen2: do not edit by hand
 
-export(cred_error)
-export(date_as_between_string)
-export(extract_criteria)
-export(extract_data)
-export(extract_schema)
-export(format_date)
-export(format_params)
 export(get_env_key)
 export(get_env_url)
-export(get_env_user)
-export(is_paginated)
-export(mm_bind_then_tbl)
 export(mm_error_body)
 export(mm_get)
 export(mm_get_names)
-export(mm_req)
+export(mm_pagebind)
 export(mm_req_append)
 export(mm_req_paginate)
 export(mm_req_params)
 export(mm_req_perform)
+export(mm_request)
 export(mm_resp_extract)
-export(mm_resp_parse)
 export(mm_set_creds)
-export(parsed_extract)
-export(remove_api_urls)
 export(testing_key)
 importFrom(lifecycle,deprecated)

R/creds.R

@@ -3,7 +3,7 @@
 #' @description
 #' This function adds your Megamation API key and base URL to your
 #' [.Renviron] file so it can be called securely without being stored in
-#' your code. After you have installed these two credentials, [mm_req()] and
+#' your code. After you have installed these two credentials, [mm_request()] and
 #' [mm_get()] will call them automatically. They can be
 #' called manually at any time with `Sys.getenv("MEGAMATION_KEY")` or
 #' `Sys.getenv("MEGAMATION_URL")`.

R/env.R

@@ -16,26 +16,18 @@ get_env_key <- function() {
   }
 }
 
-#' Error on absent MEGAMATION env vars
-#' @returns An error or `NULL`.
-#' @export
-#' @keywords internal
-cred_error <- function(x) {
-  cli::cli_abort(c(
-    "No {.envvar MEGAMATION_{toupper(x)}} found.",
-    "i" = "Did you run {.fun mm_set_creds}?"
-  ))
-  return()
-}
-
 #' Get personal key
 #'
-#' testing_key() uses the HTTR2_KEY environment var to decrypt a secret.
+#' testing_key() uses the HTTR2_KEY_MEGAMATION environment
+#' variable to decrypt a secret.
 #' @returns A string of a decrypted key.
 #' @export
 #' @keywords internal
 testing_key <- function() {
-  httr2::secret_decrypt("4E5GlxeUybPJnCQQnwyDGsPIncZI526gyfk", "HTTR2_KEY")
+  httr2::secret_decrypt(
+    "4E5GlxeUybPJnCQQnwyDGsPIncZI526gyfk",
+    "HTTR2_KEY_MEGAMATION"
+    )
 }
 
 #' Get `MEGAMATION_URL` env var
@@ -50,16 +42,3 @@ get_env_url <- function() {
   }
   cred_error("url")
 }
-
-#' Get `MEGAMATION_USER` env var
-#' @returns The string value of the MEGAMATION_USER environment variable
-#' or an error if none exists.
-#' @export
-#' @keywords internal
-get_env_user <- function() {
-  user <- Sys.getenv("MEGAMATION_USER")
-  if (!identical(user, "")) {
-    return(user)
-  }
-  cred_error("user")
-}

R/extract.R

@@ -0,0 +1,36 @@
+#' Extract data from Megamation API response
+#'
+#' `mm_resp_extract()` parses the raw bytes from an API response,
+#' and extracts data from the parsed object.
+#'
+#' @param resp An API response.
+#' @description The body of the response contains raw bytes.
+#' After converting these bytes to a string, encoding is done to resolve
+#' a UTF-8 issue from Megamation's side.
+#' @returns A data frame containing the endpoint data.
+#' @export
+#' @examples
+#' \dontrun{
+#' # Real example
+#' # Returns data of interest from a response
+#' resp <- mm_request("status") |> httr2::req_perform()
+#' resp |> mm_resp_extract()
+#' }
+#'
+#' # Fake example
+#' # Returns NULL from an empty response body
+#' resp <- httr2::response_json()
+#' resp |> mm_resp_extract()
+mm_resp_extract <- function(resp) {
+  .from <- sub(".*/@", "", resp$url) |> tolower()
+  .from <- switch(.from,
+    "data",
+    labels = "labels",
+    criteria = "criteria",
+    schema = "schema"
+  )
+  resp |>
+    mm_resp_parse() |>
+    parsed_extract(.from)
+}
+

R/get.R

@@ -0,0 +1,98 @@
+#' Get column names and which are currently filters
+#'
+#' @description
+#' `mm_get_names()` performs and combines two separate GET requests
+#' on an endpoint: one
+#' for Schema and one for Criteria. Schema returns the names and (database)
+#' types of all available columns. Criteria returns the names of columns for
+#' which filtering is enabled.
+#'
+#' @inheritParams mm_get
+#' @returns A data frame of class [`tbl_df`][tibble::tbl_df-class]
+#' containing the requested information.
+#' @export
+#' @examples
+#' \dontrun{
+#' mm_get_names("status")
+#' }
+mm_get_names <- function(endpoint) {
+  description <- NULL
+  url_ending <- c("schema", "criteria")
+
+  req <- url_ending |>
+    purrr::map(\(x) mm_request(endpoint) |> mm_req_append(x))
+  resp <- purrr::map(req, httr2::req_perform)
+  data <- purrr::map(resp, mm_resp_extract)
+  names(data) <- url_ending
+
+  data$schema$filter_enabled <- FALSE
+  data$criteria$filter_enabled <- TRUE
+
+  data$criteria |>
+    dplyr::select(- description) |>
+    dplyr::right_join(data$schema, by = "field") |>
+    tibble::as_tibble()
+}
+
+#' Get data
+#'
+#' @description
+#' `mm_get()` accomplishes the full process of a GET request:
+#'
+#' * Creates an API request and defines its behaviour.
+#' * Performs the request and fetches the response.
+#' * Converts the body of the response to a data frame.
+#'
+#' Where applicable, pagination is automatically applied to the request
+#' by [mm_req_paginate()] and returned pages are automatically combined.
+#'
+#' @inheritParams mm_request
+#' @inheritParams mm_req_params
+#' @param .paginate If `TRUE`, paginate the request.
+#' @returns A data frame of class [`tbl_df`][tibble::tbl_df-class]
+#' containing the requested information.
+#' @export
+#' @examples
+#' \dontrun{
+#' # You can supply vectors to filtering variables
+#' mm_get("workorder", wo_no = c("00001", "00002"))
+#'
+#' # You can supply API modifiers when filtering
+#' mm_get("workorder", trade = "[]PCO")
+#'
+#' # You must supply date types to the date filter
+#' jan_2023 <- seq.Date(
+#'   as.Date("2023-01-01"),
+#'   as.Date("2023-01-31"),
+#'   by = "day"
+#'   )
+#'
+#' mm_get("employee", date = jan_2023)
+#' }
+mm_get <- function(endpoint, ..., .paginate = TRUE) {
+  check_bool(.paginate)
+
+  req <- mm_request(endpoint) |> mm_req_params(...)
+
+  req <- if (!.paginate) {
+    req
+  } else mm_req_paginate(req)
+
+  resp <- mm_req_perform(req)
+
+  tbl_result <- if (!.paginate) {
+    resp[[1]] |>
+      mm_resp_extract() |>
+      tibble::as_tibble()
+  } else {
+    resp |>
+      purrr::map(
+        \(x) x |>
+          mm_resp_parse() |>
+          extract_data()
+      ) |>
+      mm_pagebind()
+  }
+
+  remove_api_urls(tbl_result)
+}

R/modify.R

@@ -0,0 +1,48 @@
+#' Append a GET request
+#' @inheritParams mm_req_paginate
+#' @param x `"criteria"`, `"labels"`, or `"schema"`.
+#' @returns An object of class `httr2_request`.
+#' @export
+#' @examplesIf httr2::secret_has_key("HTTR2_KEY_MEGAMATION")
+#' mm_request("workorder") |> mm_req_append("criteria")
+#'
+mm_req_append <- function(req, x) {
+  check_string(x)
+  .get <- rlang::arg_match(x, c("criteria", "labels", "schema"))
+
+  req |>
+    httr2::req_url_path_append(glue::glue("@{toupper(x)}"))
+}
+
+#' Modify request URL with filtering components
+#'
+#' `mm_req_params()` adds filters to the request. By default, it adds the query
+#' for all (currently available) fields.
+#'
+#'
+#' @inheritParams mm_req_paginate
+#' @param ... <[`dynamic-dots`][rlang::dyn-dots]> Name-value pairs to filter the request.
+#' The name should be the lower-case name of a
+#' field that is filter-enabled
+#' (in Megamation's words, a criteria).
+#' @param allfields If `TRUE`, return all fields currently available for
+#' the endpoint.
+#' @returns An object of class `httr2_request` with a pagination policy.
+#' @export
+#' @examplesIf httr2::secret_has_key("HTTR2_KEY_MEGAMATION")
+#' # No parameters
+#' mm_request("status") |> mm_req_params()
+#'
+#' # Multiple parameters
+#' from <- as.Date("2023-09-20")
+#' to <- as.Date("2023-10-20")
+#' date <- seq(from, to, by = "day")
+#' trade <- c("[]PCO", "[]DM")
+#' mm_request("status") |> mm_req_params(date = date, trade = trade)
+mm_req_params <- function(req, ..., allfields = TRUE) {
+  check_bool(allfields)
+  params <- format_params(...)
+  if (allfields) params <- c(params, "ALLFIELDS" = 1)
+
+  req <- req |> httr2::req_url_query(!!!params)
+}

R/pagebind.R

@@ -0,0 +1,38 @@
+#' Bind multiple Megamation API pages by row before converting to a tibble
+#'
+#' `mm_pagebind()` is needed as pages can have same-named fields with
+#' different types. This is because some field(s) of a given page
+#' may or may not contain vectors  of values in one of its row.
+#' `mm_pagebind()` takes care of this possibility by treating each page
+#' as a matrix before binding and unnesting their combination.
+#'
+#' @param pages List of data frames representing Megamation API pages.
+#' @returns A data frame of class [`tbl_df`][tibble::tbl_df-class]
+#' representing the bound pages.
+#' @export
+#' @examples
+#' page_1 <- mtcars |>
+#'   dplyr::mutate(
+#'     mpg = as.list(mpg),
+#'     )
+#' page_2 <- page_1 |>
+#'   dplyr::mutate(
+#'     cyl = list(cyl)
+#'     )
+#' pages <- list(page_1, page_2)
+#' # mpg unnests but not cyl
+#' mm_pagebind(pages)
+mm_pagebind <- function(pages) {
+  matrices <- purrr::map(pages, \(x) as.matrix(x))
+  m <- purrr::reduce(matrices, rbind)
+  data <- m |> tibble::as_tibble()
+
+  cols <- names(data)
+  lengths <- purrr::map_dbl(
+    cols,
+    \(x) purrr::map_dbl(data[[x]], length) |> max()
+  )
+  unlisted <- cols[lengths %in% 0:1]
+
+  data |> tidyr::unnest(!!unlisted)
+}