从闪亮模块内部的模态对话框获取确认

时间:2018-08-16 16:19:13

标签: r shiny modal-dialog crud

我正在开发到我的小型平台的Web界面,以在R中进行股票投资,并且在尝试实现简单的CRUD功能时遇到了一个问题,即使用捕获其结果的模式警报来确认行删除。我正在使用闪亮的模块方法。

要实现这一点,我发现了ShinyWidgets / confirmSweetAlert,所有示例代码都无缝运行。但是,在模块内部时,根本不会捕获单击确认按钮。

也许在代码中出现了问题,或者模块本身出现了问题,但是我对此深感困惑。

对于解决或实现此功能的任何建议,我将不胜感激。下面是我的模块代码。有关的行是从124到137和174到193

谢谢。

Francisco Bispo

.splitCandidates <<- data.frame()

.splitCalendar <<- data.frame()

.splitTypes <- c('PRICE_EVENT',
                 'VOLUME_EVENT',
                 'SPLIT',
                 'INPLIT')

splits <- function() {
  dt <- bmfaGetSplitCandidates()

  dt <- dt %>% transmute(Symbol = symbol,
                         Date = date,
                         `Prior Date` = prior_date,
                         Close = close,
                         `Prior Close` = prior_close,
                         `Split Factor` = split_factor,
                         `Reference Split Factor` = reference_split_factor,
                         `Last Split Date` = last_split_date)

  .splitCandidates <<- dt

  .splitCandidates
}

splitsCalendar <- function() {
  dt <- bmfaGetSplitCalendar()

  dt <- dt %>% transmute(Symbol = scal_symbol,
                         Date = scal_date,
                         `Split Type` = scal_type,
                         Issuer = scal_issuer,
                         `Split Factor` = scal_split_factor,
                         `Factor Value 1` = scal_split_factor_value1,
                         `Factor Value 2` = scal_split_factor_value2)

  .splitCalendar <<- dt

  .splitCalendar
}

quotes <- function(symbol, fromDate, toDate) {
  dt <- bmfaXtsAsDataframe(bmfaGetQuotes(symbol,
                                         dateFrom = fromDate,
                                         dateTo = toDate,
                                         source = 'bmfa',
                                         autoAssign = FALSE,
                                         normalizeColNames = TRUE))

  dt <- dt %>%
    mutate(Symbol = symbol) %>%
    select(Symbol,
           Date,
           Open,
           Close)

  dt
}

splitsCalendarNewRecord <- function() {
  .formData <- list()

  .formData$symbol     <- ""
  .formData$date       <- as.character(Sys.Date())
  .formData$type       <- .splitTypes[[1]]
  .formData$issuer     <- ""
  .formData$factor     <- ""
  .formData$factorVal1 <- 0
  .formData$factorVal2 <- 0

  .formData
}

splitsCalendarManageRecord <- function(operation, data) {
  #TODO perform data validations and user feedback
  bmfaManageSplitCalendar(operation, data)
}

splitsCalendarSaveRecord <- function(data) {
  splitsCalendarManageRecord('UPSERT', data)
}

splitsCalendarDeleteRecord <- function(data) {
  splitsCalendarManageRecord('DELETE', data)
}

splitsCalendarUpdateInputs <- function(data, session) {
  updateTextInput(session   , "splitSymbol"    , value    = data$symbol)
  updateDateInput(session   , "splitDate"      , value    = data$date)
  updateSelectInput(session , "splitType"      , selected = data$type)
  updateTextInput(session   , "splitIssuer"    , value    = data$issuer)
  updateTextInput(session   , "splitFactor"    , value    = data$factor)
  updateNumericInput(session, "splitFactorVal1", value    = data$factorVal1)
  updateNumericInput(session, "splitFactorVal2", value    = data$factorVal2)
}

# ui function

