Adaptation for config moved to BioDataScience

Author: phgrosjean

DESCRIPTION

@@ -9,7 +9,7 @@ Authors@R: c(
   email = "guyliann.engels@umons.ac.be"))
 Maintainer: Philippe Grosjean <phgrosjean@sciviews.org>
 Depends: R (>= 3.3.0)
-Imports: learndown
+Imports: learndown, BioDataScience, shiny, miniUI
 Suggests: SciViews, ggplot2, ggpubr, data.io, flow, chart, covr, knitr, testthat, gradethis
 License: MIT + file LICENSE
 Encoding: UTF-8

NAMESPACE

@@ -1,12 +1,24 @@
 # Generated by roxygen2: do not edit by hand
 
-export(config)
 export(learnr_banner)
 export(learnr_server)
 export(learnr_setup)
 export(run)
-export(sign_in)
-importFrom(learndown,config)
+export(run_app)
+export(update_pkg)
+importFrom(BioDataScience,config)
+importFrom(BioDataScience,sign_in)
+importFrom(BioDataScience,sign_out)
 importFrom(learndown,learndownLearnrBanner)
 importFrom(learndown,learndownLearnrServer)
 importFrom(learndown,run)
+importFrom(miniUI,gadgetTitleBar)
+importFrom(miniUI,miniContentPanel)
+importFrom(miniUI,miniPage)
+importFrom(miniUI,miniTitleBarButton)
+importFrom(miniUI,miniTitleBarCancelButton)
+importFrom(shiny,dialogViewer)
+importFrom(shiny,observeEvent)
+importFrom(shiny,runGadget)
+importFrom(shiny,selectInput)
+importFrom(shiny,stopApp)

NEWS.md

@@ -2,9 +2,10 @@
 
 ## Changes in version 2020.0.0
 
-- Clean up. Now depends on learndown only.
-- `config()`, `sign_in()`, `learnr_setup()` and `learnr_banner()` functions
+- Clean up. Now depends on learndown and BioDataScience only.
+- `learnr_setup()` and `learnr_banner()` functions
 added.
+- Tutorials and Shiny applications are reworked to use the {learndown} package.
 
 ## Changes in version 2019.11.0
 

R/BioDataScience1-package.R

@@ -5,7 +5,10 @@
 #' @docType package
 #' @name BioDataScience1-package
 #'
-#' @importFrom learndown config run learndownLearnrBanner learndownLearnrServer
+#' @importFrom learndown run learndownLearnrBanner learndownLearnrServer
+#' @importFrom BioDataScience config sign_in sign_out
+#' @importFrom shiny dialogViewer observeEvent selectInput stopApp runGadget
+#' @importFrom miniUI gadgetTitleBar miniContentPanel miniPage miniTitleBarButton miniTitleBarCancelButton
 NULL
 
 #@importFrom BioDataScience init

R/addins.R

