R/card-tabset.R

In shidashi: A Shiny Dashboard Template System

card_tabset_header <- function(id_tabset, index, title, active = FALSE){
  shiny::tags$li(
    class = "nav-item nav-tab-header",
    shiny::a(
      class = ifelse(active, "nav-link active", "nav-link"),
      id = sprintf("%s-%s-tab", id_tabset, index),
      'data-toggle' = "tab",
      href = sprintf("#%s-%s", id_tabset, index),
      role = "tab",
      "aria-controls" = sprintf("%s-%s", id_tabset, index),
      "aria-selected" = ifelse(active, "true", "false"),
      # "tab-index" = index,
      title
    )
  )
}

card_tabset_content <- function(id_tabset, index, active, ...){
  shiny::div(
    class = ifelse(active, "tab-pane fade active fill-min-height show position-relative", "tab-pane fade fill-min-height position-relative"),
    id = sprintf("%s-%s", id_tabset, index),
    role = "tabpanel",
    "aria-labelledby" = sprintf("%s-%s-tab", id_tabset, index),
    # "tab-index" = index,
    ...
  )
}

#' @title Generates a set of card panels
#' @description To insert, remove, or active card panels, see
#' \code{\link{card_tabset_operate}}.
#' @param ... 'HTML' tags; each tag will be placed into a card
#' @param names title of the tabs
#' @param inputId the id of the card-set, must start with letters
#' @param title the title of the card-set
#' @param active the title that will be active on load
#' @param tools a list of tools or badges generated by
#' \code{\link{card_tool}} or \code{\link{as_badge}}
#' @param footer the footer element of the card-set
#' @param class the 'HTML' class the of card-set
#' @param class_header,class_body,class_foot additional 'HTML'
#' class the of card header, body, and footer accordingly
#' @return 'HTML' tags
#' @seealso \code{\link{card_tabset_operate}}
#' @examples
#'
#' library(shiny)
#' library(shidashi)
#'
#' # Fake session to operate on card_tabset without shiny
#' session <- MockShinySession$new()
#'
#' card_tabset(
#'   inputId = "card_set",
#'   title = "Cardset with Tools",
#'   `Tab 1` = p("Tab content 1"),
#'   class_body = "height-500",
#'   tools = list(
#'     as_badge(
#'       "New|badge-success"
#'     ),
#'     card_tool(
#'       widget = "collapse"
#'     ),
#'     card_tool(
#'       widget = "maximize"
#'     )
#'   )
#' )
#'
#' card_tabset_insert(
#'   inputId = "card_set",
#'   title = "Tab 2",
#'   p("New content"),
#'   session = session
#' )
#'
#' card_tabset_activate(
#'   inputId = "card_set",
#'   title = "Tab 1",
#'   session = session
#' )
#'
#' card_tabset_remove(
#'   inputId = "card_set",
#'   title = "Tab 2",
#'   session = session
#' )
#'
#'
#'
#' @export
card_tabset <- function(
  ..., inputId = rand_string(prefix = "tabset-"), title = NULL,
  names = NULL, active = NULL, tools = NULL, footer = NULL,
  class = "", class_header = "", class_body = "", class_foot = ""){

  call_ <- match.call()

  if(grepl("^[^a-zA-Z][^a-zA-Z0-9_-]{0,}", inputId)){
    stop("card_tabset: invalid `inputId`, can only have letters, digits, '-', or '_', and must start with letters.")
  }

  tabs <- list(...)
  ntabs <- length(tabs)
  if(!length(names)){
    names <- names(tabs)
  }
  if(length(names) != ntabs){
    stop("card_tabset: `names` must have the same length as tab elements")
  }

  if(length(title) >= 1){
    data_title <- trimws(as.character(title[[1]])[[1]])
  } else {
    data_title <- ""
  }

  if(length(title) == 1){
    title <- shiny::tags$li(
      class="pt-2 px-3",
      shiny::h4(class="card-title", title)
    )
  }
  if(length(active)){
    active <- active[[1]]
  } else if(length(names)){
    active <- names[[1]]
  }

  if(length(tools)){
    tools <- shiny::tags$li(class = "nav-item ml-auto",
                            shiny::div(class = "card-tools",
                                       tools))
  }

  if(!is.null(footer)){
    footer <- shiny::div(
      class = combine_class("card-footer", class_foot),
      footer
    )
  }

  set_attr_call(shiny::div(
    class = sprintf("card card-tabs %s", class),
    `data-title` = data_title,
    shiny::div(
      class = sprintf("card-header p-0 pt-1 %s", class_header),
      shiny::tags$ul(
        class = "nav nav-tabs",
        id = inputId,
        role = "tablist",
        title,
        lapply(seq_len(ntabs), function(ii) {
          title <- names[[ii]]
          card_tabset_header(inputId, ii, title, active = title %in% active)
        }),
        tools
      )
    ),
    shiny::div(
      class = combine_class("card-body", class_body),
      shiny::div(
        class = "tab-content",
        id = sprintf("%sContent", inputId),
        lapply(seq_len(ntabs), function(ii) {
          title <- names[[ii]]
          card_tabset_content(inputId, ii, active = title %in% active, tabs[[ii]])
        })
      )
    ),
    footer
  ), call = call_)
}

#' @name card_tabset_operate
#' @title Add, active, or remove a card within \code{\link{card_tabset}}
#' @param inputId the element id of \code{\link{card_tabset}}
#' @param title the title of the card to insert, activate, or to remove
#' @param ... the content of the card
#' @param active whether to set the card to be active once added
#' @param notify_on_failure whether to show notifications on failure
#' @param session shiny session domain
#' @return These functions execute \code{session$sendCustomMessage} and return
#' whatever value generated by that function; usually nothing.
#' @seealso \code{\link{card_tabset}}
#' @export
card_tabset_insert <- function(inputId, title, ..., active = TRUE,
                            notify_on_failure = TRUE, session = shiny::getDefaultReactiveDomain()){
  session$sendCustomMessage(
    "shidashi.card_tabset_insert",
    list(
      inputId = session$ns(inputId),
      title = title,
      body = as.character(shiny::tagList(...)),
      active = isTRUE(active),
      notify_on_failure = isTRUE(notify_on_failure)
    )
  )
}

#' @rdname card_tabset_operate
#' @export
card_tabset_remove <- function(inputId, title, notify_on_failure = TRUE, session = shiny::getDefaultReactiveDomain()){
  session$sendCustomMessage(
    "shidashi.card_tabset_remove",
    list(
      inputId = session$ns(inputId),
      title = title,
      notify_on_failure = isTRUE(notify_on_failure)
    )
  )
}

#' @rdname card_tabset_operate
#' @export
card_tabset_activate <- function(inputId, title, notify_on_failure = TRUE, session = shiny::getDefaultReactiveDomain()){
  session$sendCustomMessage(
    "shidashi.card_tabset_activate",
    list(
      inputId = session$ns(inputId),
      title = title,
      notify_on_failure = isTRUE(notify_on_failure)
    )
  )
}