Merge pull request #34 from spyrales/issue_30

Issue 30

NAMESPACE

@@ -2,9 +2,14 @@
 
 export("%>%")
 export(actionButton_dsfr)
+export(add_dsfr_deps)
+export(column_dsfr)
+export(fluidPage_dsfr)
+export(fluidRow_dsfr)
 export(parse_html)
 export(radioButtons_dsfr)
 export(run_app)
+import(htmltools)
 import(shiny)
 importFrom(XML,getNodeSet)
 importFrom(XML,htmlParse)
@@ -17,6 +22,7 @@ importFrom(golem,add_resource_path)
 importFrom(golem,bundle_resources)
 importFrom(golem,favicon)
 importFrom(golem,with_golem_options)
+importFrom(htmltools,htmlDependency)
 importFrom(htmltools,htmlTemplate)
 importFrom(htmltools,tagList)
 importFrom(magrittr,"%>%")

R/app_server.R

@@ -6,4 +6,13 @@
 #' @noRd
 app_server <- function(input, output, session) {
   # Your application server logic
+
+  observeEvent(input$go,{
+    message("je clique ", input$go)
+  })
+
+  observeEvent(input$espece,{
+    message("je change d'esepce ", input$espece)
+  })
+
 }

R/app_ui.R

@@ -9,8 +9,30 @@ app_ui <- function(request) {
     # Leave this function for adding external resources
     golem_add_external_resources(),
     # Your application UI logic
-    fluidPage(
-      h1("shinygouv")
+    fluidPage_dsfr(
+      title = "Exemple shiny dsfr",
+      h1("Exemple d'utilisation de {shinygouv}"),
+      fluidRow_dsfr(
+        column_dsfr(0, #Calcul automatique de la largeur
+                    p("Premi\\u00E8re Colonne"),
+                    actionButton_dsfr("go", label = "Sample!"),
+                    plotOutput(
+                      "plot_sample"
+                    )
+                    ),
+        column_dsfr(0,#Calcul automatique de la largeur
+                    p("Deuxi\\u00E8me Colonne"),
+                    radioButtons_dsfr(
+                      inputId = "espece",
+                      label = "Especes",
+                      choices = c("Setosa" = "setosa","Versicolor" = "versicolor"),
+                      class = NULL
+                    ),
+                    plotOutput(
+                      "plot_espece"
+                    )
+        )
+      )
     )
   )
 }

R/column_dsfr.R

@@ -0,0 +1,52 @@
+# WARNING - Generated by {fusen} from /dev/v1.7.2/composant/flat_fluidpage.Rmd: do not edit by hand
+
+#' column_dsfr
+#' 
+#' 
+#' @param width width par défaut est NULL, cela signifie que la taille de la colonne depend des autres colonnes. Vous pouvez aussi utiliser 0
+#' @param ... differents tag pour construire la page
+#'
+#' @return shiny.tag.list
+#' 
+#' @importFrom htmltools tagList
+#' 
+#' @export
+#' @examples
+#' 
+#' if(interactive()){
+#' shiny::shinyApp(
+#'   ui = fluidPage_dsfr(
+#'     title = "exemple",
+#'     fluidRow_dsfr(
+#'       column_dsfr(0, "test"),
+#'       column_dsfr(0, "test"),
+#'       column_dsfr(0, "test"),
+#'       column_dsfr(0, "test")
+#'     )
+#'   ),
+#'   server = function(input, output){}
+#'   )
+#' }
+#' 
+column_dsfr <- function(width = NULL, ...){
+
+  if(is.null(width)) {
+    add_width <- ""
+    }else{
+      if(width != 0){
+        add_width <- paste0("-", width)
+      }else{
+        add_width <- ""
+      }
+    }
+
+  class <- paste0("fr-col", add_width)
+
+  layout_dsfr_template(
+      html = tagList(
+        ...
+      ),
+      class = class,
+      other_class = NULL
+    )
+}

R/fluidpage_dsfr.R