@@ -0,0 +1,83 @@
+# RStudio addins
+
+run_addin <- function() {
+  #library(shiny)
+  #library(miniUI)
+
+  selectTutorial <- function() {
+    tutorials <- dir(system.file("tutorials", package = "BioDataScience1"))
+    if (!length(tutorials)) return(NULL)
+
+    ui <- miniPage(
+      miniContentPanel(
+        selectInput("tutorial", "Tutorials in BioDataScience1:",
+          selectize = FALSE, size = 11, tutorials)
+      ),
+      gadgetTitleBar("", left = miniTitleBarCancelButton(), right =
+          miniTitleBarButton("done", "Select", primary = TRUE))
+    )
+
+    server <- function(input, output, session) {
+      observeEvent(input$done, {
+        returnValue <- input$tutorial
+        if (!is.null(returnValue))
+          BioDataScience1::run(returnValue)
+        stopApp(returnValue)
+      })
+    }
+
+    runGadget(ui, server,
+      viewer = dialogViewer("Select a tutorial",
+        width = 300, height = 250))
+  }
+
+  tutorial <- try(suppressMessages(selectTutorial()), silent = TRUE)
+  if (!is.null(tutorial) && !inherits(tutorial, "try-error"))
+    message("Running tutorial ", tutorial)
+}
+
+run_app_addin <- function() {
+  #library(shiny)
+  #library(miniUI)
+
+  selectApp <- function() {
+    apps <- dir(system.file("shiny", package = "BioDataScience1"))
+    if (!length(apps)) return(NULL)
+
+    ui <- miniPage(
+      miniContentPanel(
+        selectInput("app", "Shiny apps in BioDataScience1:",
+          selectize = FALSE, size = 11, apps)
+      ),
+      gadgetTitleBar("", left = miniTitleBarCancelButton(), right =
+        miniTitleBarButton("done", "Select", primary = TRUE))
+    )
+
+    server <- function(input, output, session) {
+      observeEvent(input$done, {
+        returnValue <- input$app
+        if (!is.null(returnValue))
+          BioDataScience1::run_app(returnValue)
+        stopApp(returnValue)
+      })
+    }
+
+    runGadget(ui, server,
+      viewer = dialogViewer("Select a Shiny application",
+        width = 300, height = 250))
+  }
+
+  app <- try(suppressMessages(selectApp()), silent = TRUE)
+  if (!is.null(app) && !inherits(app, "try-error"))
+    message("Running Shiny application ", app)
+}
+
+update_pkg_addin <- function() {
+  # Update both BioDataScience & BioDataScience1
+  learndown::update_pkg("BioDataScience",
+    github_repos = "BioDataScience-course/BioDataScience")
+  update_pkg()
+}
+
+sign_out_addin <- function()
+  BioDataScience::sign_out()

R/config.R

@@ -0,0 +1,40 @@
+#' Prepare a learnr tutorial for learndown recording
+#'
+#' These functions add recording functionalities through the learndown approach.
+
+#' @param cap The caption of learnr R code widgets.
+#' @param debug Do we issue debugging messages (by default, yes if the
+#' environment variables `LEARNDOWN_DEBUG` is not `0`).
+#'
+#' @export
+learnr_setup <- function(cap = "Code R",
+debug = Sys.getenv("LEARNDOWN_DEBUG", 0) != 0) {
+  learndown::learndownLearnrSetup(config = BioDataScience::config(),
+    sign_in = BioDataScience::sign_in(), cap = cap, debug = debug)
+}
+
+#' @rdname learnr_setup
+#' @export
+#' @param simple Do we use a simple banner without title or not?
+learnr_banner <- function(simple = FALSE) {
+  if (isTRUE(simple)) {
+    learndownLearnrBanner(
+      msg.nologin = 'Utilisateur anonyme, aucun enregistrement !',
+      msg.login = 'Enregistrement actif pour ')
+  } else {
+    learndownLearnrBanner(
+      title = "Science des donn\u00e9es biologiques\ I",
+      text = "R\u00e9alis\u00e9 par le service d'\u00c9cologie num\u00e9rique, Universit\u00e9 de Mons (Belgique)",
+      image = "https://wp.sciviews.org/BioDataScience-96.png",
+      msg.nologin = 'Utilisateur anonyme, aucun enregistrement !',
+      msg.login = 'Enregistrement actif pour ')
+  }
+}
+
+#' @rdname learnr_setup
+#' @export
+#' @param input The Shiny input.
+#' @param output The Shiny output.
+#' @param session The Shiny session.
+learnr_server <- function(input, output, session)
+  learndownLearnrServer(input, output, session)

R/learnr.R

@@ -1,32 +1,57 @@
-#' Run learnr tutorials from the BioDataScience1 package
+#' Run learnr tutorials, Shiny applications from the BioDataScience1 package, or
+#' update it
+#'
+#' Start a learnr tutorial or a Shiny application from the BioDataScience1
+#' package, possibly after updating it.
 #'
 #' @param tutorial The name of the tutorial to use. If not provided, a list of
 #' available tutorials is displayed.
