Adding custom fields to add_schedule_df and edit about tuicalendr HOT 3 OPEN

library(shiny)
library(tuicalendr)

ui <- fluidPage(
  tags$h2("Create, edit and remove schedule interactively"),
  
  tags$p("Click on the calendar to create a new schedule, then you will be able to edit or delete it."),
  
  fluidRow(
    column(
      width = 9,
      calendarOutput("my_calendar")
    ),
    column(
      width = 3,
      uiOutput("schedule_add"),
      uiOutput("schedule_update"),
      uiOutput("schedule_delete")
    )
  )
)

server <- function(input, output) {
  
  # Create calendar
  
  output$my_calendar <- renderCalendar({
    cal <- calendar(
      defaultDate = Sys.Date(),
      useNav = TRUE,
      readOnly = FALSE,
      useCreationPopup = TRUE
    ) %>%
      set_month_options(narrowWeekend = TRUE) %>%
      set_calendars_props(id = "completed", name = "Completed", color = "#FFF", bgColor = "#E41A1C") %>% 
      set_calendars_props(id = "progress", name = "In progress", color = "#FFF", bgColor = "#377EB8") %>% 
      set_calendars_props(id = "closed", name = "Closed", color = "#FFF", bgColor = "#4DAF4A") %>% 
      add_schedule(
        id = "test",
        calendarId = "progress",
        title = "Schedule in progress",
        body = "Body content",
        start = paste(Sys.Date(), "08:00:00"),
        end = paste(Sys.Date(), "12:30:00"),
        category = "time"
      )
  })
  
  
  # Interactive counter to give ID to schedules created/edited/deleted
  schedule_count <- reactiveVal(0)
  
  
  
  # Display changes
  
  output$schedule_add <- renderUI({
    if (!is.null(input$my_calendar_add)) {
      new <- input$my_calendar_add
      tags$div(
        "Schedule",
        tags$b(paste0("schedule_", schedule_count())),
        "have been added with:",
        tags$ul(
          lapply(
            seq_along(new),
            function(i) {
              tags$li(
                tags$b(names(new)[i], ":"),
                new[[i]]
              )
            }
          )
        )
      )
    }
  })
  
  output$schedule_update <- renderUI({
    if (!is.null(input$my_calendar_update)) {
      changes <- input$my_calendar_update$changes
      tags$div(
        "Schedule",
        tags$b(input$my_calendar_update$schedule$id),
        "have been updated with:",
        tags$ul(
          lapply(
            seq_along(changes),
            function(i) {
              tags$li(
                tags$b(names(changes)[i], ":"),
                changes[[i]]
              )
            }
          )
        )
      )
    }
  })
  
  output$schedule_delete <- renderUI({
    if (!is.null(input$my_calendar_delete)) {
      remove <- input$my_calendar_delete
      tags$div(
        "Schedule",
        tags$b(input$my_calendar_delete$id),
        "have been deleted with:",
        tags$ul(
          lapply(
            seq_along(remove),
            function(i) {
              tags$li(
                tags$b(names(remove)[i], ":"),
                remove[[i]]
              )
            }
          )
        )
      )
    }
  })
  
  # Update the calendar
  
  observeEvent(input$my_calendar_add, {
    # Add an id
    new_count <- schedule_count() + 1
    cal_proxy_add(
      proxy = "my_calendar",
      id = paste("schedule_", new_count),
      .list = input$my_calendar_add
    )
    schedule_count(new_count)
  })
  
  observeEvent(input$my_calendar_update, {
    cal_proxy_update(
      proxy = "my_calendar",
      .list = input$my_calendar_update
    )
  })
  
  observeEvent(input$my_calendar_delete, {
    cal_proxy_delete(
      proxy = "my_calendar",
      .list = input$my_calendar_delete
    )
  })
  
}

# Run the application
shinyApp(ui = ui, server = server)

