R/coursepage.R

In skranz/courser: Manage Course Activities like slides, clicker, RTutor Problemsets or Peer-Quizzes

examples.coursepage = function() {
  restore.point.options(display.restore.point = TRUE)
  course.dir = "D:/libraries/courser/courses/vwl"
  app = CoursePageApp(course.dir=course.dir,init.userid="sebastian.kranz@uni-ulm.de", need.password=FALSE, need.user=FALSE, fixed.password="test", use.signup=FALSE, send.welcome.email = FALSE)

  res = viewApp(app, port=app$glob$opts$student$port,launch.browser = rstudioapi::viewer)
  try(dbDisconnect(app$glob$studentdb))

}

student.schemas = function(app=getApp()) {
  restore.point("student.schema")


  if (!is.null(app$glob[["studschemas"]]))
    return(app$glob[["studschemas"]])

  schema.file = system.file("schema/studentdb.yaml", package="courser")
  app$glob[["studschemas"]] = load.and.init.schemas(schema.file)

}

get.studentdb = function(course.dir = cp$course.dir, db=app$glob[["studentdb"]], app = getApp(), cp=app$cp, create=FALSE, schemas=student.schemas()) {
  if (!is.null(db)) return(db)

  db.dir = file.path(course.dir,"course", "db")
  db.file = file.path(db.dir,"students.sqlite")
  if (!file.exists(db.file)) {
    if (!create) stop(paste0("No database students.sqlite found in ", db.dir))
    db = create.studentdb(course.dir=course.dir)
  } else {
    db = dbConnect(SQLite(),dbname = file.path(db.dir,"students.sqlite"))
  }
  db = set.db.schemas(db, schemas)
  if (!is.null(app$glob))
    app$glob$studentdb = db
  db
}

create.studentdb = function(course.dir, schema.file = NULL) {
  restore.point("create.studentdb")

  db.dir = file.path(course.dir,"course", "db")
  if (!dir.exists(db.dir))
    dir.create(db.dir)

  db = dbConnect(SQLite(),dbname = file.path(db.dir,"students.sqlite"))
  if (is.null(schema.file))
    schema.file = system.file("schema/studentdb.yaml", package="courser")
  dbmisc::dbCreateSchemaTables(db, schema.file = schema.file)
  #dbDisconnect(db)
  db
}

CoursePageApp = function(course.dir, courseid = basename(course.dir), login.db.dir=NULL, app.title=paste0(courseid), login.by.query.key="allow",  token.dir = file.path(course.dir,"course","stud_tokens"), cookie.name="courserStudLoginCookie", smtp=NULL, send.welcome.email=TRUE, ...) {
  restore.point("CoursePageApp")
  app = eventsApp()


  opts = init.th.opts(course.dir = course.dir)
  opts$courseid = courseid
  opts$token.dir = token.dir
  opts$cookie.name = cookie.name

  cp = as.environment(opts)
  cp$smtp = cp$email

  cp$db = get.studentdb(cp=cp)
  cp$students = dbGet(cp$db,"students",schemas = student.schemas())


  if (opts$has.pq) {
    cp$apq = init.apq(pq.dir=cp$pq.dir)
  }
  app$ui = fluidPage(
    mathjaxHeader(),
    if (opts$has.pq) pq.guess.headers(),
    uiOutput("mainUI")
  )

  if (is.null(app$glob$strings)) {
    string.file = system.file(file.path("forms",cp$lang,"strings.yaml"), package="courser")
    app$glob$strings = read.yaml(string.file)

  }
  if (is.null(app$glob$redraw.token.cr)) {
    file = system.file(file.path("forms",cp$lang,"redraw_token.Rmd"), package="courser")
    app$glob$redraw.token.cr = rmdtools::compile.rmd(file = file,out.type = "shiny")

  }



  app$glob$clicker.hs = get.course.clicker.highscore(course.dir = course.dir, students=cp$students)
  if (opts$has.pq) {
    app$glob$peerquiz.hs = compute.course.peerquiz.highscore(course.dir = course.dir)
  }

  app$glob$num.studs = length(unique(app$glob$clicker.hs$userid))
  app$glob$num.registered = length(unique(cp$students$userid))
  app$glob$num.unregistered = length(setdiff(unique(app$glob$clicker.hs$userid),cp$students$userid))


  app$cp = app$glob$cp = cp
  cp$cr = compile.coursepage(course.dir=course.dir, cp=cp)

  cp$send.welcome.email = send.welcome.email
  if (cp$send.welcome.email)
    coursepage.compile.welcome.email(cp=cp)

  smtp = first.none.null(smtp, list(from = opts$email$from,smtp = list(host.name = opts$email$smtpServer)))



  db.arg = list(dbname=paste0(login.db.dir,"/userDB.sqlite"),drv=SQLite())
  lop = loginModule(db.arg = db.arg, login.fun=coursepage.login, app.title=app.title,container.id = "mainUI",login.by.query.key = login.by.query.key, token.dir=token.dir, smtp=smtp, app.url = opts$coursepage$url,
#cookie.name="courserStudentLoginToken",

    ...

    )

  restore.point("CoursePageApp.with.lop")

  appInitHandler(function(...,app=getApp()) {
    initLoginDispatch(lop)
  })
  app
}


