feat: adapt management events data schema standard and dynamic ui accordingly

DESCRIPTION

@@ -10,19 +10,14 @@ Description: An app for keeping track of field activity in the Field
   ICASA standards for agricultural data.
 License: BSD_3_clause + file LICENSE
 Imports: 
-    attempt,
     bslib,
     callr,
     config (>= 0.3.1),
     DT (>= 0.25),
-    ggplot2,
     glue,
     golem (>= 0.3.1),
     htmlwidgets,
     jsonlite,
-    methods,
-    pkgload,
-    processx,
     rmarkdown,
     shiny (>= 1.6.0),
     shinyjs,

NAMESPACE

@@ -1,7 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
 export(run_app)
-import(ggplot2)
 import(rmarkdown)
 import(shiny)
 import(shinyvalidate)

R/app_server.R

@@ -74,15 +74,6 @@ app_server <- function(input, output, session) {
 
         updateSelectInput(session, "site", choices = site_choices, selected = auth_result$user)
 
-      } else if (auth_result$user == "icos_agri_user") {
-
-        shinyjs::enable("site")
-        shinyjs::show("site")
-        # Subset of site choices for the third user
-        site_choices <- sites[grepl("icos-agri", sites$site_type),]$site
-
-        updateSelectInput(session, "site", choices = site_choices, selected = auth_result$user)
-
       } else {
 
         updateSelectInput(session, "site", selected = auth_result$user)
@@ -671,55 +662,48 @@ app_server <- function(input, output, session) {
 
   })
 
-  # change language when user requests it
+  # change language when user requests it — only app chrome elements
+  # (form module handles its own schema-driven language switching)
   observeEvent(input$language, ignoreInit = TRUE, {
 
     if (dp()) message("input$language changed")
-    
+
     # get a list of all input elements which we have to relabel
     input_element_names <- names(reactiveValuesToList(input))
-    
+
     for (code_name in input_element_names) {
-
-      # TODO: update to use the update_ui_element function
-
+
       # find element in the UI structure lookup list
-      element <- structure_lookup_list[[code_name]]  
-      
+      element <- structure_lookup_list[[code_name]]
+
       # didn't find the element corresponding to code_name
-      # this should not happen if the element is in 
+      # this should not happen if the element is in
       # sidebar_ui_structure.json
       if (is.null(element$type)) next
 
       label <- get_disp_name(element$label, input$language)
 
       if (element$type == "selectInput") {
-        
+
         # fetch choices for the selectInput
         choices <- get_selectInput_choices(code_name, input$language)
-        
+
         # make sure we don't change the selected value
         current_value <- input[[code_name]]
 
         if (is.null(choices)) {
-          updateSelectInput(session, 
-                            code_name,
-                            label = ifelse(is.null(label),"",label),
+          updateSelectInput(session, code_name,
+                            label = ifelse(is.null(label), "", label),
                             selected = current_value) 
         } else {
-          updateSelectInput(session, 
-                            code_name,
-                            label = ifelse(is.null(label),"",label),
+          updateSelectInput(session, code_name,
+                            label = ifelse(is.null(label), "", label),
                             choices = choices,
                             selected = current_value)
         }
-
       } else if (element$type == "actionButton") {
-        updateActionButton(session,
-                           code_name,
-                           label = label)
+        updateActionButton(session, code_name, label = label)
       }
-
     }
 
   })

R/app_ui.R

@@ -94,9 +94,10 @@ golem_add_external_resources <- function(){
       path = app_sys('app/www'),
       app_title = 'fieldactivity'
     ),
+    tags$link(rel = "stylesheet", type = "text/css",
+              href = "www/schema.css"),
     # Add here other external resources
     # for example, you can add shinyalert::useShinyalert() 
     shinyjs::useShinyjs(),  # enable shinyjs
   )
 }
-

R/fct_event_list.R

@@ -84,4 +84,29 @@ find_event_index <- function(event, event_list) {
 
   # We didn't find a match, so return NULL
   return(NULL)
+}
+
+#' Get display names for event list table column headers
+#' Tries display_names.csv first, then schema titles as fallback
+#' @param col_names Vector of column names
+#' @param language Language code or column name
+#' @return Vector of display names
+get_event_list_colnames <- function(col_names, language) {
+  iso <- lang_to_iso(language)
+
+  vapply(col_names, function(cn) {
+    # Try display_names.csv first
+    dn <- get_disp_name(cn, language = language, is_variable_name = TRUE)
+    if (!identical(dn, cn)) return(dn)
+
+    # Try schema property titles
+    desc <- find_any_property_desc(mgmt_schema$property_registry, cn,
+                                    mgmt_schema$property_reverse_index)
+    if (!is.null(desc) && !is.null(desc$titles)) {
+      title <- schema_get_title(desc$titles, iso, "")
+      if (nchar(title) > 0) return(title)
+    }
+
+    cn
+  }, character(1))
 }