Nothing
#' Psych-DS App Server
#'
#' This file defines the server-side logic for the Psych-DS app.
#' It handles the main app flow, state management, and module coordination.
source("modules/server_modules.R", local = TRUE)
step_navigation <- function(id, state, session) {
moduleServer(id, function(input, output, session) {
# Log inputs only once at initialization
cat("Step Navigation Module initialized with ID:", id, "\n")
# Step 1 button handler
observeEvent(input$goto_step1, {
cat("STEP 1 BUTTON CLICKED\n")
# Step 1 is always accessible
state$current_step <- 1
cat("Updated current_step to:", state$current_step, "\n")
})
# Step 2 button handler
observeEvent(input$goto_step2, {
cat("STEP 2 BUTTON CLICKED\n")
# Can only go to step 2 if:
# 1. We've already been there (state$current_step >= 2), OR
# 2. We have selected a directory and at least one data file
can_go_to_step2 <- state$current_step >= 2 ||
(!is.null(state$project_dir) &&
state$project_dir != "" &&
length(state$data_files) > 0)
cat("Can go to step 2:", can_go_to_step2, "\n")
cat("- current_step:", state$current_step, "\n")
cat("- project_dir:", if(is.null(state$project_dir)) "NULL" else state$project_dir, "\n")
cat("- data_files count:", length(state$data_files), "\n")
if (can_go_to_step2) {
state$current_step <- 2
cat("Updated current_step to:", state$current_step, "\n")
} else {
showNotification("Complete Step 1 first (select a project directory and at least one data file)",
type = "warning")
cat("Navigation to Step 2 blocked - requirements not met\n")
}
})
# Step 3 button handler
observeEvent(input$goto_step3, {
cat("STEP 3 BUTTON CLICKED\n")
# Can only go to step 3 if:
# 1. We've already been there (state$current_step >= 3), OR
# 2. We have completed step 2 (dataset name and description filled)
# Check if dataset_info exists
if (is.null(state$dataset_info)) {
cat("dataset_info is NULL\n")
dataset_info_complete <- FALSE
} else {
cat("dataset_info exists\n")
cat("- name:", if(is.null(state$dataset_info$name)) "NULL" else state$dataset_info$name, "\n")
cat("- description:", if(is.null(state$dataset_info$description)) "NULL" else "EXISTS", "\n")
dataset_info_complete <- !is.null(state$dataset_info$name) &&
!is.null(state$dataset_info$description) &&
state$dataset_info$name != "" &&
state$dataset_info$description != ""
}
can_go_to_step3 <- state$current_step >= 3 || dataset_info_complete
cat("Can go to step 3:", can_go_to_step3, "\n")
cat("- current_step:", state$current_step, "\n")
cat("- dataset_info_complete:", dataset_info_complete, "\n")
if (can_go_to_step3) {
state$current_step <- 3
cat("Updated current_step to:", state$current_step, "\n")
} else {
showNotification("Complete Step 2 first (provide dataset name and description)",
type = "warning")
cat("Navigation to Step 3 blocked - requirements not met\n")
}
})
})
}
# Main server function
server <- function(input, output, session) {
# Initialize application state
state <- init_state()
# Add a reactive value to store the last create tab step
last_create_step <- reactiveVal(1)
# Track validator loading status
validator_status <- reactiveVal(FALSE)
# Observe when the validator is ready
observeEvent(input$validator_ready, {
if (input$validator_ready) {
validator_status(TRUE)
message("Validator loaded successfully and is ready to use!")
}
}, ignoreNULL = TRUE, ignoreInit = TRUE)
# Observe validation results
observeEvent(input$validation_results, {
results <- input$validation_results
message("Received validation results")
# Remove the loading notification if it exists
removeNotification(id = "validate_notif")
# Show a success message
showNotification("Validation complete!", type = "message")
# Store the results in state for use in the validation module
state$validation_results <- results
}, ignoreNULL = TRUE, ignoreInit = TRUE)
# Handle validation errors
observeEvent(input$validation_error, {
error_msg <- input$validation_error
warning("Validation error: ", error_msg)
# Remove the loading notification if it exists
removeNotification(id = "validate_notif")
showNotification(paste("Validation error:", error_msg), type = "error")
}, ignoreNULL = TRUE, ignoreInit = TRUE)
# Handle validator loading event
observeEvent(input$validator_loaded, {
validator_status(input$validator_loaded)
if (input$validator_loaded) {
message("JavaScript validator successfully loaded")
} else {
warning("JavaScript validator was not loaded correctly. Check validator.js file")
}
})
# Function to prepare and run validation
runValidation <- function(directory) {
# Check if validator is loaded
if (!validator_status()) {
showNotification("JavaScript validator not loaded", type = "error")
return(FALSE)
}
tryCatch({
# Prepare the file tree structure expected by the validator
# This is a simplified version - the real implementation would need to
# recursively build a proper tree structure of the directory
files <- list.files(directory, recursive = TRUE)
file_tree <- list()
# Build a simple file tree structure for testing
for (file in files) {
file_tree[[file]] <- list(
type = "file",
file = list(
name = basename(file),
path = file,
text = function() {
# This would be a promise in the real implementation
return(readLines(file.path(directory, file), warn = FALSE))
}
)
)
}
# Send the file tree to the JavaScript validator
session$sendCustomMessage("run_validation", file_tree)
return(TRUE)
}, error = function(e) {
showNotification(paste("Error preparing validation:", e$message), type = "error")
return(FALSE)
})
}
# Handle sidebar menu selection
observeEvent(input$sidebar, {
# Scroll to top when changing tabs
session$sendCustomMessage("scrollToTop", list())
if (input$sidebar == "create") {
# If we're on create dataset tab, use the last remembered step
# instead of always defaulting to 1
if (!is.null(last_create_step()) && last_create_step() > 0) {
state$current_step <- last_create_step()
} else if (is.null(state$current_step) || state$current_step == 0) {
# Only use the default step 1 if we never set a step before
state$current_step <- 1
}
} else if (input$sidebar == "validate") {
# For validate tab, set the validation directory to the created dataset if
# available. The input lives inside the "validate_dataset" module, so the
# id must be namespaced (same pattern as the dictionary tab below) --
# unnamespaced "validate_dir" targets nothing and vanishes silently.
if (!is.null(state$created_dataset_dir) && state$created_dataset_dir != "" && dir.exists(state$created_dataset_dir)) {
updateTextInput(session, "validate_dataset-validate_dir", value = state$created_dataset_dir)
# Also reset the validation UI
session$sendCustomMessage("reset_validation_ui", list())
}
# For tabs other than create, remember the current step before switching away
if (!is.null(state$current_step) && state$current_step > 0) {
last_create_step(state$current_step)
}
# Set current step to 0 (no step active)
state$current_step <- 0
} else if (input$sidebar == "dictionary") {
# When switching to dictionary tab, pre-populate with validated dataset
if (!is.null(state$validated_dataset_dir) && state$validated_dataset_dir != "" && dir.exists(state$validated_dataset_dir)) {
updateTextInput(session, "data_dictionary-dataset_dir", value = state$validated_dataset_dir)
showNotification("Using validated dataset for data dictionary", type = "message", duration = 3)
}
# For tabs other than create, remember the current step before switching away
if (!is.null(state$current_step) && state$current_step > 0) {
last_create_step(state$current_step)
}
# Set current step to 0 (no step active)
state$current_step <- 0
} else if (input$sidebar == "explorer") {
# When switching to explorer tab, check for datasets from different sources
dataset_to_load <- NULL
# Priority 1: From dictionary module
if (!is.null(state$dictionary_dataset_dir) && dir.exists(state$dictionary_dataset_dir)) {
dataset_to_load <- state$dictionary_dataset_dir
message_text <- "Loading dataset from data dictionary"
}
# Priority 2: From validation
else if (!is.null(state$validated_dataset_dir) && dir.exists(state$validated_dataset_dir)) {
dataset_to_load <- state$validated_dataset_dir
message_text <- "Loading validated dataset"
}
# Priority 3: From creation
else if (!is.null(state$created_dataset_dir) && dir.exists(state$created_dataset_dir)) {
dataset_to_load <- state$created_dataset_dir
message_text <- "Loading created dataset"
}
# Update the explorer if we have a dataset
if (!is.null(dataset_to_load)) {
updateTextInput(session, "dataset_explorer-dataset_dir", value = dataset_to_load)
showNotification(message_text, type = "message", duration = 3)
}
# Remember current step before switching away
if (!is.null(state$current_step) && state$current_step > 0) {
last_create_step(state$current_step)
}
# Set current step to 0 (no step active)
state$current_step <- 0
} else {
# For other tabs, remember the current step before switching away
if (!is.null(state$current_step) && state$current_step > 0) {
last_create_step(state$current_step)
}
# For other tabs, set current step to 0 (no step active)
state$current_step <- 0
}
})
stepNavServer <- step_navigation("step_nav", state, session)
# Dynamically render the Create Dataset UI based on current step
output$create_dataset_ui <- renderUI({
# Print to console for debugging
cat("Rendering UI for step:", state$current_step, "\n")
switch(as.character(state$current_step),
"1" = step1UI("step1"),
"2" = step2UI("step2"),
"3" = step3UI("step3"),
step1UI("step1")) # Default fallback
})
# Initialize the step modules
step1Server("step1", state, session)
step2Server("step2", state, session)
step3Server("step3", state, session)
# Initialize validation module
validateServer("validate_dataset", state, session)
# Directory pickers now live inside each module via bindDirectoryBrowser()
# (see modules/directory_picker.R); no shinyFiles setup is needed here.
dataDictionaryServer("data_dictionary", state, session)
datasetExplorerServer("dataset_explorer", state, session)
# Modify your validate_btn event handler
observeEvent(input$validate_btn, {
if (input$validate_dir == "") {
showModal(modalDialog(
title = "Error",
"Please select a dataset directory first.",
easyClose = TRUE,
footer = modalButton("OK")
))
} else {
withProgress(message = "Validating dataset...", value = 0.1, {
if (!dir.exists(input$validate_dir)) {
setProgress(1)
showNotification("Directory does not exist", type = "error")
return()
}
setProgress(0.3, detail = "Building file tree...")
tryCatch({
# Build the file tree
fileTree <- buildFileTree(input$validate_dir)
# Basic validation of the tree
if (length(fileTree) == 0) {
setProgress(1)
showNotification("No files found in directory", type = "error")
return()
}
# Send to the validator
setProgress(0.6, detail = "Running validator...")
message("Sending file tree to validator with ", length(fileTree), " top-level entries")
session$sendCustomMessage("run_validation", fileTree)
}, error = function(e) {
setProgress(1)
message("Error during validation: ", e$message)
showNotification(paste("Error during validation:", e$message), type = "error")
})
})
}
})
observeEvent(input$test_validation, {
# Create a test file tree
testTree <- createTestFileTree()
# Show a validation in progress notification
withProgress(message = "Testing validation with basic data...", value = 0.2, {
# Log the tree
message("Created test file tree with ", length(testTree), " top-level entries")
message("Test tree contains: ", paste(names(testTree), collapse = ", "))
# Send the test tree for validation
session$sendCustomMessage("run_validation", testTree)
# Increment progress
setProgress(0.8, detail = "Validation in progress...")
})
})
observeEvent(input$validation_results, {
if (is.null(input$validation_results)) return()
results <- input$validation_results
message("Received validation results: valid=", results$valid)
# Store results in state for the validation module to use
state$validation_results <- results
# Show notification
showNotification(
ifelse(results$valid,
"Dataset is valid!",
"Dataset has issues - see details below"),
type = ifelse(results$valid, "message", "warning"),
duration = 5
)
}, ignoreNULL = TRUE)
observeEvent(input$dictionary_btn, {
if (input$dictionary_dir == "") {
showModal(modalDialog(
title = "Error",
"Please select a dataset directory first.",
easyClose = TRUE,
footer = modalButton("OK")
))
} else {
# In a real implementation, this would load the data dictionary editor
# For now, just show a placeholder
showModal(modalDialog(
title = "Update Dictionary",
div(
p("Data dictionary editor would open here."),
p("The selected directory is:"),
p(strong(input$dictionary_dir))
),
easyClose = TRUE,
footer = modalButton("Close")
))
}
})
observeEvent(input$explorer_btn, {
if (input$explorer_dir == "") {
showModal(modalDialog(
title = "Error",
"Please select a dataset directory first.",
easyClose = TRUE,
footer = modalButton("OK")
))
} else {
# In a real implementation, this would open the dataset explorer
# For now, just show a placeholder
showModal(modalDialog(
title = "Dataset Explorer",
div(
p("Dataset explorer would open here."),
p("The selected directory is:"),
p(strong(input$explorer_dir))
),
easyClose = TRUE,
footer = modalButton("Close")
))
}
})
observeEvent(input$`validate_dataset-continue`, {
current_dir <- input$validate_dir
cat("Continue button clicked, validate_dir:", current_dir, "\n")
if (!is.null(current_dir) && current_dir != "") {
state$validated_dataset_dir <- current_dir
cat("Stored validated dataset dir:", current_dir, "\n")
}
# Switch to the data dictionary tab
session$sendCustomMessage("changeTab", list(tabName = "dictionary"))
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.