parse_json: Parse application/json data

In JohnCoene/ambiorix: Web Framework Inspired by 'Express.js'

Parse application/json data

Description

This function parses JSON data from the request body.

Usage

parse_json(req, ...)

Arguments

req	The request object.
...	Additional parameters passed to the parser function.

Details

Overriding Default Parser

By default, parse_json() uses yyjsonr::read_json_raw() for JSON parsing. You can override this globally by setting the AMBIORIX_JSON_PARSER option:

my_json_parser <- function(body, ...) {
  txt <- rawToChar(body)
  jsonlite::fromJSON(txt, ...)
}
options(AMBIORIX_JSON_PARSER = my_json_parser)

Your custom parser MUST accept the following parameters:

1. body: Raw vector containing the JSON data.

2. ...: Additional optional parameters.

Value

An R object (e.g., list or data frame) parsed from the JSON data.

See Also

parse_multipart(), parse_form_urlencoded()

Examples

if (interactive()) {
  library(ambiorix)
  library(htmltools)
  library(readxl)

  page_links <- function() {
    Map(
      f = function(href, label) {
        tags$a(href = href, label)
      },
      c("/", "/about", "/contact"),
      c("Home", "About", "Contact")
    )
  }

  forms <- function() {
    form1 <- tags$form(
      action = "/url-form-encoded",
      method = "POST",
      enctype = "application/x-www-form-urlencoded",
      tags$h4("form-url-encoded:"),
      tags$label(`for` = "first_name", "First Name"),
      tags$input(id = "first_name", name = "first_name", value = "John"),
      tags$label(`for` = "last_name", "Last Name"),
      tags$input(id = "last_name", name = "last_name", value = "Coene"),
      tags$button(type = "submit", "Submit")
    )

    form2 <- tags$form(
      action = "/multipart-form-data",
      method = "POST",
      enctype = "multipart/form-data",
      tags$h4("multipart/form-data:"),
      tags$label(`for` = "email", "Email"),
      tags$input(id = "email", name = "email", value = "[e-mail]"),
      tags$label(`for` = "framework", "Framework"),
      tags$input(id = "framework", name = "framework", value = "ambiorix"),
      tags$label(`for` = "file", "Upload CSV file"),
      tags$input(type = "file", id = "file", name = "file", accept = ".csv"),
      tags$label(`for` = "file2", "Upload xlsx file"),
      tags$input(type = "file", id = "file2", name = "file2", accept = ".xlsx"),
      tags$button(type = "submit", "Submit")
    )

    tagList(form1, form2)
  }

  home_get <- function(req, res) {
    html <- tagList(
      page_links(),
      tags$h3("hello, world!"),
      forms()
    )

    res$send(html)
  }

  home_post <- function(req, res) {
    body <- parse_json(req)
    cat(strrep(x = "-", times = 10), "\n")
    cat("Parsed JSON:\n")
    print(body)
    cat(strrep(x = "-", times = 10), "\n")

    response <- list(
      code = 200L,
      msg = "hello, world"
    )
    res$json(response)
  }

  url_form_encoded_post <- function(req, res) {
    body <- parse_form_urlencoded(req)
    cat(strrep(x = "-", times = 8), "\n")
    cat("Parsed application/x-www-form-urlencoded:\n")
    print(body)
    cat(strrep(x = "-", times = 8), "\n")

    list_items <- lapply(
      X = names(body),
      FUN = function(nm) {
        tags$li(
          nm,
          ":",
          body[[nm]]
        )
      }
    )
    input_vals <- tags$ul(list_items)

    html <- tagList(
      page_links(),
      tags$h3("Request processed"),
      input_vals
    )

    res$send(html)
  }

  multipart_form_data_post <- function(req, res) {
    body <- parse_multipart(req)

    list_items <- lapply(
      X = names(body),
      FUN = function(nm) {
        field <- body[[nm]]

        # if 'field' is a file, parse it & print on console:
        is_file <- "filename" %in% names(field)
        is_csv <- is_file && identical(field[["content_type"]], "text/csv")
        is_xlsx <- is_file &&
          identical(
            field[["content_type"]],
            "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
          )

        if (is_file) {
          file_path <- tempfile()
          writeBin(object = field$value, con = file_path)
          on.exit(unlink(x = file_path))
        }

        if (is_csv) {
          print(read.csv(file = file_path))
        }

        if (is_xlsx) {
          print(readxl::read_xlsx(path = file_path))
        }

        tags$li(
          nm,
          ":",
          if (is_file) "printed on console" else field
        )
      }
    )
    input_vals <- tags$ul(list_items)

    html <- tagList(
      page_links(),
      tags$h3("Request processed"),
      input_vals
    )

    res$send(html)
  }

  about_get <- function(req, res) {
    html <- tagList(
      page_links(),
      tags$h3("About Us")
    )
    res$send(html)
  }

  contact_get <- function(req, res) {
    html <- tagList(
      page_links(),
      tags$h3("Get In Touch!")
    )
    res$send(html)
  }

  app <- Ambiorix$new(port = 5000L)

  app$
    get("/", home_get)$
    post("/", home_post)$
    get("/about", about_get)$
    get("/contact", contact_get)$
    post("/url-form-encoded", url_form_encoded_post)$
    post("/multipart-form-data", multipart_form_data_post)

  app$start()
}

JohnCoene/ambiorix documentation built on March 5, 2025, 5:35 a.m.