# Meta --------------------------------------------------------------------
library(shiny)
library(shinydashboard)
## App name //
app_name <- "Time tracking"
source("dependencies.R")
source("global.R")
# UI ----------------------------------------------------------------------
ui <- dashboardPage(
## Header //
dashboardHeader(title = app_name),
## Sidebar content //
dashboardSidebar(
sidebarMenu(
menuItem("Tasks", tabName = "tasks",
icon = icon("database")),
menuItem("Projects", tabName = "projects",
icon = icon("list")),
menuItem("Admin access", tabName = "admin_access",
icon = icon("lock")),
tags$hr(),
menuItem("Info", tabName = "info", icon = icon("info")),
menuItem("Experimental", tabName = "experimental", icon = icon("flask"))
)
),
## Body content
dashboardBody(
tabItems(
tabItem(
tabName = "tasks",
fluidRow(
column(width = 7,
div()
),
column(width = 3,
actionButton("action_task_create", "Create task")
)
),
p(),
fluidRow(
column(width = 7,
box(
title = "Task list",
DT::dataTableOutput("dt_issues"),
width = NULL
),
uiOutput("ui_form_loggedtimes")
),
column(width = 3,
uiOutput('ui_form_logtime'),
uiOutput("ui_form_taskdetails")
)
),
fluidRow(
column(width = 6,
box(
title = "Selection info",
verbatimTextOutput('debug_selection'),
width = NULL
)
)
)
),
tabItem(
tabName = "projects",
fluidRow(
column(width = 4,
box(
title = "Projects",
selectInput("projects_list", "Projects list", letters, letters[1]),
status = "primary",
width = NULL
)
)
)
),
tabItem(
tabName = "admin_access",
fluidRow(
)
),
tabItem(
tabName = "info",
fluidRow(
box(
title = "Time format",
p("Possible formats for time inputs (examples):"),
div("* 1.5: 1.5 hours"),
div("* 1.5d: 12 hours (a day has 8 hours)"),
div("* 1.5h: 1.5 hours"),
div("* 45m: 0.75 hours"),
div("* 1d 2h 30m: 10.5 hours"),
p(),
strong("NOTE:"),
p(),
div(strong("* Everything is transformed to hours before DB commit")),
width = 12
)
)
),
tabItem("experimental",
fluidRow(
box(
selectInput(
"plotType", "Plot Type",
c(Scatter = "scatter",
Histogram = "hist")),
# Only show this panel if the plot type is a histogram
conditionalPanel(
condition = "input.plotType == 'hist'",
selectInput(
"breaks", "Breaks",
c("Sturges",
"Scott",
"Freedman-Diaconis",
"[Custom]" = "custom")),
# Only show this panel if Custom is selected
conditionalPanel(
condition = "input.breaks == 'custom'",
sliderInput("breakCount", "Break Count", min=1, max=1000, value=10)
)
)
),
conditionalPanel(
condition = "input.dt_issues_rows_selected > 0",
box(
sliderInput("breakCount", "Break Count", min=1, max=1000, value=10)
)
)
),
fluidRow(
box(actionButton("action_exp_1", "Trigger 1"), width = 3),
uiOutput("ui_experimental"),
box(textOutput("exp"))
)
)
)
)
)
# Server ------------------------------------------------------------------
server <- function(input, output, session) {
app$prepare(
public_fields_compact = GLOBALS$db$tables$issues$public_fields_compact,
public_fields_details = GLOBALS$db$tables$issues$public_fields_details,
private_fields = GLOBALS$db$tables$issues$private_fields,
times_public_fields_compact = GLOBALS$db$tables$times$public_fields_compact,
times_public_fields_details = GLOBALS$db$tables$times$public_fields_details,
times_private_fields = GLOBALS$db$tables$times$private_fields
)
##################
## Bundle input ##
##################
inputbundle_db_table_issues <- reactive({
bundleInputData_dbTableIssues(input)
})
inputbundle_db_table_times <- reactive({
bundleInputData_dbTableTimes(input)
})
################
## Dynamic UI ##
################
output$ui_form_taskdetails <- renderUI({
createDynamicUi_issueDetails(input, output)
})
output$ui_form_logtime <- renderUI({
createDynamicUi_logtime(input, output)
})
output$ui_form_loggedtimes <- renderUI({
createDynamicUi_displayLoggedTimes(input, output)
})
## UIDs //
uid_issues <- reactive({
getUids_dbTableIssues(input = input)
})
uid_times <- reactive({
getUids_dbTableTimes(input = input)
})
#############
## Actions ##
#############
## Create issue //
observeEvent(input$action_task_create_2, {
performAction_createIssue(input_bundles = list(
inputbundle_db_table_issues = inputbundle_db_table_issues
), uids = list(uid_issues = uid_issues))
})
## Update issue //
observeEvent(input$action_task_update, {
performAction_updateIssue(input_bundles = list(
inputbundle_db_table_issues = inputbundle_db_table_issues
), uids = list(uid_issues = uid_issues))
})
## Delete issue //
observeEvent(input$action_task_delete, {
performAction_deleteIssue(input_bundles = list(
inputbundle_db_table_issues = inputbundle_db_table_issues
), uids = list(uid_issues = uid_issues))
})
## Log time //
observeEvent(input$action_time_log, {
performAction_logTime(input_bundles = list(
inputbundle_db_table_times = inputbundle_db_table_times
), uids = list(uid_issues = uid_issues))
})
## Update time //
observeEvent(input$action_time_update, {
performAction_updateTime(input_bundles = list(
inputbundle_db_table_times = inputbundle_db_table_times
), uids = list(uid_issues = uid_issues, uid_times = uid_times))
})
## Delete time //
observeEvent(input$action_time_delete, {
performAction_deleteTime(input_bundles = list(
inputbundle_db_table_times = inputbundle_db_table_times
), uids = list(uid_issues = uid_issues, uid_times = uid_times))
})
####################
## Render results ##
####################
## Issues //
output$dt_issues <- DT::renderDataTable({
renderResults_dbTableIssues(input)
}, filter = "top",
width = "100%", class = "cell-border stripe",
selection = "single",
options = list(
dom = "ltipr",
autoWidth = TRUE,
columnDefs = list(list(width = '300px', targets = "_all"))
)
)
## Times //
output$dt_times <- DT::renderDataTable({
renderResults_dbTableTimes(input,
uids = list(uid_issues = uid_issues))
}, selection = "single", options = list(dom = "ltipr"))
###########
## DEBUG ##
###########
handleDebugInfo(input = input, output = output)
##################
## EXPERIMENTAL ##
##################
reactives <- reactiveValues(
action_exp_1 = 0,
action_exp_1__last = 0,
action_exp_cancel = 0,
action_exp_cancel__last = 0,
ui_decision = "hide"
)
ui_decision <- reactive({
## Dependencies //
## Trigger button:
value <- input$action_exp_1
if (reactives$action_exp_1 != value) reactives$action_exp_1 <- value
## Cancel button that is dynamically created within `createDynamicUi_experimental`
value <- input$action_exp_cancel
if (is.null(value)) {
value <- 0
}
if (reactives$action_exp_cancel != value) reactives$action_exp_cancel <- value
if (GLOBALS$debug$enabled) {
message("Dependency clearance -----")
message("action_exp_1:")
print(reactives$action_exp_1)
print(reactives$action_exp_1__last)
message("action_exp_cancel:")
print(reactives$action_exp_cancel)
print(reactives$action_exp_cancel__last)
}
ui_decision <- if (
c (reactives$action_exp_1 == 0 && reactives$action_exp_1 == 0) ||
c(
reactives$action_exp_1 > 0 &&
reactives$action_exp_1 <= reactives$action_exp_1__last &&
reactives$action_exp_cancel > 0 &&
reactives$action_exp_cancel > reactives$action_exp_cancel__last
)
) {
"hide"
} else if (
reactives$action_exp_1 >= reactives$action_exp_1__last
) {
reactives$action_exp_cancel__last <- reactives$action_exp_cancel
"show"
} else {
"Not implemented yet"
}
if (GLOBALS$debug$enabled) {
print(ui_decision)
}
## Synchronize //
reactives$action_exp_1__last <- reactives$action_exp_1
reactives$ui_decision <- ui_decision
# Sys.sleep(1)
## --> just to be able to escape infinite recursions
})
output$ui_experimental <- renderUI({
ui_decision()
createDynamicUi_experimental(input, output,
ui_decision = reactives$ui_decision)
})
# output$exp <- renderPrint({dep_clearance()})
output$exp <- renderPrint({reactiveValuesToList(reactives)})
}
# Launch ---------------------------------------------------------------
shinyApp(ui, server)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.