initial commit

.Rbuildignore

@@ -0,0 +1,4 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+^\.travis\.yml$
+^cran-comments\.md$

.gitignore

@@ -0,0 +1,5 @@
+.Rproj.user
+.Rhistory
+.RData
+*.Rproj
+inst/doc

.travis.yml

@@ -0,0 +1,3 @@
+language: r
+sudo: false
+cache: packages

DESCRIPTION

@@ -0,0 +1,22 @@
+Package: shinyforms
+Title: Description
+Version: 0.0.0.9000
+Authors@R: person("Dean", "Attali", email = "daattali@gmail.com",
+    role = c("aut", "cre"))
+Description: Description
+URL: https://github.com/daattali/shinyforms
+BugReports: https://github.com/daattali/shinyforms/issues
+Depends:
+    R (>= 3.1.0)
+Imports:
+    digest (>= 0.6.8),
+    shiny (>= 0.11.1),
+    shinyjs (>= 0.5.2)
+Suggests:
+    knitr (>= 1.7),
+    rmarkdown
+License: MIT + file LICENSE
+SystemRequirements: pandoc with https support
+LazyData: true
+VignetteBuilder: knitr
+RoxygenNote: 5.0.1

LICENSE

@@ -1,22 +1,2 @@
-The MIT License (MIT)
-
-Copyright (c) 2015 Dean Attali
-
-Permission is hereby granted, free of charge, to any person obtaining a copy
-of this software and associated documentation files (the "Software"), to deal
-in the Software without restriction, including without limitation the rights
-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-copies of the Software, and to permit persons to whom the Software is
-furnished to do so, subject to the following conditions:
-
-The above copyright notice and this permission notice shall be included in all
-copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-SOFTWARE.
-
+YEAR: 2015
+COPYRIGHT HOLDER: Dean Attali

NAMESPACE

@@ -0,0 +1,5 @@
+# Generated by roxygen2: do not edit by hand
+
+export(STORAGE_TYPES)
+export(formServer)
+export(formUI)

R/app.R

@@ -0,0 +1,54 @@
+questions <- list(
+  list(id = "name", type = "text", title = "Name", mandatory = TRUE),
+  list(id = "age", type = "numeric", title = "Name", mandatory = FALSE),
+  list(id = "favourite_pkg", type = "text", title = "Favourite R package", mandatory = FALSE),
+  list(id = "terms", type = "checkbox", title = "I agree to the terms")
+)
+formInfo <- list(
+  id = "form1",
+  questions = questions,
+  storage = list(
+    type = STORAGE_TYPES$FLATFILE,
+    path = "responses"
+  )
+)
+
+
+formInfo2 <- list(
+  id = "form2",
+  multiple = FALSE,
+  questions = list(
+    list(id = "team", type = "text", title = "Favourite soccer team"),
+    list(id = "player", type = "text", title = "Favourite player")
+  ),
+  storage = list(
+    #type = STORAGE_TYPES$GOOGLE_SHEETS,
+    #key = "1PQuXmzr-6Y9r-m5P7jtJcg2Z3WJ7SyzrLLYbBOmsPys"
+    type = STORAGE_TYPES$FLATFILE,
+    path = "soccer"
+  )
+)
+
+ui <- fluidPage(
+  h1("rOpenSci shinyforms"),
+  tabsetPanel(
+    tabPanel(
+      "Tab 1",
+      formUI(formInfo)
+    ),
+    tabPanel(
+      "Tab 2",
+      formUI(formInfo2)
+    )
+  )
+)
+
+server <- function(input, output, session) {
+  formServer(formInfo)
+  formServer(formInfo2)
+}
+
+shinyApp(ui = ui, server = server)
+
+
+

R/shinyform.R

