Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Using shinyauthr with shiny rmarkdown documents #66

Open
heimschf opened this issue Aug 27, 2023 · 1 comment
Open

Using shinyauthr with shiny rmarkdown documents #66

heimschf opened this issue Aug 27, 2023 · 1 comment

Comments

@heimschf
Copy link

Paul, Thanks for a very useful package.
I wonder whether the shinyauthr package also can be used with a shiny-rmarkdown document?

Up to now, I tried to call the shiny-rmd App (myshinyrmarkdown.Rmd) within the app.R below, but I receive an error that we cannot call run_App() within run_App() - is there an 'easy' way to achieve this?

Thanks in advance for a short clarification.


library(shinyauthr)
library(shiny)

user_base <- tibble::tibble(
 user = c("user1", "user2", "user3"),
 password = sapply(c("pass1", "pass2", "pass3"), sodium::password_store),
 permissions = c("admin", "admin", "standard"),
 name = c("U1","U2","U3")
)
ui <- fluidPage(
 # logout button
 div(class = "pull-right", shinyauthr::logoutUI(id = "logout")),
  
 shinyauthr::loginUI(id = "login"),
  
 uiOutput("sidebarpanel"),
 
)

server <- function(input, output, session) {

 credentials <- shinyauthr::loginServer(
   id = "login",
   data = user_base,
   user_col = user,
   pwd_col = password,
   sodium_hashed = TRUE,
   log_out = reactive(logout_init())
 ) 
 logout_init <- shinyauthr::logoutServer(
   id = "logout",
   active = reactive(credentials()$user_auth)
 )
 
 output$sidebarpanel <- renderUI({
    
   req(credentials()$user_auth)
   rmarkdown::run("myshinyrmarkdown.Rmd")
    
})
}
shinyApp(ui = ui, server = server)


@heimschf
Copy link
Author

Perhaps as a short note on the above, the "myshinyrmarkdown.Rmd" document is an interactive Tutorial like the below:


---
title: "Tutorial"
output: learnr::tutorial
runtime: shiny_prerendered
---

```{r setup, include=FALSE}
library(learnr)
knitr::opts_chunk$set(echo = FALSE)

Topic 1

Exercise

Here's a simple exercise with an empty code chunk provided for entering the answer.

Write the R code required to add two plus two:


Exercise with Code

Here's an exercise with some prepopulated code as well as exercise.lines = 5 to provide a bit more initial room to work.

Now write a function that adds any two numbers and then call it:

add <- function() {
  
}

Topic 2

Exercise with Hint

Here's an exercise where the chunk is pre-evaulated via the exercise.eval option (so the user can see the default output we'd like them to customize). We also add a "hint" to the correct solution via the chunk immediate below labeled print-limit-hint.

Modify the following code to limit the number of rows printed to 5:

mtcars
head(mtcars)

Quiz

You can include any number of single or multiple choice questions as a quiz. Use the question function to define a question and the quiz function for grouping multiple questions together.

Some questions to verify that you understand the purposes of various base and recommended R packages:

quiz(
  question("Which package contains functions for installing other R packages?",
    answer("base"),
    answer("tools"),
    answer("utils", correct = TRUE),
    answer("codetools")
  ),
  question("Which of the R packages listed below are used to create plots?",
    answer("lattice", correct = TRUE),
    answer("tools"),
    answer("stats"),
    answer("grid", correct = TRUE)
  )
)
 

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant