R/mod_newIngredient.R

In peernisse/riverMenu: Create Multi-Day Group Menu Plans for Wilderness River Trips

#' newIngredient UI Function
#'
#' @description A shiny Module for creating new ingredients for the database.
#'
#' @param id,input,output,session Internal parameters for {shiny}.
#'
#' @param data The reactive values list common to all modules, named 'LOCAL'
#'
#' @noRd
#'
#' @importFrom shiny NS tagList
#' @importFrom DT DTOutput renderDT datatable dataTableProxy editData
#' @importFrom shinycssloaders withSpinner
#' @importFrom shinyWidgets pickerInput updatePickerInput pickerOptions
#' @importFrom plyr round_any
#' @importFrom shinydashboard updateTabItems
#' @importFrom openxlsx readWorkbook saveWorkbook addWorksheet createWorkbook writeData read.xlsx
#' @importFrom magrittr %>%
#' @importFrom dplyr mutate select group_by case_when pull filter left_join inner_join arrange bind_rows bind_cols
#'
mod_newIngredient_ui <- function(id){
  ns <- NS(id)
  fluidRow(
    column(width = 12,
           fluidRow(
             column(width = 12,
                    uiOutput(ns('addInputs'))
             ),#end column
           ),#end fluidRow
           fluidRow(
             uiOutput(ns('viewTables'))
           )#end fluidRow
    )#end column
  )#end fluidRow

}

