Basic setup for circle CI. (#45)

* Basic setup for circle CI. * Check with devtools. * All lintr problems solved. * Packages installed. * Circle ci badge added. * Review fixes. * Fixing readme.
Appsilon · Oct 3, 2017 · 2aeabdd · 2aeabdd
1 parent 7b43ef1
commit 2aeabdd
Show file tree

Hide file tree

Showing 38 changed files with 621 additions and 214 deletions.
diff --git a/.lintr b/.lintr
@@ -0,0 +1 @@
+linters: with_defaults(line_length_linter(120))
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -19,8 +19,10 @@ Imports:
     shiny (>= 0.12.1),
     htmltools (>= 0.2.6),
     htmlwidgets (>= 0.8),
-    purrr (>= 0.2.2)
+    purrr (>= 0.2.2),
+    magrittr
 Suggests:
     dplyr,
-    gapminder
+    gapminder,
+    testthat
 RoxygenNote: 6.0.1
diff --git a/R/dsl.R b/R/dsl.R
@@ -2,8 +2,10 @@
 #'
 #' This creates an icon tag using Semantic UI styles.
 #'
-#' @param type A name of an icon. Look at http://semantic-ui.com/elements/icon.html for all possibilities.
-#' @param ... Other arguments to be added as attributes of the tag (e.g. style, class etc.)
+#' @param type A name of an icon. Look at
+#' http://semantic-ui.com/elements/icon.html for all possibilities.
+#' @param ... Other arguments to be added as attributes of the
+#' tag (e.g. style, class etc.)
 #'
 #' @export
 uiicon <- function(type = "", ...) {
@@ -22,15 +24,18 @@ uiicon <- function(type = "", ...) {
 uiheader <- function(title, description, icon = NULL) {
   shiny::h2(class = "ui header",
      if (!is.null(icon)) uiicon(icon),
-     shiny::div(class = "content", title, shiny::div(class = "sub header", description))
+     shiny::div(class = "content", title,
+       shiny::div(class = "sub header", description)
+     )
   )
 }
 
 #' Create Semantic UI cards tag
 #'
 #' This creates a cards tag using Semantic UI styles.
 #'
-#' @param ... Other arguments to be added as attributes of the tag (e.g. style, class or childrens etc.)
+#' @param ... Other arguments to be added as attributes of the
+#' tag (e.g. style, class or childrens etc.)
 #' @param class Additional classes to add to html tag.
 #'
 #' @export
@@ -42,7 +47,8 @@ uicards <- function(..., class = "") {
 #'
 #' This creates a card tag using Semantic UI styles.
 #'
-#' @param ... Other arguments to be added as attributes of the tag (e.g. style, class or childrens etc.)
+#' @param ... Other arguments to be added as attributes of the
+#' tag (e.g. style, class or childrens etc.)
 #' @param class Additional classes to add to html tag.
 #'
 #' @export
@@ -54,7 +60,8 @@ uicard <- function(..., class = "") {
 #'
 #' This creates a segment using Semantic UI styles.
 #'
-#' @param ... Other arguments to be added as attributes of the tag (e.g. style, class or childrens etc.)
+#' @param ... Other arguments to be added as attributes of the
+#' tag (e.g. style, class or childrens etc.)
 #' @param class Additional classes to add to html tag.
 #'
 #' @export
@@ -66,7 +73,8 @@ uisegment <- function(..., class = "") {
 #'
 #' This creates a form tag using Semantic UI styles.
 #'
-#' @param ... Other arguments to be added as attributes of the tag (e.g. style, class or childrens etc.)
+#' @param ... Other arguments to be added as attributes of the
+#' tag (e.g. style, class or childrens etc.)
 #' @param class Additional classes to add to html tag.
 #'
 #' @export
@@ -80,7 +88,8 @@ uiform <- function(..., class = "") {
 #'
 #' This creates a fields tag using Semantic UI styles.
 #'
-#' @param ... Other arguments to be added as attributes of the tag (e.g. style, class or childrens etc.)
+#' @param ... Other arguments to be added as attributes of the
+#' tag (e.g. style, class or childrens etc.)
 #' @param class Additional classes to add to html tag.
 #'
 #' @export
@@ -92,7 +101,8 @@ uifields <- function(..., class = "") {
 #'
 #' This creates a field tag using Semantic UI styles.
 #'
-#' @param ... Other arguments to be added as attributes of the tag (e.g. style, class or childrens etc.)
+#' @param ... Other arguments to be added as attributes of the
+#' tag (e.g. style, class or childrens etc.)
 #' @param class Additional classes to add to html tag.
 #'
 #' @export
@@ -104,7 +114,8 @@ uifield <- function(..., class = "") {
 #'
 #' This creates a HTML label tag.
 #'
-#' @param ... Other arguments to be added as attributes of the tag (e.g. style, class or childrens etc.)
+#' @param ... Other arguments to be added as attributes of the
+#' tag (e.g. style, class or childrens etc.)
 #'
 #' @export
 label <- function(...) {
@@ -114,12 +125,13 @@ label <- function(...) {
 
 #' Create dropdown Semantic UI component
 #'
-#' This creates a default dropdown using Semantic UI styles with Shiny input. Dropdown is already initialized
-#' and available under input[[name]].
+#' This creates a default dropdown using Semantic UI styles with Shiny input.
+#' Dropdown is already initialized and available under input[[name]].
 #'
 #' @param name Input name. Reactive value is available under input[[name]].
 #' @param choices All available options one can select from.
-#' @param choices_value What reactive value should be used for corresponding choice.
+#' @param choices_value What reactive value should be used for corresponding
+#' choice.
 #' @param default_text Text to be visible on dropdown when nothing is selected.
 #' @param value Pass value if you want to initialize selection for dropdown.
 #'
@@ -151,53 +163,73 @@ label <- function(...) {
 #' }
 #'
 #' @export
-dropdown <- function(name, choices, choices_value = choices, default_text = 'Select', value = NULL) {
-  unique_dropdown_class <- paste0('dropdown_name_', name)
+dropdown <- function(name,
+                     choices,
+                     choices_value = choices,
+                     default_text = "Select",
+                     value = NULL) {
+  unique_dropdown_class <- paste0("dropdown_name_", name)
+  class <- paste("ui selection fluid dropdown", unique_dropdown_class)
 
   shiny::tagList(
-    shiny::div(class = paste("ui selection fluid dropdown", unique_dropdown_class),
-               shiny_text_input(name, shiny::tags$input(type = "hidden", name = name), value = value),
+    shiny::div(class = class,
+               shiny_text_input(name,
+                 shiny::tags$input(type = "hidden", name = name),
+                 value = value
+               ),
                uiicon("dropdown"),
                shiny::div(class = "default text", default_text),
                shiny::div(class = "menu",
-                          purrr::map2(choices, choices_value, ~ div(class = "item", `data-value` = .y, .x))
+                 purrr::map2(choices, choices_value, ~
+                   div(class = "item", `data-value` = .y, .x)
+                 )
                )
     ),
-    shiny::tags$script(paste0("$('.ui.dropdown.", unique_dropdown_class, "').dropdown().dropdown('set selected', '", value,"');"))
+    shiny::tags$script(paste0(
+      "$('.ui.dropdown.", unique_dropdown_class,
+      "').dropdown().dropdown('set selected', '", value, "');"
+    ))
   )
 }
 
 #' Create Semantic UI tabs
 #'
 #' This creates tabs with content using Semantic UI styles.
 #'
-#' @param tabs A list of tabs. Each tab is a list of two elements - first element defines menu item, second element defines tab content.
+#' @param tabs A list of tabs. Each tab is a list of two elements - first
+#' element defines menu item, second element defines tab content.
 #' @param id Id of the menu element (default: randomly generated id)
-#' @param menu_class Class for the menu element (default: "top attached tabular")
-#' @param tab_content_class Class for the tab content (default: "bottom attached segment")
+#' @param menu_class Class for the menu element (default: "top attached
+#' tabular")
+#' @param tab_content_class Class for the tab content (default: "bottom attached
+#' segment")
 #'
 #' @export
-tabset <- function(tabs, id = generate_random_id("menu"), menu_class = "top attached tabular", tab_content_class = "bottom attached segment") {
-  identifiers <- replicate(length(tabs), list(id = generate_random_id("tab")), simplify = FALSE)
-  tabsWithId <- purrr::map2(identifiers, tabs, ~ c(.x, .y))
+tabset <- function(tabs,
+                   id = generate_random_id("menu"),
+                   menu_class = "top attached tabular",
+                   tab_content_class = "bottom attached segment") {
+  identifiers <- replicate(length(tabs),
+                           list(id = generate_random_id("tab")),
+                           simplify = FALSE)
+  id_tabs <- purrr::map2(identifiers, tabs, ~ c(.x, .y))
 
   shiny::tagList(
     shiny::div(id = id,
-               class = paste("ui menu", menu_class),
-               purrr::map(tabsWithId, ~
-                            shiny::a(class = paste("item", if (.$id == tabsWithId[[1]]$id) "active" else ""),
-                                     `data-tab`=.$id,
-                                     .$menu
-                            )
-               )
+      class = paste("ui menu", menu_class),
+      purrr::map(id_tabs, ~ {
+        class <- paste("item", if (.$id == id_tabs[[1]]$id) "active" else "")
+        shiny::a(class = class, `data-tab` = .$id, .$menu)
+      })
     ),
-    purrr::map(tabsWithId, ~
-                 shiny::div(class = paste("ui tab", tab_content_class, if (.$id == tabsWithId[[1]]$id) "active" else ""),
-                            `data-tab`=.$id,
-                            .$content
-                 )
-    ),
-    shiny::tags$script(paste0("$('#", id, ".menu .item').tab({onVisible: function() {$(window).resize()} });"))
+    purrr::map(id_tabs, ~ {
+      class <- paste("ui tab", tab_content_class,
+                     if (.$id == id_tabs[[1]]$id) "active" else "")
+      shiny::div(class = class, `data-tab` = .$id, .$content)
+    }),
+    shiny::tags$script(paste0(
+      "$('#", id, ".menu .item').tab({onVisible:",
+      " function() {$(window).resize()} });"))
   )
 }
 
@@ -211,41 +243,44 @@ generate_random_id <- function(prefix, id_length = 20) {
 #' This creates a message using Semantic UI
 #'
 #' @param header Header of the message
-#' @param content Content of the message. If it is a vector, creates a list of vector's elements
-#' @param type Type of the message. Look at https://semantic-ui.com/collections/message.html for all possibilities.
-#' @param icon If the message is of the type 'icon', specify the icon. Look at http://semantic-ui.com/elements/icon.html for all possibilities.
-#' @param closable Determines whether the message should be closable. Default is FALSE - not closable
+#' @param content Content of the message. If it is a vector, creates a list of
+#' vector's elements
+#' @param type Type of the message. Look at
+#' https://semantic-ui.com/collections/message.html for all possibilities.
+#' @param icon If the message is of the type 'icon', specify the icon.
+#' Look at http://semantic-ui.com/elements/icon.html for all possibilities.
+#' @param closable Determines whether the message should be closable.
+#' Default is FALSE - not closable
 #'
 #' @export
 uimessage <- function(header, content, type = "", icon, closable = FALSE) {
-  if(length(content) > 1) {
-    content <- tags$ul(class = "list", content %>% lapply(tags$li))
+  if (length(content) > 1) {
+    content <- shiny::tags$ul(class = "list", lapply(content, shiny::tags$li))
   }
   if (grepl("icon", type)) {
     if (missing(icon)) {
       stop("Type 'icon' requires an icon!")
     }
     icon_else_header <- uiicon(icon)
-    message_else_content <- div(class = "content",
-                                div(class = "header", header),
+    message_else_content <- shiny::div(class = "content",
+                                shiny::div(class = "header", header),
                                 content)
   } else {
-    icon_else_header <- div(class = "header", header)
+    icon_else_header <- shiny::div(class = "header", header)
     message_else_content <- content
   }
   div(class = paste("ui message", type),
       if (closable) {
-        uiicon("close icon", tags$script(HTML(CLOSABLE_MESSAGES)))
+        closable_messages <- "$('.message .close')
+          .on('click', function() {
+            $(this)
+              .closest('.message')
+              .transition('fade')
+            ;
+          })
+        ;"
+        uiicon("close icon", shiny::tags$script(shiny::HTML(closable_messages)))
       },
       icon_else_header,
       message_else_content)
 }
-
-CLOSABLE_MESSAGES <- "$('.message .close')
-  .on('click', function() {
-    $(this)
-      .closest('.message')
-      .transition('fade')
-    ;
-  })
-;"
diff --git a/R/search_field.R b/R/search_field.R
@@ -1,13 +1,17 @@
 #' Create search field Semantic UI component
 #'
-#' This creates a default search field using Semantic UI styles with Shiny input. Search field is already initialized
-#' and available under input[[name]]. Search will automatically route to the named API endpoint provided as parameter.
-#' API response is expected to be a JSON with property fields `title` and `description`.
+#' This creates a default search field using Semantic UI styles with Shiny
+#' input. Search field is already initialized and available under input[[name]].
+#' Search will automatically route to the named API endpoint provided
+#' as parameter. API response is expected to be a JSON with property fields
+#' `title` and `description`.
 #' See https://semantic-ui.com/modules/search.html#behaviors for more details.
 #'
 #' @param name Input name. Reactive value is available under input[[name]].
-#' @param search_api_url Register custom API url with server JSON Response containing fields `title` and `description`.
-#' @param default_text Text to be visible on serach field when nothing is selected.
+#' @param search_api_url Register custom API url with server JSON Response
+#' containing fields `title` and `description`.
+#' @param default_text Text to be visible on serach field when nothing
+#' is selected.
 #' @param value Pass value if you want to initialize selection for search field.
 #'
 #' @examples
@@ -46,7 +50,9 @@
 #'  }
 #'
 #'  search_api_url <- register_search(session, gapminder, search_api)
-#'  output$search_letters <- shiny::renderUI(search_field("search_result", search_api_url))
+#'  output$search_letters <- shiny::renderUI(
+#'    search_field("search_result", search_api_url)
+#'  )
 #'  output$selected_letters <- renderText(input[["search_result"]])
 #' })
 #'}
@@ -56,18 +62,24 @@
 #' @export
 #' @importFrom magrittr "%>%"
 #'
-search_field <- function(name, search_api_url, default_text = 'Search',  value = "") {
+search_field <- function(name,
+                         search_api_url,
+                         default_text = "Search",
+                         value = "") {
   tagList(
     div(class = paste(name, "ui search"),
         div(class = "ui icon fluid input",
             shiny_input(name,
-                        tags$input(class = "prompt search field", type = "text" , placeholder = default_text,
-                                   # Hack: Setting "oninput" to "null" is a fix for reset of selection, when using arrows
-                                   # as suggested here: https://github.com/Semantic-Org/Semantic-UI/issues/3416
-                                   oninput = "null"),
-                        value = value
+              # Hack: Setting "oninput" to "null" is a fix for reset of
+              # selection, when using arrows as suggested here:
+              # https://github.com/Semantic-Org/Semantic-UI/issues/3416
+              tags$input(class = "prompt search field",
+                         type = "text",
+                         placeholder = default_text,
+                         oninput = "null"),
+              value = value
             ),
-            uiicon('search')
+            uiicon("search")
         ),
         div(class = "results")
     ),