coursepage.login = function(userid=app$cp$userid,app=getApp(),tok=NULL,login.mode="",...) {
  restore.point("coursepage.login")

  # make session specific copy of cp
  cp = as.environment(as.list(app$glob$cp))
  app$cp = cp


  # update peerquiz
  if (isTRUE(cp$has.pq)) {
    cp$apq = update.apq(cp$apq)
    # Update also global apq
    app$glob$cp$apq = cp$apq

  }


  cp$userid = cp$email = userid

  db = cp$db = get.studentdb()

  cp$stud = dbGet(db,"students",params = nlist(userid), schemas = student.schemas())


  # save login in database
  dbInsert(db,"login_hist", vals=nlist(login_time=Sys.time(), userid=userid, showRanking=isTRUE(cp$stud$showRanking)),  schemas = student.schemas())

  # set tracker cookie entry
  courser.track.cookie(courseid=cp$courseid, token.dir=cp$token.dir,userid = userid,login.app = "coursepage", login.mode = login.mode)


  # student does not yet exist
  # show modal settings window
  if (NROW(cp$stud) == 0 || isTRUE(!cp$stud$hasRegistered)) {
    coursepage.new.student.modals(cp=cp, app=app)
    return()
  }

  cp$stud = as.list(cp$stud)

  # Recreate login token if it has been deleted
  if (!file.exists(file.path(cp$token.dir,cp$stud$token))) {
    tok = make.login.token(userid = userid,key = cp$stud$token)
    write.login.token(tok=tok, token.dir=cp$token.dir)

  }


  # Set cookie to login into clicker
  set.login.token.cookie(tok=list(userid=cp$stud$userid, key=cp$stud$token), "courserClickerCookie")

  set.login.token.cookie(tok=list(userid=cp$stud$userid, key=cp$stud$token), "courserStudentLoginCookie")




  show.coursepage()
}

