From 1143c7e935cf525cb6d83314dc94cad1d2fdb405 Mon Sep 17 00:00:00 2001 From: stein-kato Date: Tue, 7 Jan 2025 09:48:38 +0100 Subject: [PATCH 1/5] Moduler for faner --- R/app_server.R | 274 ++----------------------------------------- R/app_ui.R | 120 +------------------ R/mod_abonnement.R | 74 ++++++++++++ R/mod_abonnementV2.R | 51 ++++++++ R/mod_plots.R | 56 +++++++++ R/mod_samlerapport.R | 79 +++++++++++++ R/mod_utsending.R | 191 ++++++++++++++++++++++++++++++ R/mod_veiledning.R | 35 ++++++ 8 files changed, 499 insertions(+), 381 deletions(-) create mode 100644 R/mod_abonnement.R create mode 100644 R/mod_abonnementV2.R create mode 100644 R/mod_plots.R create mode 100644 R/mod_samlerapport.R create mode 100644 R/mod_utsending.R create mode 100644 R/mod_veiledning.R diff --git a/R/app_server.R b/R/app_server.R index 539d955..29fed46 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -9,9 +9,6 @@ app_server <- function(input, output, session) { - # Last inn data - regData <- getFakeRegData() - # Brukerinformasjon i menylinja (navbar) output$appUserName <- shiny::renderText( paste(rapbase::getUserFullName(session), @@ -20,6 +17,7 @@ app_server <- function(input, output, session) { output$appOrgName <- shiny::renderText(rapbase::getUserReshId(session)) userInfo <- rapbase::howWeDealWithPersonalData(session, callerPkg = "rapRegTemplate") + shiny::observeEvent(input$userInfo, { shinyalert::shinyalert("Dette vet Rapporteket om deg:", userInfo, type = "", imageUrl = "rap/logo.svg", @@ -27,268 +25,10 @@ app_server <- function(input, output, session) { html = TRUE, confirmButtonText = rapbase::noOptOutOk()) }) - # Veiledning - output$veiledning <- shiny::renderUI({ - rapbase::renderRmd( - system.file("veiledning.Rmd", package = "rapRegTemplate"), - outputType = "html_fragment" - ) - }) - - - # Figur og tabell - # Figur - output$distPlot <- shiny::renderPlot({ - makeHist(df = regData, var = input$var, bins = input$bins) - }) - - # Tabell - output$distTable <- shiny::renderTable({ - makeHist(df = regData, var = input$var, bins = input$bins, - makeTable = TRUE) - }) - - - # Samlerapport - ## vis - output$samlerapport <- shiny::renderUI({ - rapbase::renderRmd( - system.file("samlerapport.Rmd", package = "rapRegTemplate"), - outputType = "html_fragment", - params = list(type = "html", - var = input$varS, - bins = input$binsS) - ) - }) - - ## last ned - output$downloadSamlerapport <- shiny::downloadHandler( - filename = function() { - basename(tempfile(pattern = "rapRegTemplateSamlerapport", - fileext = paste0(".", input$formatS))) - }, - content = function(file) { - srcFile <- - normalizePath(system.file("samlerapport.Rmd", package = "rapRegTemplate")) - fn <- rapbase::renderRmd(srcFile, outputType = input$formatS, - params = list(type = input$formatS, - var = input$varS, - bins = input$binsS)) - file.rename(fn, file) - } - ) - - - # Abonnement - ## rekative verdier for aa holde rede paa endringer som skjer mens - ## applikasjonen kjorer - subscription <- shiny::reactiveValues( - tab = rapbase::makeAutoReportTab(session, type = "subscription") - ) - - ## lag tabell over gjeldende status for abonnement - output$activeSubscriptions <- DT::renderDataTable( - subscription$tab, server = FALSE, escape = FALSE, selection = "none", - options = list(dom = "tp", ordning = FALSE, - columnDefs = list(list(visible = FALSE, targets = 6))), - rownames = FALSE - ) - - ## lag side som viser status for abonnement, ogsaa naar det ikke finnes noen - output$subscriptionContent <- shiny::renderUI({ - userFullName <- rapbase::getUserFullName(session) - if (length(subscription$tab) == 0) { - shiny::p(paste("Ingen aktive abonnement for", userFullName)) - } else { - shiny::tagList( - shiny::p(paste0("Aktive abonnement som sendes per epost til ", - userFullName, ":")), - DT::dataTableOutput("activeSubscriptions") - ) - } - }) - - ## nye abonnement - ## Objects currently shared among subscription and dispathcment - orgs <- list(Sykehus1 = 1234, - Sykehus2 = 4321) - reports <- list( - Samlerapport1 = list( - synopsis = "Automatisk samlerapport1", - fun = "samlerapport1Fun", - paramNames = c("p1", "p2"), - paramValues = c("Alder", 1) - ), - Samlerapport2 = list( - synopsis = "Automatisk samlerapport2", - fun = "samlerapport2Fun", - paramNames = c("p1", "p2"), - paramValues = c("BMI", 1) - ) - ) - - ## Subscription - rapbase::autoReportServer( - id = "testSubscription", registryName = "rapRegTemplate", - type = "subscription", reports = reports, orgs = orgs, freq = "quarter" - ) - - # Utsending - ## reaktive verdier for aa holde rede paa endringer som skjer mens - ## applikasjonen kjorer - dispatchment <- shiny::reactiveValues( - tab = rapbase::makeAutoReportTab(session = session, type = "dispatchment"), - report = "Automatisk samlerapport1", - freq = "M\u00E5nedlig-month", - email = vector() - ) - - ## observer og foreta endringer mens applikasjonen kjorer - shiny::observeEvent(input$addEmail, { - dispatchment$email <- c(dispatchment$email, input$email) - }) - shiny::observeEvent(input$delEmail, { - dispatchment$email <- - dispatchment$email[!dispatchment$email == input$email] - }) - shiny::observeEvent(input$dispatch, { - package <- "rapRegTemplate" - type <- "dispatchment" - owner <- rapbase::getUserName(session) - ownerName <- rapbase::getUserFullName(session) - interval <- strsplit(input$dispatchmentFreq, "-")[[1]][2] - intervalName <- strsplit(input$dispatchmentFreq, "-")[[1]][1] - runDayOfYear <- rapbase::makeRunDayOfYearSequence( - interval = interval - ) - - email <- dispatchment$email - organization <- rapbase::getUserReshId(session) - - if (input$dispatchmentRep == "Automatisk samlerapport1") { - synopsis <- "Automatisk samlerapport1" - fun <- "samlerapport1Fun" - paramNames <- c("p1", "p2") - paramValues <- c("Alder", 1) - - } - if (input$dispatchmentRep == "Automatisk samlerapport2") { - synopsis <- "Automatisk samlerapport2" - fun <- "samlerapport2Fun" - paramNames <- c("p1", "p2") - paramValues <- c("BMI", 2) - } - rapbase::createAutoReport(synopsis = synopsis, package = package, - type = type, fun = fun, paramNames = paramNames, - paramValues = paramValues, owner = owner, - ownerName = ownerName, - email = email, organization = organization, - runDayOfYear = runDayOfYear, - interval = interval, intervalName = intervalName) - dispatchment$tab <- - rapbase::makeAutoReportTab(session, type = "dispatchment") - dispatchment$email <- vector() - }) - - ## ui: velg rapport - output$report <- shiny::renderUI({ - shiny::selectInput( - "dispatchmentRep", "Rapport:", - c("Automatisk samlerapport1", "Automatisk samlerapport2"), - selected = dispatchment$report - ) - }) - - ## ui: velg frekvens - output$freq <- shiny::renderUI({ - shiny::selectInput( - "dispatchmentFreq", "Frekvens:", - list("\u00C5rlig" = "\u00C5rlig-year", - Kvartalsvis = "Kvartalsvis-quarter", - Maanedlig = "M\u00E5nedlig-month", - Ukentlig = "Ukentlig-week", - Daglig = "Daglig-DSTday"), - selected = dispatchment$freq - ) - }) - - ## ui: legg til gyldig- og slett epost - output$editEmail <- shiny::renderUI({ - if (!grepl("^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\\.[A-Za-z]{2,}$", - input$email)) { - shiny::tags$p("Angi mottaker over") - } else { - if (input$email %in% dispatchment$email) { - shiny::actionButton("delEmail", "Slett epostmottaker", - icon = shiny::icon("trash")) - } else { - shiny::actionButton("addEmail", "Legg til epostmottaker", - icon = shiny::icon("pencil")) - } - } - }) - - ## ui: vis valgte mottakere - output$recipients <- shiny::renderText(paste(dispatchment$email, - sep = "
")) - - ## ui: lag ny utsending - output$makeDispatchment <- shiny::renderUI({ - if (length(dispatchment$email) == 0) { - NULL - } else { - shiny::actionButton("dispatch", "Lag utsending", - icon = shiny::icon("save")) - } - }) - - ## lag tabell over gjeldende status for utsending - output$activeDispatchments <- DT::renderDataTable( - dispatchment$tab, server = FALSE, escape = FALSE, selection = "none", - options = list(dom = "tp", ordering = FALSE), rownames = FALSE - ) - - - ## ui: lag side som viser status for utsending, ogsaa naar det ikke finnes noen - output$dispatchmentContent <- shiny::renderUI({ - if (length(dispatchment$tab) == 0) { - shiny::p("Det finnes ingen utendinger") - } else { - shiny::tagList( - shiny::p("Aktive utsendinger:"), - DT::dataTableOutput("activeDispatchments") - ) - } - }) - - # Rediger eksisterende auto rapport (alle typer) - shiny::observeEvent(input$edit_button, { - repId <- strsplit(input$edit_button, "_")[[1]][2] - rep <- rapbase::readAutoReportData()[[repId]] - if (rep$type == "subscription") { - - } - if (rep$type == "dispatchment") { - dispatchment$freq <- paste0(rep$intervalName, "-", rep$interval) - dispatchment$email <- rep$email - rapbase::deleteAutoReport(repId) - dispatchment$tab <- - rapbase::makeAutoReportTab(session, type = "dispatchment") - dispatchment$report <- rep$synopsis - } - if (rep$type == "bulletin") { - - } - }) - - # Slett eksisterende auto rapport (alle typer) - shiny::observeEvent(input$del_button, { - repId <- strsplit(input$del_button, "_")[[1]][2] - rapbase::deleteAutoReport(repId) - subscription$tab <- - rapbase::makeAutoReportTab(session, type = "subscription") - dispatchment$tab <- - rapbase::makeAutoReportTab(session, type = "dispatchment") - }) - + veiledning_server("veiledning") + plots_server("plots") + samlerapport_server("samlerapport") + abonnement_server("abonnement") + abonnementV2_server("abonnementV2") + utsending_server("utsending") } diff --git a/R/app_ui.R b/R/app_ui.R index 8826354..244312e 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -20,139 +20,31 @@ app_ui <- function() { windowTitle = regTitle, theme = "rap/bootstrap.css", id = "tabs", - shiny::tabPanel( "Veiledning", - shiny::mainPanel( - width = 12, - shiny::htmlOutput("veiledning", inline = TRUE), - rapbase::appNavbarUserWidget( - user = shiny::uiOutput("appUserName"), - organization = shiny::uiOutput("appOrgName"), - addUserInfo = TRUE - ) - ) + veiledning_ui("veiledning") ), shiny::tabPanel( "Figur og tabell", - shiny::sidebarLayout( - shiny::sidebarPanel( - width = 3, - shiny::selectInput( - inputId = "var", - label = "Variabel:", - c("mpg", "disp", "hp", "drat", "wt", "qsec") - ), - shiny::sliderInput( - inputId = "bins", - label = "Antall grupper:", - min = 1, - max = 10, - value = 5 - ) - ), - shiny::mainPanel( - shiny::tabsetPanel( - shiny::tabPanel("Figur", shiny::plotOutput("distPlot")), - shiny::tabPanel("Tabell", shiny::tableOutput("distTable")) - ) - ) - ) + plots_ui("plots") ), shiny::tabPanel( "Samlerapport", - shiny::tabPanel( - "Fordeling av mpg", - shiny::sidebarLayout( - shiny::sidebarPanel( - width = 3, - shiny::selectInput( - inputId = "varS", - label = "Variabel:", - c("mpg", "disp", "hp", "drat", "wt", "qsec") - ), - shiny::sliderInput( - inputId = "binsS", - label = "Antall grupper:", - min = 1, - max = 10, - value = 5 - ), - shiny::selectInput( - inputId = "formatS", - label = "Velg format for nedlasting:", - choices = list(PDF = "pdf", HTML = "html") - ), - shiny::downloadButton( - outputId = "downloadSamlerapport", - label = "Last ned!" - ) - ), - shiny::mainPanel( - shiny::uiOutput("samlerapport") - ) - ) - ) + samlerapport_ui("samlerapport") ), shiny::tabPanel( "Abonnement", - shiny::sidebarLayout( - shiny::sidebarPanel( - width = 3, - shiny::selectInput( - "subscriptionRep", "Rapport:", - c("Samlerapport1", "Samlerapport2") - ), - shiny::selectInput( - "subscriptionFreq", "Frekvens:", - list("\u212brlig" = "\u212brlig-year", - Kvartalsvis = "Kvartalsvis-quarter", - "M\u00e5nedlig" = "M\u00e5nedlig-month", - Ukentlig = "Ukentlig-week", - Daglig = "Daglig-DSTday"), - selected = "M\u00e5nedlig-month" - ), - shiny::actionButton( - "subscribe", "Bestill", - icon = shiny::icon("paper-plane") - ) - ), - shiny::mainPanel( - shiny::uiOutput("subscriptionContent") - ) - ) + abonnement_ui("abonnement") ), shiny::tabPanel( shiny::span("Abonnement v2", title = "Bestill tilsending av rapporter p\u00e5 e-post"), - shiny::sidebarLayout( - shiny::sidebarPanel( - rapbase::autoReportInput("testSubscription") - ), - shiny::mainPanel( - rapbase::autoReportUI("testSubscription") - ) - ) + abonnementV2_ui("abonnementV2") ), shiny::tabPanel( "Utsending", - shiny::sidebarLayout( - shiny::sidebarPanel( - width = 3, - shiny::uiOutput("report"), - shiny::uiOutput("freq"), - shiny::textInput("email", "Epostmottakere:"), - shiny::uiOutput("editEmail"), - shiny::htmlOutput("recipients"), - shiny::tags$hr(), - shiny::uiOutput("makeDispatchment") - ), - shiny::mainPanel( - shiny::uiOutput("dispatchmentContent") - ) - ) + utsending_ui("utsending") ) - ) # navbarPage ) # tagList } diff --git a/R/mod_abonnement.R b/R/mod_abonnement.R new file mode 100644 index 0000000..21f2ad4 --- /dev/null +++ b/R/mod_abonnement.R @@ -0,0 +1,74 @@ +#' Shiny module providing GUI and server logic for the subscription tab +#' +#' @param id Character string module namespace +NULL + +abonnement_ui <- function(id) { + ns <- shiny::NS(id) + + shiny::sidebarLayout( + shiny::sidebarPanel( + width = 3, + shiny::selectInput( + ns("subscriptionRep"), "Rapport:", + c("Samlerapport1", "Samlerapport2") + ), + shiny::selectInput( + ns("subscriptionFreq"), "Frekvens:", + list("\u212brlig" = "\u212brlig-year", + Kvartalsvis = "Kvartalsvis-quarter", + "M\u00e5nedlig" = "M\u00e5nedlig-month", + Ukentlig = "Ukentlig-week", + Daglig = "Daglig-DSTday"), + selected = "M\u00e5nedlig-month" + ), + shiny::actionButton( + ns("subscribe"), "Bestill", + icon = shiny::icon("paper-plane") + ) + ), + shiny::mainPanel( + shiny::uiOutput(ns("subscriptionContent")) + ) + ) +} + +abonnement_server <- function(id) { + shiny::moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + + # Abonnement + ## rekative verdier for aa holde rede paa endringer som skjer mens + ## applikasjonen kjorer + subscription <- shiny::reactiveValues( + tab = rapbase::makeAutoReportTab(session, type = "subscription") + ) + + ## lag tabell over gjeldende status for abonnement + output$activeSubscriptions <- DT::renderDataTable( + subscription$tab, server = FALSE, escape = FALSE, selection = "none", + options = list(dom = "tp", ordning = FALSE, + columnDefs = list(list(visible = FALSE, targets = 6))), + rownames = FALSE + ) + + ## lag side som viser status for abonnement, ogsaa naar det ikke finnes noen + output$subscriptionContent <- shiny::renderUI({ + userFullName <- rapbase::getUserFullName(session) + if (length(subscription$tab) == 0) { + shiny::p(paste("Ingen aktive abonnement for", userFullName)) + } else { + shiny::tagList( + shiny::p(paste0("Aktive abonnement som sendes per epost til ", + userFullName, ":")), + DT::dataTableOutput("activeSubscriptions") + ) + } + }) + + } + ) +} \ No newline at end of file diff --git a/R/mod_abonnementV2.R b/R/mod_abonnementV2.R new file mode 100644 index 0000000..dba4fa0 --- /dev/null +++ b/R/mod_abonnementV2.R @@ -0,0 +1,51 @@ +#' Shiny module providing GUI and server logic for the subscription v2 tab +#' +#' @param id Character string module namespace +NULL + +abonnementV2_ui <- function(id) { + ns <- shiny::NS(id) + +shiny::sidebarLayout( + shiny::sidebarPanel( + rapbase::autoReportInput(ns("testSubscription")) + ), + shiny::mainPanel( + rapbase::autoReportUI(ns("testSubscription")) + ) + ) +} + +abonnementV2_server <- function(id) { + shiny::moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + ## nye abonnement + ## Objects currently shared among subscription and dispathcment + orgs <- list(Sykehus1 = 1234, + Sykehus2 = 4321) + reports <- list( + Samlerapport1 = list( + synopsis = "Automatisk samlerapport1", + fun = "samlerapport1Fun", + paramNames = c("p1", "p2"), + paramValues = c("Alder", 1) + ), + Samlerapport2 = list( + synopsis = "Automatisk samlerapport2", + fun = "samlerapport2Fun", + paramNames = c("p1", "p2"), + paramValues = c("BMI", 1) + ) + ) + + ## Subscription + rapbase::autoReportServer( + id = "testSubscription", registryName = "kvarus", + type = "subscription", reports = reports, orgs = orgs, freq = "quarter" + ) + } + ) +} \ No newline at end of file diff --git a/R/mod_plots.R b/R/mod_plots.R new file mode 100644 index 0000000..bfd2d85 --- /dev/null +++ b/R/mod_plots.R @@ -0,0 +1,56 @@ +#' Shiny module providing GUI and server logic for the plot tab +#' +#' @param id Character string module namespace +NULL + +plots_ui <- function(id) { + ns <- shiny::NS(id) + + shiny::sidebarLayout( + shiny::sidebarPanel( + width = 3, + shiny::selectInput( + inputId = ns("var"), + label = "Variabel:", + c("mpg", "disp", "hp", "drat", "wt", "qsec") + ), + shiny::sliderInput( + inputId = ns("bins"), + label = "Antall grupper:", + min = 1, + max = 10, + value = 5 + ) + ), + shiny::mainPanel( + shiny::tabsetPanel( + shiny::tabPanel(ns("Figur"), shiny::plotOutput(ns("distPlot"))), + shiny::tabPanel(ns("Tabell"), shiny::tableOutput(ns("distTable"))) + ) + ) + ) +} + +plots_server <- function(id) { + shiny::moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + # Last inn data + regData <- getFakeRegData() + + # Figur og tabell + # Figur + output$distPlot <- shiny::renderPlot({ + makeHist(df = regData, var = input$var, bins = input$bins) + }) + + # Tabell + output$distTable <- shiny::renderTable({ + makeHist(df = regData, var = input$var, bins = input$bins, + makeTable = TRUE) + }) + } + ) +} \ No newline at end of file diff --git a/R/mod_samlerapport.R b/R/mod_samlerapport.R new file mode 100644 index 0000000..2fa0794 --- /dev/null +++ b/R/mod_samlerapport.R @@ -0,0 +1,79 @@ +#' Shiny module providing GUI and server logic for the report tab +#' +#' @param id Character string module namespace +NULL + +samlerapport_ui <- function(id) { + ns <- shiny::NS(id) + + shiny::tabPanel( + "Fordeling av mpg", + shiny::sidebarLayout( + shiny::sidebarPanel( + width = 3, + shiny::selectInput( + inputId = "varS", + label = "Variabel:", + c("mpg", "disp", "hp", "drat", "wt", "qsec") + ), + shiny::sliderInput( + inputId = "binsS", + label = "Antall grupper:", + min = 1, + max = 10, + value = 5 + ), + shiny::selectInput( + inputId = "formatS", + label = "Velg format for nedlasting:", + choices = list(PDF = "pdf", HTML = "html") + ), + shiny::downloadButton( + outputId = "downloadSamlerapport", + label = "Last ned!" + ) + ), + shiny::mainPanel( + shiny::uiOutput("samlerapport") + ) + ) + ) +} + +samlerapport_server <- function(id) { + shiny::moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + # Samlerapport + ## vis + output$samlerapport <- shiny::renderUI({ + rapbase::renderRmd( + system.file("samlerapport.Rmd", package = "rapRegTemplate"), + outputType = "html_fragment", + params = list(type = "html", + var = input$varS, + bins = input$binsS) + ) + }) + + ## last ned + output$downloadSamlerapport <- shiny::downloadHandler( + filename = function() { + basename(tempfile(pattern = "rapRegTemplateSamlerapport", + fileext = paste0(".", input$formatS))) + }, + content = function(file) { + srcFile <- + normalizePath(system.file("samlerapport.Rmd", package = "rapRegTemplate")) + fn <- rapbase::renderRmd(srcFile, outputType = input$formatS, + params = list(type = input$formatS, + var = input$varS, + bins = input$binsS)) + file.rename(fn, file) + } + ) + } + ) +} \ No newline at end of file diff --git a/R/mod_utsending.R b/R/mod_utsending.R new file mode 100644 index 0000000..a7cd17f --- /dev/null +++ b/R/mod_utsending.R @@ -0,0 +1,191 @@ +#' Shiny module providing GUI and server logic for the dispatch tab +#' +#' @param id Character string module namespace +NULL + +utsending_ui <- function(id) { + ns <- shiny::NS(id) +shiny::sidebarLayout( + shiny::sidebarPanel( + width = 3, + shiny::uiOutput(ns("report")), + shiny::uiOutput(ns("freq")), + shiny::textInput(ns("email"), "Epostmottakere:"), + shiny::uiOutput(ns("editEmail")), + shiny::htmlOutput(ns("recipients")), + shiny::tags$hr(), + shiny::uiOutput(ns("makeDispatchment")) + ), + shiny::mainPanel( + shiny::uiOutput(ns("dispatchmentContent")) + ) + ) +} + +utsending_server <- function(id) { + shiny::moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + + # Utsending + ## reaktive verdier for aa holde rede paa endringer som skjer mens + ## applikasjonen kjorer + dispatchment <- shiny::reactiveValues( + tab = rapbase::makeAutoReportTab(session = session, type = "dispatchment"), + report = "Automatisk samlerapport1", + freq = "M\u00E5nedlig-month", + email = vector() + ) + + ## observer og foreta endringer mens applikasjonen kjorer + shiny::observeEvent(input$addEmail, { + dispatchment$email <- c(dispatchment$email, input$email) + }) + shiny::observeEvent(input$delEmail, { + dispatchment$email <- + dispatchment$email[!dispatchment$email == input$email] + }) + shiny::observeEvent(input$dispatch, { + package <- "rapRegTemplate" + type <- "dispatchment" + owner <- rapbase::getUserName(session) + ownerName <- rapbase::getUserFullName(session) + interval <- strsplit(input$dispatchmentFreq, "-")[[1]][2] + intervalName <- strsplit(input$dispatchmentFreq, "-")[[1]][1] + runDayOfYear <- rapbase::makeRunDayOfYearSequence( + interval = interval + ) + + email <- dispatchment$email + organization <- rapbase::getUserReshId(session) + + if (input$dispatchmentRep == "Automatisk samlerapport1") { + synopsis <- "Automatisk samlerapport1" + fun <- "samlerapport1Fun" + paramNames <- c("p1", "p2") + paramValues <- c("Alder", 1) + + } + if (input$dispatchmentRep == "Automatisk samlerapport2") { + synopsis <- "Automatisk samlerapport2" + fun <- "samlerapport2Fun" + paramNames <- c("p1", "p2") + paramValues <- c("BMI", 2) + } + rapbase::createAutoReport(synopsis = synopsis, package = package, + type = type, fun = fun, paramNames = paramNames, + paramValues = paramValues, owner = owner, + ownerName = ownerName, + email = email, organization = organization, + runDayOfYear = runDayOfYear, + interval = interval, intervalName = intervalName) + dispatchment$tab <- + rapbase::makeAutoReportTab(session, type = "dispatchment") + dispatchment$email <- vector() + }) + + ## ui: velg rapport + output$report <- shiny::renderUI({ + shiny::selectInput( + "dispatchmentRep", "Rapport:", + c("Automatisk samlerapport1", "Automatisk samlerapport2"), + selected = dispatchment$report + ) + }) + + ## ui: velg frekvens + output$freq <- shiny::renderUI({ + shiny::selectInput( + "dispatchmentFreq", "Frekvens:", + list("\u00C5rlig" = "\u00C5rlig-year", + Kvartalsvis = "Kvartalsvis-quarter", + Maanedlig = "M\u00E5nedlig-month", + Ukentlig = "Ukentlig-week", + Daglig = "Daglig-DSTday"), + selected = dispatchment$freq + ) + }) + + ## ui: legg til gyldig- og slett epost + output$editEmail <- shiny::renderUI({ + if (!grepl("^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\\.[A-Za-z]{2,}$", + input$email)) { + shiny::tags$p("Angi mottaker over") + } else { + if (input$email %in% dispatchment$email) { + shiny::actionButton("delEmail", "Slett epostmottaker", + icon = shiny::icon("trash")) + } else { + shiny::actionButton("addEmail", "Legg til epostmottaker", + icon = shiny::icon("pencil")) + } + } + }) + + ## ui: vis valgte mottakere + output$recipients <- shiny::renderText(paste(dispatchment$email, + sep = "
")) + + ## ui: lag ny utsending + output$makeDispatchment <- shiny::renderUI({ + if (length(dispatchment$email) == 0) { + NULL + } else { + shiny::actionButton("dispatch", "Lag utsending", + icon = shiny::icon("save")) + } + }) + + ## lag tabell over gjeldende status for utsending + output$activeDispatchments <- DT::renderDataTable( + dispatchment$tab, server = FALSE, escape = FALSE, selection = "none", + options = list(dom = "tp", ordering = FALSE), rownames = FALSE + ) + + + ## ui: lag side som viser status for utsending, ogsaa naar det ikke finnes noen + output$dispatchmentContent <- shiny::renderUI({ + if (length(dispatchment$tab) == 0) { + shiny::p("Det finnes ingen utendinger") + } else { + shiny::tagList( + shiny::p("Aktive utsendinger:"), + DT::dataTableOutput("activeDispatchments") + ) + } + }) + + # Rediger eksisterende auto rapport (alle typer) + shiny::observeEvent(input$edit_button, { + repId <- strsplit(input$edit_button, "_")[[1]][2] + rep <- rapbase::readAutoReportData()[[repId]] + if (rep$type == "subscription") { + + } + if (rep$type == "dispatchment") { + dispatchment$freq <- paste0(rep$intervalName, "-", rep$interval) + dispatchment$email <- rep$email + rapbase::deleteAutoReport(repId) + dispatchment$tab <- + rapbase::makeAutoReportTab(session, type = "dispatchment") + dispatchment$report <- rep$synopsis + } + if (rep$type == "bulletin") { + + } + }) + + # Slett eksisterende auto rapport (alle typer) + shiny::observeEvent(input$del_button, { + repId <- strsplit(input$del_button, "_")[[1]][2] + rapbase::deleteAutoReport(repId) + subscription$tab <- + rapbase::makeAutoReportTab(session, type = "subscription") + dispatchment$tab <- + rapbase::makeAutoReportTab(session, type = "dispatchment") + }) + } + ) +} \ No newline at end of file diff --git a/R/mod_veiledning.R b/R/mod_veiledning.R new file mode 100644 index 0000000..823f03b --- /dev/null +++ b/R/mod_veiledning.R @@ -0,0 +1,35 @@ +#' Shiny module providing GUI and server logic for the intro tab +#' +#' @param id Character string module namespace +NULL + +veiledning_ui <- function(id) { + ns <- shiny::NS(id) + + shiny::mainPanel( + width = 12, + shiny::htmlOutput(ns("veiledning"), inline = TRUE), + rapbase::appNavbarUserWidget( + user = shiny::uiOutput(ns("appUserName")), + organization = shiny::uiOutput(ns("appOrgName")), + addUserInfo = TRUE + ) + ) +} + +veiledning_server <- function(id) { + shiny::moduleServer( + id, + function(input, output, session) { + ns <- session$ns + + # Veiledning + output$veiledning <- shiny::renderUI({ + rapbase::renderRmd( + system.file("veiledning.Rmd", package = "rapRegTemplate"), + outputType = "html_fragment" + ) + }) + } + ) +} \ No newline at end of file From 3c94fa3db23d20800eed28650fd2a1cebac539a3 Mon Sep 17 00:00:00 2001 From: stein-kato Date: Tue, 7 Jan 2025 16:45:23 +0100 Subject: [PATCH 2/5] Namspace og linting --- R/app_server.R | 2 +- R/app_ui.R | 2 +- R/mod_abonnement.R | 54 ++++--- R/mod_abonnementV2.R | 64 ++++----- R/mod_samlerapport.R | 12 +- R/mod_utsending.R | 330 +++++++++++++++++++++---------------------- 6 files changed, 231 insertions(+), 233 deletions(-) diff --git a/R/app_server.R b/R/app_server.R index 29fed46..d7ccacc 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -29,6 +29,6 @@ app_server <- function(input, output, session) { plots_server("plots") samlerapport_server("samlerapport") abonnement_server("abonnement") - abonnementV2_server("abonnementV2") + abonnement_v2_server("abonnementV2") utsending_server("utsending") } diff --git a/R/app_ui.R b/R/app_ui.R index 244312e..aa0e7a9 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -39,7 +39,7 @@ app_ui <- function() { shiny::tabPanel( shiny::span("Abonnement v2", title = "Bestill tilsending av rapporter p\u00e5 e-post"), - abonnementV2_ui("abonnementV2") + abonnement_v2_ui("abonnementV2") ), shiny::tabPanel( "Utsending", diff --git a/R/mod_abonnement.R b/R/mod_abonnement.R index 21f2ad4..42390d1 100644 --- a/R/mod_abonnement.R +++ b/R/mod_abonnement.R @@ -39,36 +39,34 @@ abonnement_server <- function(id) { function(input, output, session) { ns <- session$ns - - # Abonnement - ## rekative verdier for aa holde rede paa endringer som skjer mens - ## applikasjonen kjorer - subscription <- shiny::reactiveValues( - tab = rapbase::makeAutoReportTab(session, type = "subscription") - ) - - ## lag tabell over gjeldende status for abonnement - output$activeSubscriptions <- DT::renderDataTable( - subscription$tab, server = FALSE, escape = FALSE, selection = "none", - options = list(dom = "tp", ordning = FALSE, - columnDefs = list(list(visible = FALSE, targets = 6))), - rownames = FALSE - ) + # Abonnement + ## rekative verdier for aa holde rede paa endringer som skjer mens + ## applikasjonen kjorer + subscription <- shiny::reactiveValues( + tab = rapbase::makeAutoReportTab(session, type = "subscription") + ) - ## lag side som viser status for abonnement, ogsaa naar det ikke finnes noen - output$subscriptionContent <- shiny::renderUI({ - userFullName <- rapbase::getUserFullName(session) - if (length(subscription$tab) == 0) { - shiny::p(paste("Ingen aktive abonnement for", userFullName)) - } else { - shiny::tagList( - shiny::p(paste0("Aktive abonnement som sendes per epost til ", - userFullName, ":")), - DT::dataTableOutput("activeSubscriptions") + ## lag tabell over gjeldende status for abonnement + output$activeSubscriptions <- DT::renderDataTable( + subscription$tab, server = FALSE, escape = FALSE, selection = "none", + options = list(dom = "tp", ordning = FALSE, + columnDefs = list(list(visible = FALSE, targets = 6))), + rownames = FALSE ) - } - }) - + + ## lag side som viser status for abonnement, ogsaa naar det ikke finnes noen + output$subscriptionContent <- shiny::renderUI({ + userFullName <- rapbase::getUserFullName(session) + if (length(subscription$tab) == 0) { + shiny::p(paste("Ingen aktive abonnement for", userFullName)) + } else { + shiny::tagList( + shiny::p(paste0("Aktive abonnement som sendes per epost til ", + userFullName, ":")), + DT::dataTableOutput(ns("activeSubscriptions")) + ) + } + }) } ) } \ No newline at end of file diff --git a/R/mod_abonnementV2.R b/R/mod_abonnementV2.R index dba4fa0..77cbf0f 100644 --- a/R/mod_abonnementV2.R +++ b/R/mod_abonnementV2.R @@ -3,49 +3,49 @@ #' @param id Character string module namespace NULL -abonnementV2_ui <- function(id) { +abonnement_v2_ui <- function(id) { ns <- shiny::NS(id) -shiny::sidebarLayout( - shiny::sidebarPanel( - rapbase::autoReportInput(ns("testSubscription")) - ), - shiny::mainPanel( - rapbase::autoReportUI(ns("testSubscription")) - ) - ) + shiny::sidebarLayout( + shiny::sidebarPanel( + rapbase::autoReportInput(ns("testSubscription")) + ), + shiny::mainPanel( + rapbase::autoReportUI(ns("testSubscription")) + ) + ) } -abonnementV2_server <- function(id) { +abonnement_v2_server <- function(id) { shiny::moduleServer( id, function(input, output, session) { ns <- session$ns - ## nye abonnement - ## Objects currently shared among subscription and dispathcment - orgs <- list(Sykehus1 = 1234, - Sykehus2 = 4321) - reports <- list( - Samlerapport1 = list( - synopsis = "Automatisk samlerapport1", - fun = "samlerapport1Fun", - paramNames = c("p1", "p2"), - paramValues = c("Alder", 1) - ), - Samlerapport2 = list( - synopsis = "Automatisk samlerapport2", - fun = "samlerapport2Fun", - paramNames = c("p1", "p2"), - paramValues = c("BMI", 1) + ## nye abonnement + ## Objects currently shared among subscription and dispathcment + orgs <- list(Sykehus1 = 1234, + Sykehus2 = 4321) + reports <- list( + Samlerapport1 = list( + synopsis = "Automatisk samlerapport1", + fun = "samlerapport1Fun", + paramNames = c("p1", "p2"), + paramValues = c("Alder", 1) + ), + Samlerapport2 = list( + synopsis = "Automatisk samlerapport2", + fun = "samlerapport2Fun", + paramNames = c("p1", "p2"), + paramValues = c("BMI", 1) + ) ) - ) - ## Subscription - rapbase::autoReportServer( - id = "testSubscription", registryName = "kvarus", - type = "subscription", reports = reports, orgs = orgs, freq = "quarter" - ) + ## Subscription + rapbase::autoReportServer( + id = ns("testSubscription"), registryName = "rapRegTemplate", + type = "subscription", reports = reports, orgs = orgs, freq = "quarter" + ) } ) } \ No newline at end of file diff --git a/R/mod_samlerapport.R b/R/mod_samlerapport.R index 2fa0794..72efdd9 100644 --- a/R/mod_samlerapport.R +++ b/R/mod_samlerapport.R @@ -12,29 +12,29 @@ samlerapport_ui <- function(id) { shiny::sidebarPanel( width = 3, shiny::selectInput( - inputId = "varS", + inputId = ns("varS"), label = "Variabel:", c("mpg", "disp", "hp", "drat", "wt", "qsec") ), shiny::sliderInput( - inputId = "binsS", + inputId = ns("binsS"), label = "Antall grupper:", min = 1, max = 10, value = 5 ), shiny::selectInput( - inputId = "formatS", + inputId = ns("formatS"), label = "Velg format for nedlasting:", choices = list(PDF = "pdf", HTML = "html") ), shiny::downloadButton( - outputId = "downloadSamlerapport", + outputId = ns("downloadSamlerapport"), label = "Last ned!" ) ), shiny::mainPanel( - shiny::uiOutput("samlerapport") + shiny::uiOutput(ns("samlerapport")) ) ) ) @@ -58,7 +58,7 @@ samlerapport_server <- function(id) { ) }) - ## last ned + ## last ned output$downloadSamlerapport <- shiny::downloadHandler( filename = function() { basename(tempfile(pattern = "rapRegTemplateSamlerapport", diff --git a/R/mod_utsending.R b/R/mod_utsending.R index a7cd17f..2567ebe 100644 --- a/R/mod_utsending.R +++ b/R/mod_utsending.R @@ -5,21 +5,22 @@ NULL utsending_ui <- function(id) { ns <- shiny::NS(id) -shiny::sidebarLayout( - shiny::sidebarPanel( - width = 3, - shiny::uiOutput(ns("report")), - shiny::uiOutput(ns("freq")), - shiny::textInput(ns("email"), "Epostmottakere:"), - shiny::uiOutput(ns("editEmail")), - shiny::htmlOutput(ns("recipients")), - shiny::tags$hr(), - shiny::uiOutput(ns("makeDispatchment")) - ), - shiny::mainPanel( - shiny::uiOutput(ns("dispatchmentContent")) - ) - ) + + shiny::sidebarLayout( + shiny::sidebarPanel( + width = 3, + shiny::uiOutput(ns("report")), + shiny::uiOutput(ns("freq")), + shiny::textInput(ns("email"), "Epostmottakere:"), + shiny::uiOutput(ns("editEmail")), + shiny::htmlOutput(ns("recipients")), + shiny::tags$hr(), + shiny::uiOutput(ns("makeDispatchment")) + ), + shiny::mainPanel( + shiny::uiOutput(ns("dispatchmentContent")) + ) + ) } utsending_server <- function(id) { @@ -28,164 +29,163 @@ utsending_server <- function(id) { function(input, output, session) { ns <- session$ns - - # Utsending - ## reaktive verdier for aa holde rede paa endringer som skjer mens - ## applikasjonen kjorer - dispatchment <- shiny::reactiveValues( - tab = rapbase::makeAutoReportTab(session = session, type = "dispatchment"), - report = "Automatisk samlerapport1", - freq = "M\u00E5nedlig-month", - email = vector() - ) - - ## observer og foreta endringer mens applikasjonen kjorer - shiny::observeEvent(input$addEmail, { - dispatchment$email <- c(dispatchment$email, input$email) - }) - shiny::observeEvent(input$delEmail, { - dispatchment$email <- - dispatchment$email[!dispatchment$email == input$email] - }) - shiny::observeEvent(input$dispatch, { - package <- "rapRegTemplate" - type <- "dispatchment" - owner <- rapbase::getUserName(session) - ownerName <- rapbase::getUserFullName(session) - interval <- strsplit(input$dispatchmentFreq, "-")[[1]][2] - intervalName <- strsplit(input$dispatchmentFreq, "-")[[1]][1] - runDayOfYear <- rapbase::makeRunDayOfYearSequence( - interval = interval + # Utsending + ## reaktive verdier for aa holde rede paa endringer som skjer mens + ## applikasjonen kjorer + dispatchment <- shiny::reactiveValues( + tab = rapbase::makeAutoReportTab(session = session, type = "dispatchment"), + report = "Automatisk samlerapport1", + freq = "M\u00E5nedlig-month", + email = vector() ) - email <- dispatchment$email - organization <- rapbase::getUserReshId(session) - - if (input$dispatchmentRep == "Automatisk samlerapport1") { - synopsis <- "Automatisk samlerapport1" - fun <- "samlerapport1Fun" - paramNames <- c("p1", "p2") - paramValues <- c("Alder", 1) - - } - if (input$dispatchmentRep == "Automatisk samlerapport2") { - synopsis <- "Automatisk samlerapport2" - fun <- "samlerapport2Fun" - paramNames <- c("p1", "p2") - paramValues <- c("BMI", 2) - } - rapbase::createAutoReport(synopsis = synopsis, package = package, - type = type, fun = fun, paramNames = paramNames, - paramValues = paramValues, owner = owner, - ownerName = ownerName, - email = email, organization = organization, - runDayOfYear = runDayOfYear, - interval = interval, intervalName = intervalName) - dispatchment$tab <- - rapbase::makeAutoReportTab(session, type = "dispatchment") - dispatchment$email <- vector() - }) - - ## ui: velg rapport - output$report <- shiny::renderUI({ - shiny::selectInput( - "dispatchmentRep", "Rapport:", - c("Automatisk samlerapport1", "Automatisk samlerapport2"), - selected = dispatchment$report - ) - }) - - ## ui: velg frekvens - output$freq <- shiny::renderUI({ - shiny::selectInput( - "dispatchmentFreq", "Frekvens:", - list("\u00C5rlig" = "\u00C5rlig-year", - Kvartalsvis = "Kvartalsvis-quarter", - Maanedlig = "M\u00E5nedlig-month", - Ukentlig = "Ukentlig-week", - Daglig = "Daglig-DSTday"), - selected = dispatchment$freq + ## observer og foreta endringer mens applikasjonen kjorer + shiny::observeEvent(input$addEmail, { + dispatchment$email <- c(dispatchment$email, input$email) + }) + shiny::observeEvent(input$delEmail, { + dispatchment$email <- + dispatchment$email[!dispatchment$email == input$email] + }) + shiny::observeEvent(input$dispatch, { + package <- "rapRegTemplate" + type <- "dispatchment" + owner <- rapbase::getUserName(session) + ownerName <- rapbase::getUserFullName(session) + interval <- strsplit(input$dispatchmentFreq, "-")[[1]][2] + intervalName <- strsplit(input$dispatchmentFreq, "-")[[1]][1] + runDayOfYear <- rapbase::makeRunDayOfYearSequence( + interval = interval + ) + + email <- dispatchment$email + organization <- rapbase::getUserReshId(session) + + if (input$dispatchmentRep == "Automatisk samlerapport1") { + synopsis <- "Automatisk samlerapport1" + fun <- "samlerapport1Fun" + paramNames <- c("p1", "p2") + paramValues <- c("Alder", 1) + + } + if (input$dispatchmentRep == "Automatisk samlerapport2") { + synopsis <- "Automatisk samlerapport2" + fun <- "samlerapport2Fun" + paramNames <- c("p1", "p2") + paramValues <- c("BMI", 2) + } + rapbase::createAutoReport(synopsis = synopsis, package = package, + type = type, fun = fun, paramNames = paramNames, + paramValues = paramValues, owner = owner, + ownerName = ownerName, + email = email, organization = organization, + runDayOfYear = runDayOfYear, + interval = interval, intervalName = intervalName) + dispatchment$tab <- + rapbase::makeAutoReportTab(session, type = "dispatchment") + dispatchment$email <- vector() + }) + + ## ui: velg rapport + output$report <- shiny::renderUI({ + shiny::selectInput( + ns("dispatchmentRep"), "Rapport:", + c("Automatisk samlerapport1", "Automatisk samlerapport2"), + selected = dispatchment$report + ) + }) + + ## ui: velg frekvens + output$freq <- shiny::renderUI({ + shiny::selectInput( + ns("dispatchmentFreq"), "Frekvens:", + list("\u00C5rlig" = "\u00C5rlig-year", + Kvartalsvis = "Kvartalsvis-quarter", + Maanedlig = "M\u00E5nedlig-month", + Ukentlig = "Ukentlig-week", + Daglig = "Daglig-DSTday"), + selected = dispatchment$freq + ) + }) + + ## ui: legg til gyldig- og slett epost + output$editEmail <- shiny::renderUI({ + if (!grepl("^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\\.[A-Za-z]{2,}$", + input$email)) { + shiny::tags$p("Angi mottaker over") + } else { + if (input$email %in% dispatchment$email) { + shiny::actionButton("delEmail", "Slett epostmottaker", + icon = shiny::icon("trash")) + } else { + shiny::actionButton("addEmail", "Legg til epostmottaker", + icon = shiny::icon("pencil")) + } + } + }) + + ## ui: vis valgte mottakere + output$recipients <- shiny::renderText(paste(dispatchment$email, + sep = "
")) + + ## ui: lag ny utsending + output$makeDispatchment <- shiny::renderUI({ + if (length(dispatchment$email) == 0) { + NULL + } else { + shiny::actionButton("dispatch", "Lag utsending", + icon = shiny::icon("save")) + } + }) + + ## lag tabell over gjeldende status for utsending + output$activeDispatchments <- DT::renderDataTable( + dispatchment$tab, server = FALSE, escape = FALSE, selection = "none", + options = list(dom = "tp", ordering = FALSE), rownames = FALSE ) - }) - - ## ui: legg til gyldig- og slett epost - output$editEmail <- shiny::renderUI({ - if (!grepl("^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\\.[A-Za-z]{2,}$", - input$email)) { - shiny::tags$p("Angi mottaker over") - } else { - if (input$email %in% dispatchment$email) { - shiny::actionButton("delEmail", "Slett epostmottaker", - icon = shiny::icon("trash")) + + + ## ui: lag side som viser status for utsending, ogsaa naar det ikke finnes noen + output$dispatchmentContent <- shiny::renderUI({ + if (length(dispatchment$tab) == 0) { + shiny::p("Det finnes ingen utendinger") } else { - shiny::actionButton("addEmail", "Legg til epostmottaker", - icon = shiny::icon("pencil")) + shiny::tagList( + shiny::p("Aktive utsendinger:"), + DT::dataTableOutput("activeDispatchments") + ) } - } - }) - - ## ui: vis valgte mottakere - output$recipients <- shiny::renderText(paste(dispatchment$email, - sep = "
")) - - ## ui: lag ny utsending - output$makeDispatchment <- shiny::renderUI({ - if (length(dispatchment$email) == 0) { - NULL - } else { - shiny::actionButton("dispatch", "Lag utsending", - icon = shiny::icon("save")) - } - }) - - ## lag tabell over gjeldende status for utsending - output$activeDispatchments <- DT::renderDataTable( - dispatchment$tab, server = FALSE, escape = FALSE, selection = "none", - options = list(dom = "tp", ordering = FALSE), rownames = FALSE - ) + }) + # Rediger eksisterende auto rapport (alle typer) + shiny::observeEvent(input$edit_button, { + repId <- strsplit(input$edit_button, "_")[[1]][2] + rep <- rapbase::readAutoReportData()[[repId]] + if (rep$type == "subscription") { - ## ui: lag side som viser status for utsending, ogsaa naar det ikke finnes noen - output$dispatchmentContent <- shiny::renderUI({ - if (length(dispatchment$tab) == 0) { - shiny::p("Det finnes ingen utendinger") - } else { - shiny::tagList( - shiny::p("Aktive utsendinger:"), - DT::dataTableOutput("activeDispatchments") - ) - } - }) - - # Rediger eksisterende auto rapport (alle typer) - shiny::observeEvent(input$edit_button, { - repId <- strsplit(input$edit_button, "_")[[1]][2] - rep <- rapbase::readAutoReportData()[[repId]] - if (rep$type == "subscription") { - - } - if (rep$type == "dispatchment") { - dispatchment$freq <- paste0(rep$intervalName, "-", rep$interval) - dispatchment$email <- rep$email + } + if (rep$type == "dispatchment") { + dispatchment$freq <- paste0(rep$intervalName, "-", rep$interval) + dispatchment$email <- rep$email + rapbase::deleteAutoReport(repId) + dispatchment$tab <- + rapbase::makeAutoReportTab(session, type = "dispatchment") + dispatchment$report <- rep$synopsis + } + if (rep$type == "bulletin") { + + } + }) + + # Slett eksisterende auto rapport (alle typer) + shiny::observeEvent(input$del_button, { + repId <- strsplit(input$del_button, "_")[[1]][2] rapbase::deleteAutoReport(repId) + subscription$tab <- + rapbase::makeAutoReportTab(session, type = "subscription") dispatchment$tab <- rapbase::makeAutoReportTab(session, type = "dispatchment") - dispatchment$report <- rep$synopsis - } - if (rep$type == "bulletin") { - - } - }) - - # Slett eksisterende auto rapport (alle typer) - shiny::observeEvent(input$del_button, { - repId <- strsplit(input$del_button, "_")[[1]][2] - rapbase::deleteAutoReport(repId) - subscription$tab <- - rapbase::makeAutoReportTab(session, type = "subscription") - dispatchment$tab <- - rapbase::makeAutoReportTab(session, type = "dispatchment") - }) - } - ) + }) + } + ) } \ No newline at end of file From 3e5cff8d2a47761b9a8df02e456097a8672cb113 Mon Sep 17 00:00:00 2001 From: stein-kato Date: Wed, 8 Jan 2025 12:10:44 +0100 Subject: [PATCH 3/5] Fjernet abonnement V1 --- DESCRIPTION | 2 +- R/app_server.R | 1 - R/app_ui.R | 8 ++--- R/mod_abonnement.R | 77 ++++++++++++++------------------------------ R/mod_abonnementV2.R | 51 ----------------------------- 5 files changed, 28 insertions(+), 111 deletions(-) delete mode 100644 R/mod_abonnementV2.R diff --git a/DESCRIPTION b/DESCRIPTION index 7dd68f4..bb5b503 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,7 +21,7 @@ Imports: shiny, shinyalert Remotes: - Rapporteket/rapbase + Rapporteket/rapbase@main License: GPL-3 Encoding: UTF-8 LazyData: true diff --git a/R/app_server.R b/R/app_server.R index d7ccacc..26c007a 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -29,6 +29,5 @@ app_server <- function(input, output, session) { plots_server("plots") samlerapport_server("samlerapport") abonnement_server("abonnement") - abonnement_v2_server("abonnementV2") utsending_server("utsending") } diff --git a/R/app_ui.R b/R/app_ui.R index aa0e7a9..2290aca 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -33,13 +33,9 @@ app_ui <- function() { samlerapport_ui("samlerapport") ), shiny::tabPanel( - "Abonnement", - abonnement_ui("abonnement") - ), - shiny::tabPanel( - shiny::span("Abonnement v2", + shiny::span("Abonnement", title = "Bestill tilsending av rapporter p\u00e5 e-post"), - abonnement_v2_ui("abonnementV2") + abonnement_ui("abonnement") ), shiny::tabPanel( "Utsending", diff --git a/R/mod_abonnement.R b/R/mod_abonnement.R index 42390d1..84d0505 100644 --- a/R/mod_abonnement.R +++ b/R/mod_abonnement.R @@ -1,72 +1,45 @@ -#' Shiny module providing GUI and server logic for the subscription tab +#' Shiny module providing GUI and server logic for the subscription v2 tab #' #' @param id Character string module namespace NULL abonnement_ui <- function(id) { - ns <- shiny::NS(id) shiny::sidebarLayout( shiny::sidebarPanel( - width = 3, - shiny::selectInput( - ns("subscriptionRep"), "Rapport:", - c("Samlerapport1", "Samlerapport2") - ), - shiny::selectInput( - ns("subscriptionFreq"), "Frekvens:", - list("\u212brlig" = "\u212brlig-year", - Kvartalsvis = "Kvartalsvis-quarter", - "M\u00e5nedlig" = "M\u00e5nedlig-month", - Ukentlig = "Ukentlig-week", - Daglig = "Daglig-DSTday"), - selected = "M\u00e5nedlig-month" - ), - shiny::actionButton( - ns("subscribe"), "Bestill", - icon = shiny::icon("paper-plane") - ) + rapbase::autoReportInput("testSubscription") ), shiny::mainPanel( - shiny::uiOutput(ns("subscriptionContent")) + rapbase::autoReportUI("testSubscription") ) ) } abonnement_server <- function(id) { - shiny::moduleServer( - id, - function(input, output, session) { - ns <- session$ns - - # Abonnement - ## rekative verdier for aa holde rede paa endringer som skjer mens - ## applikasjonen kjorer - subscription <- shiny::reactiveValues( - tab = rapbase::makeAutoReportTab(session, type = "subscription") - ) + - ## lag tabell over gjeldende status for abonnement - output$activeSubscriptions <- DT::renderDataTable( - subscription$tab, server = FALSE, escape = FALSE, selection = "none", - options = list(dom = "tp", ordning = FALSE, - columnDefs = list(list(visible = FALSE, targets = 6))), - rownames = FALSE + ## nye abonnement + ## Objects currently shared among subscription and dispathcment + orgs <- list(Sykehus1 = 1234, + Sykehus2 = 4321) + reports <- list( + Samlerapport1 = list( + synopsis = "Automatisk samlerapport1", + fun = "samlerapport1Fun", + paramNames = c("p1", "p2"), + paramValues = c("Alder", 1) + ), + Samlerapport2 = list( + synopsis = "Automatisk samlerapport2", + fun = "samlerapport2Fun", + paramNames = c("p1", "p2"), + paramValues = c("BMI", 1) + ) ) - ## lag side som viser status for abonnement, ogsaa naar det ikke finnes noen - output$subscriptionContent <- shiny::renderUI({ - userFullName <- rapbase::getUserFullName(session) - if (length(subscription$tab) == 0) { - shiny::p(paste("Ingen aktive abonnement for", userFullName)) - } else { - shiny::tagList( - shiny::p(paste0("Aktive abonnement som sendes per epost til ", - userFullName, ":")), - DT::dataTableOutput(ns("activeSubscriptions")) - ) - } - }) - } + ## Subscription + rapbase::autoReportServer( + id = "testSubscription", registryName = "rapRegTemplate", + type = "subscription", reports = reports, orgs = orgs, freq = "quarter" ) } \ No newline at end of file diff --git a/R/mod_abonnementV2.R b/R/mod_abonnementV2.R deleted file mode 100644 index 77cbf0f..0000000 --- a/R/mod_abonnementV2.R +++ /dev/null @@ -1,51 +0,0 @@ -#' Shiny module providing GUI and server logic for the subscription v2 tab -#' -#' @param id Character string module namespace -NULL - -abonnement_v2_ui <- function(id) { - ns <- shiny::NS(id) - - shiny::sidebarLayout( - shiny::sidebarPanel( - rapbase::autoReportInput(ns("testSubscription")) - ), - shiny::mainPanel( - rapbase::autoReportUI(ns("testSubscription")) - ) - ) -} - -abonnement_v2_server <- function(id) { - shiny::moduleServer( - id, - function(input, output, session) { - ns <- session$ns - - ## nye abonnement - ## Objects currently shared among subscription and dispathcment - orgs <- list(Sykehus1 = 1234, - Sykehus2 = 4321) - reports <- list( - Samlerapport1 = list( - synopsis = "Automatisk samlerapport1", - fun = "samlerapport1Fun", - paramNames = c("p1", "p2"), - paramValues = c("Alder", 1) - ), - Samlerapport2 = list( - synopsis = "Automatisk samlerapport2", - fun = "samlerapport2Fun", - paramNames = c("p1", "p2"), - paramValues = c("BMI", 1) - ) - ) - - ## Subscription - rapbase::autoReportServer( - id = ns("testSubscription"), registryName = "rapRegTemplate", - type = "subscription", reports = reports, orgs = orgs, freq = "quarter" - ) - } - ) -} \ No newline at end of file From 903ee821802ac22ab84b755dfb6587735b410cd8 Mon Sep 17 00:00:00 2001 From: stein-kato Date: Wed, 8 Jan 2025 12:22:44 +0100 Subject: [PATCH 4/5] Linting --- R/mod_abonnement.R | 47 ++++++++++++++++++++++---------------------- R/mod_plots.R | 5 ++--- R/mod_samlerapport.R | 9 ++++----- R/mod_utsending.R | 14 ++++++------- R/mod_veiledning.R | 3 +-- 5 files changed, 37 insertions(+), 41 deletions(-) diff --git a/R/mod_abonnement.R b/R/mod_abonnement.R index 84d0505..3bb52c9 100644 --- a/R/mod_abonnement.R +++ b/R/mod_abonnement.R @@ -16,30 +16,29 @@ abonnement_ui <- function(id) { } abonnement_server <- function(id) { - - ## nye abonnement - ## Objects currently shared among subscription and dispathcment - orgs <- list(Sykehus1 = 1234, - Sykehus2 = 4321) - reports <- list( - Samlerapport1 = list( - synopsis = "Automatisk samlerapport1", - fun = "samlerapport1Fun", - paramNames = c("p1", "p2"), - paramValues = c("Alder", 1) - ), - Samlerapport2 = list( - synopsis = "Automatisk samlerapport2", - fun = "samlerapport2Fun", - paramNames = c("p1", "p2"), - paramValues = c("BMI", 1) - ) - ) + ## nye abonnement + ## Objects currently shared among subscription and dispathcment + orgs <- list(Sykehus1 = 1234, + Sykehus2 = 4321) + reports <- list( + Samlerapport1 = list( + synopsis = "Automatisk samlerapport1", + fun = "samlerapport1Fun", + paramNames = c("p1", "p2"), + paramValues = c("Alder", 1) + ), + Samlerapport2 = list( + synopsis = "Automatisk samlerapport2", + fun = "samlerapport2Fun", + paramNames = c("p1", "p2"), + paramValues = c("BMI", 1) + ) + ) - ## Subscription - rapbase::autoReportServer( - id = "testSubscription", registryName = "rapRegTemplate", - type = "subscription", reports = reports, orgs = orgs, freq = "quarter" + ## Subscription + rapbase::autoReportServer( + id = "testSubscription", registryName = "rapRegTemplate", + type = "subscription", reports = reports, orgs = orgs, freq = "quarter" ) -} \ No newline at end of file +} diff --git a/R/mod_plots.R b/R/mod_plots.R index bfd2d85..b3ab065 100644 --- a/R/mod_plots.R +++ b/R/mod_plots.R @@ -35,7 +35,6 @@ plots_server <- function(id) { shiny::moduleServer( id, function(input, output, session) { - ns <- session$ns # Last inn data regData <- getFakeRegData() @@ -49,8 +48,8 @@ plots_server <- function(id) { # Tabell output$distTable <- shiny::renderTable({ makeHist(df = regData, var = input$var, bins = input$bins, - makeTable = TRUE) + makeTable = TRUE) }) } ) -} \ No newline at end of file +} diff --git a/R/mod_samlerapport.R b/R/mod_samlerapport.R index 72efdd9..6efec03 100644 --- a/R/mod_samlerapport.R +++ b/R/mod_samlerapport.R @@ -44,7 +44,6 @@ samlerapport_server <- function(id) { shiny::moduleServer( id, function(input, output, session) { - ns <- session$ns # Samlerapport ## vis @@ -68,12 +67,12 @@ samlerapport_server <- function(id) { srcFile <- normalizePath(system.file("samlerapport.Rmd", package = "rapRegTemplate")) fn <- rapbase::renderRmd(srcFile, outputType = input$formatS, - params = list(type = input$formatS, - var = input$varS, - bins = input$binsS)) + params = list(type = input$formatS, + var = input$varS, + bins = input$binsS)) file.rename(fn, file) } ) } ) -} \ No newline at end of file +} diff --git a/R/mod_utsending.R b/R/mod_utsending.R index 2567ebe..78bfdf6 100644 --- a/R/mod_utsending.R +++ b/R/mod_utsending.R @@ -100,10 +100,10 @@ utsending_server <- function(id) { shiny::selectInput( ns("dispatchmentFreq"), "Frekvens:", list("\u00C5rlig" = "\u00C5rlig-year", - Kvartalsvis = "Kvartalsvis-quarter", - Maanedlig = "M\u00E5nedlig-month", - Ukentlig = "Ukentlig-week", - Daglig = "Daglig-DSTday"), + Kvartalsvis = "Kvartalsvis-quarter", + Maanedlig = "M\u00E5nedlig-month", + Ukentlig = "Ukentlig-week", + Daglig = "Daglig-DSTday"), selected = dispatchment$freq ) }) @@ -111,7 +111,7 @@ utsending_server <- function(id) { ## ui: legg til gyldig- og slett epost output$editEmail <- shiny::renderUI({ if (!grepl("^[A-Za-z0-9._%+-]+@[A-Za-z0-9.-]+\\.[A-Za-z]{2,}$", - input$email)) { + input$email)) { shiny::tags$p("Angi mottaker over") } else { if (input$email %in% dispatchment$email) { @@ -126,7 +126,7 @@ utsending_server <- function(id) { ## ui: vis valgte mottakere output$recipients <- shiny::renderText(paste(dispatchment$email, - sep = "
")) + sep = "
")) ## ui: lag ny utsending output$makeDispatchment <- shiny::renderUI({ @@ -188,4 +188,4 @@ utsending_server <- function(id) { }) } ) -} \ No newline at end of file +} diff --git a/R/mod_veiledning.R b/R/mod_veiledning.R index 823f03b..c58d8d5 100644 --- a/R/mod_veiledning.R +++ b/R/mod_veiledning.R @@ -21,7 +21,6 @@ veiledning_server <- function(id) { shiny::moduleServer( id, function(input, output, session) { - ns <- session$ns # Veiledning output$veiledning <- shiny::renderUI({ @@ -32,4 +31,4 @@ veiledning_server <- function(id) { }) } ) -} \ No newline at end of file +} From b8a3439a099fdddef7bd13dd75a6bdf0a1ed3894 Mon Sep 17 00:00:00 2001 From: stein-kato Date: Wed, 8 Jan 2025 12:27:03 +0100 Subject: [PATCH 5/5] Id til abonnement --- R/mod_abonnement.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/mod_abonnement.R b/R/mod_abonnement.R index 3bb52c9..2105bbb 100644 --- a/R/mod_abonnement.R +++ b/R/mod_abonnement.R @@ -7,10 +7,10 @@ abonnement_ui <- function(id) { shiny::sidebarLayout( shiny::sidebarPanel( - rapbase::autoReportInput("testSubscription") + rapbase::autoReportInput(id) ), shiny::mainPanel( - rapbase::autoReportUI("testSubscription") + rapbase::autoReportUI(id) ) ) } @@ -38,7 +38,7 @@ abonnement_server <- function(id) { ## Subscription rapbase::autoReportServer( - id = "testSubscription", registryName = "rapRegTemplate", + id = id, registryName = "rapRegTemplate", type = "subscription", reports = reports, orgs = orgs, freq = "quarter" ) }