@@ -0,0 +1,46 @@
+# WARNING - Generated by {fusen} from /dev/v1.7.2/composant/flat_fluidpage.Rmd: do not edit by hand
+
+#' fluidPage_dsfr
+#' 
+#' @param ... element a inclure dans la page
+#' @param theme pas implemente
+#' @param lang pas implemente
+#' @param title titre de la page
+#'
+#' @return html
+#' 
+#' @importFrom htmltools tagList
+#' 
+#' @export
+#'
+#' @examples
+#' my_page <- fluidPage_dsfr(
+#'   title = "Gouv",
+#'   htmltools::div("test")
+#' )
+#' if(interactive()){
+#' shiny::shinyApp(
+#'   my_page,
+#'   server = function(input, output){}
+#'   )
+#' }
+fluidPage_dsfr <- function(
+    ...,
+    title = NULL,
+    theme = NULL,
+    lang = NULL
+) {
+
+  # TODO theme et lang
+  # check les params
+  ui <- fluidPage_dsfr_template(
+    title = tagList(title),
+    body = tagList(
+      ...
+      )
+  ) %>%
+    parse_html(zone = "/html") %>% 
+    add_dsfr_deps() 
+  ui
+
+}

R/fluidpage_dsfr_template.R

@@ -0,0 +1,27 @@
+# WARNING - Generated by {fusen} from /dev/v1.7.2/composant/flat_fluidpage.Rmd: do not edit by hand
+
+#' fluidPage_dsfr_template
+#' 
+#' @param title titre de la page
+#' @param body body 
+#'
+#' @importFrom htmltools htmlTemplate
+#' @return html
+#' @noRd
+fluidPage_dsfr_template <- function(
+    title,
+    body
+){
+
+  htmltools::htmlTemplate(
+    filename = system.file(
+      "v1.7.2",
+      "composant", 
+      "fluidpage.html",
+      package = "shinygouv"
+    ),
+    title = title,
+    body = body
+  )
+}
+

R/fluidrow_dsfr.R

@@ -0,0 +1,35 @@
+# WARNING - Generated by {fusen} from /dev/v1.7.2/composant/flat_fluidpage.Rmd: do not edit by hand
+
+#' fluidRow_dsfr
+#' 
+#' 
+#' @param ... differents tag pour construire la page
+#' @param class ajout de class pour la fluidRow_dsfr (voir la page officiel du CSS)
+#'
+#' @return shiny.tag.list
+#' @importFrom htmltools tagList
+#' 
+#' @export
+#' @examples
+#' 
+#' if(interactive()){
+#' shiny::shinyApp(
+#'   ui = fluidPage_dsfr(
+#'     title = "exemple",
+#'     fluidRow_dsfr(
+#'       shiny::p("Voici un exemple")
+#'     )
+#'   ),
+#'   server = function(input, output){}
+#'   )
+#' }
+#' 
+fluidRow_dsfr <- function(..., class = NULL){
+    layout_dsfr_template(
+      html = tagList(
+        ...
+      ),
+      class = "fr-grid-row",
+      other_class = class
+    )
+}

R/layout_dsfr_template.R

@@ -0,0 +1,30 @@
+# WARNING - Generated by {fusen} from /dev/v1.7.2/composant/flat_fluidpage.Rmd: do not edit by hand
+
+#' layout_dsfr_template
+#' 
+#' @param html list de tag
+#' @param class class de la div
+#' @param other_class autre classes a ajouter
+#'
+#' @importFrom htmltools htmlTemplate
+#' @return html
+#' @noRd
+layout_dsfr_template <- function(
+    html,
+    class,
+    other_class
+){
+
+  htmltools::htmlTemplate(
+    filename = system.file(
+      "v1.7.2",
+      "layout", 
+      "layout.html",
+      package = "shinygouv"
+    ),
+    html = html,
+    class = class,
+    other_class = other_class
+  )
+}
+

R/parse_html.R

@@ -1,18 +1,19 @@
 # WARNING - Generated by {fusen} from /dev/flat_tools.Rmd: do not edit by hand
 
-#' Traduit du html en resultat shiny
+#' Traduit du html en resultat shiny 
 #'
 #' @param html_code resultat d'une fonction htmlTemplate ou une chaine de caractere
