Skip to content

Commit

Permalink
Merge pull request #12 from andyquinterom/T11
Browse files Browse the repository at this point in the history
chore: Cran suggestions
  • Loading branch information
pierina-ixpantia authored Oct 17, 2024
2 parents b3bfdf6 + b805ee3 commit d49d843
Show file tree
Hide file tree
Showing 4 changed files with 28 additions and 25 deletions.
2 changes: 2 additions & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,8 @@ Description: The best way to implement middle ware for 'shiny' Applications. 'to
model for incoming HTTP requests and server sessions. 'tower' is a very minimal
package with little overhead, it is mainly meant for other package developers
to implement new behavior.
URL: https://github.com/ixpantia/tower
BugReports: https://github.com/ixpantia/tower/issues
License: MIT + file LICENSE
Encoding: UTF-8
Roxygen: list(markdown = TRUE)
Expand Down
24 changes: 12 additions & 12 deletions R/http_helpers.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@
#' @param method A string containing the HTTP method to match
#' @param path A string containing the path to match
#' @param handler A function to call when the layer is matched
#' @return A tower object with the layer added
#' @value The tower with the added route
#' @export
add_route <- function(tower, method = "GET", path, handler) {
handler <- compiler::cmpfun(handler)
Expand All @@ -22,7 +22,7 @@ add_route <- function(tower, method = "GET", path, handler) {
#' @param tower A tower object
#' @param path A string containing the path to match
#' @param handler A function to call when the route is matched
#' @return A tower object with the route added
#' @value The tower with the added GET route
#' @export
add_get_route <- function(tower, path, handler) {
add_route(tower, "GET", path, handler)
Expand All @@ -33,7 +33,7 @@ add_get_route <- function(tower, path, handler) {
#' @param tower A tower object
#' @param path A string containing the path to match
#' @param handler A function to call when the route is matched
#' @return A tower object with the route added
#' @value The tower with the added POST route
#' @export
add_post_route <- function(tower, path, handler) {
add_route(tower, "POST", path, handler)
Expand All @@ -44,7 +44,7 @@ add_post_route <- function(tower, path, handler) {
#' @param tower A tower object
#' @param path A string containing the path to match
#' @param handler A function to call when the route is matched
#' @return A tower object with the route added
#' @value The tower with the added PUT route
#' @export
add_put_route <- function(tower, path, handler) {
add_route(tower, "PUT", path, handler)
Expand All @@ -55,7 +55,7 @@ add_put_route <- function(tower, path, handler) {
#' @param tower A tower object
#' @param path A string containing the path to match
#' @param handler A function to call when the route is matched
#' @return A tower object with the route added
#' @value The tower with the added DELETE route
#' @export
add_delete_route <- function(tower, path, handler) {
add_route(tower, "DELETE", path, handler)
Expand All @@ -66,7 +66,7 @@ add_delete_route <- function(tower, path, handler) {
#' @param tower A tower object
#' @param path A string containing the path to match
#' @param handler A function to call when the route is matched
#' @return A tower object with the route added
#' @value The tower with the added PATCH route
#' @export
add_patch_route <- function(tower, path, handler) {
add_route(tower, "PATCH", path, handler)
Expand All @@ -78,7 +78,7 @@ add_patch_route <- function(tower, path, handler) {
#' @param ... Additional arguments to pass to \code{\link[jsonlite]{fromJSON}}
#' when parsing the request body. This will only be used the first time the
#' request body is parsed. Subsequent calls will return the cached result.
#' @return A list containing the request body
#' @value The R object representation of the body's JSON content
#' @export
req_body_json <- function(req, ...) {
if (!is.null(req[[".parsed.body.json"]])) {
Expand All @@ -100,7 +100,7 @@ req_body_json <- function(req, ...) {
#' @title Extract form data from a request
#' @description Extracts form data from a request
#' @param req A request object
#' @return A list containing the form data
#' @value A list containing the form data in the body
#' @export
req_body_form <- function(req) {
if (!is.null(req[[".parsed.body.form"]])) {
Expand All @@ -120,7 +120,7 @@ req_body_form <- function(req) {
#' @title Extract query parameters from a request
#' @description Extracts query parameters from a request
#' @param req A request object
#' @return A list containing the query parameters
#' @value A list containing the query parameters
#' @export
req_query <- function(req) {
if (!is.null(req[[".parsed.query"]])) {
Expand Down Expand Up @@ -152,7 +152,7 @@ cookie_unescape <- function(.x) {
#'
#' @param x A string containing the cookies
#'
#' @return A list containing the cookies
#' @value A list containing the HTTP cookies
#' @keywords internal
parse_cookies <- function(x) {
if (is.null(x)) {
Expand All @@ -178,7 +178,7 @@ cookie_to_header <- function(.x, .y) {
#' @param key A string containing the cookie key
#' @param value A string containing the cookie value
#'
#' @return A string containing the cookie
#' @value A string containing the formated cookie
#' @export
build_http_cookie <- function(key, value) {
glue::glue("{key}={value}; path=/; SameSite=Lax; HttpOnly")
Expand All @@ -187,7 +187,7 @@ build_http_cookie <- function(key, value) {
#' @title Extract cookies from a request
#' @description Extracts cookies from a request
#' @param req A request object
#' @return A list containing the cookies
#' @value A list containing the cookies
#' @export
req_cookies <- function(req) {
if (!is.null(req[[".parsed.cookies"]])) {
Expand Down
16 changes: 8 additions & 8 deletions R/response_builder.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
#' @title Create a response builder
#' @description Creates a response builder
#' @return A response builder object
#' @value A response builder object
#' @export
response_builder <- function() {
resp <- new.env(parent = emptyenv())
Expand All @@ -20,7 +20,7 @@ response_builder <- function() {
#' @param res A response builder object
#' @param name The name of the header
#' @param value The value of the header
#' @return The response builder object
#' @value The response builder object
#' @export
set_header <- function(res, name, value) {
res$headers[[name]] <- value
Expand All @@ -31,7 +31,7 @@ set_header <- function(res, name, value) {
#' @description Sets the status of a response
#' @param res A response builder object
#' @param status The status to set
#' @return The response builder object
#' @value The response builder object
#' @export
set_status <- function(res, status) {
res$status <- status
Expand All @@ -43,7 +43,7 @@ set_status <- function(res, status) {
#' @param res A response builder object
#' @param name The name of the cookie
#' @param value The value of the cookie
#' @return The response builder object
#' @value The response builder object
#' @export
add_cookie <- function(res, name, value) {
res$cookies[[name]] <- value
Expand All @@ -54,7 +54,7 @@ add_cookie <- function(res, name, value) {
#' @description Sets the content type of a response
#' @param res A response builder object
#' @param content_type The content type to set
#' @return The response builder object
#' @value The response builder object
#' @export
set_content_type <- function(res, content_type) {
res$content_type <- content_type
Expand Down Expand Up @@ -111,7 +111,7 @@ serialize_body <- function(body, content_type) {
#' @description Adds a body to a response, if no content type is set, it will be detected
#' @param res A response builder object
#' @param body The body to add
#' @return The response builder object
#' @value The response builder object
#' @export
add_body <- function(res, body) {
if (is.null(res$content_type)) {
Expand All @@ -125,7 +125,7 @@ add_body <- function(res, body) {
#' @description Adds a body to a response as JSON
#' @param res A response builder object
#' @param body The body to add
#' @return The response builder object
#' @value The response builder object
#' @export
add_body_json <- function(res, body) {
set_content_type(res, "application/json")
Expand All @@ -136,7 +136,7 @@ add_body_json <- function(res, body) {
#' @title Build a response
#' @description Builds a response
#' @param res A response builder object
#' @return A response object
#' @value A 'shiny' response object
#' @export
build_response <- function(res) {
content_type <- ifelse(
Expand Down
11 changes: 6 additions & 5 deletions R/service.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ compiler_options <- list(optimize = 3L)
#' @title Create a new tower
#' @description Create a new tower to build upon.
#' @param app A 'shiny' app object
#' @return A new tower
#' @value A new tower object to add more layers to
#' @export
create_tower <- function(app) {
structure(
Expand All @@ -21,6 +21,7 @@ create_tower <- function(app) {
#' @description Print a tower
#' @param x A tower
#' @param ... Ignored arguments (for compatibility with print)
#' @value No return value, called for side effects
#' @export
print.tower <- function(x, ...) {
cat(
Expand All @@ -37,7 +38,7 @@ print.tower <- function(x, ...) {
#' a response. A layer can short circuit by returning a response
#' directly or call the next layer will `req$NEXT(req)` which
#' will call the next layer in the middleware.
#' @return The tower with the layer added
#' @value The tower with the added layer
#' @export
add_http_layer <- function(tower, layer) {
tower$http_layers <- c(
Expand All @@ -57,7 +58,7 @@ add_http_layer <- function(tower, layer) {
#' and has no return value. This function will be called before
#' the original server function. If you want to short-circuit
#' the server use an exception.
#' @return The tower with the layer added
#' @value The tower with the added layer
#' @export
add_server_layer <- function(tower, layer) {
tower$server_layers <- c(
Expand Down Expand Up @@ -137,7 +138,7 @@ build_server <- function(tower) {
#' @description Build a 'shiny' app from a tower. This will create
#' a new 'shiny' app with the specified layers added.
#' @param tower A tower
#' @return A 'shiny' app object that can be started
#' @value A 'shiny' app object that can be started
#' @export
build_tower <- function(tower) {
app <- tower$app
Expand All @@ -149,7 +150,7 @@ build_tower <- function(tower) {
#' @title Into parts
#' @description Splits a shiny.appobj into its parts, the ui and server
#' @param app A shiny.appobj
#' @return A list with the ui and server handlers
#' @value A list with the ui and server handlers
#' @export
app_into_parts <- function(app) {
ui <- app$httpHandler
Expand Down

0 comments on commit d49d843

Please sign in to comment.