coursepage.new.student.modals = function(cp, app=getApp()) {
  restore.point("coursepage.new.student.modals")

  db = cp$db
  if (NROW(cp$stud) == 0) {
    stud = list(userid=cp$userid,email=cp$email, nick=random.nickname(1))
  } else {
    stud = as.list(cp$stud[1,])
  }

  label = app$glob$strings$setting_btn


  settings.ui = student.settings.ui(cp=cp, submitBtn = actionButton("settingsModalBtn",label),values = stud)


  add.form.handlers(form=cp$settings.form,btn.id="settingsModalBtn",function(values,...)  {
      args = list(...)
      restore.point("settingsModalBtn")

      #res = dbGet(db, "students", params=values["nick"], schemas = student.schemas())
      #if (NROW(res)>0) {
      #  show.form.alert(form=form, msg=paste0("There is already a user with alias ", values$nick, ". Please pick another alias"))
      #}

      # Draw a random nickname
      #values$nick = paste0(courserClicker::random.nickname(1),"_", sample.int(10000,1))
      values$email = values$userid


      stud[names(values)] = values
      stud = student.default.aux.values(stud = stud)

      if (is.null(stud$token))
        stud$token = redraw.course.student.token(cp=cp,stud=stud)


      res = dbInsert(db, "students", stud, schemas=student.schemas())
      cp$stud = res$values
      dbInsert(db, "students_hist", c(list(mtime=Sys.time()),cp$stud), schemas=student.schemas())

      # Update restricted_login
      userhash = digest(cp$stud$userid)
      file = file.path(cp$clicker.dir,"restricted_login", userhash)
      if (isTRUE(cp$stud$simpleClickerLogin)) {
        if (file.exists(file)) file.remove(file)
      } else {
        if (!file.exists(file)) writeLines("block",file)
      }

      if(isTRUE(cp$send.welcome.email))
        coursepage.send.welcome.email(cp=cp, stud=stud)

      removeModal()

      set.login.token.cookie(tok=list(userid=stud$userid, key=stud$token), "courserClickerCookie")
      show.coursepage()
    })
    title = replace.whiskers(app$glob$strings$setting_title, list(courseid=cp$courseid, course.title=cp$course.title))

    # show first terms modal
    if (!isTRUE(stud$agreedTerms)) {
      ok.handler = function(...) {
        restore.point("termsOkHandler")
        stud$agreedTerms = TRUE
        showModal(modalDialog(
          settings.ui,
          title = title,
          easyClose = FALSE,footer = NULL
        ))
      }
      courser.show.terms.modal(course.dir=cp$course.dir, lang=cp$lang,ok.handler = ok.handler)
      return()
    }

    showModal(modalDialog(
      settings.ui,
      title = title,
      easyClose = FALSE,footer = NULL
    ))
    return()

}

show.coursepage = function(app=getApp(), cp=app$cp) {
  restore.point("show.coursepage")

  # Possibly update highscore
  if (!is.courser.clicker.highscore.up.to.date(cp$course.dir)) {
    app$glob$clicker.hs = get.course.clicker.highscore(course.dir = course.dir, students=cp$students)
  }

  cp$cp.ui = rmdtools::render.compiled.rmd(cp$cr, envir=cp$stud,out.type = "shiny")
  cp$settings.ui = student.settings.ui(cp=cp,values = cp$stud,submit.handler = coursepage.submit.settings)
  cp$aux.settings.ui = student.aux.settings.ui(cp=cp,values = cp$stud,submit.handler = coursepage.submit.settings)

  ui = tabsetPanel(
    tabPanel(cp$courseid,cp$cp.ui),
    tabPanel(app$glob$strings$setting_tab,cp$settings.ui),
    tabPanel(app$glob$strings$aux_setting_tab,cp$aux.settings.ui)
  )

  setUI("mainUI",ui)
  dsetUI("mainUI",ui)


}

coursepage.submit.settings = function(values, app=getApp(),cp=app$cp,... ) {
  restore.point("coursepage.submit.settings")
  db = get.studentdb()

  stud = cp$stud
  stud[names(values)] = values
  res = dbInsert(db, "students", stud, schemas=student.schemas(),mode = "replace")
  dbInsert(db, "students_hist", c(list(mtime=Sys.time()),stud), schemas=student.schemas())

  cp$stud = res$values
  show.coursepage()
}

# need to put to external file at some point
student.default.aux.values = function(stud) {
  stud$defaultShowRanking = stud$showRanking = stud$emailRanking = sample(c(FALSE,TRUE),1)
  stud$simpleClickerLogin = TRUE
  stud
}


