Skip to content

Commit 22a9dc4

Browse files
asbatesgogonzo
asbates
and
gogonzo
authored
show & hide filter state inputs (#195)
Allows filter state inputs to collapse and expand, defaulting to collapsed. Only 1 filter state per data set can be open at a time. - For a given data set, filter information is in an accordion of collapsible cards - Only 1 filter state (per data set) can be open at a time. - Card headers show a summary of the filter state. Logical and choices filter state UIs don't display correctly, at least on Bootstrap 4. Closes #129. --------- Co-authored-by: Dawid Kałędkowski <dawid.kaledkowski@gmail.com>
1 parent 89fa5be commit 22a9dc4

File tree

10 files changed

+323
-44
lines changed

10 files changed

+323
-44
lines changed

‎R/FilterState.R‎

Lines changed: 110 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -369,6 +369,7 @@ FilterState <- R6::R6Class( # nolint
369369
moduleServer(
370370
id = id,
371371
function(input, output, session) {
372+
private$server_summary("summary")
372373
private$server_inputs("inputs")
373374
reactive(input$remove) # back to parent to remove self
374375
}
@@ -381,39 +382,17 @@ FilterState <- R6::R6Class( # nolint
381382
#' @param id (`character(1)`)\cr
382383
#' shiny element (module instance) id;
383384
#' the UI for this class contains simple message stating that it is not supported
384-
#'
385-
ui = function(id) {
385+
#' @param parent_id (`character(1)`) id of the FilterStates card container
386+
ui = function(id, parent_id) {
386387
ns <- NS(id)
387-
fluidPage(
388-
include_css_files(pattern = "filter-panel"),
389-
theme = get_teal_bs_theme(),
390-
fluidRow(
391-
column(
392-
width = 10,
393-
class = "no-left-right-padding",
394-
tags$div(
395-
tags$span(private$varname,
396-
class = "filter_panel_varname"
397-
),
398-
if (checkmate::test_character(self$get_varlabel(), min.len = 1) &&
399-
tolower(private$varname) != tolower(self$get_varlabel())) {
400-
tags$span(self$get_varlabel(), class = "filter_panel_varlabel")
401-
}
402-
)
403-
),
404-
column(
405-
width = 2,
406-
class = "no-left-right-padding",
407-
actionLink(
408-
ns("remove"),
409-
label = "",
410-
icon = icon("circle-xmark", lib = "font-awesome"),
411-
class = "remove pull-right"
412-
)
413-
)
414-
),
415-
private$ui_inputs(ns("inputs"))
416-
)
388+
389+
theme <- getOption("teal.bs_theme")
390+
391+
if (is.null(theme)) {
392+
private$ui_bs3(id, parent_id)
393+
} else {
394+
private$ui_bs45(id, parent_id)
395+
}
417396
}
418397
),
419398

@@ -538,7 +517,13 @@ FilterState <- R6::R6Class( # nolint
538517
},
539518

540519
# shiny modules -----
541-
# module with inputs
520+
ui_summary = function(id) {
521+
stop("abstract class")
522+
},
523+
server_summary = function(id) {
524+
stop("abstract class")
525+
},
526+
#' module with inputs
542527
ui_inputs = function(id) {
543528
stop("abstract class")
544529
},
@@ -622,6 +607,98 @@ FilterState <- R6::R6Class( # nolint
622607
)
623608
invisible(NULL)
624609
})
610+
},
611+
# @description
612+
# Filter card UI for Bootstrap 3.
613+
#
614+
# @param id (`character(1)`) Id for the containing HTML element.
615+
# @param parent_id (`character(1)`) id of the FilterStates card container
616+
ui_bs3 = function(id, parent_id) {
617+
ns <- NS(id)
618+
619+
tags$div(
620+
id = id,
621+
class = "panel panel-default",
622+
tags$div(
623+
class = "panel-heading",
624+
tags$div(
625+
class = "panel-title",
626+
tags$a(
627+
class = "accordion-toggle",
628+
`data-toggle` = "collapse",
629+
`data-parent` = paste0("#", parent_id),
630+
href = paste0("#", ns("body")),
631+
tags$span(tags$strong(self$get_varname())),
632+
if (length(self$get_varlabel())) {
633+
tags$span(self$get_varlabel(), class = "filter-card-varlabel")
634+
} else {
635+
NULL
636+
}
637+
),
638+
actionLink(
639+
inputId = ns("remove"),
640+
label = icon("circle-xmark", lib = "font-awesome"),
641+
class = "filter-card-remove"
642+
)
643+
),
644+
private$ui_summary(ns("summary"))
645+
),
646+
tags$div(
647+
id = ns("body"),
648+
class = "panel-collapse collapse out",
649+
tags$div(
650+
class = "panel-body",
651+
private$ui_inputs(ns("inputs"))
652+
)
653+
)
654+
)
655+
},
656+
# @description
657+
# Filter card ui for Bootstrap 4 and 5.
658+
#
659+
# @param id (`character(1)`) Id for the containing HTML element.
660+
# @param parent_id (`character(1)`) id of the FilterStates card container
661+
ui_bs45 = function(id, parent_id) {
662+
ns <- NS(id)
663+
664+
tags$div(
665+
id = id,
666+
class = "card",
667+
tags$div(
668+
class = "card-header",
669+
tags$div(
670+
class = "card-title",
671+
tags$a(
672+
class = "accordion-toggle",
673+
`data-toggle` = "collapse",
674+
`data-bs-toggle` = "collapse",
675+
href = paste0("#", ns("body")),
676+
tags$span(tags$strong(self$get_varname())),
677+
if (length(self$get_varlabel())) {
678+
tags$span(self$get_varlabel(), class = "filter-card-varlabel")
679+
} else {
680+
NULL
681+
}
682+
),
683+
actionLink(
684+
inputId = ns("remove"),
685+
label = icon("circle-xmark", lib = "font-awesome"),
686+
class = "filter-card-remove"
687+
)
688+
),
689+
private$ui_summary(ns("summary"))
690+
),
691+
tags$div(
692+
id = ns("body"),
693+
class = "collapse out",
694+
`data-parent` = paste0("#", parent_id),
695+
`data-bs-parent` = paste0("#", parent_id),
696+
tags$div(
697+
class = "card-body",
698+
private$ui_inputs(ns("inputs"))
699+
)
700+
)
701+
)
625702
}
626703
)
627704
)

