Use GET parameters from URL to update code/exercise element

[MarHai]

Hi everyone,

I am trying to get learnr to present an exercise code element with some code inside that is being generated/updated dynamically depending on some GET parameters in the URL when calling the shiny/learnr app. For example, if I load http://127.0.0.1:5488/test.Rmd?code=1 I want the page to include a slightly different code in an exercise than if I load http://127.0.0.1:5488/test.Rmd?code=2.

I am able to read in the URL parameters in a context="server" but am unable to promote this to the frontend. My thought was to update the code inside the exercise from the server, just like you would do with an shiny::updateTextAreaInput.

---
title: "test"
tutorial:
  id: "localhost.test"
  version: 0.1.0
output: 
  learnr::tutorial:
	progressive: true
runtime: shiny_prerendered
---

```{r setup, include=FALSE}
library(shiny)
library(learnr)

code_chunk <- NULL
```

```{r context="server"}
observe({
  params <- parseQueryString(isolate(session$clientData$url_search))
  if (is.null(params[['code']])) {
	code <- "warning('No code given')"
  } else {
	if (params[['code']] == '1') {
	  code <- "print('hello, world')"
	} else {
	  code <- "cat('hello, world')"
	}
  }
  code_chunk <<- code
})
```

```{r copied_code, exercise=TRUE}
code_chunk
```

Is there any way this is possible? Or do you have alternative solutions/suggestions?

Thanks,
Mario

[gadenbuie]

It is possible to update the text in a code box dynamically from the Shiny server that runs the learnr tutorial, which means that you could in theory use the query parameters to initialize the code boxes. There are probably more than a few edge cases you'd want to think through (or end up running into).

The process for updating an exercise code box from the server isn't very straightforward and it requires writing a little bit of JavaScript. I'd recommend taking a look at my answer to a similar question on Posit Community.

First, you'd include a chunk of JavaScript in your learnr document.

```{js echo=FALSE}
//
// A custom Shiny message handler that updates the code in any exercise
// From R you'll send a list(label = "exercise-chunk-label", code = "new code for editor"))
//
Shiny.addCustomMessageHandler('set-exercise-code', function(x) {
  var el = $(`.tutorial-exercise[data-label="${x.label}"] .tutorial-exercise-code-editor`)
  var exerciseInput = Shiny.inputBindings.bindingNames["tutorial.exerciseInput"].binding
  exerciseInput.setValue(el, {code: x.code})
})
```

Then, include this function in your setup chunk or in a chunk with context = "server":

update_exercise <- function(label, code, session = shiny::getDefaultReactiveDomain()) {
  session$sendCustomMessage("set-exercise-code", list(label = label, code = code))
}

which you can then use to update an exercise using the label of its chunk:

update_exercise("plus", "2 + 2")

I hope that helps! If you do figure out how to make this work, we'd love to see what you come up with!

[MarHai]

Amazing, thanks a lot for the very fast and exactly-what-I-needed answer.

I've included a slightly modified version in the setup:

```{r setup, include=FALSE}
updateExercise <- function(code) {
  shiny::getDefaultReactiveDomain()$sendCustomMessage('set_exercise_code', list(code = code))
}
```

I've included only one to-be-updated field, hence the hardcoded field label/name:

```{r url_code, exercise=TRUE}
# Loading ...
```

Then, there's the front-end javascript code:

```{js echo=FALSE}
Shiny.addCustomMessageHandler('set_exercise_code', function(x) {
  var el = $('.tutorial-exercise[data-label="url_code"] .tutorial-exercise-code-editor');
  var exerciseInput = Shiny.inputBindings.bindingNames['tutorial.exerciseInput'].binding;
  exerciseInput.setValue(el, { code: x.code });
})
```

And, ultimately, in context="server", the URL is parsed and the function is called:

```{r context="server"}
observe({
  params <- parseQueryString(isolate(session$clientData$url_search))
  code <- "warning('No code given')"
  if ( !is.null(params[['code']])) {
    if (params[['code']] == '1') {
      code <- "print('hello, world')"
    } else {
      code <- "cat('hello, world')"
    }
  }
  updateExercise(code)
})
```