✨ export generate_form()

inSileco · Nov 10, 2020 · 71ef2b4 · 71ef2b4
1 parent 41137cd
commit 71ef2b4
Show file tree

Hide file tree

Showing 13 changed files with 139 additions and 49 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -6,10 +6,13 @@ export(fob_among)
 export(fob_date)
 export(fob_integer)
 export(fob_numeric)
+export(fob_pattern)
 export(fob_text)
 export(fob_word)
+export(generate_form)
+export(generate_form_choices)
+export(generate_form_pattern)
 export(join)
-export(match_pattern)
 export(multi)
 importFrom(cli,style_bold)
 importFrom(cli,style_underline)

diff --git a/R/build_form.R b/R/build_form.R
diff --git a/R/one_among.R → R/fob_among.R b/R/one_among.R → R/fob_among.R
@@ -4,7 +4,7 @@
 #' @param choices A vector of choices. 
 #' @param output Either "choice" or "id".
 #' @param field_name Name of the field (optional).
-#' @param ... further arguments passed to generate_form_choices().
+#' @param ... further arguments to be passed to [generate_form_choices()].
 #' 
 #' @return Return the choice selected either as the choice value or its identifier (an integer).
 #' @export
@@ -24,6 +24,7 @@ fob_among <- function(question, choices, field_name = "", output = "choice",
     question = question,
     choices = choices,
     field_name = field_name,
+    post = postf,
     ...
   ) 
 

diff --git a/R/one_integer.R → R/fob_integer.R b/R/one_integer.R → R/fob_integer.R
@@ -5,7 +5,7 @@
 #' @param field_name Name of the field (optional).
 #' @param max maximum of characters (ignored if `NULL`).
 #' @param format date format. 
-#' @param ... further argument.  
+#' @param ... further arguments to be passed to [generate_form_pattern()].
 #' 
 #' @return Return the choice selected either as the choice value or its identifier (an integer).
 #' @export

diff --git a/R/match_pattern.R → R/fob_pattern.R b/R/match_pattern.R → R/fob_pattern.R
@@ -2,23 +2,22 @@
 #' 
 #' @param question The question to be asked. 
 #' @param pattern Pattern to be matched. 
-#' @param post Post processing. 
 #' @param field_name Name of the field (optional).
 #' @param prompt the string printed when prompting the user for input (see [readline()]).
+#' @param ... further arguments passed to [generate_form_pattern()].
 #' 
 #' @return answer validated.
 #' @export
 