‎R/FilterStateChoices.R‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -357,6 +357,34 @@ ChoicesFilterState <- R6::R6Class( # nolint
357357
NULL
358358
}
359359
)
360+
},
361+
362+
# @description
363+
# Server module to display filter summary
364+
# @param id `shiny` id parameter
365+
ui_summary = function(id) {
366+
ns <- NS(id)
367+
uiOutput(ns("summary"), class = "filter-card-summary")
368+
},
369+
370+
# @description
371+
# UI module to display filter summary
372+
# @param shiny `id` parametr passed to moduleServer
373+
# renders text describing number of selected levels
374+
# and if NA are included also
375+
server_summary = function(id) {
376+
moduleServer(
377+
id = id,
378+
function(input, output, session) {
379+
output$summary <- renderUI({
380+
n_selected <- length(self$get_selected())
381+
tagList(
382+
tags$span(sprintf("%s levels selected", n_selected)),
383+
if (self$get_keep_na()) tags$span("NA") else NULL
384+
)
385+
})
386+
}
387+
)
360388
}
361389
)
362390
)

‎R/FilterStateDate.R‎

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -313,6 +313,36 @@ DateFilterState <- R6::R6Class( # nolint
313313
NULL
314314
}
315315
)
316+
},
317+
318+
# @description
319+
# UI module to display filter summary
320+
# @param id `shiny` id parameter
321+
ui_summary = function(id) {
322+
ns <- NS(id)
323+
uiOutput(ns("summary"), class = "filter-card-summary")
324+
},
325+
326+
# @description
327+
# Server module to display filter summary
328+
# @param shiny `id` parametr passed to moduleServer
329+
# renders text describing selected date range and
330+
# if NA are included also
331+
server_summary = function(id) {
332+
moduleServer(
333+
id = id,
334+
function(input, output, session) {
335+
output$summary <- renderUI({
336+
selected <- as.character(self$get_selected())
337+
min <- selected[1]
338+
max <- selected[2]
339+
tagList(
340+
tags$span(paste0(min, " - ", max)),
341+
if (self$get_keep_na()) tags$span("NA") else NULL
342+
)
343+
})
344+
}
345+
)
316346
}
317347
)
318348
)