stockQuotesSplitsUI <- function(id) {
  ns <- NS(id)

  tagList(
    fluidRow(
      column(12,div(actionButton(ns("refresh"), "Refresh", icon = icon("refresh")), class="moduleActionButtonPanel"))
    ),
    fluidRow(
      column(7,
             p("Split Candidates", class="tableCaption"),
             p("Select a symbol on table to show its history.", class="tableNotes"),
             DTOutput(ns("splitCandidates"))),
      column(5,
             p("Quote History", class="formCaption"),
             div(class="formBody", DTOutput(ns("quoteHistory"))))
    ),
    fluidRow(hr()),
    fluidRow(
      column(8,
             p("Splits Calendar", class="tableCaption"),
             p("Select a split on the table to edit.", class="tableNotes"),
             DTOutput(ns("splitCalendar"))),
      column(4,
             p("Edit Split", class="formCaption"),
             div(class="formBody",
                 textInput(ns("splitSymbol"), "Symbol", value = "", width = "100%"),
                 dateInput(ns("splitDate"), "Date", value = NULL, min = NULL, max = NULL,
                           format = "yyyy-mm-dd", startview = "month", weekstart = 0,
                           language = "en", width = "100%", autoclose = TRUE),
                 selectInput(ns("splitType"), "Type", .splitTypes, multiple = FALSE, width = "100%"),
                 textInput(ns("splitIssuer"), "Issuer", value = "", width = "100%"),
                 textInput(ns("splitFactor"), "Split Factor", value = "", width = "100%"),
                 numericInput(ns("splitFactorVal1"), "Factor Value #1", value = 0, width = "100%"),
                 numericInput(ns("splitFactorVal2"), "Factor Value #2", value = 0, width = "100%"),
                 div(actionButton(ns("submit"), "Submit", icon = icon("check")),
                     actionButton(ns("new"), "New", icon = icon("plus")),
                     actionButton(ns("delete"), "Delete", icon = icon("minus")),
                     class="moduleActionButtonPanel")))
    ),
    conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                     div(class = "busyMessage",
                         img(src="images/loading.gif", class="busyIcon")
                     ))
  )
}

# server function

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

  ##--crud functions

  formData <- reactive({
    .formData <- list()

    .formData$symbol     <- input$splitSymbol
    .formData$date       <- input$splitDate
    .formData$type       <- input$splitType
    .formData$issuer     <- input$splitIssuer
    .formData$factor     <- input$splitFactor
    .formData$factorVal1 <- input$splitFactorVal1
    .formData$factorVal2 <- input$splitFactorVal2

    .formData
  })

  observeEvent(input$new, {
    splitsCalendarUpdateInputs(splitsCalendarNewRecord(), session)
  })

  observeEvent(input$submit, {
    splitsCalendarSaveRecord(formData())
  }, priority = 1)

  observeEvent(input$delete, {
    confirmSweetAlert(
      session = session,
      inputId = "splitConfirmDelete",
      type = NULL,
      text = p(icon("question-circle", "fa-3x"), "Confirm deletion ?", class="messageDialogBox"),
      btn_labels = c("Cancel", "Ok"),
      danger_mode = TRUE, html = TRUE
    )
  })

  observeEvent(input$splitConfirmDelete, {
    if (isTRUE(input$splitConfirmDelete)) {
      sendSweetAlert(session = session, title = "Ok! I'm ready to delete...", text = NULL, type = NULL,
                     btn_labels = "Ok", html = FALSE, closeOnClickOutside = TRUE)
      # splitsCalendarDeleteRecord(formData())
    } else
      sendSweetAlert(session = session, title = "Oh! Oh!", text = NULL, type = NULL,
                     btn_labels = "Ok", html = FALSE, closeOnClickOutside = TRUE)
  }, ignoreNULL = TRUE)

  observeEvent(input$splitCalendar_rows_selected, {
    if (!is.null(input$splitCalendar_rows_selected) && input$splitCalendar_rows_selected > 0) {
      .tableData <- list()

      i <- input$splitCalendar_rows_selected

      .tableData$symbol     <- .splitCalendar[i,1]
      .tableData$date       <- .splitCalendar[i,2]
      .tableData$type       <- .splitCalendar[i,3]
      .tableData$issuer     <- .splitCalendar[i,4]
      .tableData$factor     <- .splitCalendar[i,5]
      .tableData$factorVal1 <- .splitCalendar[i,6]
      .tableData$factorVal2 <- .splitCalendar[i,7]

      splitsCalendarUpdateInputs(.tableData, session)
    }
  })

  ##-- end crud functions

  output$splitCandidates <- renderDT({
    input$refresh
    splits()
  }, selection = 'single', options = list(pageLength = 5))

  output$quoteHistory <- renderDT({
    if (!is.null(input$splitCandidates_rows_selected) && input$splitCandidates_rows_selected > 0) {
      i <- input$splitCandidates_rows_selected
      quotes(.splitCandidates[i,1], as.Date(.splitCandidates[i,8]), as.Date(.splitCandidates[i,2]))
    } else
      quotes('XXXX', Sys.Date(), Sys.Date())
  }, selection = 'none', options = list(pageLength = 5))

  output$splitCalendar <- renderDT({
    input$refresh
    input$submit
    input$deleteOk
    splitsCalendarUpdateInputs(splitsCalendarNewRecord(), session)
    splitsCalendar()
  }, selection = 'single')

}

0 个答案:

没有答案