162 composant implémentation de wellpanel et sidebarlayout

NEWS.md

@@ -1,4 +1,6 @@
 # shinygouv 1.0.5  
+## Composants  
+* implémentation de wellpanel et sidebarlayout
 
 ## Composants  
 * amélioration du style de sliderInput_dsfr  

R/mod_input_ui.R

@@ -61,6 +61,35 @@ mod_input_ui_ui <- function(id){
                      "Afficher le deuxi\u00e8me onglet"
         )
       )
+    ),
+    fluidRow_dsfr( class = "fr-my-4w",
+       column_dsfr(
+         12,
+         h3("Demo wellPanel_dsfr() et sidebarLayout_dsfr()"),
+         extra_class = "fr-my-6w"
+       ),
+       column_dsfr(
+         12,
+         wellPanel_dsfr("Ceci est un wellPanel avec titre", title="Mon wellPanel"),
+         wellPanel_dsfr("Ceci est un wellPanel avec option grey et sans titre", grey = TRUE)
+       ),
+       sidebarLayout_dsfr(
+         # Sidebar with a slider input
+         sidebarPanel_dsfr(
+           sliderInput_dsfr(
+             ns("obssb"),
+             "Nombre d'observations:",
+             min = 0,
+             max = 1000,
+             value = 500),
+           width = 4,
+           title = "Mon sidebarPanel"
+         ),
+         # Show a plot of the generated distribution
+         mainPanel_dsfr(
+           plotOutput(ns("distPlot"))
+         )
+       )
     )
   )
 }
@@ -96,6 +125,11 @@ mod_input_ui_server <- function(id){
       )
     })
 
+    #well
+    output$distPlot <- renderPlot({
+      hist(rnorm(input$obssb))
+    })
+
   })
 
 }

R/shinygouv-dependencies.R