‎R/FilterStateDatettime.R‎

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -389,6 +389,36 @@ DatetimeFilterState <- R6::R6Class( # nolint
389389
NULL
390390
}
391391
)
392+
},
393+
394+
# @description
395+
# UI module to display filter summary
396+
# @param id `shiny` id parameter
397+
ui_summary = function(id) {
398+
ns <- NS(id)
399+
uiOutput(ns("summary"), class = "filter-card-summary")
400+
},
401+
402+
# @description
403+
# UI module to display filter summary
404+
# @param shiny `id` parametr passed to moduleServer
405+
# renders text describing selected date range and
406+
# if NA are included also
407+
server_summary = function(id) {
408+
moduleServer(
409+
id = id,
410+
function(input, output, session) {
411+
output$summary <- renderUI({
412+
selected <- format(self$get_selected(), "%Y-%m-%d %H:%M:%S")
413+
min <- selected[1]
414+
max <- selected[2]
415+
tagList(
416+
tags$span(paste0(min, " - ", max)),
417+
if (self$get_keep_na()) tags$span("NA") else NULL
418+
)
419+
})
420+
}
421+
)
392422
}
393423
)
394424
)

‎R/FilterStateEmpty.R‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -165,6 +165,28 @@ EmptyFilterState <- R6::R6Class( # nolint
165165
private$keep_na_srv("keep_na")
166166
}
167167
)
168+
},
169+
170+
# @description
171+
# UI module to display filter summary.
172+
# EmptyFilterState contains only missing
173+
# values.
174+
# @param id `shiny` id parameter
175+
ui_summary = function(id) {
176+
tagList(tags$span("All empty"))
177+
},
178+
179+
# @description
180+
# Server module to display filter summary
181+
# @param shiny `id` parametr passed to moduleServer
182+
# Doesn't render anything
183+
server_summary = function(id) {
184+
moduleServer(
185+
id = id,
186+
function(input, output, session) {
187+
NULL
188+
}
189+
)
168190
}
169191
)
170192
)

‎R/FilterStateLogical.R‎

Lines changed: 27 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -291,6 +291,33 @@ LogicalFilterState <- R6::R6Class( # nolint
291291
NULL
292292
}
293293
)
294+
},
295+
296+
# @description
297+
# UI module to display filter summary
298+
# @param id `shiny` id parameter
299+
ui_summary = function(id) {
300+
ns <- NS(id)
301+
uiOutput(ns("summary"), class = "filter-card-summary")
302+
},
303+
304+
# @description
305+
# Server module to display filter summary
306+
# @param shiny `id` parametr passed to moduleServer
307+
# renders text describing whether TRUE or FALSE is selected
308+
# and if NA are included also
309+
server_summary = function(id) {
310+
moduleServer(
311+
id = id,
312+
function(input, output, session) {
313+
output$summary <- renderUI({
314+
tagList(
315+
tags$span(self$get_selected()),
316+
if (self$get_keep_na()) tags$span("NA") else NULL
317+
)
318+
})
319+
}
320+
)
294321
}
295322
)
296323
)

‎R/FilterStateRange.R‎

Lines changed: 35 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -322,7 +322,8 @@ RangeFilterState <- R6::R6Class( # nolint
322322
# id of shiny element
323323
ui_inputs = function(id) {
324324
ns <- NS(id)
325-
fluidRow(
325+
div(
326+
class = "choices_state",
326327
div(
327328
class = "filterPlotOverlayRange",
328329
plotOutput(ns("plot"), height = "100%"),
@@ -498,6 +499,39 @@ RangeFilterState <- R6::R6Class( # nolint
498499
)
499500
invisible(NULL)
500501
})
502+
},
503+
504+
# @description
505+
# UI module to display filter summary
506+
# @param id `shiny` id parameter
507+
# renders text describing selected range and
508+
# if NA or Inf are included also
509+
ui_summary = function(id) {
510+
ns <- NS(id)
511+
uiOutput(ns("summary"), class = "filter-card-summary")
512+
},
513+
514+
# @description
515+
# Server module to display filter summary
516+
# @param shiny `id` parametr passed to moduleServer
517+
# renders text describing selected range and
518+
# if NA or Inf are included also
519+
server_summary = function(id) {
520+
moduleServer(
521+
id = id,
522+
function(input, output, session) {
523+
output$summary <- renderUI({
524+
selected <- sprintf("%.4g", self$get_selected())
525+
min <- selected[1]
526+
max <- selected[2]
527+
tagList(
528+
tags$span(paste0(min, " - ", max)),
529+
if (self$get_keep_na()) tags$span("NA") else NULL,
530+
if (self$get_keep_inf()) tags$span("Inf") else NULL
531+
)
532+
})
533+
}
534+
)
501535
}
502536
)
503537
)

0 commit comments

Comments
 (0)