-#' @param ... Further arguments passed to `learnr::run_tutorial()`.
+#' @param app The name of the Shiny application to use. If not provided, a list
+#' of available applications is displayed.
+#' @param ... Further arguments passed to `learnr::run_tutorial()` or to
+#' `shiny::runApp()`.
 #' @param update Do we check for an updated version first, and if it is found,
 #' update the package automatically?
-#' @param ask In case `tutorial` is not provided, do we ask to select in a list?
-#'
-#' @description Start the learnr R engine in the current R session with the
-#' selected tutorial.
+#' @param ask In case `tutorial` or `app` is not provided, do we ask to select
+#' in a list?
+#' @param in.job Should the application be run in a Job in RStudio (`TRUE` by
+#' default)?
 #'
-#' @return If `tutorial` is not provided, in interactive mode with `ask = TRUE`,
-#' you have to select one in a list, and in non interactive mode, or
-#' `ask = FALSE`, it returns the list of all available tutorials.
+#' @return If `tutorial` or `app` is not provided, in interactive mode with
+#' `ask = TRUE`, you have to select one in a list, and in non interactive mode,
+#' or `ask = FALSE`, it returns the list of all available tutorials or Shiny
+#' applications in the BioDataScience1 package.
 #' @export
 #' @keywords utilities
-#' @concept run interactive learnr documents from the BioDataScience package
+#' @concept run interactive learnr or Shiny applications
 #' @examples
+#' \dontrun{
 #' # To start from a list of available tutorials:
 #' run()
-#' \dontrun{
-#' run("00a_learnr")
+#' # Idem for Shiny applications:
+#' run_app()
 #' }
 run <- function(tutorial, ..., update = ask, ask = interactive()) {
-  #BioDataScience::init()
   if (missing(tutorial))
     tutorial <- NULL
   learndown::run(tutorial = tutorial, package = "BioDataScience1",
-    repos = "BioDataScience-course/BioDataScience1", ..., update = update,
-    ask = ask)
+    github_repos = "BioDataScience-course/BioDataScience1",
+    ..., update = update, ask = ask)
 }
+
+#' @rdname run
+#' @export
+run_app <- function(app, ..., update = ask, ask = interactive(),
+in.job = TRUE) {
+  if (missing(app))
+    app <- NULL
+  learndown::run_app(app = app, package = "BioDataScience1",
+    github_repos = "BioDataScience-course/BioDataScience1",
+    ..., update = update, ask = ask, in.job = in.job)
+}
+
+#' @rdname run
+#' @export
+update_pkg <- function()
+  learndown::update_pkg(package = "BioDataScience1",
+    github_repos = "BioDataScience-course/BioDataScience1")

R/run.R

@@ -0,0 +1,19 @@
+Name: Run learnr tutorial
+Description: Run one of the learnr tutorials in this package (after possibly updating it)
+Binding: run_addin
+Interactive: true
+
+Name: Run Shiny application
+Description: Run one of the Shiny applications in this package (after possibly updating it)
+Binding: run_app_addin
+Interactive: true
+
+Name: Update
+Description: Update the package
+Binding: update_pkg_addin
+Interactive: true
+
+Name: Sign out
+Description: Sign out current user
+Binding: sign_out_addin
+Interactive: true

inst/rstudio/addins.dcf

@@ -1,5 +1,5 @@
 learndown::learndownShinyVersion("0.0.9001") # Set app version
-BioDataScience1::config()
+BioDataScience::config()
 
 library(shiny)
 library(learndown)
@@ -45,7 +45,7 @@ server <- function(input, output, session) {
   })
 
   trackEvents(session, input, output,
-    sign_in.fun = BioDataScience1::sign_in)
+    sign_in.fun = BioDataScience::sign_in)
   trackSubmit(session, input, output, max_score = 2, solution =
       list(limits_x = c(0, 100), limits_y = c(0, 40)),
     comment = "Choix des limits de x et y",