#' @title mod_edit_billsUI and mod_edit_bills
#' @description A shiny module to manage quote and bill data. This shiny module is
#' quiet big and in the future it should be divided in smaller module
#'
#' @param id shiny id
#' @param docmode either \code{"quote"} to mange quote document or \code{"bill"} (default) to manage bill document
#'
#' @importFrom shiny NS actionButton icon br
#' @importFrom DT dataTableOutput
#'
#' @export
#'
#' @examples
#' ## No example yet
mod_edit_billsUI <- function(id, docmode = "bill") {
ns <- NS(id)
fluidPage(
fluidRow(
inline(actionButton(ns("add"), paste("New", docmode), icon = icon("plus", lib = "glyphicon")), va = "middle"),
inline(actionButton(ns("delRow"), paste("Delete", docmode), icon = icon("remove", lib = "glyphicon")), va = "middle"),
inline(actionButton(ns("edit"), "Edit status", icon = icon("wrench", lib = "glyphicon")), va = "middle"),
inline(actionButton(ns("savedata"), label = "Save change", icon = icon("floppy-save", lib = "glyphicon")), va = "middle"),
inline(actionButton(ns("downloadpdf"), label = "Download PDF", icon = icon("download-alt", lib = "glyphicon")), va = "middle")
),
br(),
dataTableOutput(ns("origTable"))
)
}
#' mod_edit_bills server function
#'
#' @param input internal
#' @param output internal
#' @param session internal
#' @param data reactive data with bill or quote information
#' @param servicesdata reactive data with services information
#' @param clientsdata reactive data with clients information
#' @param quotesdata only if \code{mode = "bill"}. Reactive data with quotes information
#' @param billingaddressesdata reactive data with billind addresses information
#' @param path reactive string value. The path to the directory where the file will be exported
#' @param filename string value. The name of the file when exported
#' @param mode either \code{"quote"} to mange quote document or \code{"bill"} (default) to manage bill document
#' @param settingsdata reactive data with settings information
#'
#' @importFrom shiny reactiveValues reactive observeEvent showModal modalDialog modalButton uiOutput tagList actionButton icon renderUI numericInput hr selectInput dateInput checkboxInput textInput h4 updateNumericInput updateSelectInput updateDateInput updateCheckboxInput updateTextInput radioButtons removeModal selectizeInput textAreaInput observe updateSelectizeInput strong textOutput isolate h5 updateTextAreaInput
#' @importFrom dplyr filter pull bind_cols bind_rows select mutate
#' @importFrom DT renderDataTable datatable
#' @importFrom lubridate ymd
#' @importFrom readr write_delim
#' @importFrom rmarkdown render
#' @importFrom sass sass sass_import
#' @importFrom shiny tableOutput renderTable
#' @importFrom shinyFiles shinyDirButton getVolumes shinyDirChoose parseDirPath
#' @importFrom shinyjs hide
#' @importFrom tibble tibble as_tibble add_row
#' @importFrom xml2 as_list
#' @importFrom purrr map
#'
#' @export
#' @rdname mod_edit_billsUI
mod_edit_bills <- function(input, output, session, data = reactive(NULL), servicesdata = reactive(NULL), clientsdata = reactive(NULL), quotesdata = NULL, billingaddressesdata = NULL, path, filename, mode = "bill", settingsdata = reactive(NULL)) {
#####################################################
############## INITIALISATION ####################
#####################################################
rv <- reactiveValues(no = 1, update = 0)#, newdf = newdf)
newdf <- NA # pour éviter un erreur avec l'utilisation de '<<-' qui est nécessaire
newservices <- NA # pour éviter un erreur avec l'utilisation de '<<-' qui est nécessaire
df <- reactive({
if (rv$update != 0) {
df <- newdf
}
else {
df <- data()
}
df
})
dfserv <- reactive({
if (rv$update != 0) {
dfserv <- newservices
}
else {
dfserv <- servicesdata()
}
dfserv
})
observeEvent(data(), {
rv$update <- 0
# Pour stocker les presta dans un tableau au fur et à mesure qu'on en ajoute
rv$datapresta <- tibble(
Designation = vector(mode = "character"),
Quantity = vector(mode = "double"),
Unit = vector(mode = "character"),
Unit_price = vector(mode = "double")
)
})
#################################################
############## ADD BUTTON ####################
#################################################
# Add New button
# --------------
observeEvent(input$add, {
addData()
})
# Modal dialog to add data
# -------------------------
addData <- reactive({
input$add
ns <- session$ns
if (mode == "quote") {
showModal(
modalDialog(
title = "New quote",
uiOutput(ns("displayaddquote")),
footer = tagList(
actionButton(ns("reset_page"),"Reset", icon = icon("refresh", lib = "glyphicon")),
actionButton(ns("update"), "Add new", icon = icon("ok", lib = "glyphicon")),
modalButton("Close", icon = icon("eject", lib = "glyphicon"))
),
easyClose = TRUE,
size = "l"
)
)
}
if (mode == "bill") {
showModal(
modalDialog(
title = "New bill",
uiOutput(ns("whichdisplayaddbill")),
footer = tagList(
modalButton("Close", icon = icon("eject", lib = "glyphicon"))
),
easyClose = TRUE,
size = "l"
)
)
}
})
# UI TO add QUOTE data
# ---------------------
output$displayaddquote <- renderUI({
ns <- session$ns
mydf <- df()
incr <- nrow(mydf) + 1
mylist <- list()
mylist[[1]] <- fluidRow(column(width = 6,
textInput(ns("id_est"), label = "ID_Quote", value = paste0("D", format(Sys.Date(), "%y%m"), "-", paste0(rep(0, 4 - nchar(incr)), collapse = ""), incr))),
column(width = 6,
dateInput(inputId = ns("date"), label = "Date", format = "dd-mm-yyyy"))
)
mylist[[2]] <- h4("Client selection")
mylist[[3]] <- fluidRow(column(width = 6,
selectizeInput(inputId = ns("dclient"), label = "ID Client", choices = c("", clientsdata()$ID_Client)),
selectizeInput(inputId = ns("dclient2"), label = "Name", choices = c("", paste(clientsdata()$Firstname, clientsdata()$Name, sep = " ")))
),
column(width = 6,
br(),
verbatimTextOutput(ns("client_info"))
)
)
mylist[[4]] <- h4("Description des prestations")
mylist[[5]] <- tableOutput(ns("allservice"))
mylist[[6]] <- br()
mylist[[7]] <- fluidRow(
column(width = 6, textAreaInput(inputId = ns("design"), label = "Designation", resize = "none", value = "")),
column(width = 2, numericInput(inputId = ns("qtity"), label = "Quantity", value = 0)),
column(width = 2, textInput(inputId = ns("unit"), label = "Unit", value = "")),
column(width = 2, numericInput(inputId = ns("price"), label = "Price", value = 0))
)
mylist[[8]] <- actionButton(inputId = ns("add_service"), label = "Add service")
mylist[[9]] <- br()
mylist[[10]] <- numericInput(inputId = ns("discount"), label = "Discount (%)", value = 0, min = 0, max = 100, step = 1)
do.call(tagList, mylist)
})
##### A COMMENTER ######
observe({
req(input$dclient2)
dd <- clientsdata()[paste(clientsdata()$Firstname, clientsdata()$Name, sep = " ") == input$dclient2,]
updateSelectizeInput(session, 'dclient', choices = c("", clientsdata()$ID_Client), selected = dd$ID_Client)
})
observe({
req(input$dclient)
dd2 <- clientsdata()[clientsdata()$ID_Client == input$dclient,]
updateSelectizeInput(session, 'dclient2', choices = c("", paste(clientsdata()$Firstname, clientsdata()$Name, sep = " ")), selected = paste(dd2$Firstname, dd2$Name, sep = " "))
})
# On montre le résultat d'affichage de l'adresse du client sur le devis
output$client_info <- renderText({
with(clientsdata()[clientsdata()$ID_Client == input$dclient, ],
paste0(Firstname, " ", Name, "\n",
ifelse(!is.na(Company) | !is.na(Department), paste0(Company, " ", Department, "\n"), ""),
ifelse(!is.na(Address1), Address1, ""), "\n",
ifelse(!is.na(Address2), paste0(Address2, "\n"), ""),
ifelse(!is.na(Postal_code), Postal_code, ""), " ", ifelse(!is.na(City), City, ""), "\n",
ifelse(!is.na(Office_line), paste0(Office_line, "\n"), ""),
ifelse(!is.na(e_mail), paste0(e_mail, "\n"), "")))
})
# DEFINITION PRESTATIONS
dttemp <- reactive({
tibble(
Designation = input$design,
Quantity = input$qtity,
Unit = input$unit,
Unit_price = input$price
)})
# Action du bouton pour ajouter des lignes de presta
observeEvent(input$add_service, {
rv$datapresta <- rbind(rv$datapresta, dttemp())
output$allservice <- renderTable(rv$datapresta)
#show("allservice")
#rv$datapresta[,'Quantity'] <- gsub("[.]", ",", as.character(unlist(rv$datapresta[,'Quantity'])))
#rv$datapresta[,'Unit_price'] <- gsub("[.]", ",", as.character(unlist(rv$datapresta[,'Unit_price'])))
updateTextAreaInput(session, "design", value = "")
updateNumericInput(session, "qtity", value = 0)
updateTextInput(session, "unit", value = "")
updateNumericInput(session, "price", value = 0)
})
# Resetting 'devis' creation page
observeEvent(input$reset_page, {
rv$datapresta <- tibble(
Designation = vector(mode = "character"),
Quantity = vector(mode = "double"),
Unit = vector(mode = "character"),
Unit_price = vector(mode = "double")
)
hide("allservice")
#reset("create_devis_page")
})
# UI to choose which type of bill adder to display
# -------------------------------------------------
output$whichdisplayaddbill <- renderUI({
ns <- session$ns
mylist <- list()
mylist[[1]] <- h4("Selection of associated quote")
if (nrow(quotesdata()) > 0) {
mylist[[2]] <- fluidRow(
column(width = 6, selectizeInput(inputId = ns("which_est"), label = NULL, choices = c("", quotesdata()$ID_Quote))),
column(width = 6, actionButton(inputId = ns("gobill"), label = "Go !"))
)
mylist[[3]] <- actionButton(inputId = ns("noquote"), label = "No associated quote")
} else {
mylist[[2]] <- actionButton(inputId = ns("noquote"), label = "No associated quote")
}
do.call(tagList, mylist)
})
# Modal to add new bill from a quote
# ----------------------------------
observeEvent(input$gobill, {
ns <- session$ns
showModal(
modalDialog(
title = "New bill",
uiOutput(ns("bill_with_quote")),
footer = tagList(
actionButton(ns("update"), "Add new", icon = icon("ok", lib = "glyphicon")),
modalButton("Close", icon = icon("eject", lib = "glyphicon"))
),
easyClose = TRUE,
size = "l"
)
)
})
# Modal to add new bill with no associated quote
# ----------------------------------------------
observeEvent(input$noquote, {
showModal(modalDialog(
title = "New bill", "Please add an associated quote first",
easyClose = TRUE, footer = modalButton("OK"), size = "l"
))
})
# UI to add new bill from a quote
# -------------------------------
output$bill_with_quote <- renderUI({
ns <- session$ns
mydf <- df()
incr <- nrow(mydf) + 1
mylist <- list()
mylist[[1]] <- h4("Bill information")
mylist[[2]] <- fluidRow(column(width = 6,
textInput(ns("id_bill"), label = "ID_Bill", value = paste0("F", format(Sys.Date(), "%y%m"), "-", paste0(rep(0, 4 - nchar(incr)), collapse = ""), incr))),
column(width = 6,
dateInput(inputId = ns("date"), label = "Date", format = "dd-mm-yyyy"))
)
mylist[[3]] <- strong("Client : ", textOutput(ns("which_client"), inline = TRUE))
mylist[[4]] <- br()
which_client <- quotesdata() %>%
filter(ID_Quote == input$which_est) %>%
pull(ID_Client)
which_workplace <- clientsdata() %>%
filter(ID_Client == which_client) %>%
pull(ID_Workplace)
which_addr <- billingaddressesdata() %>%
filter(ID_Workplace == which_workplace) %>%
pull(ID_Address)
mylist[[5]] <- fluidRow(column(width = 6,
selectizeInput(inputId = ns("id_billing_address"), label = "Billing Address", choices = c("", which_addr))),
column(width = 6,
br(),
verbatimTextOutput(ns("billing_info")))
)
mylist[[6]] <- br()
mylist[[7]] <- numericInput(inputId = ns("deposit"), label = "Deposit", value = 0, min = 0, max = NA, step = 1)
do.call(tagList, mylist)
})
# A COMMENTER
observeEvent(input$which_est, {
req(input$which_est)
output$billing_info <- renderText({
with(billingaddressesdata()[billingaddressesdata()$ID_Address == input$id_billing_address, ],
paste0(ifelse(!is.na(Company) | !is.na(Department), paste0(Company, " ", Department, "\n"), ""),
ifelse(!is.na(Address1), Address1, ""), "\n",
ifelse(!is.na(Address2), paste0(Address2, "\n"), ""),
ifelse(!is.na(Postal_code), Postal_code, ""), " ", ifelse(!is.na(City), City, ""), "\n",
ifelse(!is.na(Country), paste0(Country, "\n"), "")))
})
which_client <- quotesdata() %>%
filter(ID_Quote == input$which_est) %>%
pull(ID_Client)
output$which_client <- renderText(which_client)
which_workplace <- clientsdata() %>%
filter(ID_Client == which_client) %>%
pull(ID_Workplace)
which_addr <- billingaddressesdata() %>%
filter(ID_Workplace == which_workplace) %>%
pull(ID_Address)
updateSelectizeInput(session, inputId = "id_billing_address", choices = c("", which_addr))
})
# Update (add new) button
# -----------------------
observeEvent(input$update, {
x <- as_tibble(df())
dd <- as_tibble(dfserv())
x1 <- add_row(x)
rv$no <- nrow(x1)
ids <- rv$no
if (mode == "quote") {
presta <- as_tibble(isolate(rv$datapresta))
amount <- sum(presta$Quantity*presta$Unit_price)
x1$ID_Quote[ids] <- input$id_est
x1$ID_Client[ids] <- input$dclient
x1$Date[ids] <- as.character(format(ymd(input$date), "%d-%m-%Y"))
x1$Amount[ids] <- amount
x1$Discount[ids] <- input$discount
x1$Net_payable[ids] <- amount*(1 - (input$discount/100))
x1$Status[ids] <- "In_progress"
x1$Status_comment[ids] <- ""
z <- bind_cols(tibble(ID_Quote = rep(x1$ID_Quote[ids], nrow(rv$datapresta)),
ID_Bill = rep("", nrow(rv$datapresta)),
N_Service = 1:nrow(rv$datapresta)),
presta)
z <- bind_rows(dd, z)
}
if (mode == "bill") {
dd[dd$ID_Quote == input$which_est, "ID_Bill"] <- input$id_bill
z <- dd
serv <- filter(dd, ID_Quote == input$which_est)
amount <- sum(serv$Quantity*serv$Unit_price)
x1$ID_Bill[ids] <- input$id_bill
x1$ID_Client[ids] <- pull(filter(quotesdata(), ID_Quote == input$which_est), ID_Client)
x1$ID_Address[ids] <- input$id_billing_address
x1$Date[ids] <- as.character(format(ymd(input$date), "%d-%m-%Y"))
x1$Amount[ids] <- amount
x1$Discount[ids] <- pull(filter(quotesdata(), ID_Quote == input$which_est), Discount)
x1$Deposit[ids] <- input$deposit
x1$Net_payable[ids] <- amount*(1 - (x1$Discount[ids]/100)) - input$deposit
x1$Status[ids] <- "In_progress"
x1$Payment[ids] <- ""
}
newdf <<- x1
newservices <<- z
rv$update <- rv$update + 1
})
####################################################
############## DELETE BUTTON ####################
####################################################
# Delete button
# -------------
observeEvent(input$delRow, {
ids <- input$origTable_rows_selected
if (length(ids) > 0) {
x <- as_tibble(df())
z <- as_tibble(dfserv())
if (mode == "quote") {
idest <- x$ID_Quote[ids]
newservices <<- z %>%
filter(ID_Quote != idest)
}
x <- x[-ids, ]
newdf <<- x
rv$update <- rv$update + 1
}
else {
showModal(modalDialog(
title = "Delete Row", "Please Select Row(s) To Delete. Press 'Esc' or Press 'OK' button",
easyClose = TRUE, footer = modalButton("OK"), size = "l"
))
}
})
####################################################
################ EDIT BUTTON ####################
####################################################
# Edit Data button
# ----------------
observeEvent(input$edit, {
ids <- input$origTable_rows_selected
if (length(ids) == 1) {
rv$no <- ids
} else if (rv$no > nrow(df())) {
rv$no <- 1
}
editData()
})
# Modal dialog to edit data
# -------------------------
editData <- reactive({
input$edit
ns <- session$ns
showModal(
modalDialog(
title = paste0("Edit ", mode),
uiOutput(ns("displayedit")),
footer = tagList(
actionButton(ns("update_status"), "Save", icon = icon("ok", lib = "glyphicon")),
modalButton("Close", icon = icon("eject", lib = "glyphicon"))
),
easyClose = TRUE,
size = "l"
)
)
})
# UI displaying data to edit in modal dialog
# -----------------------------------------
output$displayedit <- renderUI({
ns <- session$ns
ids <- rv$no
if (length(ids) == 1) {
mydf <- df()
mylist <- list()
mylist[[1]] <- inline(actionButton(inputId = ns("home"), label = NULL, icon = icon("backward", lib = "glyphicon")), m = 3)
mylist[[2]] <- inline(actionButton(inputId = ns("left"), label = NULL, icon = icon("chevron-left", lib = "glyphicon")), m = 3)
mylist[[3]] <- inline(numericInput(inputId = ns("rowno"), label = NULL, value = rv$no, min = 1, max = nrow(mydf), step = 1, width = 50 + 10 * log10(nrow(mydf))), m = 3)
mylist[[4]] <- inline(actionButton(inputId = ns("right"), label = NULL, icon = icon("chevron-right",lib = "glyphicon")), m = 3)
mylist[[5]] <- inline(actionButton(inputId = ns("end"), label = NULL, icon = icon("forward",lib = "glyphicon")), m = 3)
mylist[[6]] <- hr()
mydf <- as_tibble(mydf[rv$no,])
mylist[[7]] <- inline(textInput(ns("status"), label = "Status", value = mydf$Status))
if (mode == "quote") {
mylist[[8]] <- inline(textInput(ns("comment"), label = "Comment", value = mydf$Status_comment))
}
if (mode == "bill") {
mylist[[8]] <- inline(textInput(ns("payment"), label = "Payment method", value = mydf$Payment))
}
do.call(tagList, mylist)
}
else {
h4("You can edit data after select one row in datatable.")
}
})
# Update Status button
# --------------------
observeEvent(input$update_status, {
x <- as_tibble(df())
ids <- rv$no
x$Status[ids] <- input$status
rv$update <- rv$update + 1
if (mode == "quote") {
x$Status_comment[ids] <- input$comment
}
if (mode == "bill") {
x$payment[ids] <- input$Payment
}
newdf <<- x
rv$update <- rv$update + 1
})
# Backward button
# ----------------
observeEvent(input$home, {
rv$no <- 1
})
# Forward button
# ----------------
observeEvent(input$end, {
rv$no <- nrow(df())
})
# Left chevron button
# ----------------
observeEvent(input$left, {
value <- ifelse(rv$no > 1, rv$no - 1, 1)
rv$no <- value
})
# Right chevron button
# ----------------
observeEvent(input$right, {
value <- ifelse(rv$no < nrow(df()), rv$no + 1, nrow(df()))
rv$no <- value
})
# Row number selection
# ----------------
observeEvent(input$rowno, {
maxno <- nrow(df())
if (input$rowno > maxno) {
updateNumericInput(session, "rowno", value = maxno)
rv$no <- maxno
}
else {
rv$no <- input$rowno
}
})
# Action when row number changed
# ------------------------------
observeEvent(rv$no, {
mydf <- df()
if (!is.null(mydf)) {
mydf <- as_tibble(mydf[rv$no, ])
updateTextInput(session, "status", value = mydf$Status)
if (mode == "quote") {
updateTextInput(session, "comment", value = mydf$Status_comment)
}
if (mode == "bill") {
updateTextInput(session, "payment", value = mydf$Payment)
}
}
})
###########################################################
################ SAVE CHANGE BUTTON ####################
###########################################################
# Modal dialog to save change button
# ----------------------------------
observeEvent(input$savedata, {
ns <- session$ns
showModal(
modalDialog(
title = "Which delimiter should be used ?",
radioButtons(
inputId = ns("sep"), label = "Separation", selected = ";",
choices = c(Comma = ",", "Semi colon" = ";", Tabulation = "\t")
),
footer = tagList(
actionButton(ns("save"), "Save", icon = icon("save", lib = "glyphicon")),
modalButton("Close", icon = icon("eject", lib = "glyphicon"))
),
easyClose = TRUE,
size = "l"
))
})
# Save Button
# -----------
observeEvent(input$save, {
ns <- session$ns
write_delim(x = df(), path = normalizePath(file.path(path(), filename[1])), delim = input$sep)
#write_delim(x = as.data.frame(dfserv()), path = normalizePath(file.path(path(), filename[2])), delim = input$sep)
write_delim(x = dfserv(), path = normalizePath(file.path(path(), filename[2])), delim = input$sep)
removeModal()
})
#############################################################
################ DOWNLOAD PDF BUTTON ####################
############################################################
# Modal dialog to download pdf button
# -----------------------------------
observeEvent(input$downloadpdf, {
ns <- session$ns
ids <- input$origTable_rows_selected
if (length(ids) == 1) {
rv$no <- ids
} else {
rv$no <- 1
}
showModal(
modalDialog(
title = "Printing options",
uiOutput(ns("print_option")),
footer = tagList(
actionButton(inputId = ns("printpdf"), label = "Download", icon = icon("download-alt", lib = "glyphicon")),
modalButton("Close", icon = icon("eject", lib = "glyphicon"))
),
easyClose = TRUE,
size = "l"
))
})
# UI for print options
# -------------------
output$print_option <- renderUI({
ns <- session$ns
ids <- rv$no
mydf <- df()
mylist <- list()
mylist[[1]] <- h4("Document to print")
mylist[[2]] <- inline(actionButton(inputId = ns("home"), label = NULL, icon = icon("backward", lib = "glyphicon")), m = 3)
mylist[[3]] <- inline(actionButton(inputId = ns("left"), label = NULL, icon = icon("chevron-left", lib = "glyphicon")), m = 3)
mylist[[4]] <- inline(numericInput(inputId = ns("rowno"), label = NULL, value = rv$no, min = 1, max = nrow(mydf), step = 1, width = 50 + 10 * log10(nrow(mydf))), m = 3)
mylist[[5]] <- inline(actionButton(inputId = ns("right"), label = NULL, icon = icon("chevron-right",lib = "glyphicon")), m = 3)
mylist[[6]] <- inline(actionButton(inputId = ns("end"), label = NULL, icon = icon("forward",lib = "glyphicon")), m = 3)
if (mode == "quote") {
iddoc <- pull(mydf[ids,], ID_Quote)
thedoc <- h5(paste("Quote :", iddoc))
}
if (mode == "bill") {
iddoc <- pull(mydf[ids,], ID_Bill)
thedoc <- h5(paste("Bill :", iddoc))
}
idclient <- pull(mydf[ids,], ID_Client)
thename <- pull(filter(clientsdata(), ID_Client == idclient), Name)
thefirstname <- pull(filter(clientsdata(), ID_Client == idclient), Firstname)
mylist[[7]] <- fluidRow(column(width = 4, thedoc),
column(width = 8, h5(paste("Client :", idclient, "(",thefirstname, thename,")"))))
mylist[[8]] <- tableOutput(ns("theserv"))
mylist[[9]] <- br()
mylist[[10]] <- tableOutput(ns("totdat"))
if (mode == "bill") {
mylist[[11]] <- textAreaInput(ns("comment"), label = "Comment :")
}
addno <- length(mylist)
mylist[[addno + 1]] <- h4("Output options")
mylist[[addno + 2]] <- h5("Name of output file")
mylist[[addno + 3]] <- textInput(inputId = ns("output_name"), label = NULL, value = iddoc)
mylist[[addno + 4]] <- h5("Directory of output file")
mylist[[addno + 5]] <- fluidRow(
column(width = 8, verbatimTextOutput(ns("pathoutput"), placeholder = TRUE)),
column(width = 4, shinyDirButton(id = ns("diroutput"), label = "Browse...", title = "Directory of output file", buttonType = "primary")))
do.call(tagList, mylist)
})
# Table output
# ------------
observeEvent(rv$no, {#input$downloadpdf, {
ns <- session$ns
ids <- rv$no
mydf <- df()
servdf <- dfserv()
idclient <- reactive(pull(mydf[ids,], ID_Client))
if (mode == "quote") {
iddoc <- reactive(pull(mydf[ids,], ID_Quote))
amount <- reactive(round(pull(mydf[ids,], Amount), 2))
discount <- reactive(pull(mydf[ids,], Discount))
net <- reactive(round(pull(mydf[ids,], Net_payable), 2))
theserv <- reactive({
servdf %>%
filter(ID_Quote == iddoc()) %>%
select(Designation, Quantity, Unit, Unit_price) %>%
mutate(Unit_price = round(Unit_price, 2)) %>%
mutate(Total = round(Quantity * Unit_price, 2))
})
totdat <- reactive({
tibble(
x = c("Amount", "Discount", "Net payable"),
y = c(amount(), paste(discount(), "%"), net())
)
})
}
if (mode == "bill") {
idaddress <- reactive(pull(mydf, ID_Address))
iddoc <- reactive(pull(mydf[ids,], ID_Bill))
amount <- reactive(round(pull(mydf[ids,], Amount), 2))
discount <- reactive(pull(mydf[ids,], Discount))
deposit <- reactive(round(pull(mydf[ids,], Deposit), 2))
net <- reactive(round(pull(mydf[ids,], Net_payable), 2))
theserv <- reactive({
servdf %>%
filter(ID_Bill == iddoc()) %>%
select(Designation, Quantity, Unit, Unit_price) %>%
mutate(Unit_price = round(Unit_price, 2)) %>%
mutate(Total = round(Quantity * Unit_price, 2))
})
totdat <- reactive({
tibble(
x = c("Amount", "Discount", "Deposit", "Net payable"),
y = c(amount(), paste(discount(), "%"), deposit(), net())
)
})
}
output$theserv <- renderTable(theserv())
output$totdat <- renderTable(totdat(), colnames = FALSE)
})
# Directory choice
# ----------------
volumes <- getVolumes()
shinyDirChoose(input, "diroutput", roots = volumes, session = session)
filepath <- reactive({
req(input$diroutput)
parseDirPath(volumes, input$diroutput)
})
output$pathoutput <- renderText({
req(filepath())
filepath()
})
# Download button
# ---------------
observeEvent(input$printpdf, {
ns <- session$ns
ids <- rv$no
mydf <- df()
# Copy the report file to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).
sets <- settingsdata()
setslist <- as_list(sets)$settings
logoname <- setslist$logo$file
tempReport <- normalizePath(file.path(tempdir(), "template.Rmd"), mustWork = FALSE, winslash = "/")
tempSCSS <- normalizePath(file.path(tempdir(), "template_style.scss"), mustWork = FALSE, winslash = "/")
tempCSS <- normalizePath(file.path(tempdir(), "template_style.css"), mustWork = FALSE, winslash = "/")
tempVar <- normalizePath(file.path(tempdir(), "_variables.scss"), mustWork = FALSE, winslash = "/")
tempImage <- normalizePath(file.path(tempdir(), logoname), mustWork = FALSE, winslash = "/")
file.copy(system.file("www/template.Rmd", package = "manageR"), tempReport, overwrite = TRUE)
file.copy(system.file("www/template_style.scss", package = "manageR"), tempSCSS, overwrite = TRUE)
file.copy(system.file(paste0("www/", logoname), package = "manageR"), tempImage, overwrite = TRUE)
# SCSS compilation
if (mode == "quote") {
doc <- "Devis"
ndoc <- pull(mydf[ids,], ID_Quote)
}
if (mode == "bill") {
doc <- "Facture"
ndoc <- pull(mydf[ids,], ID_Bill)
}
write(x = paste0("$columns: 12; \n$doc: \"", doc, "\"; \n$ndoc: \"", ndoc, "\";"), file = tempVar)
sass(input = sass_import(tempSCSS), output = tempCSS)
# Set up parameters to pass to Rmd document
params <- list(info = list(), config = list(), client = list(), services = list())
params$info$date <- pull(mydf[ids,], Date)
params$info$doc <- doc
params$info$ndoc <- ndoc
params$info$nclient <- idclient <- pull(mydf[ids,], ID_Client)
params$client$name <- pull(filter(clientsdata(), ID_Client == idclient), Name)
params$client$firstname <- pull(filter(clientsdata(), ID_Client == idclient), Firstname)
params$client$company <- pull(filter(clientsdata(), ID_Client == idclient), Company)
params$client$department <- pull(filter(clientsdata(), ID_Client == idclient), Department)
params$client$address1 <- pull(filter(clientsdata(), ID_Client == idclient), Address1)
params$client$address2 <- pull(filter(clientsdata(), ID_Client == idclient), Address2)
params$client$postal_code <- pull(filter(clientsdata(), ID_Client == idclient), Postal_code)
params$client$city <- pull(filter(clientsdata(), ID_Client == idclient), City)
params$client$mobile <- pull(filter(clientsdata(), ID_Client == idclient), Office_line)
params$client$e_mail <- pull(filter(clientsdata(), ID_Client == idclient), e_mail)
if (mode == "quote") {
amount <- round(pull(mydf[ids,], Amount), 2)
discount <- pull(mydf[ids,], Discount)
net <- round(pull(mydf[ids,], Net_payable), 2)
params$services$data <- dfserv() %>%
filter(ID_Quote == ndoc) %>%
select(Designation, Quantity, Unit, Unit_price) %>%
mutate(Unit_price = round(Unit_price, 2)) %>%
mutate(Total = round(Quantity * Unit_price, 2))
params$services$totdata <- tibble(
x = c("Amount", "Discount", "Net payable"),
y = c(amount, paste(discount, "%"), net)
)
}
if (mode == "bill") {
idaddress <- pull(mydf[ids,], ID_Address)
params$info$nclient <- paste(params$info$nclient, idaddress, sep = "\n")
params$info$doc <- "Facture"
params$billing$company <- pull(filter(billingaddressesdata(), ID_Address == idaddress), Company)
params$billing$department <- pull(filter(billingaddressesdata(), ID_Address == idaddress), Department)
params$billing$address1 <- pull(filter(billingaddressesdata(), ID_Address == idaddress), Address1)
params$billing$address2 <- pull(filter(billingaddressesdata(), ID_Address == idaddress), Address2)
params$billing$postal_code <- pull(filter(billingaddressesdata(), ID_Address == idaddress), Postal_code)
params$billing$city <- pull(filter(billingaddressesdata(), ID_Address == idaddress), City)
params$billing$siret <- pull(filter(billingaddressesdata(), ID_Address == idaddress), Register_Siret)
params$comment <- input$comment
amount <- round(pull(mydf[ids,], Amount), 2)
discount <- pull(mydf[ids,], Discount)
deposit <- round(pull(mydf[ids,], Deposit), 2)
net <- round(pull(mydf[ids,], Net_payable), 2)
params$services$data <- dfserv() %>%
filter(ID_Bill == ndoc) %>%
select(Designation, Quantity, Unit, Unit_price) %>%
mutate(Unit_price = round(Unit_price, 2)) %>%
mutate(Total = round(Quantity * Unit_price, 2))
params$services$totdata <- tibble(
x = c("Amount", "Discount", "Deposit", "Net payable"),
y = c(amount, paste(discount, "%"), deposit, net)
)
}
params$config <- map(setslist$config, unlist)
params$bankinfo <- map(setslist$bankinfo, unlist)
params$logo <- map(setslist$logo, unlist)
params$services$tva <- "no"
# knit the document
render(tempReport, #output_file = input$output_name,
params = params, #output_format = hpdf_document_base(),
envir = new.env(parent = globalenv()),
encoding = "UTF-8")
# Close modal dialog
removeModal()
# Copy the document to the final directory
tempOutput <- normalizePath(file.path(tempdir(), "template.pdf"), mustWork = FALSE)
finalOutput <- normalizePath(file.path(filepath(), paste0(input$output_name, ".pdf")), mustWork = FALSE)
file.copy(tempOutput, finalOutput, overwrite = TRUE)
})
###########################################################
################# DISPLAY DATATABLE ####################
###########################################################
output$origTable <- renderDataTable({
datatable(df(), selection = "single", caption = NULL)
})
################################################
################# RETURN ####################
################################################
return(list(data = reactive(df()), serv = reactive(dfserv()), up = reactive(rv$update)))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.