Merge pull request #24 from InControlofEffects/dev

Version 0.1.0

.Rbuildignore

@@ -26,3 +26,5 @@
 ^webpack\.config\.js$
 ^src$
 ^pkgbump\.config\.json$
+^\.lintr$
+^pnpm-lock\.yaml$

.lintr

@@ -0,0 +1,2 @@
+linters: with_defaults(line_length_linter = line_length_linter(81), commented_code_linter = NULL, object_name_linter = NULL)
+exclusions: list("src/")

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: iceComponents
 Title: A set of custom components used in the In Control of Effects application
-Version: 0.0.9
+Version: 0.1.0
 Authors@R: 
     person(
         given = "David",
@@ -16,9 +16,9 @@ LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.1
 Imports: 
-    htmltools (>= 0.5.0),
-    rheroicons (>= 0.2.3),
-    shiny (>= 1.5.0),
+    htmltools (>= 0.5.1.1),
+    rheroicons (>= 0.3.1),
+    shiny (>= 1.6.0),
     R6
 Remotes: 
     davidruvolo51/rheroicons

R/accordion.R

@@ -93,7 +93,7 @@ accordion <- function(
     ids <- accordion_helpers$set_html_ids(inputId = inputId)
 
     # build child elements
-    el <- tags$div(
+    el <- htmltools::tags$div(
         id = ids$group,
         class = "accordion accordion__default",
         accordion_helpers$heading(
@@ -134,4 +134,79 @@ reset_accordion <- function(inputId) {
         inputId = inputId,
         message = "reset"
     )
+}
+
+#' accordion_helpers
+#' Create a series of secondary functions that generate child elements of the
+#' accordion and process arguments. These functions are added to a nested list
+#' object that is called inthe main function.
+#' @noRd
+accordion_helpers <- list()
+
+
+#' set_html_ids
+#' Define a function that generates the IDs and data attributes for properly
+#' linking elements across helper functions
+#' @param inputId a user defined
+#' @noRd
+accordion_helpers$set_html_ids <- function(inputId) {
+    ns <- shiny::NS(namespace = inputId)
+    ids <- list(
+        group = inputId,
+        heading_id = ns("accordionHeading"),
+        button_id = ns("accordionBtn"),
+        content_id = ns("accordionSection")
+    )
+    return(ids)
+}
+
+#' @name heading
+#' Define a function that returns the heading of the accordion section. This
+#' function returns a heading element (<h4>) that places the title in a button.
+#' The button is used to open and close the hidden section. This function is
+#' used in the primary function along with the `content()` function.
+#' @param ids a list object generated by set_html_ids
+#' @param title user defined title
+#' @param props the processed arguments generated from the validate_props func
+#' @importFrom htmltools tags tagList
+#' @noRd
+accordion_helpers$heading <- function(ids, title, heading_level) {
+    htmltools::tags[[heading_level]](
+        id = ids$heading_id,
+        class = "accordion__heading",
+        `data-accordion-group` = ids$group,
+        htmltools::tags$button(
+            id = ids$button_id,
+            class = "accordion__toggle",
+            `data-accordion-group` = ids$group,
+            `aria-controls` = ids$content_id,
+            `aria-expanded` = "false",
+            htmltools::tags$span(
+                class = "toggle__label",
+                title
+            ),
+            rheroicons::rheroicon(
+                name = "chevron_down",
+                type = "outline",
+                class = "toggle__icon"
+            )
+        )
+    )
+}
+
+#' \code{content}
+#' Define a function that creates the collapsible element in the accordion.
+#' This function is used in the primary function along with the `heading()`
+#' function.
+#' @param ids a list object generated by set_html_ids
+#' @param content user defined html element or tagList of elements
+#' @noRd
+accordion_helpers$content <- function(ids, content) {
+    htmltools::tags$section(
+        id = ids$content_id,
+        class = "accordion__content",
+        `aria-labelledby` = ids$heading_id,
+        hidden = "",
+        content
+    )
 }

R/accordion_input.R

@@ -76,8 +76,8 @@
 #'   shinyApp(ui, server)
 #' }
 #'
-#' @importFrom htmltools tags tagList
 #' @return Create an accordion component that is also a checkbox input
+#'
 #' @export
 accordion_input <- function(
     inputId,
@@ -97,7 +97,7 @@ accordion_input <- function(
     ids <- accordion_input_helpers$set_html_ids(inputId = inputId)
 
     # build child elements
-    el <- tags$div(
+    el <- htmltools::tags$div(
         id = ids$group,
         class = "accordion accordion__input",
         `data-accordion-initial-state` = tolower(checked),
@@ -156,4 +156,99 @@ clear_accordion_input <- function(inputId) {
         inputId = inputId,
         message = "clearAccordionInput"
     )
+}
+
+#' accordion_input_helpers
+#'
+#' Create a series of secondary functions that generate child elements of the
+#' accordion and process arguments. These functions are added to a nested list
+#' object that is called in the main function.
+#'
+#' @noRd
+accordion_input_helpers <- list()
+
+
+#' set_html_ids
+#'
+#' Define a function that generates the IDs and data attributes for properly
+#' linking elements across helper functions
+#'
+#' @param inputId a user defined ID
+#'
+#' @noRd
+accordion_input_helpers$set_html_ids <- function(inputId) {
+    list(
+        group = inputId,
+        checkbox_id = paste0(inputId, "-accordionInput"),
+        button_id = paste0(inputId, "-accordionBtn"),
+        content_id = paste0(inputId, "-accordionSection"),
+        label_id = paste0(inputId, "-accordionInputLabel")
+    )
+}
+
+#' @name heading
+#'
+#' Define a function that returns the checkbox input element and the accordion
+#' toggle button, which is used to open and close the hidden section. This
+#' function is used in the primary function along with `content()`.
+#'
+#' @param ids a list object generated by set_html_ids
+#' @param title user defined title
+#' @param checked a logical argument to determin if the input element
+#'      should be checked by default
+#'
+#' @noRd
+accordion_input_helpers$heading <- function(ids, title, checked) {
+
+    i <- htmltools::tags$input(
+        type = "checkbox",
+        class = "accordion__checkbox",
+        id = ids$checkbox_id
+    )
+
+    # add checked attribute (if applicable)
+    if (checked) i[["attribs"]][["checked"]] <- "true"
+
+    # generate markup
+    htmltools::tagList(
+        i,
+        htmltools::tags$label(
+            id = ids$label_id,
+            `for` = ids$checkbox_id,
+            class = "accordion__heading",
+            title
+        ),
+        htmltools::tags$button(
+            id = ids$button_id,
+            class = "accordion__toggle",
+            `aria-controls` = ids$content_id,
+            `aria-labelledby` = ids$label_id,
+            `aria-expanded` = "false",
+            rheroicons::rheroicon(
+                name = "chevron_down",
+                type = "outline",
+                class = "toggle__icon"
+            )
+        )
+    )
+}
+
+#' content
+#'
+#' Define a function that creates the collapsible element in the accordion.
+#' This function is used in the primary function along with the `heading()`
+#' function.
+#'
+#' @param ids a list object generated by set_html_ids
+#' @param content user defined html element or tagList of elements
+#'
+#' @noRd
+accordion_input_helpers$content <- function(ids, content) {
+    htmltools::tags$section(
+        id = ids$content_id,
+        class = "accordion__content",
+        `aria-labelledby` = ids$label_id,
+        hidden = "",
+        content
+    )
 }

R/card.R

@@ -54,15 +54,15 @@ card <- function(
     css <- "ice__card"
     if (!is.null(class)) css <- paste0(css, " ", class)
 
-    tags$div(
+    htmltools::tags$div(
         id = inputId,
         class = css,
         rheroicons::rheroicon(
             name = icon_name,
             type = icon_type,
-            classnames = "ice__card__icon"
+            class = "ice__card__icon"
         ),
-        tags$p(
+        htmltools::tags$p(
             class = "ice__card__label",
             htmltools::HTML(text)
         )

R/card_group.R

@@ -58,5 +58,5 @@
 card_group <- function(..., class = NULL) {
     css <- "card__group"
     if (!is.null(class)) css <- paste0(css, " ", class)
-    tags$div(class = css, ...)
+    htmltools::tags$div(class = css, ...)
 }

R/checkbox_group.R

@@ -76,10 +76,10 @@ checkbox_group <- function(
     }
 
     # generate markup for parent element
-    parent <- tags$fieldset(
+    parent <- htmltools::tags$fieldset(
         id = inputId,
         class = "checkbox__group",
-        tags$legend(
+        htmltools::tags$legend(
             class = "checkbox__title",
             title
         ),
@@ -91,8 +91,8 @@ checkbox_group <- function(
 
     # attach caption
     if (!is.null(caption)) {
-        parent$children <- tagList(
-            tags$p(
+        parent$children <- htmltools::tagList(
+            htmltools::tags$p(
                 class = "checkbox__caption",
                 caption
             ),
@@ -136,4 +136,75 @@ clear_checkbox_group <- function(inputId) {
         inputId = inputId,
         message = "clear"
     )
-}
+}
+
+#' checkbox_group_helpers
+#'
+#' Create a series of secondary functions that generate the required elements
+#' for creating a checkbox input component. The following functions are added
+#' to a nested list object and used in the main function.
+#'
+#' @noRd
+checkbox_group_helpers <- list()
+
+
+#' checkbox_option
+#'
+#' Create a single checkbox option based
+#' @param inputId a unique id for the checkbox option
+#' @param choice a name for the option
+#' @param value an value for the option (is choice by default)
+#' @param checked if TRUE, then input will be checked at render
+#' @importFrom htmltools tags tagList
+#' @noRd
+checkbox_group_helpers$checkbox_option <- function(
+    inputId,
+    choice,
+    value,
+    checked
+) {
+
+    # create input
+    i <- htmltools::tags$input(
+        id = choice,
+        class = "option__checkbox",
+        type = "checkbox",
+        name = inputId
+    )
+
+    # add checked when TRUE
+    if (checked) i$attribs$checked <- "true"
+
+    # generate markup
+    el <- htmltools::tags$div(
+        class = "checkbox__group__option",
+        i,
+        htmltools::tags$label(
+            `for` = choice,
+            class = "option__label",
+            choice
+        )
+    )
+
+    return(el)
+}
+
+
+#' checkox_set
+#'
+#' Create a series of checkbox inputs
+#' @param inputId an ID for the group of inputs
+#' @param data an object containing choices, values, checked status
+#' @noRd
+checkbox_group_helpers$checkbox_set <- function(inputId, data) {
+    children <- list()
+    lapply(seq_len(length(data$choices)), function(index) {
+        children[[index]] <<- checkbox_group_helpers$checkbox_option(
+            inputId = inputId,
+            choice = data$choice[[index]],
+            value = data$value[[index]],
+            checked = data$checked[[index]]
+        )
+    })
+    return(children)
+}

R/container.R

@@ -26,5 +26,5 @@
 container <- function(..., class = NULL) {
     css <- "main"
     if (!is.null(class)) css <- paste0(css, " ", class)
-    tags$main(id = "main", class = css, ...)
+    htmltools::tags$main(id = "main", class = css, ...)
 }

R/error_box.R

@@ -59,12 +59,12 @@ error_box <- function(
     css <- "error__box error__hidden"
     if (!is.null(class)) css <- paste0(css, " ", class)
 
-    tags$div(
+    htmltools::tags$div(
         id = inputId,
         class = css,
         role = "alert",
         rheroicons::rheroicon(name = icon_name, type = icon_type),
-        tags$span(class = "error__box__text")
+        htmltools::tags$span(class = "error__box__text")
     )
 }