student.settings.ui = function(cp=app$cp, values = list(userid=cp$userid), submitBtn=NULL, submit.handler=NULL) {
  restore.point("student.settings.ui")
  lang = first.non.null(cp[["lang"]],"en")
  file = system.file(paste0("forms/",lang,"/student_settings.yaml"), package = "courser")
  cp$settings.form = yaml.form(file=file, lang=lang, prefix="stud_settings")
  ui = form.ui.simple(cp$settings.form, submitBtn=submitBtn,values = values,submit.handler = submit.handler)
  ui
}

student.aux.settings.ui = function(cp=app$cp, values = list(userid=cp$userid), submitBtn=NULL, submit.handler=NULL) {
  restore.point("student.aux.settings.ui")
  lang = first.non.null(cp[["lang"]],"en")
  file = system.file(paste0("forms/",lang,"/student_aux_settings.yaml"), package = "courser")
  cp$settings.form = yaml.form(file=file, lang=lang, prefix="stud_aux_settings")
  ui = form.ui.simple(cp$settings.form, submitBtn=submitBtn,values = values,submit.handler = submit.handler)
  token.ui = render.compiled.rmd(app$glob$redraw.token.cr, envir=list(token=cp$stud$token))
  tagList(
    ui,
    token.ui
  )
}



compile.coursepage = function(course.dir, page.file = file.path(course.dir,"course", "course_page.Rmd"), cp=app$cp, app=getApp()) {
  cr = rmdtools::compile.rmd(file = page.file)
  cr
}

coursepage_num_unregistered = function(..., app=getApp(), cp=app$cp) {
  app$glob$num.unregistered
}


coursepage_num_students = function(..., app=getApp(), cp=app$cp) {
  app$glob$num.studs
}

coursepage_num_registered = function(..., app=getApp(), cp=app$cp) {
  app$glob$num.registered
}


coursepage_current_tasks = function(...,cp=app$cp, app=getApp()) {
  restore.point("coursepage_current_tasks")
  if (isTRUE(cp$has.pq)) {
    ui = active.pqs.ui(cp$apq, userid=cp$userid)
  } else {
    ui = HTML("---")
  }
  ui
}

coursepage_closed_pq = function(...,cp=app$cp, app=getApp()) {
  if (isTRUE(cp$has.pq)) {
    ui = closed.pqs.ui(apq = cp$apq, userid=cp$userid)
  } else {
    ui = HTML("---")
  }
  ui
}




coursepage_clicker_ranking = function(...,width=480, height=280,cp=app$cp, app=getApp()) {
  args = list(...)
  restore.point("coursepage_ranglists")
  cat("\ncoursepage_ranglists")

  hs = app$glob$clicker.hs
  # user has not yet particpated
  if (length(which(hs$userid==cp$userid))==0)
    return(p("---"))

  clicker.svg = user.highscore.svg(hs, userid=cp$userid, lang=cp$lang, width=width, height=height)

  tagList(
    HTML(clicker.svg)
  )
}


coursepage_peerquiz_ranking = function(...,width=480, height=280,session.label="", cp=app$cp, app=getApp()) {
  args = list(...)
  restore.point("coursepage_peerquiz_ranking")

  hs = app$glob$peerquiz.hs
  # user has not yet particpated
  if (length(which(hs$userid==cp$userid))==0)
    return(p("---"))

  clicker.svg = user.highscore.svg(hs, userid=cp$userid, lang=cp$lang, width=width, height=height,session.label = session.label)

  tagList(
    HTML(clicker.svg)
  )
}


coursepage_start_clicker = function(label="Start Clicker",mode="buttonlink", app=getApp(), cp=app$cp) {
  restore.point("coursepage_start_clicker_button")

  token = cp$stud$token
  if (is.empty(token)) {
    token = redraw.course.student.token(cp=cp)
  }

  clicker.url = paste0(cp$clicker$url,"?key=",token)
  HTML(paste0('<a id="startClickerAppLink" href="',clicker.url,'" target="_blank" ', if (mode=="buttonlink") 'class="btn btn-default btn-xs"','>',label,'</a>'))

}

