Skip to content

UI utils #3

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

Merged
danielrak merged 3 commits into from
Apr 6, 2026
Merged

UI utils #3

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
e3da3d9
in progress: integration of from_example to function
danielrak Mar 31, 2026
2b2fda8
rework from example and directly function writing ui
danielrak Apr 6, 2026
f4e188d
Add from example to function functionality. Whole minimal process is …
danielrak Apr 6, 2026
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
116 changes: 58 additions & 58 deletions .Rhistory
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,61 +1,3 @@
}
# Detect x <- ..., x = ... (as assignment), x <<- ..., ... -> x, ... ->> x
is_assignment_call <- function(x) {
is.call(x) && is.symbol(x[[1]]) && as.character(x[[1]]) %in%
c("<-", "=", "<<-", "->", "->>")
}
# Extract symbol bound by an assignment call (only if LHS is a bare symbol)
assignment_lhs_symbol <- function(x) {
if (!is_assignment_call(x)) return(NULL)
op <- as.character(x[[1]])
# For -> and ->>, the assigned symbol is the 3rd element
lhs <- if (op %in% c("->", "->>")) x[[3]] else x[[2]]
if (is.symbol(lhs)) {
nm <- as.character(lhs)
if (length(nm) == 1 && !is.na(nm) && nm != "") return(nm)
}
NULL
}
rewrite <- function(node, bound = character()) {
# Strings -> params
if (is.character(node) && length(node) == 1) {
key <- paste0("chr:", node)
pname <- make_param(key, node)
return(rlang::sym(pname))
}
# Symbols: keep local/bound; capture external non-functions
if (is.symbol(node)) {
s <- as.character(node)
if (length(s) != 1 || is.na(s) || s == "") return(node)
if (s %in% bound) return(node)
if (exists(s, envir = env, inherits = TRUE)) {
val <- get(s, envir = env, inherits = TRUE)
if (!is.function(val)) {
key <- paste0("sym:", s)
pname <- make_param(key, val)
return(rlang::sym(pname))
}
}
return(node)
}
# Expression vectors
if (is.expression(node)) {
out <- lapply(as.list(node), rewrite, bound = bound)
return(as.expression(out))
}
# Calls
if (is.call(node)) {
head <- node[[1]]
head_name <- if (is.symbol(head)) as.character(head) else NULL
# Handle { ... } as a sequential block with growing bound vars
if (!is.null(head_name) && head_name == "{") {
args <- as.list(node)
# args[[1]] is "{"
cur_bound <- bound
if (length(args) >= 2) {
for (i in seq.int(2, length(args))) {
stmt <- args[[i]]
# Rewrite statement with current bound
args[[i]] <- rewrite(stmt, bound = cur_bound)
# If original statement binds a new symbol, extend bound for following statements
new_nm <- assignment_lhs_symbol(stmt)
Expand Down Expand Up @@ -510,3 +452,61 @@ library(genprocShiny)
remove.packages("genprocShiny")
devtools::load_all()
devtools::load_all()
devtools::load_all()
run_app()
run_app()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
expression("function (x) x + 1")
expression("function (x) x + 1") %>% eval()
library(dplyr)
expression("function (x) x + 1") %>% eval()
symbol("function (x) x + 1") %>% eval()
sym("function (x) x + 1") %>% eval()
expr(sym("function (x) x + 1")) %>% eval()
expr(sym("function (x) x + 1")) %>% eval
expr(sym("function (x) x + 1")) %>% eval %>% class
expr(sym("function (x) x + 1")) %>% eval %>% eval
as.expression("function (x) x + 1")
as.expression("function (x) x + 1") %>% eval()
as.expression("function (x) x + 1") %>% eval() %>% class
as.expression("function (x) x + 1") %>% eval() %>% expression()
parse("function (x)x + 1")
devtools::load_all()
rlang::parse_expr("function (x) x + 1")
rlang::parse_expr("function (x) x + 1") %>% eval
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
golem::run_dev()
rlang::parse_expr("get('cars') %>% select(1)")
rlang::parse_expr("get('cars') %>% select(1)") %>% from_example_to_function()
library(dplyr)
rlang::parse_expr("get('cars') %>% select(1)") %>% from_example_to_function()
rlang::parse_expr("get('cars') %>% select(1)")
rlang::parse_expr("get('cars') %>% select(1)") %>% str
rlang::parse_expr("get('cars') %>% select(1)") %>% from_example_to_function()
rlang::parse_expr("get('cars') %>% select(1)") %>% from_example_to_function()
golem::run_dev()
parse("get('cars') %>% select(1)") %>% from_example_to_function()
library(dplyr)
parse("get('cars') %>% select(1)") %>% from_example_to_function()
from_example_to_function
golem::run_dev()
devtools::check()
14 changes: 5 additions & 9 deletions R/app_ui.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -25,17 +25,13 @@ app_ui <- function(request) {
alt = "genproc logo"
)
),
tabsetPanel(
tabPanel("Main",

mod_mask_ui("mask_1"),
mod_func_code_ui("func_1"),
mod_gproc_ui("gproc_1"),
mod_log_ui("log_1")
mod_mask_ui("mask_1"),
mod_func_code_ui("func_1"),
mod_gproc_ui("gproc_1"),
mod_log_ui("log_1")


),
tabPanel("Utils")
)
)
)
)
Expand Down
143 changes: 106 additions & 37 deletions R/mod_func_code.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,60 +15,129 @@ mod_func_code_ui <- function(id) {
fluidRow(

tags$h2("2 - Function"),
column(6,
textAreaInput(ns("funccode"), label = tags$h3("Write your function code"),
width = "800px", height = "100px"),
fluidRow(column(4, actionButton(ns("funcok"), label = "Validate function")),
column(6, wellPanel(verbatimTextOutput(ns("funccheck")))))),

column(6,
tags$h3("Function preview"),
wellPanel(class = "gp-well2",
verbatimTextOutput(ns("functext"))))),
# function writing
tabsetPanel(
tabPanel("Build function",
column(6,

# From example
textAreaInput(ns("egcode"), label = tags$h3("Write your example code"),
width = "800px", height = "100px"),
fluidRow(column(4, actionButton(ns("egok"), label = "Validate example")),
column(6, wellPanel(verbatimTextOutput(ns("egcheck"))))),

# Direct writing
textAreaInput(ns("funccode"), label = tags$h3("Write your function code"),
width = "800px", height = "100px"),
fluidRow(column(4, actionButton(ns("funcok"), label = "Validate function")),
column(6, wellPanel(verbatimTextOutput(ns("funccheck")))))),
# Preview function
column(6,
tags$h3("Function preview"),
wellPanel(class = "gp-well2",
verbatimTextOutput(ns("functext"))))
),

tabPanel("Arguments mapping",
# arguments mapping
fluidRow(
column(6,
textAreaInput(ns("argmap"), label = tags$h3("Map your function arguments to mask names"),
width = "800px", height = "100px"),
fluidRow(column(4, actionButton(ns("argsok"), label = "Validate mapping")),
column(6, wellPanel(verbatimTextOutput(ns("argscheck")))))),

column(6,
tags$h3("Arguments mapping preview"),
wellPanel(class = "gp-well2",
verbatimTextOutput(ns("argtext"))))))

))

fluidRow(
column(6,
textAreaInput(ns("argmap"), label = tags$h3("Map your function arguments to mask names"),
width = "800px", height = "100px"),
fluidRow(column(4, actionButton(ns("argsok"), label = "Validate mapping")),
column(6, wellPanel(verbatimTextOutput(ns("argscheck")))))),

column(6,
tags$h3("Arguments mapping preview"),
wellPanel(class = "gp-well2",
verbatimTextOutput(ns("argtext")))))
)
)
}

