Implemented add_to_sidebar; Added global sidebar

DESCRIPTION

@@ -17,7 +17,8 @@ Imports:
     flexdashboard,
     yaml,
     assertive.sets,
-    stringr
+    stringr,
+    glue
 Suggests: 
     highcharter,
     plotly,
@@ -39,4 +40,5 @@ Collate:
     'get_set.R'
     'pages.R'
     'reexports.R'
+    'sidebar.R'
     'vis_objects.R'

NAMESPACE

@@ -3,6 +3,7 @@
 export("%>%")
 export(add_component)
 export(add_page)
+export(add_to_sidebar)
 export(assemble)
 export(embed_var)
 export(i2dashboard)
@@ -11,6 +12,7 @@ export(remove_page)
 exportClasses(i2dashboard)
 exportMethods(add_component)
 exportMethods(add_page)
+exportMethods(add_to_sidebar)
 exportMethods(assemble)
 exportMethods(remove_page)
 importFrom(magrittr,"%>%")

R/AllGenerics.R

@@ -11,6 +11,9 @@ setGeneric("remove_page", function(dashboard, ...) standardGeneric("remove_page"
 #' @export
 setGeneric("add_component", function(dashboard, component, ...) standardGeneric("add_component"))
 
+#' @export
+setGeneric("add_to_sidebar", function(dashboard, component, ...) standardGeneric("add_to_sidebar"))
+
 #' @export
 setGeneric("interactivity", function(dashboard) standardGeneric("interactivity"))
 setGeneric("interactivity<-", function(dashboard, value) standardGeneric("interactivity<-"))

R/assemble.R

@@ -30,6 +30,15 @@ setMethod("assemble", "i2dashboard", function(dashboard, pages = names(dashboard
     pages <- pages[-na.omit(match(exclude, pages))]
   }
 
+  # Handle global sidebar if it has content
+  if(length(dashboard@sidebar) > 0) {
+    knitr::knit_expand(file = system.file("templates", "global_sidebar.Rmd", package = "i2dash"),
+                       delim = c("<%", "%>"),
+                       content = dashboard@sidebar,
+                       datawidth = 250) %>%
+      cat(file = tmp_document, append = TRUE, sep="\n")
+  }
+
   # write page to tempfile
   for (pagename in pages){
     name <- .create_page_name(pagename)
@@ -43,7 +52,7 @@ setMethod("assemble", "i2dashboard", function(dashboard, pages = names(dashboard
       sidebar <- dashboard@pages[[name]]$sidebar
 
       .render_page(title = title, components = components, layout = layout,  menu = menu, sidebar = sidebar) %>%
-        cat(file = tmp_document, append = TRUE, sep='')
+        cat(file = tmp_document, append = TRUE, sep="\n")
     } else {
       warning(sprintf("i2dashboard dashboard does not contain a page named '%s'", pagename))
     }
@@ -72,7 +81,8 @@ setMethod("assemble", "i2dashboard", function(dashboard, pages = names(dashboard
 .render_page <- function(title, components, layout = c("default", "storyboard", "focal_left", "2x2_grid"), menu = NULL, sidebar = NULL) {
   if(!is.null(sidebar)) {
     sidebar <- knitr::knit_expand(file = system.file("templates", "sidebar_template.Rmd", package = "i2dash"),
-                                  content = sidebar)
+                                  delim = c("<%", "%>"),
+                                  content = sidebar, datawidth = 250)
   }
 
   template <- switch(layout,

R/components.R

@@ -86,15 +86,19 @@ embed_var <- function(x, ...) {
   xfun::embed_file(f, text = 'Download full data as .csv', ...)
 }
 
-#' Method to embed content from a text file in a component
+#' Method to embed content from a text file in a component/sidebar
 #'
 #' @param file The file containing the text content.
 #' @param title The components title.
+#' @param raw Whether or not to emit raw file content
 #'
 #' @return A character string containing the evaluated component
-render_text <- function(file, title = NULL) {
-  content <- readLines(con = file)
-  knitr::knit_expand(file = system.file("templates", "text_component.Rmd", package = "i2dash"),
+render_text <- function(file, title = NULL, raw = FALSE) {
+  readLines(con = file) %>%
+    paste(collapse = "\n") -> content
+
+  if(raw) return(content)
+  knitr::knit_expand(file = system.file("templates", "component.Rmd", package = "i2dash"),
                      delim = c("<%", "%>"),
                      content = content,
                      title = title)
@@ -105,15 +109,18 @@ render_text <- function(file, title = NULL) {
 #' @param image The path to the image file.
 #' @param image_alt_text The alt text of the image.
 #' @param title The components title.
+#' @param raw Whether or not to emit solely the markdown image code.
 #'
 #' @return A character string containing the evaluated component
-render_image <- function(image, image_alt_text = NULL, title = NULL) {
+render_image <- function(image, image_alt_text = NULL, title = NULL, raw = FALSE) {
   if(is.null(image_alt_text)) {
     image_alt_text <- image
   }
-  knitr::knit_expand(file = system.file("templates", "image_component.Rmd", package = "i2dash"),
+  content <- glue::glue("![{image_alt_text}]({image})\n", image_alt_text = image_alt_text, image = image)
+
+  if(raw) return(content)
+  knitr::knit_expand(file = system.file("templates", "component.Rmd", package = "i2dash"),
                      delim = c("<%", "%>"),
-                     image = image,
-                     image_alt_text = image_alt_text,
+                     content = content,
                      title = title)
 }

R/i2dashboard.R

 #' The idashboard S4 class.
 #'
-#'
-#'
 #' @slot title The dashboards title
 #' @slot author The author of the dashboard
 #' @slot interactive If a shiny-based report should be created
@@ -9,6 +7,7 @@
 #' @slot datadir Path to the directory, where report data is stored.
 #' @slot file Filename of the resulting report Rmd file.
 #' @slot pages A list of dashboard pages
+#' @slot sidebar Content of the global sidebar
 #'
 #' @name idashboard-class
 #' @rdname idashboard-class
@@ -21,7 +20,8 @@ setClass("i2dashboard",
     theme = "character",
     datadir = "character",
     file = "character",
-    pages = "list"
+    pages = "list",
+    sidebar = "character"
     ),
   prototype=list(
     title = "i2dashboard",

R/sidebar.R

+#' Add content to a sidebar
+#'
+#' This method allows to add content either to the global sidebar, or to a sidebar of an existing page.
+#'
+#' @param dashboard A \linkS4class{i2dash::i2dashboard}.
+#' @param content The name of a function of a path to a file.
+#' @param page The name of the page to which add the sidebar.
+#' @param global Whether or not to add the content to the global sidebar.
+#' @param copy Whether or not to copy images to \code{dashboard@datadir}.
+#' @param ... Additional parameters passed to the components render function.
+#'
+#' @rdname i2dashboard-methods
+#' @export
+setMethod("add_to_sidebar", "i2dashboard", function(dashboard, content, page = "default", global = FALSE, copy = FALSE, ...) {
+  # Logic to guess intended usage
+  mode <- "function"
+  if(stringr::str_detect(tolower(content), "\\.[md|txt]+$")) {
+    mode <- "text"
+  }
+  if(stringr::str_detect(tolower(content), "\\.[png|jpg|jpeg|gif]+$")) {
+    if(copy) {
+      location <- file.path(dashboard@datadir, basename(content))
+      file.copy(content, location)
+      content <- location
+    }
+    mode <- "image"
+  }
+
+  if(mode == "function") {
+    pn <- strsplit(content, "::")[[1]]
+    eval_function <- if(length(pn) == 1) {
+      get(pn[[1]], envir = asNamespace("i2dash"), mode = "function")
+    } else {
+      get(pn[[2]], envir = asNamespace(pn[[1]]), mode = "function")
+    }
+  }
+
+  content <- switch(mode,
+                      "function" = do.call(eval_function, args = list(dashboard, ...)),
+                      "text" = do.call("render_text", args = list(content, raw = TRUE)),
+                      "image" = do.call("render_image", args = list(content, raw = TRUE)))
+
+
+  if(is.list(content)) {
+    warning(sprintf("Component function returned unsupported content for sidebar."))
+    return(dashboard)
+  }
+
+  if(global) {
+    dashboard@sidebar <- paste0(dashboard@sidebar, content)
+  } else {
+    name <- .create_page_name(page)
+    if (!(name %in% names(dashboard@pages))) {
+      warning(sprintf("i2dashboard dashboard does not contain a page named '%s'", name))
+      return(dashboard)
+    }
+    dashboard@pages[[name]]$sidebar <- paste0(dashboard@pages[[name]]$sidebar, content)
+  }
+  return(dashboard)
+})

inst/templates/text_component.Rmd → inst/templates/component.Rmd

 ### <% title %>
 
 <% content %>
+

inst/templates/global_sidebar.Rmd

+Inputs {.sidebar data-width=<% datawidth %>}
+=====================================
+
+<% content %>
+

inst/templates/image_component.Rmd

-### <% title %>
-
-![<% image_alt_text %>](<% image %>)

inst/templates/layout_default.Rmd

@@ -7,4 +7,5 @@
 Column {.tabset}
 ----------------------------------------------------
 
-<% components %>
\ No newline at end of file
+<% components %>
+

inst/templates/layout_focal_left.Rmd

@@ -14,4 +14,5 @@ Column {data-width=400}
    
 <% if(length(components) > 1) components[[2]] %>
 
-<% if(length(components) > 2) components[[3]] %>
\ No newline at end of file
+<% if(length(components) > 2) components[[3]] %>
+

inst/templates/sidebar_template.Rmd

-Inputs {.sidebar}
+Inputs {.sidebar data-width=<% datawidth %>}
 -------------------------------------
 
-{{ content }}
+<% content %>
+

man/i2dashboard-methods.Rd

 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/assemble.R, R/pages.R
+% Please edit documentation in R/assemble.R, R/pages.R, R/sidebar.R
 \docType{methods}
 \name{assemble,i2dashboard-method}
 \alias{assemble,i2dashboard-method}
 \alias{add_page,i2dashboard-method}
 \alias{remove_page,i2dashboard-method}
+\alias{add_to_sidebar,i2dashboard-method}
 \title{Method to assemble a dashboard to a Rmd file.}
 \usage{
 \S4method{assemble}{i2dashboard}(dashboard,
@@ -15,6 +16,9 @@
   layout = "default", menu = NULL, sidebar = NULL, ...)
 
 \S4method{remove_page}{i2dashboard}(dashboard, page)
+
+\S4method{add_to_sidebar}{i2dashboard}(dashboard, content,
+  page = "default", global = FALSE, copy = FALSE, ...)
 }
 \arguments{
 \item{dashboard}{A \linkS4class{i2dash::i2dashboard}.}
@@ -37,16 +41,24 @@
 
 \item{menu}{The name of the menu, under which the page should appear.}
 
+\item{content}{The name of a function of a path to a file.}
+
+\item{global}{Whether or not to add the content to the global sidebar.}
+
+\item{copy}{Whether or not to copy images to \code{dashboard@datadir}.}
+
 \item{dashboard}{A \linkS4class{i2dash::i2dashboard}.}
 
 \item{dashboard}{A \linkS4class{i2dash::i2dashboard}.}
 
 \item{page}{The name of the page to be removed.}
-}
-\description{
-Method to assemble a dashboard to a Rmd file.
 
-Method to add a page to an i2dashboard
+\item{dashboard}{A \linkS4class{i2dash::i2dashboard}.}
+
+\item{page}{The name of the page to which add the sidebar.}
 
-Method to remove a page to an i2dashboard
+\item{...}{Additional parameters passed to the components render function.}
+}
+\description{
+This method allows to add content either to the global sidebar, or to a sidebar of an existing page.
 }

man/idashboard-class.Rd

@@ -37,5 +37,7 @@ Create a new i2dashboard object.
 \item{\code{file}}{Filename of the resulting report Rmd file.}
 
 \item{\code{pages}}{A list of dashboard pages}
+
+\item{\code{sidebar}}{Content of the global sidebar}
 }}
 

man/render_image.Rd

@@ -4,7 +4,7 @@
 \alias{render_image}
 \title{Method to embed an image file in a component}
 \usage{
-render_image(image, image_alt_text = NULL, title = NULL)
+render_image(image, image_alt_text = NULL, title = NULL, raw = FALSE)
 }
 \arguments{
 \item{image}{The path to the image file.}
@@ -12,6 +12,8 @@ render_image(image, image_alt_text = NULL, title = NULL)
 \item{image_alt_text}{The alt text of the image.}
 
 \item{title}{The components title.}
+
+\item{raw}{Whether or not to emit solely the markdown image code.}
 }
 \value{
 A character string containing the evaluated component

man/render_text.Rd

@@ -2,18 +2,20 @@
 % Please edit documentation in R/components.R
 \name{render_text}
 \alias{render_text}
-\title{Method to embed content from a text file in a component}
+\title{Method to embed content from a text file in a component/sidebar}
 \usage{
-render_text(file, title = NULL)
+render_text(file, title = NULL, raw = FALSE)
 }
 \arguments{
 \item{file}{The file containing the text content.}
 
 \item{title}{The components title.}
+
+\item{raw}{Whether or not to emit raw file content}
 }
 \value{
 A character string containing the evaluated component
 }
 \description{
-Method to embed content from a text file in a component
+Method to embed content from a text file in a component/sidebar
 }