-match_pattern <- function(question, pattern, post = NULL, field_name = "",
-  prompt = "Enter your answer:") {  
+fob_pattern <- function(question, pattern, field_name = "",
+  prompt = "Enter your answer:", ...) {  
 
   generate_form_pattern(
     question = question, 
     prompt = prompt, 
     pattern = pattern, 
-    pre = NULL, 
-    post = post, 
-    field_name = field_name
+    field_name = field_name,
+    ...
   ) 
 
 }

diff --git a/R/form_unit.R → R/generate.R b/R/form_unit.R → R/generate.R
@@ -1,4 +1,16 @@
-
+#' Generate form 
+#'
+#' @param prompt The string printed when prompting the user for input (see [readline()]).
+#' @param question The question to be asked. 
+#' @param choices A vector of choices. 
+#' @param validate A function used to validate the answer, if `NULL` then validation step is ignored.
+#' @param field_name Name of the field (optional).
+#' @param confirm a logical. Should the answer be confirmed (default is FALSE).
+#' @param pre A function for pre processing.
+#' @param post A function for post processing. 
+#' @param pattern pattern to be matched. 
+#'
+#' @export
 
 generate_form <- function(prompt = "", question = NULL, choices = NULL,
   validate = NULL, confirm = FALSE, pre = NULL, post = NULL, field_name = "") {
@@ -43,7 +55,7 @@ generate_form <- function(prompt = "", question = NULL, choices = NULL,
         valid()
       } else {
         if (!is.null(validate)) {
-          stop("validate should be a function or `NULL`")
+          stop("`validate` should be a function or `NULL`")
         }
       }
 
@@ -54,15 +66,16 @@ generate_form <- function(prompt = "", question = NULL, choices = NULL,
     structure(out, class = "form_partial", field_name = field_name)
 }
 
-
-
+#' @describeIn generate_form match pattern.
+#' @export
 generate_form_pattern <- function(prompt = "", question = NULL, choices = NULL, 
   pattern = "*", confirm = FALSE, pre = NULL, post = NULL, field_name = "") {
   vf <- function(x) grepl(pattern, x)
   generate_form(prompt, question, choices, vf, confirm, pre, post, field_name)
 }
 
-
+#' @describeIn generate_form list fo choices.
+#' @export
 generate_form_choices <- function(prompt = "", question = NULL, choices, 
   confirm = FALSE, pre = NULL, post = NULL, field_name = "") {
   vf <- function(x) return(x %in% as.character(seq_along(choices)))

diff --git a/R/zzz.R b/R/zzz.R
@@ -51,4 +51,11 @@ get_confirmed <- function() {
   grepl("^Y$|^YES$", toupper(x))
 }
 
-not_confirmed <- function() msgWarning('Not confirmed!')
+not_confirmed <- function() msgWarning('Not confirmed!')
+
+
+# 
+# month.name
+# months(ISOdate(2004,1:12,1))
+# weekdays(ISOdate(2004,1,5:11)) 
+# Sys.setlocale("LC_TIME"e,"fr_FR") ;format(ISOdate(2004,1:12,1), "%B")
diff --git a/README.md b/README.md
@@ -2,32 +2,34 @@
 [![R-CMD-check](https://github.com/inSileco/formbuildr/workflows/R-CMD-check/badge.svg)](https://github.com/inSileco/formbuildr/actions?query=workflow%3AR-CMD-check)
 [![lifecycle](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://www.tidyverse.org/lifecycle/#experimental)
 
-An R :package: to build forms with the command line interface.
+An R :package: to readily build forms with the command line interface.
 
 
 ```R
-R> q1 <- one_among("Fruits?", c("Apple", "Pear"), "fruit")
-R> q2 <- yes_or_no("Be or not to be", "shake")
-R> q3 <- one_date("When was that?", "date")
-R> q4 <- match_pattern("2 letters + 1 digit", "^[A-Za-z]{2}[0-9]$")
+R> q1 <- fob_among("Fruits?", c("Apple", "Pear"), "fruit", confirm = TRUE)
+R> q2 <- fob_yorn("Be or not to be", "shake")
+R> q3 <- fob_date("When was that?", "date")
+R> q4 <- fob_pattern("2 letters + 1 digit", "^[A-Za-z]{2}[0-9]$")
 R> myform <- q1 %+% q2 %+% q3 %+% q4
 R> res <- myform()   
 ❓ Fruits? ❓
 ℹ Multiple choices:
 1 :  Apple 
 2 :  Pear 
 Enter your choice: 1
+⚠ Confirmed?
+[Y]es or [N]o: Y 
 ✔ validated!
 ❓ Be or not to be ❓
-Enter [Y]es or [N]o: no 
+Enter [Y]es or [N]o: N
 ✔ validated!
 ❓ When was that? ❓
-Enter your answer (a date %Y-%m-%d): 2000000
-⚠ Validation failed, try again!
-Enter your answer (a date %Y-%m-%d): 2020-12-01
+Enter your answer (a date %Y-%m-%d): 2010-12-01 
 ✔ validated!
 ❓ 2 letters + 1 digit ❓
-Enter your answer:hh1   
+Enter your answer:000  
+⚠ Validation failed, try again!
+Enter your answer:lo1
 ✔ validated!
 
 R> res
@@ -38,10 +40,10 @@ $shake
 [1] FALSE
 
 $date
-[1] "2020-12-01"
+[1] "2010-12-01"
 
 $answer_4
-[1] "hh1"
+[1] "lo1"
 
 attr(,"class")
 [1] "form_answers"
@@ -54,8 +56,8 @@ the last line returns `answers.yaml` with the following content:
 ```yaml
 fruit: Apple
 shake: no
-date: '2020-12-01'
-answer_4: hh1
+date: '2010-12-01'
+answer_4: lo1
 ```
 
 Alternatively, you can use `join(q1, q2, q3, q4)` to create the same form. Also,

diff --git a/man/fob_among.Rd b/man/fob_among.Rd
diff --git a/man/fob_integer.Rd b/man/fob_integer.Rd
diff --git a/man/match_pattern.Rd → man/fob_pattern.Rd b/man/match_pattern.Rd → man/fob_pattern.Rd
diff --git a/man/generate_form.Rd b/man/generate_form.Rd
diff --git a/tests/testthat/test_basic.R b/tests/testthat/test_basic.R
@@ -1,8 +1,8 @@
 context("NULL")
 
-q1 <- one_among("Fruits?", c("Apple", "Pear"), "fruit")
-q2 <- one_yorn("Be or not to be", "shake")
-q3 <- one_date("When was that?", "date")
-q4 <- match_pattern("2 letters + 1 digit", "^[A-Za-z]{2}[0-9]$")
+q1 <- fob_among("Fruits?", c("Apple", "Pear"), "fruit", confirm = TRUE)
+q2 <- fob_yorn("Be or not to be", "shake")
+q3 <- fob_date("When was that?", "date")
+q4 <- fob_pattern("2 letters + 1 digit", "^[A-Za-z]{2}[0-9]$")
 myform <- q1 %+% q2 %+% q3 %+% q4
 # res <- myform()