haml.R

library(rlang)

# from adv-r
partition_nameness <- function(lst) {
  is_named <- names(lst) != ""
  list(
    named = lst[is_named],
    unnamed = lst[!is_named]
  )
}

partition_children <- function(lst) {
  children <- list()
  inner <- list()
  for (i in seq_along(lst)) {
    leaf <- lst[[i]]
    if (length(leaf) > 1) {
      children[[i]] <- leaf
    } else {
      inner[[i]] <- leaf
    }
  }
  list(children = children, inner = inner)
}

get_class <- function(lst) {
  if (is.null(lst$class)) {
    return("")
  }
  cls <- strsplit(lst$class, " ")[[1]]
  cls <- sapply(cls, function(x) {paste0(".", x)})
  paste0(cls, collapse = "")
}

get_id <- function(lst) {
  if (is.null(lst$id)) {
    return("")
  }
  paste0("#", lst$id)
}

get_inner <- function(lst) {
  # TODO: handle escapes
  paste0(" ", lst, collapse = '\n')
}

get_atts <- function(lst) {
  if (length(lst) < 1) {
    return("")
  }
  # need to escape characters here
  at_names <- names(lst)
  vars <- paste0(at_names, " => ", lst)
  vars <- paste0(vars, collapse = ", ")
  paste0("{", vars, "}")
}

get_name <- function(html_name) {
  if (is.null(html_name)) {
    return("")
  }
  if (html_name == "div") {
    return("")
  }
  paste0("%", html_name)
}

homl <- function(html, indent) {
  if (length(html) < 1) {
    return("")
  }

  out <- ""
  for (i in seq_along(html)) {
    ahtml <- html
    if (length(html[[i]]) != 1) {
      ahtml <- html[[i]]
    }
    named <- get_name(ahtml$name)
    classes <- get_class(ahtml$attribs)
    ahtml$attribs$class <- NULL

    id <- get_id(ahtml$attribs)
    ahtml$attribs$id <- NULL

    atts <- get_atts(ahtml$attribs)
    childs <- partition_children(ahtml$children)
    inner <- get_inner(childs$inner)

    out <- paste0(
      strrep(" ", indent),
      out,
      named,
      classes,
      id,
      inner,
      "\n  ",
      homl(childs$children, indent + 2)
    )
    out <- paste0(out, "\n")
  }
  out
}

# example1: homl(list(name = "div", attribs = list(class = "shiyn hello", id = "ker")))
# example2:

y <- tags$div(class = "row",
              tags$div(class = "col-sm-4",
                       tags$form(class = "well",
                                 tags$div(class = "form-group shiny-input-container",
                                          tags$label(class = "control-label", `for` = "category", "Category"),
                                          tags$div(
                                            tags$select(class = "basic-select", id = "category",
                                                        tags$option(value = "A", selected = NA, "A"),
                                                        tags$option(value = "B", "B"),
                                                        tags$option(value = "CD", "C & D")
                                            )
                                          )
                                 )
                       )
              ),
              tags$div(class = "col-sm-8",
                       tags$div(id="plot", class="shiny-plot-output", style="width: 100%; height: 400px")
              )
)

x <- tags$section(class = "container",
                       tags$h1("This is a title"),
                       tags$h2("A subtitle"),
                       tags$div(class = "content",
                                "This is some body content! You can",
                                "put multiple lines here."
                       )
)