R/reload_translators.R

In nachocab/clickme: Straight from R to JS: Create interactive visualizations from R

#' Traverse a list of paths and determine what objects are defined in the
#' source files that appear in the "translator" folder of each path
#' It returns a list of sourced objects.
#' We do this to control what objects get added to the global namespace
get_sourced_objects <- function(paths) {
    sourced_objects <- lapply(paths, function(path) {
        translator_files <- list.files(file.path(path, "translator"), full.names = TRUE)

        # the call to camel_case is to avoid a weird issue with lowercase folders renamed to uppercase in OSX
        main_translator_file <- file.path(path, "translator", paste0(camel_case(basename(path)), ".R"))

        # ensure the main translator file is loaded before the helper files
        translator_files <- move_in_front(main_translator_file, translator_files)

        temp_environment <- new.env()
        sapply(translator_files, function(translator_file){
            suppressWarnings(sys.source(translator_file, envir = temp_environment))
        })

        ls(temp_environment)
    })

    names(sourced_objects) <- paths
    # remove empty list elements
    sourced_objects <- sourced_objects[lapply(sourced_objects, length) > 0]

    sourced_objects
}


#' Load the translator files in each template
#'
#' Translators are only allowed to create one object with the name of their
#' template and a clickme helper function in the global namespace.
#'
reload_translators <- function() {
    clickme_helper <<- list()

    template_paths <- list.files(getOption("clickme_templates_path"), full.names = TRUE)
    template_objects <- get_sourced_objects(template_paths)

    # some template paths might have been removed because they didn't define
    # any objects in the global namespace, so we ignore them
    template_paths <- names(template_objects)
    template_objects <- unname(template_objects)

    # Ensure that each translator only creates one object with the name of its
    # template and the clickme_helper function
    sapply(1:length(template_paths), function(t){
        template_name <- basename(template_paths[t])
        valid_global_names <- c(template_name, "clickme_helper")

        invalid_global_names <- setdiff(template_objects[[t]], valid_global_names)
        if (length(invalid_global_names) > 0) {
            stop(sprintf("The %s template is defining the following names in the global namespace:\n%s\n\nYou should define these as reference class methods or fields",
                 basename(template_paths[t]),
                 enumerate(invalid_global_names), call. = FALSE)
            )
        }
    })

    # ensure that the translator file where the template is defined gets loaded before any of the other helper files
    translator_files <- list.files(file.path(template_paths, "translator"), full.names = TRUE)
    main_translator_files <- file.path(template_paths, "translator", sapply(template_paths, function(path) paste0(basename(path), ".R")))
    translator_files <- move_in_front(main_translator_files, translator_files)

    suppressWarnings(sapply(translator_files, source))

    return()
}