diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/api.R | 182 | ||||
| -rw-r--r-- | R/cepis-package.R | 24 | ||||
| -rw-r--r-- | R/client.R | 122 | ||||
| -rw-r--r-- | R/conditions.R | 73 | ||||
| -rw-r--r-- | R/http.R | 210 | ||||
| -rw-r--r-- | R/models.R | 212 | ||||
| -rw-r--r-- | R/normalize.R | 43 |
7 files changed, 866 insertions, 0 deletions
@@ -0,0 +1,182 @@ +#' Look up a single CEP +#' +#' @description +#' Accepts the CEP masked or unmasked and returns everything the DNE database +#' has for it, including the coordinate when there is one. +#' +#' @param cep A length-one character vector: `"01001-000"` or `"01001000"`. +#' @param client A [cepis_client()]. Defaults to a shared client built with +#' the default configuration. +#' +#' @return A [cepis_address]. +#' +#' @section Conditions: +#' \describe{ +#' \item{`cepis_invalid_cep`}{the CEP is not 8 digits. No request is made.} +#' \item{`cepis_not_found`}{well-formed, but not in the database.} +#' \item{`cepis_rate_limited`}{429 on every attempt.} +#' \item{`cepis_server_error`}{5xx on every attempt.} +#' \item{`cepis_network_error`}{the request never completed.} +#' \item{`cepis_invalid_response`}{a success status with an unreadable +#' body.} +#' } +#' +#' All of them inherit `cepis_error`; see [cepis_conditions]. +#' +#' @examples +#' \donttest{ +#' address <- cep_lookup("01001-000") +#' address$localidade +#' if (!is.null(address$geo) && address$geo$is_precise) { +#' c(address$geo$lat, address$geo$lon) +#' } +#' } +#' +#' @export +cep_lookup <- function(cep, client = default_client()) { + number <- normalize_cep(cep) + response <- cepis_fetch(client, paste0("/", number)) + + if (response$status == 404L) { + stop(not_found_error( + paste0("CEP ", number, " does not exist in the DNE database"), + cep = number + )) + } + if (response$status == 400L) { + stop(invalid_cep_error( + api_message(response$body, paste0("CEP ", number, " rejected")), + value = cep + )) + } + if (response$status != 200L) { + stop(server_error( + paste0("the API answered ", response$status, " for CEP ", number), + status = response$status + )) + } + + new_address(json_object(response$body)) +} + +#' Look up many CEPs in one request +#' +#' @description +#' Resolves up to 500 CEPs per request, chunking longer inputs automatically. +#' Do not loop over [cep_lookup()]: a loop of 500 calls pays 500 TLS +#' handshakes, the batch pays one. +#' +#' @param ceps A character vector of CEPs, masked or unmasked. +#' @param client A [cepis_client()]. Defaults to a shared client built with +#' the default configuration. +#' +#' @return A list of **the same length and in the same order** as `ceps`. +#' Each element is a [cepis_address], or `NULL` where the CEP does not +#' exist or is malformed — it does not vanish from the list, and it does not +#' signal a condition. That is the right difference from [cep_lookup()]: in +#' a batch of a thousand, one bad CEP must not cost the other nine hundred +#' and ninety-nine. Use [normalize_cep()] beforehand if you need to know +#' *which* input was malformed. +#' +#' A list rather than a `data.frame` because `NULL` is the only unambiguous +#' "no such CEP" in R: a row of `NA`s reads as an address with unknown +#' fields, which is a different statement, and an empty row cannot be told +#' apart from a CEP the database knows only by number. Rectangle it with +#' `do.call(rbind, lapply(result, function(a) as.data.frame(a[1:13])))` when +#' a `data.frame` is what you want. +#' +#' @section Batches carry no coordinate: +#' The endpoint behind them is CSV, and the CSV has no `geo` column. Every +#' address returned here has `geo = NULL`, including for CEPs that do have +#' one. Need `geo`? Use [cep_lookup()], one at a time. +#' +#' @examples +#' \donttest{ +#' ceps <- c("01001000", "99999999", "20040020") +#' result <- cep_lookup_many(ceps) +#' vapply(result, function(a) if (is.null(a)) NA_character_ else a$localidade, +#' character(1)) +#' } +#' +#' @export +cep_lookup_many <- function(ceps, client = default_client()) { + if (length(ceps) == 0L) { + return(list()) + } + ceps <- as.character(ceps) + + result <- list() + starts <- seq(1L, length(ceps), by = MAX_BATCH) + for (start in starts) { + chunk <- ceps[start:min(start + MAX_BATCH - 1L, length(ceps))] + result <- c(result, lookup_chunk(client, chunk)) + } + result +} + +lookup_chunk <- function(client, ceps) { + query <- utils::URLencode(paste(ceps, collapse = ","), reserved = TRUE) + response <- cepis_fetch(client, paste0("/csv?ceps=", query)) + + if (response$status == 400L) { + stop(invalid_cep_error( + api_message(response$body, "the API rejected the batch"), + value = ceps + )) + } + if (response$status != 200L) { + stop(server_error( + paste0("the API answered ", response$status, " for a batch of ", + length(ceps), " CEP(s)"), + status = response$status + )) + } + + table <- csv_rows(response$body) + rows <- vector("list", nrow(table)) + for (index in seq_len(nrow(table))) { + row <- as.list(table[index, , drop = FALSE]) + localidade <- row[["localidade"]] + if (is.null(localidade) || !nzchar(trimws(localidade))) { + next + } + rows[[index]] <- new_address(row) + } + + rows[seq_along(ceps)] +} + +#' Ask the API how it is, and which database it is serving +#' +#' @description +#' Useful for two things: checking that the API answers, and knowing which +#' version of the DNE database is live. The database changes every two weeks. +#' +#' @param client A [cepis_client()]. Defaults to a shared client built with +#' the default configuration. +#' +#' @return A [cepis_health]. +#' +#' @section Conditions: +#' An API reporting itself degraded is not a failure here — that arrives in +#' `status`, and checking health is exactly when you want the diagnosis +#' rather than an error. Network failures still signal `cepis_network_error`. +#' +#' @examples +#' \donttest{ +#' health <- cep_health() +#' health$ok +#' health$dne +#' } +#' +#' @export +cep_health <- function(client = default_client()) { + response <- cepis_fetch(client, "/health", accepted_status = c(200L, 503L)) + if (!(response$status %in% c(200L, 503L))) { + stop(server_error( + paste0("the API answered ", response$status, " at /health"), + status = response$status + )) + } + new_health(json_object(response$body)) +} diff --git a/R/cepis-package.R b/R/cepis-package.R new file mode 100644 index 0000000..c028b02 --- /dev/null +++ b/R/cepis-package.R @@ -0,0 +1,24 @@ +#' cepis: client for the public CEP API at cep.is +#' +#' @description +#' Resolves Brazilian postal codes against <https://cep.is>. Official +#' Correios data (DNE), refreshed every two weeks. +#' +#' ```r +#' address <- cep_lookup("01001-000") +#' address$logradouro # "Praca da Se" +#' address$localidade # "Sao Paulo" +#' ``` +#' +#' The API surface is English, but the **data fields keep the API's own +#' Portuguese names** (`logradouro`, `bairro`, `localidade`, `uf`). What you +#' read in the JSON at <https://cep.is/01001000> is what you read on the +#' returned object, with no translation layer in between. +#' +#' Start at [cep_lookup()] for one CEP, [cep_lookup_many()] for many, +#' [cep_health()] for the API's status and [cepis_client()] for anything +#' beyond the default configuration. Failures are classed conditions, +#' described in [cepis_conditions]. +#' +#' @keywords internal +"_PACKAGE" diff --git a/R/client.R b/R/client.R new file mode 100644 index 0000000..cdd72f0 --- /dev/null +++ b/R/client.R @@ -0,0 +1,122 @@ +DEFAULT_BASE_URL <- "https://cep.is" + +MAX_BATCH <- 500L + +RETRIABLE_STATUS <- c(429L, 500L, 502L, 503L, 504L) + +#' Build a client for the cep.is API +#' +#' @description +#' Holds the configuration and nothing else: no connection, no state between +#' calls. Build one and reuse it, or skip it entirely — [cep_lookup()], +#' [cep_lookup_many()] and [cep_health()] fall back to a shared default +#' client built with these defaults. +#' +#' @param base_url Where the API lives. Point it at a local instance (the API +#' repo brings one up on `http://localhost:8080` with `just up`) or at a +#' test server. It is the only parameter that usually changes between +#' environments. Trailing slashes are stripped, so it cannot produce +#' doubled separators that some proxies normalise and others 404. +#' @param timeout Seconds allowed for **one attempt**, connection and +#' transfer together. It is not a cap on the whole call, since a call may +#' make several attempts; that cap is `total_timeout`. +#' @param max_attempts How many attempts in total, counting the first. `1` +#' disables retrying. The default of `3` covers the common case (one +#' transient failure) without turning a real outage into a long wait. +#' @param backoff_base Base of the exponential wait, in seconds. The actual +#' wait is drawn from `[0, base * 2^(n - 1)]` — *full jitter*. The +#' randomness is not decoration: without it, N clients that fail together +#' come back together and reproduce the spike that took the service down. +#' @param backoff_max Cap on each individual wait, in seconds. It applies to +#' a server-sent `Retry-After` too, or a `Retry-After: 3600` from a +#' misconfigured proxy would park the session for an hour. +#' @param total_timeout Cap on the whole call, attempts and waits included. +#' `NULL` leaves `max_attempts` as the only bound. Set it in code serving a +#' web request: without it the worst case is `max_attempts * timeout` plus +#' the sum of the backoffs. +#' @param user_agent Overrides the `User-Agent`. The default identifies the +#' package and its version, which is what lets the server diagnose an old +#' client misbehaving. +#' +#' @return An object of class `cepis_client`, to pass as the `client` +#' argument of [cep_lookup()], [cep_lookup_many()] and [cep_health()]. +#' +#' @examples +#' client <- cepis_client(base_url = "http://localhost:8080", timeout = 5) +#' client$max_attempts +#' +#' @export +cepis_client <- function(base_url = DEFAULT_BASE_URL, + timeout = 10, + max_attempts = 3L, + backoff_base = 0.5, + backoff_max = 8, + total_timeout = NULL, + user_agent = NULL) { + if (!is.character(base_url) || length(base_url) != 1L || is.na(base_url)) { + stop("base_url must be a length-one character vector") + } + if (!is.numeric(timeout) || length(timeout) != 1L || is.na(timeout) || + timeout <= 0) { + stop("timeout must be a positive number of seconds") + } + if (!is.numeric(max_attempts) || length(max_attempts) != 1L || + is.na(max_attempts) || max_attempts < 1) { + stop("max_attempts must be >= 1") + } + if (!is.numeric(backoff_base) || length(backoff_base) != 1L || + is.na(backoff_base) || backoff_base < 0) { + stop("backoff_base must be >= 0") + } + if (!is.numeric(backoff_max) || length(backoff_max) != 1L || + is.na(backoff_max) || backoff_max < 0) { + stop("backoff_max must be >= 0") + } + if (!is.null(total_timeout) && + (!is.numeric(total_timeout) || length(total_timeout) != 1L || + is.na(total_timeout) || total_timeout <= 0)) { + stop("total_timeout must be NULL or a positive number of seconds") + } + if (is.null(user_agent)) { + user_agent <- paste0( + "cepis-r/", as.character(utils::packageVersion("cepis")), + " (+https://cep.is)" + ) + } + + structure( + list( + base_url = sub("/+$", "", base_url), + timeout = as.numeric(timeout), + max_attempts = as.integer(max_attempts), + backoff_base = as.numeric(backoff_base), + backoff_max = as.numeric(backoff_max), + total_timeout = total_timeout, + user_agent = user_agent + ), + class = "cepis_client" + ) +} + +#' @export +print.cepis_client <- function(x, ...) { + cat("<cepis_client> ", x$base_url, "\n", sep = "") + cat(" timeout: ", x$timeout, "s per attempt, ", x$max_attempts, + " attempt(s)\n", sep = "") + cat(" backoff: ", x$backoff_base, "s base, ", x$backoff_max, "s cap\n", + sep = "") + cat(" total timeout: ", + if (is.null(x$total_timeout)) "none" else paste0(x$total_timeout, "s"), + "\n", sep = "") + cat(" user agent: ", x$user_agent, "\n", sep = "") + invisible(x) +} + +cepis_state <- new.env(parent = emptyenv()) + +default_client <- function() { + if (is.null(cepis_state$client)) { + cepis_state$client <- cepis_client() + } + cepis_state$client +} diff --git a/R/conditions.R b/R/conditions.R new file mode 100644 index 0000000..1eebe5b --- /dev/null +++ b/R/conditions.R @@ -0,0 +1,73 @@ +#' Conditions signalled by cepis +#' +#' @description +#' Every failure raised by this package is a classed condition inheriting +#' from `cepis_error`, so one handler catches all of them: +#' +#' ```r +#' tryCatch( +#' cep_lookup(cep_from_form), +#' cepis_not_found = function(e) NULL, +#' cepis_error = function(e) reschedule() +#' ) +#' ``` +#' +#' Below `cepis_error` the split is by **the decision you have to make**, not +#' by the HTTP status that caused it: +#' +#' | class | when | does retrying help? | +#' | --- | --- | --- | +#' | `cepis_invalid_cep` | not 8 digits | no | +#' | `cepis_not_found` | well-formed, not in the database | no | +#' | `cepis_rate_limited` | 429 | yes, later | +#' | `cepis_server_error` | 5xx | yes, later | +#' | `cepis_network_error` | DNS, connection, timeout, TLS | yes, later | +#' | `cepis_invalid_response` | unintelligible response | probably not | +#' +#' That split is why `cepis_not_found` is not "the HTTP 404 condition": it is +#' also signalled with no request made at all, when the CEP is malformed +#' before it ever leaves the machine. +#' +#' Each condition carries the fields a caller needs to act on it: +#' `cepis_rate_limited` has `retry_after` (seconds the server asked for, or +#' `NULL`), `cepis_server_error` has `status`, `cepis_network_error` has +#' `url`, and `cepis_invalid_cep` has `value`, the input as it arrived. +#' +#' `cepis_invalid_response` almost always means something between you and the +#' API is answering instead of it — a captive Wi-Fi portal, a corporate +#' proxy, an HTML error page. Useful as a diagnosis: the problem is not in +#' your code. +#' +#' @name cepis_conditions +NULL + +cepis_condition <- function(class, message, ...) { + structure( + list(message = message, call = NULL, ...), + class = c(class, "cepis_error", "error", "condition") + ) +} + +invalid_cep_error <- function(message, value = NULL) { + cepis_condition("cepis_invalid_cep", message, value = value) +} + +not_found_error <- function(message, cep = NULL) { + cepis_condition("cepis_not_found", message, cep = cep) +} + +rate_limited_error <- function(message, retry_after = NULL) { + cepis_condition("cepis_rate_limited", message, retry_after = retry_after) +} + +server_error <- function(message, status) { + cepis_condition("cepis_server_error", message, status = status) +} + +network_error <- function(message, url) { + cepis_condition("cepis_network_error", message, url = url) +} + +invalid_response_error <- function(message) { + cepis_condition("cepis_invalid_response", message) +} diff --git a/R/http.R b/R/http.R new file mode 100644 index 0000000..6ef4511 --- /dev/null +++ b/R/http.R @@ -0,0 +1,210 @@ +elapsed <- function() { + proc.time()[["elapsed"]] +} + +MONTH_NUMBERS <- c( + Jan = 1L, Feb = 2L, Mar = 3L, Apr = 4L, May = 5L, Jun = 6L, + Jul = 7L, Aug = 8L, Sep = 9L, Oct = 10L, Nov = 11L, Dec = 12L +) + +http_date_seconds <- function(value) { + parts <- regmatches( + value, + regexec( + paste0( + "^[A-Za-z]{3}, ([0-9]{2}) ([A-Za-z]{3}) ([0-9]{4}) ", + "([0-9]{2}):([0-9]{2}):([0-9]{2}) GMT$" + ), + value + ) + )[[1L]] + if (length(parts) != 7L) { + return(NULL) + } + month <- MONTH_NUMBERS[parts[3L]] + if (is.na(month)) { + return(NULL) + } + target <- ISOdatetime( + as.integer(parts[4L]), month, as.integer(parts[2L]), + as.integer(parts[5L]), as.integer(parts[6L]), as.integer(parts[7L]), + tz = "GMT" + ) + if (is.na(target)) { + return(NULL) + } + max(0, as.numeric(difftime(target, Sys.time(), units = "secs"))) +} + +retry_after_seconds <- function(value) { + if (is.null(value) || length(value) != 1L || is.na(value)) { + return(NULL) + } + value <- trimws(value) + if (!nzchar(value)) { + return(NULL) + } + seconds <- suppressWarnings(as.numeric(value)) + if (!is.na(seconds)) { + return(max(0, seconds)) + } + http_date_seconds(value) +} + +backoff_wait <- function(client, attempt, retry_after) { + if (!is.null(retry_after)) { + return(min(retry_after, client$backoff_max)) + } + ceiling <- min(client$backoff_base * 2^(attempt - 1L), client$backoff_max) + stats::runif(1L, 0, ceiling) +} + +cepis_handle <- function(client) { + handle <- curl::new_handle() + curl::handle_setheaders( + handle, + "User-Agent" = client$user_agent, + "Accept" = "application/json, text/csv;q=0.9, */*;q=0.1", + "Accept-Encoding" = "identity" + ) + curl::handle_setopt( + handle, + connecttimeout_ms = as.integer(client$timeout * 1000), + timeout_ms = as.integer(client$timeout * 1000) + ) + handle +} + +cepis_fetch <- function(client, path, accepted_status = 200L) { + url <- paste0(client$base_url, path) + deadline <- if (is.null(client$total_timeout)) { + NULL + } else { + elapsed() + client$total_timeout + } + + last_status <- NULL + last_retry_after <- NULL + last_message <- NULL + + for (attempt in seq_len(client$max_attempts)) { + if (!is.null(deadline) && elapsed() >= deadline) { + break + } + + response <- tryCatch( + curl::curl_fetch_memory(url, handle = cepis_handle(client)), + error = function(e) e + ) + + if (inherits(response, "condition")) { + last_status <- NULL + last_retry_after <- NULL + last_message <- conditionMessage(response) + } else { + status <- as.integer(response$status_code) + headers <- curl::parse_headers_list(response$headers) + if (status %in% accepted_status || !(status %in% RETRIABLE_STATUS)) { + return(list(status = status, body = response$content, + headers = headers)) + } + last_status <- status + last_retry_after <- retry_after_seconds(headers[["retry-after"]]) + last_message <- NULL + } + + if (attempt == client$max_attempts) { + break + } + + wait <- backoff_wait(client, attempt, last_retry_after) + if (!is.null(deadline)) { + remaining <- deadline - elapsed() + if (remaining <= 0) { + break + } + wait <- min(wait, remaining) + } + Sys.sleep(wait) + } + + attempts <- paste0(" (after ", client$max_attempts, " attempt(s))") + if (identical(last_status, 429L)) { + stop(rate_limited_error( + paste0("rate limit reached at ", url, attempts), + retry_after = last_retry_after + )) + } + if (!is.null(last_status)) { + stop(server_error( + paste0("the API answered ", last_status, " at ", url, attempts), + status = last_status + )) + } + stop(network_error( + paste0("could not reach ", url, attempts, ": ", last_message), + url = url + )) +} + +decode_body <- function(body) { + if (length(body) >= 3L && + identical(as.integer(body[1:3]), c(239L, 187L, 191L))) { + body <- body[-(1:3)] + } + text <- rawToChar(body) + Encoding(text) <- "UTF-8" + text +} + +json_object <- function(body) { + text <- decode_body(body) + data <- tryCatch( + jsonlite::parse_json(text, simplifyVector = FALSE), + error = function(e) e + ) + if (inherits(data, "condition") || !is.list(data) || + (length(data) > 0L && is.null(names(data)))) { + stop(invalid_response_error(paste0( + "response is not a JSON object - something between you and the API is ", + "answering instead of it: ", substr(text, 1L, 120L) + ))) + } + data +} + +api_message <- function(body, fallback) { + data <- tryCatch( + jsonlite::parse_json(decode_body(body), simplifyVector = FALSE), + error = function(e) NULL + ) + message <- if (is.list(data)) data[["mensagem"]] else NULL + if (is.character(message) && length(message) == 1L && nzchar(message)) { + message + } else { + fallback + } +} + +csv_rows <- function(body) { + path <- tempfile(fileext = ".csv") + on.exit(unlink(path), add = TRUE) + writeBin(body, path) + + table <- tryCatch( + utils::read.csv( + path, + colClasses = "character", + na.strings = character(0L), + check.names = FALSE, + encoding = "UTF-8" + ), + error = function(e) e + ) + if (inherits(table, "condition")) { + stop(invalid_response_error(paste0( + "batch response is not valid CSV: ", conditionMessage(table) + ))) + } + table +} diff --git a/R/models.R b/R/models.R new file mode 100644 index 0000000..076db48 --- /dev/null +++ b/R/models.R @@ -0,0 +1,212 @@ +#' A CEP and everything the database knows about it +#' +#' @description +#' The object returned by [cep_lookup()] and by each element of +#' [cep_lookup_many()]. It is a plain list of class `cepis_address`, so +#' `address$localidade` and `str(address)` work as usual. +#' +#' **The data fields keep the API's Portuguese names.** Fields the database +#' does not have for a CEP come back as empty strings, never `NA` — that is +#' what the API returns, and changing it here would create a difference +#' between reading the JSON and reading this package. +#' +#' @section Fields: +#' \describe{ +#' \item{`cep`}{the 8 digits, always unmasked. [formatted_cep()] adds the +#' mask.} +#' \item{`logradouro`, `complemento`, `unidade`, `bairro`}{the street and +#' its qualifiers.} +#' \item{`localidade`, `uf`, `estado`, `regiao`}{municipality, state code, +#' state name, region.} +#' \item{`ibge`, `gia`, `ddd`, `siafi`}{the codes the database carries.} +#' \item{`geo`}{a [cepis_geo] object, or `NULL` when the database has no +#' coordinate for that CEP. `NULL` and not a row of `NA`s because the API +#' **omits** the whole field in that case (about 43% of CEPs) rather than +#' sending null.} +#' \item{`raw`}{the response exactly as it arrived, uninterpreted, so a +#' field the API grows before this package is updated is not lost.} +#' } +#' +#' @name cepis_address +NULL + +#' The coordinate of a CEP, when the database has one +#' +#' @description +#' The `geo` field of a [cepis_address], a plain list of class `cepis_geo`. +#' The point is the **median** of the coordinates of that CEP's addresses, +#' not the mean: one badly geocoded address 40 km away shifts a mean and does +#' not move a median. +#' +#' @section Fields: +#' \describe{ +#' \item{`lat`, `lon`}{decimal degrees, WGS 84.} +#' \item{`raio_m`}{the radius, in metres, containing 90% of that CEP's +#' addresses.} +#' \item{`precisao`}{`"logradouro"` or `"localidade"` — see below.} +#' \item{`is_precise`}{`TRUE` when `precisao` is `"logradouro"`. Derived, +#' not sent by the API.} +#' } +#' +#' @section Always check precisao before measuring distance: +#' There are two kinds of point, and the difference between them is tens of +#' kilometres: +#' +#' | `precisao` | typical `raio_m` | what the point is | +#' | --- | --- | --- | +#' | `logradouro` | 110-140 m | the stretch of street: good for maps and for distance | +#' | `localidade` | 7-40 km | the municipality centroid, because the CEP *is* the whole city | +#' +#' `raio_m` exists precisely so that error cannot pass unnoticed. +#' +#' @name cepis_geo +NULL + +#' The answer of `GET /health` +#' +#' @description +#' A plain list of class `cepis_health`, returned by [cep_health()]. Good for +#' two things: checking that the API answers, and knowing **which version of +#' the database** is live. The DNE database changes every two weeks; `dne` +#' identifies it. +#' +#' @section Fields: +#' \describe{ +#' \item{`status`}{`"ok"` when the API reports itself healthy.} +#' \item{`ok`}{`status == "ok"`. Derived, not sent by the API.} +#' \item{`dne`}{identifier of the fortnightly database.} +#' \item{`ceps`}{how many CEPs it holds.} +#' \item{`geo`}{how many of those carry a coordinate.} +#' \item{`base_gerada_em`}{when the base was generated, UTC.} +#' } +#' +#' @name cepis_health +NULL + +ADDRESS_FIELDS <- c( + "cep", "logradouro", "complemento", "unidade", "bairro", "localidade", + "uf", "estado", "regiao", "ibge", "gia", "ddd", "siafi" +) + +text_field <- function(data, name) { + value <- data[[name]] + if (is.null(value) || length(value) != 1L || is.na(value)) { + return("") + } + as.character(value) +} + +new_geo <- function(block) { + lat <- suppressWarnings(as.numeric(block[["lat"]])) + lon <- suppressWarnings(as.numeric(block[["lon"]])) + raio <- suppressWarnings(as.numeric(block[["raio_m"]])) + precisao <- block[["precisao"]] + + usable <- length(lat) == 1L && length(lon) == 1L && length(raio) == 1L && + length(precisao) == 1L && !anyNA(c(lat, lon, raio)) && + is.character(precisao) && !is.na(precisao) + if (!usable) { + return(NULL) + } + + structure( + list( + lat = lat, + lon = lon, + raio_m = as.integer(round(raio)), + precisao = precisao, + is_precise = identical(precisao, "logradouro") + ), + class = "cepis_geo" + ) +} + +new_address <- function(data) { + geo <- NULL + block <- data[["geo"]] + if (is.list(block)) { + geo <- new_geo(block) + } + + fields <- lapply(ADDRESS_FIELDS, function(name) text_field(data, name)) + names(fields) <- ADDRESS_FIELDS + + structure(c(fields, list(geo = geo, raw = data)), class = "cepis_address") +} + +new_health <- function(data) { + count <- function(name) { + value <- suppressWarnings(as.numeric(data[[name]])) + if (length(value) != 1L || is.na(value)) 0L else as.integer(value) + } + status <- text_field(data, "status") + + structure( + list( + status = status, + ok = identical(status, "ok"), + dne = text_field(data, "dne"), + ceps = count("ceps"), + geo = count("geo"), + base_gerada_em = text_field(data, "base_gerada_em") + ), + class = "cepis_health" + ) +} + +#' Add the mask to a CEP +#' +#' @description +#' `"01001000"` becomes `"01001-000"`. The API always answers unmasked; +#' formatting is presentation, and it lives here so it does not become a +#' repeated `paste0()` in every project that uses this package. +#' +#' @param x A [cepis_address] or a character vector of CEPs. +#' +#' @return A character vector of masked CEPs. A value that is not 8 digits is +#' returned unchanged, because this is a formatting helper and not a +#' validator — [normalize_cep()] is the validator. +#' +#' @examples +#' formatted_cep("01001000") +#' +#' @export +formatted_cep <- function(x) { + if (inherits(x, "cepis_address")) { + x <- x$cep + } + x <- as.character(x) + masked <- paste0(substr(x, 1L, 5L), "-", substr(x, 6L, 8L)) + ifelse(grepl("^[0-9]{8}$", x), masked, x) +} + +#' @export +print.cepis_address <- function(x, ...) { + cat("<cepis_address>", formatted_cep(x$cep), "\n") + street <- paste(c(x$logradouro, x$complemento, x$bairro), collapse = ", ") + cat(" ", street, "\n", sep = "") + cat(" ", x$localidade, "/", x$uf, " (IBGE ", x$ibge, ", DDD ", x$ddd, + ")\n", sep = "") + if (is.null(x$geo)) { + cat(" geo: none\n") + } else { + cat(" geo: ", x$geo$lat, ", ", x$geo$lon, " (raio ", x$geo$raio_m, + " m, ", x$geo$precisao, ")\n", sep = "") + } + invisible(x) +} + +#' @export +print.cepis_geo <- function(x, ...) { + cat("<cepis_geo> ", x$lat, ", ", x$lon, " (raio ", x$raio_m, " m, ", + x$precisao, ")\n", sep = "") + invisible(x) +} + +#' @export +print.cepis_health <- function(x, ...) { + cat("<cepis_health> ", x$status, "\n", sep = "") + cat(" dne: ", x$dne, " (generated ", x$base_gerada_em, ")\n", sep = "") + cat(" ceps: ", x$ceps, ", with geo: ", x$geo, "\n", sep = "") + invisible(x) +} diff --git a/R/normalize.R b/R/normalize.R new file mode 100644 index 0000000..e54c0ef --- /dev/null +++ b/R/normalize.R @@ -0,0 +1,43 @@ +#' Return the 8 digits of a CEP, accepting the mask +#' +#' @description +#' `"01001-000"`, `"01001000"`, `"01001.000"` and `" 01001-000 "` all become +#' `"01001000"`. +#' +#' This runs **before** any request: a 7-digit CEP is the caller's bug, and +#' spending a round trip for the server to say so wastes both sides' time. +#' +#' @param value A length-one character vector. Numbers are rejected on +#' purpose: `1001000` has already lost the leading zero that makes +#' `"01001000"` a CEP. Convert with `sprintf("%08d", x)` first. +#' +#' @return The 8 digits, as a length-one character vector. +#' +#' @section Conditions: +#' Signals [cepis_invalid_cep][cepis_conditions] unless exactly 8 digits +#' remain. +#' +#' @examples +#' normalize_cep("01001-000") +#' +#' @export +normalize_cep <- function(value) { + if (!is.character(value) || length(value) != 1L || is.na(value)) { + stop(invalid_cep_error( + paste0( + "CEP must be a length-one character vector, got ", + class(value)[1L], " of length ", length(value) + ), + value = value + )) + } + + cleaned <- gsub("[-. ]", "", trimws(value)) + if (!grepl("^[0-9]{8}$", cleaned)) { + stop(invalid_cep_error( + paste0("CEP must be 8 digits, got \"", value, "\""), + value = value + )) + } + cleaned +} |