@@ -46,7 +46,8 @@ add_dsfr_deps <- function(tag, version = get_dsfr_version()) {
       package = "shinygouv",
       src = c(file = "external_deps"),
       stylesheet = c(
-        "slider.css"
+        "slider.css",
+        "well.css"
       ),
       script = list(
         list(type = "text/javascript", src = "shiny-compat.js"),

R/sidebarlayout_dsfr.R

@@ -0,0 +1,102 @@
+#' sidebarLayout_dsfr
+#'
+#' Créez une mise en page (`sidebarLayout_dsfr()`) avec une barre latérale (`sidebarPanel_dsfr()`) et
+#' une zone principale (`mainPanel_dsfr()`). La barre latérale peut s'afficher avec une
+#' couleur d'arrière-plan grise et contient généralement des contrôles d'entrée.
+#' La zone principale occupe les 2/3 de la largeur et contient généralement des sorties.
+#'
+#' @param sidebarPanel Le `sidebarPanel_dsfr()` contenant les contrôles d'entrée.
+#' @param mainPanel Le `mainPanel_dsfr()` contenant les sorties.
+#' @param position La position de la barre latérale par rapport à la zone principale ("gauche"
+#' ou "droit").
+#' @param width La largeur de la barre latérale et du panneau principal. Par défaut,
+#' La barre latérale occupe 1/3 de la largeur et le panneau principal 2/3. Le total
+#' doit être inférieur ou égale à 12.
+#' @param title titre du panneau de barre latérale (facultatif)
+#' @param ... Éléments de sortie à inclure dans la barre latérale/panneau principal.
+#' @return html
+#' @references inspiré de la fonction [shiny::sidebarLayout()]
+#' @family layout functions
+#' @rdname sidebarLayout_dsfr
+#'
+#' @examples
+#' ## Only run examples in interactive R sessions
+#' if (interactive()) {
+#' options(device.ask.default = FALSE)
+#'
+#' # Define UI
+#' ui <- fluidPage_dsfr(
+#'
+#'   # Application title
+#'   titlePanel("Hello Shiny!"),
+#'
+#'   sidebarLayout_dsfr(
+#'
+#'     # Sidebar with a slider input
+#'     sidebarPanel_dsfr(
+#'       sliderInput_dsfr("obs",
+#'                   "Number of observations:",
+#'                   min = 0,
+#'                   max = 1000,
+#'                   value = 500),
+#'       width = 4,
+#'       title = "My sidebar"
+#'     ),
+#'
+#'     # Show a plot of the generated distribution
+#'     mainPanel_dsfr(
+#'       plotOutput("distPlot")
+#'     )
+#'   )
+#' )
+#'
+#' # Server logic
+#' server <- function(input, output) {
+#'   output$distPlot <- renderPlot({
+#'     hist(rnorm(input$obs))
+#'   })
+#' }
+#'
+#' # Complete app with UI and server components
+#' shinyApp(ui, server)
+#' }
+#' @export
+sidebarLayout_dsfr <- function(
+    sidebarPanel,
+    mainPanel,
+    position = c("left", "right")
+) {
+  # determine the order
+  position <- match.arg(position)
+  if (position == "left") {
+    firstPanel <- sidebarPanel
+    secondPanel <- mainPanel
+  }
+  else if (position == "right") {
+    firstPanel <- mainPanel
+    secondPanel <- sidebarPanel
+  }
+  fluidRow_dsfr(firstPanel, secondPanel, class = "fr-col-12")
+}
+
+#' sidebarPanel_dsfr
+#' @export
+#' @rdname sidebarLayout_dsfr
+sidebarPanel_dsfr <- function(..., width = 4, title = NULL) {
+  column_dsfr(
+    width = width,
+    wellPanel_dsfr(..., title = title),
+    extra_class = "sb-complementary"
+  )
+}
+
+#' mainPanel_dsfr
+#' @export
+#' @rdname sidebarLayout_dsfr
+mainPanel_dsfr <- function(..., width = 8) {
+  column_dsfr(
+    width = width,
+    ...,
+    extra_class = "fr-py-2w fr-px-4w sb-main"
+  )
+}

R/wellPanel_dsfr_template.R

@@ -0,0 +1,33 @@
+#' wellPanel_dsfr_template
+#' @param domtitle titre de la carte
+#' @param greyclass class du container principal
+#' @param content body de la carte
+#'
+#' @importFrom htmltools htmlTemplate
+#' @return html
+#' @noRd
+wellPanel_dsfr_template <- function(
+    title,
+    grey,
+    content
+) {
+  if ( !is.null(title) ) {
+    domtitle <- tags$div(
+      class = "fr-card__header fr-px-4w fr-py-2w",
+      h3(class = "fr-card__title", title)
+    )
+  } else {
+    domtitle <- ""
+  }
+  htmltools::htmlTemplate(
+    filename = system.file(
+      get_dsfr_version(with_v = TRUE),
+      "composant",
+      "wellpanel.html",
+      package = "shinygouv"
+    ),
+    title = domtitle,
+    grey = grey,
+    content = content
+  )
+}

R/wellpanel_dsfr.R

@@ -0,0 +1,46 @@
+#' wellPanel_dsfr
+#'
+#' Crée un panneau avec une bordure légèrement incrustée et un arrière-plan gris et un titre, si on le souhaite.
+#'
+#' @param ... Éléments d'interface utilisateur à inclure à l'intérieur du panneau.
+#' @param title titre du panneau (optionnel)
+#' @param grey arrière-plan gris du panneau (FALSE par défaut)
+#'
+#' @return html
+#' @references inspiré de la fonction [shiny::wellPanel()]
+#' @family layout functions
+#'
+#' @importFrom htmltools tagList
+#'
+#' @examples
+#' if (interactive()) {
+#'   shiny::shinyApp(
+#'     ui = fluidPage_dsfr(
+#'       title = "exemple",
+#'       fluidRow_dsfr(
+#'       column_dsfr(
+#'         12,
+#'         wellPanel_dsfr("Ceci est un wellPanel avec titre", title="Mon wellPanel"),
+#'         wellPanel_dsfr("Ceci est un wellPanel avec option grey et sans titre", grey = TRUE)
+#'       )
+#'       )
+#'     ),
+#'     server = function(input, output) {}
+#'   )
+#' }
+#' @export
+wellPanel_dsfr <- function(
+    ...,
+    title = NULL,
+    grey = FALSE
+) {
+  ui <- wellPanel_dsfr_template(
+    title,
+    grey = ifelse ( grey, " fr-card--grey", ""),
+    content = tagList(
+      ...
+    )
+  )
+
+  ui
+}

inst/external_deps/well.css

@@ -0,0 +1,16 @@
+:root {
+  --background-main-grey:var(--grey-main-525);
+  --grey-main-525:#7b7b7b;
+}
+.sg-well {
+  height: inherit !important;
+}
+.sg-well > .fr-card__header {
+  background-color: var(--background-main-grey);
+}
+.sg-well > .fr-card__header > .fr-card__title {
+  color: var(--text-inverted-grey);
+}
+.sg-container {
+  max-width: 78rem;
+}

inst/v1.9.3/composant/wellpanel.html

@@ -0,0 +1,8 @@
+<div class="sg-well fr-card fr-card--shadow{{grey}} fr-my-2w">
+{{title}}
+  <div class="fr-card__body">
+    <div class="fr-card__content">
+      {{content}}
+    </div>
+  </div>
+</div>

tests/testthat/test-sidebarLayout_dsfr.R

@@ -0,0 +1,71 @@
+test_that("mainPanel_dsfr works", {
+  expect_true(inherits(mainPanel_dsfr, "function"))
+
+  test_html <-mainPanel_dsfr(shiny::tags$span("Prefet", br(), "de", br(), "Bretagne"), width = 12)
+
+  #' @description tester si shiny.tag
+  expect_s3_class(test_html, "shiny.tag.list")
+
+})
+
+test_that("sidebarPanel_dsfr works", {
+  expect_true(inherits(sidebarPanel_dsfr, "function"))
+
+  test_html <-sidebarPanel_dsfr(shiny::tags$span("Prefet", br(), "de", br(), "Bretagne"), width = 4, title = "Mon test")
+
+  #' @description tester si shiny.tag
+  expect_s3_class(test_html, "shiny.tag.list")
+
+})
+
+test_that("sidebarLayout_dsfr works", {
+  test_html <-
+    sidebarLayout_dsfr(
+      sidebarPanel_dsfr(
+        tags$p("Lorem ipsum dolor sit amet."),
+        width = 4,
+        title = "My sidebar"
+      ),
+      mainPanel_dsfr(
+        tags$p("Lorem ipsum dolor sit amet, consectetur adipiscing elit,
+                     sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.
+                     Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi
+                     ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit
+                     in voluptate velit esse cillum dolore eu fugiat nulla pariatur.
+                     Excepteur sint occaecat cupidatat non proident, sunt in culpa qui
+                     officia deserunt mollit anim id est laborum.")
+      )
+    )
+
+  #' @description tester si shiny.tag
+  expect_s3_class(test_html, "shiny.tag.list")
+
+  ## lecture snapshot
+  snapshot_html <- readRDS(
+    file = file.path(
+      "snapshot", # pour passer les tests en production (apres le inflate),
+      # "tests/testthat/snapshot", # pour passer les tests en developpement (avant le inflate),
+      "sidebarLayout_dsfr.Rda")
+  )
+
+  #' @description Verifer que le HTML est correct en sortie
+  # Retire tous les espaces et saut de ligne pour la comparaison
+  # Pour eviter les problèmes inter-OS
+  expect_equal(gsub("\\s|\\n", "", test_html),
+               gsub("\\s|\\n", "", snapshot_html))
+
+  # Si erreur au précedent test deux cas possible :
+  #
+  # - nouveau composant: Lancer le saveRDS, relancer le test et recommenter le saveRDS
+  #
+  # - composant a mettre a jour: si le test ne passe plus avant de changer le snapshot,
+  #  assurez vous d'avoir bien pris en compte la nouvelle personnalisation
+  #  dans la fonction footer_dsfr puis lancer le saveRDS, relancer le test et recommenter le saveRDS
+  #
+  # saveRDS(test_html,
+  #         file = file.path("tests/testthat/snapshot",
+  #                          "sidebarLayout_dsfr.Rda"
+  #                          )
+  #         )
+
+})

tests/testthat/test-wellPanel_dsfr.R

@@ -0,0 +1,6 @@
+test_that("wellPanel_dsfr works", {
+  expect_true(inherits(wellPanel_dsfr, "function"))
+  test_html <- wellPanel_dsfr("Ceci est un wellPanel avec titre", title="Mon wellPanel")
+  #' @description tester si shiny.tag
+  expect_s3_class(test_html, "shiny.tag.list")
+})