R/utils_googleform.R

In brentscott93/googleforms: Easily create a shiny app that mimics the look of a google form

#' Generates UI
#' @description This is the 'muscle' behind the UI building and taken from the UI of shinyforms. It takes a list(id, type, etc.) and decides what to make. Used with lapply in main googleform() function over questions arguments.
#' @param question A list containing id, type, required, and (optionally) choices
formQ <- function(question){

  #decide what widget to make
  #all the shiny widgets have been renamed with wrappers to mimic the google form options
  #built off of shinyforms
  if (question$type == "numeric") {
    input <- shiny::numericInput(question$id, NULL, 0)
  } else if (question$type == "checkbox") {
    input <- shiny::checkbox(question$id, question$choices)
  } else if (question$type == 'multiplechoice'){
    input <- multipleChoice(question$id, question$choices)
  } else if (question$type == 'dropdown'){
    input < dropdown(question$id, choices)
  } else if (question$type == 'shortanswer'){
    input <- shortAnswer(question$id)
  } else if (question$type == 'paragraph'){
    input <- paragraph(question$id)
  } else if (question$type == 'height'){
    input <- selectHeight(question$id)
  }

#if questions is marked as required add a 'Required *' tag before widget
  if(!is.null(question$required)){
    if (question$required) {
      ui <- shiny::tagList(h5('Required *', style = 'color:#fd0800;'), input)
    } else {
      ui <- input
    }
  } else {
    ui <- input
  }

  #put everything ina dashboard box to make it look like a googleform
  #one widget to a box
  shinydashboard::box(width = NULL,
                      solidHeader = T,
                      title = question$title,
                      ui )


}



#' Convenient wrappers for shiny widgets using the googleForm lingo
#' @param id an inputId
#' @param choices a list
#' @export
multipleChoice <- function(id, choices){
  shiny::radioButtons(inputId = id,
                      label = NULL,
                      choices = choices,
                      inline = F)
}

#' Limited theme option to change color of form
#' @param color a character string of a hex color code
theme_googleform <- function(color){
  fresh::create_theme(
    fresh::adminlte_color(
      light_blue = color)
  )
}



#' Convenient wrappers for shiny widgets using the googleForm lingo
#' @param id an inputId
#' @param choices a list
#' @export
checkbox <- function(id, choices){
  shiny::checkboxInput(inputId =  id,
                       label = NULL,
                       value= F)
}

#' Convenient wrappers for shiny widgets using the googleForm lingo
#' @param id an inputId
#' @param choices a list
#' @export
dropdown <- function(id, choices){
  shiny::selectInput(inputId = id,
                     label = NULL,
                     choices = choices)
}


#' Convenient wrappers for shiny widgets using the googleForm lingo
#' @param id an inputId
#' @export
shortAnswer <- function(id){
  shiny::textInput(inputId = id,
                   label = NULL)

}

#' Convenient wrappers for shiny widgets using the googleForm lingo
#' @param id an inputId
#' @export
paragraph <- function(id){
  shiny::textAreaInput(inputId = id,
                       label = NULL,
                       width = '100%')
}

#' Helper for height wrapper
#' @description Makes a list of height in feet-height notation
heightChoices <- function(){
  ft <- 0:7
  inch <-  1:11
  ht <- expand.grid(ft, inch)
  ht <- ht[order(ht$Var1),]

  ht_string <- vector()
  for(i in 1:nrow(ht)){
    ht_string[[i]] <- paste0(ht$Var1[[i]], "-", ht$Var2[[i]])
  }
  return(ht_string)
}

#' Convenient wrapper for making a selectInput about choosing a person's height in feet and inches
#' @param id an inputId
#' @export
selectHeight <- function(id){
  shiny::selectInput(inputId = id,
                     label = NULL,
                     choices = heightChoices())
}





#would be nice to implement a more rigourous testing system of required values
#Not implemented
# validateRequired <- function(question){
#   # if (question$type == "numeric") {
#   #   if(question$required) req(input[[question$id]])
#   # } else if (question$type == "checkbox") {
#   #  # if(question$required) req(input[[question$id]])
#   # } else if (question$type == 'multiplechoice'){
#   #   if(question$required) req(input[[question$id]])
#   # } else if (question$type == 'dropdown'){
#   #   if(question$required) req(input[[question$id]])
#   if (question$type == 'shortanswer'){
#     if(question$required){
#       if(input[[question$id]] == '')showNotification('Please answer all required fields', type = 'error')
#       req(input[[question$id]])
#     }
#   } else if (question$type == 'paragraph'){
#     if(question$required){
#       if(input[[question$id]] == '')showNotification('Please answer all required fields', type = 'error')
#       req(input[[question$id]])
#     }
#   } else if (question$type == 'height'){
#     if(question$required){
#       if(input[[question$id]] == '0-0')showNotification('Please answer all required fields', type = 'error')
#       req(input[[question$id]])
#     }
#   }
# }