@@ -0,0 +1,190 @@
+library(shiny)
+
+#' @export
+STORAGE_TYPES <- list(
+  FLATFILE = "flatfile",
+  SQLITE = "sqlite",
+  MYSQL = "mysql",
+  MONGO = "mongo",
+  GOOGLE_SHEETS = "gsheets",
+  DROPBOX = "dropbox",
+  AMAZON_S3 = "s3"
+)
+
+labelMandatory <- function(label) {
+  tagList(
+    label,
+    span("*", class = "mandatory_star")
+  )
+}
+
+appCSS <- "
+.mandatory_star { color: red; }
+.shiny-input-container { margin-top: 25px; }
+.sf_submit_msg { margin-left: 15px; }
+.sf_error { color: red; }
+"
+
+saveData <- function(data, storage) {
+  if (storage$type == STORAGE_TYPES$FLATFILE) {
+    saveDataFlatfile(data, storage)
+  } else if (storage$type == STORAGE_TYPES$GOOGLE_SHEETS) {
+    saveDataGsheets(data, storage)
+  }
+}
+
+saveDataFlatfile <- function(data, storage) {
+  fileName <- paste0(
+    paste(
+      format(Sys.time(), "%Y%m%d-%H%M%OS"),
+      digest::digest(data, algo = "md5"),
+      sep = "_"
+    ),
+    ".csv"
+  )
+
+  resultsDir <- storage$path
+
+  # write out the results
+  write.csv(x = data, file = file.path(resultsDir, fileName),
+            row.names = FALSE, quote = TRUE)
+}
+loadDataFlatfile <- function() {
+  files <- list.files(file.path(resultsDir), full.names = TRUE)
+  data <- lapply(files, read.csv, stringsAsFactors = FALSE)
+  data <- do.call(rbind, data)
+
+  data
+}
+
+saveDataGsheets <- function(data, storage) {
+  gs_add_row(gs_key(storage$key), input = data)
+}
+loadDataGsheets <- function() {
+  gs_read_csv(gs_key(storage$key))
+}
+
+#' @export
+formUI <- function(formInfo) {
+
+  ns <- NS(formInfo$id)
+
+  questions <- formInfo$questions
+
+  fieldsMandatory <- Filter(function(x) { !is.null(x$mandatory) && x$mandatory }, questions)
+  fieldsMandatory <- unlist(lapply(fieldsMandatory, function(x) { x$id }))
+
+  tagList(
+    shinyjs::useShinyjs(debug=T),
+    shinyjs::inlineCSS(appCSS),
+    div(
+      id = ns("form"),
+      lapply(
+        questions,
+        function(question) {
+          label <- question$title
+          if (question$id %in% fieldsMandatory) {
+            label <- labelMandatory(label)
+          }
+
+          if (question$type == "text") {
+            textInput(ns(question$id), label, "")
+          } else if (question$type == "numeric") {
+            numericInput(ns(question$id), label, 0)
+          } else if (question$type == "checkbox") {
+            checkboxInput(ns(question$id), label, FALSE)
+          }
+        }
+      ),
+      actionButton(ns("submit"), "Submit", class = "btn-primary"),
+      shinyjs::hidden(
+        span(id = ns("submit_msg"), class = "sf_submit_msg", "Submitting..."),
+        div(class = "sf_error", id = ns("error"),
+            div(br(), tags$b("Error: "), span(id = ns("error_msg")))
+        )
+      )
+    ),
+    shinyjs::hidden(
+      div(
+        id = ns("thankyou_msg"),
+        h3("Thanks, your response was submitted successfully!"),
+        actionLink(ns("submit_another"), "Submit another response")
+      )
+    )
+  )
+}
+
+#' @export
+formServer <- function(formInfo) {
+  callModule(formServerHelper, formInfo$id, formInfo)
+}
+
+formServerHelper <- function(input, output, session, formInfo) {
+  questions <- formInfo$questions
+
+  fieldsMandatory <- Filter(function(x) { x$mandatory }, questions)
+  fieldsMandatory <- unlist(lapply(fieldsMandatory, function(x) { x$id }))
+  fieldsAll <- unlist(lapply(questions, function(x) { x$id }))
+
+  observe({
+    mandatoryFilled <-
+      vapply(fieldsMandatory,
+             function(x) {
+               !is.null(input[[x]]) && input[[x]] != ""
+             },
+             logical(1))
+    mandatoryFilled <- all(mandatoryFilled)
+
+    shinyjs::toggleState(id = "submit", condition = mandatoryFilled)
+  })
+
+  # When the Submit button is clicked, submit the response
+  observeEvent(input$submit, {
+
+    # User-experience stuff
+    shinyjs::disable("submit")
+    shinyjs::show("submit_msg")
+    shinyjs::hide("error")
+    on.exit({
+      shinyjs::enable("submit")
+      shinyjs::hide("submit_msg")
+    })
+
+    # Save the data (show an error message in case of error)
+    tryCatch({
+      saveData(formData(), formInfo$storage)
+      shinyjs::reset("form")
+      shinyjs::hide("form")
+      shinyjs::show("thankyou_msg")
+    },
+    error = function(err) {
+      shinyjs::logjs(err)
+      shinyjs::html("error_msg", err$message)
+      shinyjs::show(id = "error", anim = TRUE, animType = "fade")
+    })
+  })
+
+  if (!is.null(formInfo$multiple) && !formInfo$multiple) {
+    submitMultiple <- FALSE
+    shinyjs::hide("submit_another")
+  } else {
+    submitMultiple <- TRUE
+  }
+  observeEvent(input$submit_another, {
+    if (!submitMultiple) {
+      return()
+    }
+    shinyjs::show("form")
+    shinyjs::hide("thankyou_msg")
+  })
+
+  # Gather all the form inputs (and add timestamp)
+  formData <- reactive({
+    data <- sapply(fieldsAll, function(x) input[[x]])
+    data <- c(data, timestamp = as.integer(Sys.time()))
+    data <- t(data)
+    data
+  }) 
+
+
+}