+#' @param zone zone a garder pour parser
 #'
 #' @return shiny.tag
 #' @export
 #'
 #' @examples
 #' html_code <- '<button id="test" type="button" class="btn btn-default action-button">test</button>'
 #' parse_html(html_code)
-parse_html <- function(html_code) {
-  xml <- parse_to_xml(html_code)
-  to_character <- render_node(xml, prefix = TRUE)
-
-  eval(parse(text = to_character))
+parse_html <- function(html_code, zone = "/html/body/*") {
+
+  xml <- parse_to_xml(html_code, zone) %>% render_node(prefix = TRUE)
+  
+  eval(parse(text = xml)) 
 }

R/parse_to_xml.R

@@ -1,22 +1,22 @@
 # WARNING - Generated by {fusen} from /dev/flat_tools.Rmd: do not edit by hand
 
 #' Traduit du code html de htmltools pour du code xml
-#'
+#' 
 #' @param html_code resultat de la fonction htmlTemplate
 #' @importFrom XML htmlParse getNodeSet
 #'
 #' @noRd
-parse_to_xml <- function(html_code) {
-  if (inherits(html_code, "XMLInternalElementNode")) {
+parse_to_xml <- function(html_code, zone = "/html/body/*"){
+  if(inherits(html_code, "XMLInternalElementNode")){
     stop("Use this function with character or shiny.tag.list")
   }
-
-  if (!is.character(html_code)) {
+  
+  if(!is.character(html_code)){
     html_code <- as.character(html_code)
   }
-
-  html_code %>%
-    XML::htmlParse() %>%
-    XML::getNodeSet("/html/body/*") %>%
-    getElement(1)
+  
+    html_code %>% 
+      XML::htmlParse() %>% 
+      XML::getNodeSet(zone) %>% 
+      getElement(1) 
 }

R/radiobuttons_dsfr.R

@@ -1,50 +1,44 @@
 # WARNING - Generated by {fusen} from /dev/v1.7.2/composant/flat_radioButtons.Rmd: do not edit by hand
 
 #' radioButtons_dsfr
-#'
+#' 
 #' @param inputId id de l'input
 #' @param label label du bouton
 #' @param choices Liste des valeurs à sélectionner (si les éléments de la liste portent un nom, c'est ce nom qui est affiché à l'utilisateur et non la valeur)
-#' @param inline Si TRUE, positionne les choix en ligne (c'est-à-dire horizontalement). Non implemente
-#' @param class des classes a ajouter si necessaire
+#' @param inline Si TRUE, positionne les choix en ligne (c'est-à-dire horizontalement). 
+#' @param class des classes a ajouter si necessaire 
 #' @return html
-#'
+#' 
 #' @export
 #'
 #' @examples
 #' radioButtons_dsfr(
-#'   inputId = "test",
-#'   label = "Test",
-#'   choices = c("A", "B"),
-#'   class = NULL
+#'       inputId = "test", label = "Test", choices = c("A","B"), class = NULL
 #' )
-#'
+#' 
 #' # radioButtons_dsfr(
-#' #       inputId = "test",
-#' #       label = "Test",
+#' #       inputId = "test", 
+#' #       label = "Test", 
 #' #       choices = c("Choix A" = "A","Choix B" = "B"),
 #' #       class = NULL
 #' # )
 radioButtons_dsfr <- function(
-  inputId,
-  label,
-  choices,
-  inline = FALSE,
-  class = NULL
-) {
-
+  inputId, label, choices, inline = FALSE, class = NULL  
+  ) {
+
   # check les params
   assertthat::assert_that(is.character(inputId))
   assertthat::assert_that(is.character(label))
   assertthat::assert_that(is.character(choices))
-  assertthat::assert_that(is.logical(inline))
-
-  radioButtons_dsfr_template(
+  assertthat::assert_that(is.logical(inline))  
+  
+    radioButtons_dsfr_template(
     inputId = inputId,
     label = label,
     choix = choices,
-    inline = inline, # TODO
+    inline = inline, 
     class = class
-  ) %>%
-    parse_html()
+    ) %>%
+      parse_html()
+
 }