github rough outline

UIs/ui_github.R

@@ -0,0 +1,24 @@
+
+# Navigating github
+github_tab <- tabPanel(
+  title = "Connect to GitHub",
+  fluidPage(
+    fluidRow(
+      column(width = 12,
+             shinydashboard::box(width = NULL,
+                                 status = "danger",
+                                 solidHeader = TRUE,
+                                 title = "Create a new repo",
+                                 textInput("username", "Enter GitHub username"),
+                                 textInput("password", "Enter GitHub password"),
+                                 helpText(" "),
+                                 uiOutput("git_project_name"),
+                                 textInput("repo_URL", "Enter GitHub repo URL"),
+                                 actionButton("create_github", "Create GitHub repo"),
+                                 actionButton("push", "Push"),
+                                 actionButton("pull", "Pull"),
+                                 uiOutput("git_text"))
+      )
+    )
+  )
+)

global.R

@@ -5,6 +5,7 @@
 
 library('shinydashboard')
 library('NeuroDecodeR')
+library('gh')
 library('ggplot2')
 library('dplyr')
 library('shinyAce')
@@ -29,7 +30,7 @@ options(shiny.maxRequestSize=1000*1024^2)
 
 # Prefixes of data to check valid types
 multi_result_prefix <- list("analysis_ID", "result_name", "ds_", "cv_", "cl_", "fp_", "rm_")
-single_result_prefix <- list("rm_confusion_matrix")
+single_result_prefix <- list("rm_main_results", "rm_confusion_matrix", "cross_validation_paramaters")
 
 # List of inputs for decoding results
 all_result_type <- c("zero_one_loss", "normalized_rank", "decision_vals", "all")

server.R

@@ -27,6 +27,8 @@ myServer <- function(input,output,session){
   rv <- reactiveValues()
 
   rv$base_dir <- NULL
+  rv$projects_available <- list.dirs(file.path(app_base_dir, "projects"),
+                                     full.names = FALSE, recursive = FALSE)
 
   # Raster reactive values
   rv$raster_base_dir <- NULL
@@ -68,8 +70,11 @@ myServer <- function(input,output,session){
 ############################ Server source files ###############################
 ################################################################################
 
-  # Server files for "Binning the Raster Data" tab
+  # Server files for project changes
   source("servers/server_select_project.R", local = TRUE)
+  source("servers/server_github.R", local = TRUE)
+
+  # Server files for "Binning the Raster Data" tab
   source("servers/server_binning_params.R", local = TRUE)
   source("servers/server_plot_raster.R", local = TRUE)
   source("servers/server_upload_new_raster.R", local = TRUE)

servers/server_github.R

@@ -0,0 +1,56 @@
+
+################################################################################
+################################# Create Repo ##################################
+################################################################################
+
+# Select project
+output$git_project_name <- renderUI({
+  req(rv$working_dir, rv$projects_available)
+  selectInput("git_project_name",
+              'Select the project you want to create a new repo for',
+              rv$projects_available,
+              selected = basename(rv$working_dir))
+})
+
+
+
+# Create a new repo if one does not exist with the current project name
+observeEvent(input$create_github, {
+  # Check all the info is in there
+  if (input$username == "") {
+    output$git_text <- renderText("<br><font color='red'>Please enter a username</font>")
+  } else if (input$password == "") {
+    output$git_text <- renderText("<br><font color='red'>Please enter a password</font>")
+  } else if (input$repo_URL == "") {
+    output$git_text <- renderText("<br><font color='red'>Please enter a repo URL first</font>")
+
+  # If a project already exists, throw an error
+  } else if (file.exists(file.path("projects", input$git_project_name))) {
+    output$git_text <- renderText("<br>A project with this project name already exists")
+
+  # When everything is correct
+  } else {
+    # Create new project the new project directory
+    create_github_repo(input$git_project_name)
+    output$git_text <- renderText(paste0("Created new repo called: ",
+                                         input$git_project_name))
+  }
+})
+
+################################################################################
+############################## Push/pull buttons ###############################
+################################################################################
+
+# Run push button
+observeEvent(input$push, {
+  req(input$git_project_name)
+  gert::git_push(repo = file.path("projects", input$git_project_name))
+})
+
+# Run pull button
+observeEvent(input$pull, {
+  req(input$git_project_name)
+  gert::git_pull(repo = file.path("projects", input$git_project_name))
+})
+
+

servers/server_select_project.R

@@ -12,10 +12,7 @@ output$project_option <- renderUI({
 output$select_project_folder <- renderUI({
   req(input$project_option)
   if(input$project_option == "Select a Project"){
-    projects_available <- list.dirs(file.path(app_base_dir, "projects"),
-                                    full.names = FALSE, recursive = FALSE)
-
-    list(selectInput("select_project_folder", 'Please select a folder', projects_available),
+    list(selectInput("select_project_folder", 'Please select a folder', rv$projects_available),
          helpText("Current Project: "),
          htmlOutput("show_chosen_project"))
   }
@@ -86,6 +83,11 @@ observeEvent(input$create_project,{
   }
 })
 
+# Update options if there is a new project
+observeEvent(input$create_project, {
+  rv$projects_available <- list.dirs(file.path(app_base_dir, "projects"),
+                                     full.names = FALSE, recursive = FALSE)
+})
 
 ################################################################################
 ############################### Set directories ################################

ui.R

@@ -5,6 +5,7 @@
 
 # UI files for project selection sidebar
 source("UIs/ui_select_project.R")
+source("UIs/ui_github.R")
 
 # UI files for binning tabs
 source("UIs/ui_binning_params.R")
@@ -72,7 +73,8 @@ body <- dashboardBody(
     # Tab to open project folder
     tabItem(tabName = "project",
             navbarPage(title = "",
-                       select_proj_tab)),
+                       select_proj_tab,
+                       github_tab)),
     # Tab for binning the data
     tabItem(tabName = "bin",
             navbarPage(title = "",