#' func_code Server Functions
#'
#' @noRd
mod_func_code_server <- function(id, mask_data){
moduleServer(id, function(input, output, session){
mod_func_code_server <- function(id, mask_data) {
moduleServer(id, function(input, output, session) {
ns <- session$ns

func_expr <- reactive(eval_parse(text = input$funccode))
func_code <- eventReactive(input$funcok, func_expr())
func_check <- eventReactive(input$funcok, validate_func(func_expr()))
# the unique function
current_func <- reactiveVal(NULL)
current_check <- reactiveVal("No function validated yet.")

# build function from example
observeEvent(input$egok, {
tryCatch({
eg_expr <- parse(text = input$egcode)
fun <- from_example_to_function(eg_expr)

# write generated function into the function text area
fun_txt <- paste(deparse(fun), collapse = "\n")
updateTextAreaInput(session, "funccode", value = fun_txt)

# store as current function
current_func(fun)
current_check(validate_func(fun))

output$funccheck <- renderPrint(func_check())
output$functext <- renderPrint(func_code())
}, error = function(e) {
current_check(paste("Error:", conditionMessage(e)))
})
})

args_expr <- reactive(eval_parse(text = input$argmap))
args_code <- eventReactive(input$argsok, args_expr())
args_check <- eventReactive(
input$argsok,
{
validate_args(args_expr(),
mask_data = mask_data(), func = func_code())})
# validate function written directly in funccode
observeEvent(input$funcok, {
tryCatch({
fun <- eval_parse(text = input$funccode)

current_func(fun)
current_check(validate_func(fun))

}, error = function(e) {
current_check(paste("Error:", conditionMessage(e)))
})
})

# unique preview
output$functext <- renderPrint({
req(current_func())
current_func()
})

# unique validation message
output$funccheck <- renderPrint({
current_check()
})

# arguments mapping
args_expr <- reactive({
eval_parse(text = input$argmap)
})

args_code <- eventReactive(input$argsok, {
args_expr()
})

args_check <- eventReactive(input$argsok, {
req(current_func())
validate_args(
args_expr(),
mask_data = mask_data(),
func = current_func()
)
})

output$argscheck <- renderPrint(args_check())
output$argtext <- renderPrint(args_code())

list("func_code_return" = func_code,
"args_mapping_return" = args_code)

list(
"func_code_return" = current_func,
"args_mapping_return" = args_code
)
})
}

Expand Down
6 changes: 6 additions & 0 deletions inst/demo_assets/func_and_args_mapping.R
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,9 @@
# eg
{
data <- readr::read_rds(file.path("./r_built_in_datasets", "airquality.rds"))
data %>% readr::write_csv(file.path("./out", "airquality.csv"))
}

# func
function (param_1 = "./r_built_in_datasets", param_2 = "airquality.rds",
param_3 = "./out", param_4 = "airquality.csv")
Expand Down
Loading