coursepage_homeslides = function(..., cp=app$cp, app=getApp()) {
  restore.point("coursepage_homeslides")

  last.dir = if (isTRUE(cp$local)) "local-home-slides" else "home-slides"

  dir = file.path(cp$course.dir,"course","shiny-server",last.dir)

  slides = list.files(dir)
  urls = paste0(cp$base_url,":",cp$homeslides$port,"/",slides,"?key=", cp$stud$token)

  html = paste0('<li><a href="',urls,'" target="_blank">',slides,'</a></li>', collapse="\n")
  html = paste0("<ul>\n", html,"\n</ul>")
  html
}

coursepage_redraw_token_button = function(label="New URL Code",msg="A new url code has been drawn: ") {
  ui = tagList(
    smallButton(id="redrawTokenBtn", label=label),
    uiOutput("redrawTokenMsg")
  )
  buttonHandler("redrawTokenBtn", function(...) {
    token = redraw.course.student.token(reset.links=TRUE)
    timedMessage("redrawTokenMsg",msg = paste0(msg,token),millis = Inf)
  })
  ui
}
is.empty = function(x, na.is.empty=TRUE) {
  if (length(x)==0) return(TRUE)
  if (na.is.empty & all(is.na(x))) return(TRUE)
  if (is.character(x) & nchar(x)==0) return(TRUE)
  FALSE
}

redraw.course.student.token = function(cp=app$cp, nchar=30, db=app$glob$studentdb, app=getApp(),reset.links=FALSE,stud=cp$stud, set.cookie = TRUE,...) {

  old.token = stud$token
  userid = stud$userid
  restore.point("redraw.course.student.token")

  if (!is.empty(old.token)) {
    # remove student token
    file = file.path(cp$token.dir,old.token)
    if (file.exists(file))
      file.remove(file)
  }

  # draw a token key
  tok = make.login.token(userid = userid, nchar.key = nchar)

  # save in db
  dbUpdate(db,table = "students",vals = list(token=tok$key),where = list(userid=cp$userid))

  # save in coursepage token dir
  write.login.token(tok=tok, token.dir=cp$token.dir)

  # set cookie that allows login
  # into home slides or clicker app
  # without url query key
  if (set.cookie)
    try(set.login.token.cookie(tok=tok,cp$cookie.name))

  if (NROW(cp$stud)>0)
    cp$stud$token= tok$key

  if (reset.links) {
    clicker.url = paste0(cp$clicker$url,"?key=",tok$key)
    callJS("$('#startClickerAppLink').attr","href",clicker.url)
    # TO DO: Reset links for slides

  }
  return(tok$key)
}

coursepage.send.welcome.email = function(cp, stud=cp$stud) {
  restore.point("coursepage.send.welcome.email")
  cr.li = cp$welcome.email.cr.li
  smtp = cp[["smtp"]]

  if (is.null(cr.li) | is.null(smtp)) return()

  email.enclos = c(stud,list(
    coursepage.url = cp$coursepage$url,
    coursepage.url.with.key = paste0(cp$coursepage$url,"?key=", stud$token),
    clicker.url = cp$clicker$url,
    clicker.url.with.key = paste0(cp$clicker$url,"?key=", stud$token),
    course.title = cp$course.title
  ))

  subject = render.compiled.rmd(cr.li$subject,envir = email.enclos)

  body = render.compiled.rmd(cr.li$body,envir = email.enclos)
  from = smtp$from
  control = list(smtpServer = smtp$smtpServer)

  # Try to send the welcome email
  try(sendmailR::sendmail(from=from, to=stud$email, subject=subject, msg = sep.lines(body), control=control))

}

coursepage.compile.welcome.email = function(cp, file = file.path(cp$course.dir, "course","settings","welcome_email.Rmd")) {
  restore.point("coursepage.compile.welcome.email")
  if (!file.exists(file)) return()

  txt = readUtf8(file,sep.lines = FALSE)
  li = parse.hashdot.yaml(txt)
  cr.li = lapply(li, function(txt) {
    compile.rmd(text = txt,fragment.only = TRUE,out.type = "md")
  })
  cp$welcome.email.cr.li = cr.li
  cr.li
}