refactor: Simplify app.R

Appsilon · Feb 1, 2024 · c4eed32 · c4eed32
1 parent 6469dd5
commit c4eed32
Showing 1 changed file with 37 additions and 44 deletions.
diff --git a/R/app.R b/R/app.R
@@ -35,23 +35,17 @@ configure_logger <- function() {
   }
 }
 
-fix_server_reloading <- function(server) {
-  reparse(curly_wrap(server))
-}
-
 reparse <- function(f) {
   eval(parse(text = deparse(f)), envir = environment(f))
 }
 
-curly_wrap <- function(f) {
-  wrapped <- function() {
-    do.call(f, as.list(match.call())[-1])
-  }
-  formals(wrapped) <- formals(f)
-  wrapped
+load_app_source <- function() {
+  main <- new.env(parent = globalenv())
+  source(fs::path("app", "main.R"), local = main)
+  main
 }
 
-load_app <- function() {
+load_app_box <- function() {
   # Silence "no visible binding" notes raised by `box::use()` on R CMD check.
   app <- NULL
   main <- NULL
@@ -88,39 +82,36 @@ register_reload_callback <- function(callback) {
 }
 
 with_head_tags <- function(ui) {
-  wrap <- function(tag) {
-    shiny::tagList(
-      shiny::tags$head(
-        react_support(), # Needs to go before `app.min.js`, which defines the React components.
-        shiny::tags$script(src = "static/js/app.min.js"),
-        shiny::tags$link(rel = "stylesheet", href = "static/css/app.min.css", type = "text/css"),
-        shiny::tags$link(rel = "icon", href = "static/favicon.ico", sizes = "any")
-      ),
-      tag
-    )
-  }
-  if (is.function(ui)) {
-    purrr::compose(wrap, ui)
-  } else {
-    wrap(ui)
+  head <- shiny::tags$head(
+    react_support(), # Needs to go before `app.min.js`, which defines the React components.
+    shiny::tags$script(src = "static/js/app.min.js"),
+    shiny::tags$link(rel = "stylesheet", href = "static/css/app.min.css", type = "text/css"),
+    shiny::tags$link(rel = "icon", href = "static/favicon.ico", sizes = "any")
+  )
+  function(request) {
+    shiny::tagList(head, ui(request))
   }
 }
 
-call_ui <- function(ui, request) {
+normalize_ui <- function(ui) {
   if (!is.function(ui)) {
-    ui
+    function(request) ui
   } else if (length(formals(ui)) == 0) {
-    ui()
+    function(request) ui()
   } else {
-    ui(request)
+    function(request) ui(request)
   }
 }
 
-call_server <- function(server, input, output, session) {
+normalize_server <- function(server) {
   if ("session" %in% formalArgs(server)) {
-    server(input, output, session)
+    function(input, output, session) {
+      server(input = input, output = output, session = session)
+    }
   } else {
-    server(input, output)
+    function(input, output, session) {
+      server(input = input, output = output)
+    }
   }
 }
 
@@ -177,34 +168,36 @@ app <- function() {
   if (identical(entrypoint, "app_dir")) {
     shiny::shinyAppDir("app")
   } else if (identical(entrypoint, "source")) {
-    main <- new.env()
-    source(fs::path("app", "main.R"), local = main)
+    main <- load_app_source()
+    ui <- normalize_ui(main$ui)
+    server <- main$server
     shiny::shinyApp(
-      ui = with_head_tags(main$ui),
+      ui = with_head_tags(ui),
       server = main$server
     )
   } else if (identical(entrypoint, "box_top_level")) {
-    app_env <- load_app()
+    app_env <- load_app_box()
     ui <- function(request) {
-      call_ui(app_env$main$ui, request)
+      normalize_ui(app_env$main$ui)(request)
     }
     server <- function(input, output, session) {
-      call_server(app_env$main$server, input, output, session)
+      normalize_server(app_env$main$server)(input, output, session)
     }
     shiny::shinyApp(
       ui = with_head_tags(ui),
       server = reparse(server)
     )
   } else if (is.null(entrypoint)) {
-    app_env <- load_app()
-    # Wrap the UI in a function to support Shiny bookmarking.
-    ui <- function(request) app_env$main$ui("app")
-    server <- function(input, output) {
+    app_env <- load_app_box()
+    ui <- function(request) {
+      app_env$main$ui("app")
+    }
+    server <- function(input, output, session) {
       app_env$main$server("app")
     }
     shiny::shinyApp(
       ui = with_head_tags(ui),
-      server = fix_server_reloading(server)
+      server = reparse(server)
     )
   } else {
     stop()