library(shiny)
library(tuicalendr)
library(shinyWidgets)


calendarProps <- data.frame(
  id = c("1", "2", "3"), 
  name = c("TODO", "Meetings", "Tasks"),
  color = c("#FFF", "#FFF", "#000"), 
  bgColor = c("#E41A1C", "#377EB8", "#4DAF4A"),
  borderColor = c("#a90000", "#005288", "#0a7f1c")
)


n <- 20

date_start <- sample(
  seq(from = as.POSIXct(Sys.Date()-14), by = "1 hour", length.out = 24*7*4),
  n, TRUE
)
date_end <- date_start + sample(1:25, n, TRUE) * 3600
schedules <- data.frame(
  id = 1:n, 
  calendarId = as.character(sample(1:3, n, TRUE)),
  title = LETTERS[1:n],
  body = paste("Body schedule", letters[1:n]),
  start = format(date_start, format = "%Y-%m-%dT%H:%00:%00"),
  end = format(date_end, format = "%Y-%m-%dT%H:%00:%00"),
  category = sample(c("allday", "time", "task"), n, TRUE),
  stringsAsFactors = FALSE
)
schedules$raw <- lapply(
  X = seq_len(n),
  FUN = function(i) {
    list(status = sample(c("Completed", "In progress", "Closed"), 1)) # random status
  }
)




ui <- fluidPage(
  fluidRow(
    column(
      width = 8, offset = 2,
      tags$h2("Custom popover with HTML"),
      calendarOutput(outputId = "cal"),
      uiOutput("ui")
    )
  )
)

server <- function(input, output, session) {
  
  output$cal <- renderCalendar({
    calendar(defaultView = "month", taskView = TRUE, useDetailPopup = FALSE) %>% 
      # set_month_options(visibleWeeksCount = 2) %>%
      set_calendars_props_df(df = calendarProps) %>% 
      add_schedule_df(df = schedules) %>%
      set_events(
        clickSchedule = JS(
          "function(event) {", 
          "Shiny.setInputValue('calendar_id_click', {id: event.schedule.id, x: event.event.clientX, y: event.event.clientY});", 
          "}"
        )
      )
  })
  
  
  observeEvent(input$calendar_id_click, {
    removeUI(selector = "#calendar_panel")
    id <- as.numeric(input$calendar_id_click$id)
    # Get the appropriate line clicked
    sched <- schedules[schedules$id == id, ]
    
    insertUI(
      selector = "body",
      ui = absolutePanel(
        id = "calendar_panel",
        top = input$calendar_id_click$y,
        left = input$calendar_id_click$x, 
        draggable = FALSE,
        width = "300px",
        panel(
          status = "primary",
          actionLink(
            inputId = "close_calendar_panel", 
            label = NULL, icon = icon("close"), 
            style = "position: absolute; top: 5px; right: 5px;"
          ),
          tags$br(),
          tags$div(
            style = "text-align: center;",
            tags$p(
              "Here you can put custom", tags$b("HTML"), "elements."
            ),
            tags$p(
              "You clicked on schedule", sched$id, 
              "starting from", sched$start,
              "ending", sched$end
            ),
            tags$b("Current status:"), sched$raw[[1]]$status,
            radioButtons(
              inputId = "status",
              label = "New status:",
              choices = c("Completed", "In progress", "Closed"),
              selected = sched$raw[[1]]$status
            )
          )
        )
      )
    )
  })
  
  observeEvent(input$close_calendar_panel, {
    removeUI(selector = "#calendar_panel")
  })
  
  rv <- reactiveValues(id = NULL, status = NULL)
  observeEvent(input$status, {
    rv$id <- input$calendar_id_click$id
    rv$status <- input$status
  })
  
  output$ui <- renderUI({
    tags$div(
      "Schedule", tags$b(rv$id), "has been updated with status", tags$b(rv$status)
    )
  })
  
}

shinyApp(ui, server)