#' newIngredient Server Functions
#'
#' @noRd
mod_newIngredient_server <- function(id, data){
  moduleServer( id, function(input, output, session){
    ns <- session$ns
    LOCAL<-data
    #OBSERVERS---------------------------------------------------
    #New ingredient dataframe preview

    observe({

      LOCAL$newIngredient <- data.frame(
        INGREDIENT = ifelse(is.null(input$ing_ingredient),"",input$ing_ingredient),
        HYP_TRIP_SIZE = ifelse(is.null(input$ing_people),"",input$ing_people),
        SERVING_SIZE_FACTOR = ifelse(is.null(input$ing_ssf),"",input$ing_ssf),
        HYP_QUANTITY = ifelse(is.null(input$ing_people),'',
                              paste0(
                                round_any(as.numeric(input$ing_ssf)*as.numeric(input$ing_people),1,ceiling) %>% as.character(.),
                                " (",input$ing_ssd," (s))"
                              )#end paste
        ),#end ifelse
        INGREDIENT_CATEGORY = ifelse(is.null(input$ing_cat),"",input$ing_cat),
        SERVING_SIZE_DESCRIPTION = ifelse(is.null(input$ing_ssd),"",input$ing_ssd),
        INGREDIENT_DESCRIPTION = ifelse(is.null(input$ing_desc),"",input$ing_desc),
        STORAGE_DESCRIPTION = ifelse(is.null(input$ing_storage),"",input$ing_storage),
        INGREDIENT_ID = max(LOCAL$li$INGREDIENT_ID) + 1,
        UPTIME = Sys.Date(),
        UPUSER = ''
      )#end df
    })#end observe

    #UI OUTPUT------------------------------------------------------------
    output$addInputs <- renderUI({
      ns <- session$ns
      inputPanel(
        uiOutput(ns('luingcat')),
        textInput(ns('ing_ingredient'),"Ingredient Name"),
        textInput(ns('ing_desc'),"Ingredient Description"),
        textInput(ns('ing_ssd'),"Ingredient Unit Description", placeholder = ''),
        pickerInput(ns("ing_storage"),"Storage Description",
                    choices = c("Cooler Storage","Dry Storage"),
                    selected = "Cooler Storage"),
        pickerInput(ns('ing_people'),"Hypothetical Trip Size",choices = seq(1,30,1),
                    options = pickerOptions(style = "highlighted")#This passes this string to the class of the object so you can target it in CSS
        ),
        textInput(ns("ing_ssf"),label="Serving Size Factor",placeholder = "1 / people to consume 1 unit"),
        actionButton(ns('info'), label = '', icon = icon('info'))
      )#end inputPanel
    })#end renderUI


    #PREVIEW INGREDIENT TABLE OUTPUT------------------------------------

    output$viewTables <- renderUI({
      ns <- session$ns
      column(width = 12,
             div(if(is.null(input$ing_ingredient) || input$ing_ingredient == ''){h2('')} else
             {h2(paste('Preview of',input$ing_ingredient), style = "display: inline;")}
             ),#end div
             br(),
             DTOutput(ns('newIngredient')),
             btn_panelItem(ns(id='commit'),lbl='Save New Ingredient', class = "btn-success"),
             btn_panelItem(ns(id='cancel'),lbl='Cancel', class = "btn-default")
      )#end column
    })#end renderUI

    #Preview new ingredient table 1 row at a time
    output$newIngredient <- renderDT(dtStyle1(session,df = LOCAL$newIngredient, edit = FALSE, filter = 'none', scrollY = '100px', dom = 't'))


    #Modal for SSF information---------------------
    observeEvent(input$info,{
      showModal(
        modalDialog(
          title = "Serving Size Factor",
          tags$ul(
            tags$li('NOTE: Serving Size Factor (SSF) gets multiplied by trip size and should depend on your Ingredient Unit Description.
                     Calculate it as 1 / number of people to consume 1 unit of the ingredient. Or, if 1 person consumes more than one unit,
                    it is the number of units per person.'),
            tags$li('You can tweak Hypothetical Trip Size and SSF until HYP_QUANTITY below makes sense for this ingredient and Serving Size Unit.'),
            tags$li('HYP_QUANTITY and Hypothetical Trip Size do not get stored, SSF gets stored with this ingredient, you can edit later
              by editing the meal(s) this ingredient is used in.'),
            tags$li('Ex: If 1 \"can\" of tuna serves 3, the SSF is 0.33. If one serving of steak is going to be 5 \"ounces\", you might set Ingredient
         Unit Description to \"ounces\", and the SSF to 5.')
          )#end ul
        )#end modalDialog
      )#end showModal
    })


    #FUNCTIONS--------------------------------------------------

    #INGREDIENT CATEGORY PICKER
    #input$newmealinput<-inp
    #Lookup ingredient category
    output$luingcat<-renderUI({
      ns<-session$ns
      pickerInput(
        ns('ing_cat'),label = 'Ingredient Category',
        selected = '--Select Category--',
        choices = c('--Select Category--',LOCAL$li %>% pull(INGREDIENT_CATEGORY) %>% as.character() %>% unique(.) %>% sort(.))
      )#end ppicker
    })#end lu ing cat

    #TODO move this to the functions library
    #COMMIT BUTTON LOGIC---------------------------------
    observeEvent(input$commit,{
      ns <- session$ns
      #Warn if serving size factor is not numeric coercible
      if (input$ing_ingredient == "" ||input$ing_cat == "" || input$ing_ssd == "" || input$ing_desc == "" ) {
        showModal(
          modalDialog(
            title="Warning!",
            "Please fill in all input fields."
          )#end showModal
        )#end modalDialog
        return(NULL)
      } else

      if (input$ing_ssf == "" | is.na(as.numeric(input$ing_ssf))==TRUE) {
        showModal(
          modalDialog(
            title="Warning!",
            "Serving Size Factor must be a number"
          )#end showModal
        )#end modalDialog
        return(NULL)
      } else

      if (input$ing_ingredient != "" && input$ing_cat != "" && input$ing_ssd != ""
            && input$ing_desc != "" && is.na(as.numeric(input$ing_ssf)) == FALSE) {

        #Launch decision modal
        newIngredientModal(session,input,output)

      }#end if else
    })#END BUTTON add new ingredient LOCAL button

    #Modal button if save database
    observeEvent(input$modalCommitNewIng, {
      withProgress(
        #Add new ID from database
        LOCAL$newIngredient <- LOCAL$newIngredient %>%
          mutate(
            SERVING_SIZE_FACTOR = as.numeric(SERVING_SIZE_FACTOR),
            INGREDIENT_ID = gsGetIDs()[[2]]#Getting latest next ingredient ID from DB
          )

        ,message = 'Writing to Database...'
      )#end progress

      #Append new ingredient locally
      commitNewIngredient(session,input,output,data = LOCAL)

      #Append new ingredient data to the datatbase

      LOCAL$newIngredient %>%
        select(INGREDIENT_ID, INGREDIENT_CATEGORY, INGREDIENT, INGREDIENT_DESCRIPTION,
          SERVING_SIZE_DESCRIPTION, SERVING_SIZE_FACTOR, STORAGE_DESCRIPTION, UPTIME, UPUSER) %>%
        mutate(UPTIME = Sys.Date()) %>%
        unique(.) %>%
        googlesheets4::sheet_append(dbURL, .,sheet = 'LU_INGREDIENTS')


      #Clear inputs
      LOCAL$newIngredient <- data.frame()
      updateTextInput(session = session,'ing_cat',value = "--Select Category--")
      updateTextInput(session = session,'ing_ingredient',value = NA_character_)
      updateTextInput(session = session,'ing_desc',value = NA_character_)
      updateTextInput(session = session,'ing_ssd',value = NA_character_)
      updateTextInput(session = session,'ing_ssf',value = NA_character_,placeholder = "Number Multiplied by Trip Size")
      updateTextInput(session = session,'ing_storage',value = "Cooler Storage")

      removeModal()

    })#end observeEvent

    #Modal button save local only
    observeEvent(input$modalThisMenuOnly, {
      withProgress(
        #Add new ID from database
        LOCAL$newIngredient <- LOCAL$newIngredient %>%
          mutate(
            SERVING_SIZE_FACTOR = as.numeric(SERVING_SIZE_FACTOR),
            INGREDIENT_ID = gsGetIDs()[[2]]#Getting latest next ingredient ID from DB
          ),
      message = 'Writing...'
      )#end progress

      #Append new ingredient locally
      commitNewIngredient(session,input,output,data = LOCAL)

      #Clear inputs
      LOCAL$newIngredient <- data.frame()
      updateTextInput(session = session,'ing_cat',value = "--Select Category--")
      updateTextInput(session = session,'ing_ingredient',value = NA_character_)
      updateTextInput(session = session,'ing_desc',value = NA_character_)
      updateTextInput(session = session,'ing_ssd',value = NA_character_)
      updateTextInput(session = session,'ing_ssf',value = NA_character_,placeholder = "Number Multiplied by Trip Size")
      updateTextInput(session = session,'ing_storage',value = "Cooler Storage")

      removeModal()

    })#end observeEvent

    #CANCEL BUTTON LOGIC------------------------------------
    observeEvent(input$cancel, {
      #Clear inputs
      LOCAL$newIngredient <- data.frame()
      updateTextInput(session = session,'ing_cat',value = "--Select Category--")
      updateTextInput(session = session,'ing_ingredient',value = NA_character_)
      updateTextInput(session = session,'ing_desc',value = NA_character_)
      updateTextInput(session = session,'ing_ssd',value = NA_character_)
      updateTextInput(session = session,'ing_ssf',value = NA_character_,placeholder = "Number Multiplied by Trip Size")
      updateTextInput(session = session,'ing_storage',value = "Cooler Storage")
    })#end observeEvent

    #EXPORTING MODULE VALUES-----------------
    toExport<-list(
      LOCAL = LOCAL,
      event_pagenav = reactive(pagenav),
      #selNewMeal_SelectedRows = reactive(selNewMeal$selectedRows),#preselected rows to redraw ingrdient list dataframe
      #input_rtnNewMeal = reactive(input$returnNewMeal),
      input_commit = reactive(input$commit),
      input_cancel = reactive(input$cancel)

    )

    return(toExport)

  })#end mod_newIngredient_server
}