Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Field titles #333

Merged
merged 6 commits into from
Mar 6, 2024
+55 −24
Merged

Field titles #333

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
aefdde4
feat: use title for fields closes #319 fixes #314
JohnCoene Mar 6, 2024
388716d
feat: field titles as arguments
JohnCoene Mar 6, 2024
bf04c82
ci: add tests
JohnCoene Mar 6, 2024
38e28af
lint: blockr 193
JohnCoene Mar 6, 2024
7f9d4da
lint: block l 423
JohnCoene Mar 6, 2024
6381894
revert: do not expose field titles
JohnCoene Mar 6, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
38 changes: 22 additions & 16 deletions R/block.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -206,7 +206,11 @@ new_data_block <- function(
if (length(selected) == 0) selected <- datasets[1]

fields <- list(
dataset = new_select_field(selected, datasets)
dataset = new_select_field(
selected,
datasets,
title = "Dataset"
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would put title as a parameter in case people want to change the default value.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

added

)
)

expr <- substitute(
Expand Down Expand Up @@ -238,7 +242,7 @@ new_upload_block <- function(...) {

new_block(
fields = list(
file = new_upload_field(),
file = new_upload_field(title = "File"),
expression = new_hidden_field(data_path)
),
expr = quote(c(.(expression))),
Expand Down Expand Up @@ -271,7 +275,7 @@ new_filesbrowser_block <- function(volumes = c(home = path.expand("~")), ...) {

new_block(
fields = list(
file = new_filesbrowser_field(volumes = volumes),
file = new_filesbrowser_field(volumes = volumes, title = "File"),
expression = new_hidden_field(data_path)
),
expr = quote(c(.(expression))),
Expand Down Expand Up @@ -377,7 +381,7 @@ xpt_block <- function(data, ...) {
new_result_block <- function(...) {

fields <- list(
stack = new_result_field()
stack = new_result_field(title = "Stack")
)

new_block(
Expand Down Expand Up @@ -475,8 +479,7 @@ new_filter_block <- function(
col_choices <- function(data) colnames(data)

fields <- list(
columns = new_select_field(columns, col_choices, multiple = TRUE),
values = new_list_field(values, sub_fields),
columns = new_select_field(columns, col_choices, multiple = TRUE, title = "Columns"),
filter_func = new_select_field(
filter_fun,
choices = c(
Expand All @@ -489,8 +492,10 @@ new_filter_block <- function(
"<",
">=",
"<="
)
),
title = "Comparison"
),
values = new_list_field(values, sub_fields, title = "Value"),
expression = new_hidden_field(filter_exps)
)

Expand Down Expand Up @@ -521,7 +526,7 @@ new_select_block <- function(data, columns = colnames(data)[1], ...) {

# Select_field only allow one value, not multi select
fields <- list(
columns = new_select_field(columns, all_cols, multiple = TRUE)
columns = new_select_field(columns, all_cols, multiple = TRUE, title = "Columns")
)

new_block(
Expand Down Expand Up @@ -635,8 +640,8 @@ new_summarize_block <- function(
)

fields <- list(
funcs = new_select_field(func, func_choices, multiple = TRUE),
columns = new_list_field(sub_fields = sub_fields),
funcs = new_select_field(func, func_choices, multiple = TRUE, title = "Functions"),
columns = new_list_field(sub_fields = sub_fields, title = "Columns"),
expression = new_hidden_field(summarize_expr)
)

Expand Down Expand Up @@ -670,7 +675,7 @@ new_arrange_block <- function(data, columns = colnames(data)[1], ...) {

# Type as name for arrange and group_by
fields <- list(
columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name")
columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name", title = "Columns")
)

new_block(
Expand All @@ -694,7 +699,7 @@ new_group_by_block <- function(data, columns = colnames(data)[1], ...) {

# Select_field only allow one value, not multi select
fields <- list(
columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name")
columns = new_select_field(columns, all_cols, multiple = TRUE, type = "name", title = "Columns")
)

new_block(
Expand Down Expand Up @@ -742,10 +747,11 @@ new_join_block <- function(data, y = NULL, type = character(),
join_func = new_select_field(
paste(type, "join", sep = "_"),
paste(join_types, "join", sep = "_"),
type = "name"
type = "name",
title = "Type"
),
y = new_result_field(y),
by = new_select_field(by, by_choices, multiple = TRUE)
y = new_result_field(y, title = "Stack"),
by = new_select_field(by, by_choices, multiple = TRUE, title = "By")
)

new_block(
Expand Down Expand Up @@ -779,7 +785,7 @@ new_head_block <- function(
}

fields <- list(
n_rows = new_numeric_field(n_rows, n_rows_min, nrow(data)),
n_rows = new_numeric_field(n_rows, n_rows_min, nrow(data), title = "Number of rows"),
expression = new_hidden_field(tmp_expr)
)

Expand Down
17 changes: 17 additions & 0 deletions R/field.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -557,3 +557,20 @@ generate_server.result_field <- function(x, ...) {
})
}
}

get_field_name <- function(field, name = "") {
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Add unit test to get_field_name and get_field_names.

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

added tests

title <- attr(field, "title")

if (title == "")
return(name)

title
}

get_field_names <- function(x) {
titles <- character(length(x))
for (i in seq_along(x)){
titles[i] <- get_field_name(x[[i]], names(x)[i])
}
titles
}
16 changes: 8 additions & 8 deletions R/ui.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@
ui_input,
x,
id = chr_ply(names(x), ns),
name = names(x)
name = get_field_names(x)
)

div(
Expand Down Expand Up @@ -629,21 +629,21 @@
#' @rdname generate_ui
#' @export
ui_update.string_field <- function(x, session, id, name) {
updateTextInput(session, input_ids(x, id), name, value(x))
updateTextInput(session, input_ids(x, id), get_field_name(x, name), value(x))

Check warning on line 632 in R/ui.R

View check run for this annotation

Codecov / codecov/patch

R/ui.R#L632 

Added line #L632 was not covered by tests
}

#' @rdname generate_ui
#' @export
ui_update.select_field <- function(x, session, id, name) {
updateSelectInput(
session, input_ids(x, id), name, value(x, "choices"), value(x)
session, input_ids(x, id), get_field_name(x, name), value(x, "choices"), value(x)

Check warning on line 639 in R/ui.R

View check run for this annotation

Codecov / codecov/patch

R/ui.R#L639 

Added line #L639 was not covered by tests
)
}

#' @rdname generate_ui
#' @export
ui_update.switch_field <- function(x, session, id, name) {
bslib::update_switch(input_ids(x, id), name, value(x), session)
bslib::update_switch(input_ids(x, id), get_field_name(x, name), value(x), session)

Check warning on line 646 in R/ui.R

View check run for this annotation

Codecov / codecov/patch

R/ui.R#L646 

Added line #L646 was not covered by tests
}

#' @rdname generate_ui
Expand All @@ -663,7 +663,7 @@

insertUI(
selector = paste0("#", ns_id, "_cont"),
ui = ui_input(field, ns_id, name),
ui = ui_input(field, ns_id, get_field_name(x, name)),

Check warning on line 666 in R/ui.R

View check run for this annotation

Codecov / codecov/patch

R/ui.R#L666 

Added line #L666 was not covered by tests
session = session
)
}
Expand All @@ -672,15 +672,15 @@
#' @export
ui_update.range_field <- function(x, session, id, name) {
updateSliderInput(
session, input_ids(x, id), name, value(x), value(x, "min"), value(x, "max")
session, input_ids(x, id), get_field_name(x, name), value(x), value(x, "min"), value(x, "max")

Check warning on line 675 in R/ui.R

View check run for this annotation

Codecov / codecov/patch

R/ui.R#L675 

Added line #L675 was not covered by tests
)
}

#' @rdname generate_ui
#' @export
ui_update.numeric_field <- function(x, session, id, name) {
updateNumericInput(
session, input_ids(x, id), name, value(x), value(x, "min"), value(x, "max")
session, input_ids(x, id), get_field_name(x, name), value(x), value(x, "min"), value(x, "max")

Check warning on line 683 in R/ui.R

View check run for this annotation

Codecov / codecov/patch

R/ui.R#L683 

Added line #L683 was not covered by tests
)
}

Expand Down Expand Up @@ -738,7 +738,7 @@
ui = do.call(
tagList,
map(
ui_input, fields, input_ids(x, ns_id), paste0(name, "_", names(fields))
ui_input, fields, input_ids(x, ns_id), paste0(name, ": ", names(fields))

Check warning on line 741 in R/ui.R

View check run for this annotation

Codecov / codecov/patch

R/ui.R#L741 

Added line #L741 was not covered by tests
)
),
session = session
Expand Down
Loading