beaumontmeteo/app.R

# Load necessary libraries
library(shiny)
library(httr)
library(shinycssloaders)

invisible(lapply(
  list.files(path = "R", pattern = "\\.R$", full.names = TRUE),
  source
))

locations <- get_rain_locations()
secondary_metrics <- get_weather_metric_catalog(include_rain = FALSE)
db_path <- default_rain_db_path()
ensure_weather_db(db_path)

get_window_slider_config <- function(unit = "days") {
  switch(
    unit,
    days = list(label = "Past days", max = 60L, value = 10L),
    months = list(label = "Past months", max = 24L, value = 6L),
    years = list(label = "Past years", max = 10L, value = 1L),
    list(label = "Past days", max = 60L, value = 10L)
  )
}


last_day_of_month <- function(year, month) {
  next_month_year <- year + if (month == 12L) 1L else 0L
  next_month <- if (month == 12L) 1L else month + 1L
  next_month_start <- as.Date(sprintf("%04d-%02d-01", next_month_year, next_month))
  as.integer(format(next_month_start - 1L, "%d"))
}


subtract_calendar_period <- function(date, amount, unit) {
  date <- as.Date(date)
  amount <- as.integer(amount)

  if (amount <= 0L) {
    return(date)
  }

  date_lt <- as.POSIXlt(date, tz = "UTC")
  year <- date_lt$year + 1900L
  month <- date_lt$mon + 1L
  day <- date_lt$mday

  if (identical(unit, "months")) {
    total_months <- year * 12L + (month - 1L) - amount
    target_year <- total_months %/% 12L
    target_month <- total_months %% 12L + 1L
    target_day <- min(day, last_day_of_month(target_year, target_month))

    return(as.Date(sprintf("%04d-%02d-%02d", target_year, target_month, target_day)))
  }

  if (identical(unit, "years")) {
    target_year <- year - amount
    target_day <- min(day, last_day_of_month(target_year, month))

    return(as.Date(sprintf("%04d-%02d-%02d", target_year, month, target_day)))
  }

  date - amount
}


window_start_date <- function(end_date, amount, unit) {
  end_date <- as.Date(end_date)
  amount <- max(1L, as.integer(amount))

  if (identical(unit, "days")) {
    return(end_date - amount + 1L)
  }

  subtract_calendar_period(end_date, amount, unit) + 1L
}


format_window_label <- function(amount, unit) {
  amount <- max(1L, as.integer(amount))
  unit_label <- if (amount == 1L) sub("s$", "", unit) else unit

  sprintf("last %s %s", amount, unit_label)
}


get_rain_view_choices <- function(window_unit = "days") {
  switch(
    window_unit,
    days = c(
      "6-minute rain" = "raw",
      "Daily total" = "daily"
    ),
    months = c(
      "Daily total" = "daily",
      "Weekly total" = "weekly"
    ),
    years = c(
      "Weekly total" = "weekly",
      "Monthly total" = "monthly"
    ),
    c(
      "6-minute rain" = "raw",
      "Daily total" = "daily"
    )
  )
}


get_metric_view_choices <- function(window_unit = "days") {
  switch(
    window_unit,
    days = c(
      "Raw observations" = "raw",
      "Daily aggregate" = "daily"
    ),
    months = c(
      "Daily aggregate" = "daily",
      "Weekly aggregate" = "weekly"
    ),
    years = c(
      "Weekly aggregate" = "weekly",
      "Monthly aggregate" = "monthly"
    ),
    c(
      "Raw observations" = "raw",
      "Daily aggregate" = "daily"
    )
  )
}


get_preferred_window_view <- function(window_unit = "days") {
  switch(
    window_unit,
    days = "raw",
    months = "weekly",
    years = "monthly",
    "raw"
  )
}


ui <- fluidPage(
  tags$head(
    tags$style(HTML("
      .container-fluid {
        max-width: 1480px;
      }
      .status-block {
        margin-top: 16px;
        padding: 12px;
        background: #f6f8f9;
        border: 1px solid #d9e1e5;
        border-radius: 6px;
      }
      .help-block {
        margin-top: 12px;
      }
      .panel-card {
        min-height: 100%;
        padding: 16px;
        background: #fbfcfd;
        border: 1px solid #d9e1e5;
        border-radius: 8px;
      }
      .panel-title {
        margin-top: 0;
      }
    "))
  ),

  titlePanel("Beaumont Weather Cache"),

  sidebarLayout(
    sidebarPanel(
      width = 3,
      selectInput(
        inputId = "location_id",
        label = "Location",
        choices = stats::setNames(locations$location_id, locations$label),
        selected = locations$location_id[1]
      ),
      radioButtons(
        inputId = "window_unit",
        label = "Time window",
        choices = c(
          "Days" = "days",
          "Months" = "months",
          "Years" = "years"
        ),
        selected = "days",
        inline = TRUE
      ),
      sliderInput(
        inputId = "window_amount",
        label = "Past days",
        min = 1,
        max = 60,
        value = 10,
        step = 1
      ),
      radioButtons(
        inputId = "rain_view_mode",
        label = "Rain display",
        choices = c(
          "6-minute rain" = "raw",
          "Daily total" = "daily"
        ),
        selected = "raw"
      ),
      checkboxInput(
        inputId = "hide_zero",
        label = "Hide zero rainfall",
        value = TRUE
      ),
      selectInput(
        inputId = "metric_id",
        label = "Second panel",
        choices = stats::setNames(secondary_metrics$metric_id, secondary_metrics$label),
        selected = "air_temperature"
      ),
      radioButtons(
        inputId = "metric_view_mode",
        label = "Second panel display",
        choices = c(
          "Raw observations" = "raw",
          "Daily aggregate" = "daily"
        ),
        selected = "raw"
      ),
      uiOutput("syncControls"),
      div(
        class = "status-block",
        verbatimTextOutput("cacheStatus")
      )
    ),

    mainPanel(
      width = 9,
      fluidRow(
        column(
          width = 6,
          div(
            class = "panel-card",
            h3(class = "panel-title", "Rain"),
            withSpinner(plotOutput("rainPlot", height = "420px"))
          )
        ),
        column(
          width = 6,
          div(
            class = "panel-card",
            h3(class = "panel-title", textOutput("metricTitle", container = span)),
            withSpinner(plotOutput("metricPlot", height = "420px")),
            h4("Latest values by station"),
            tableOutput("metricLatest")
          )
        )
      )
    )
  )
)


server <- function(input, output, session) {
  api_headers <- load_api_headers()
  data_version <- reactiveVal(0L)
  last_sync_message <- reactiveVal("")

  selected_location <- reactive({
    get_rain_location(input$location_id, locations = locations)
  })

  selected_metric <- reactive({
    get_weather_metric(input$metric_id)
  })

  observeEvent(input$window_unit, {
    settings <- get_window_slider_config(input$window_unit)
    preferred_view <- get_preferred_window_view(input$window_unit)
    rain_choices <- get_rain_view_choices(input$window_unit)
    metric_choices <- get_metric_view_choices(input$window_unit)
    current_value <- if (is.null(input$window_amount)) {
      settings$value
    } else {
      as.integer(input$window_amount)
    }
    current_rain_view <- if (!is.null(input$rain_view_mode) && input$rain_view_mode %in% rain_choices) {
      input$rain_view_mode
    } else {
      preferred_view
    }
    current_metric_view <- if (!is.null(input$metric_view_mode) && input$metric_view_mode %in% metric_choices) {
      input$metric_view_mode
    } else {
      preferred_view
    }

    updateSliderInput(
      session = session,
      inputId = "window_amount",
      label = settings$label,
      min = 1,
      max = settings$max,
      value = min(max(current_value, 1L), settings$max),
      step = 1
    )

    updateRadioButtons(
      session = session,
      inputId = "rain_view_mode",
      choices = rain_choices,
      selected = current_rain_view
    )

    updateRadioButtons(
      session = session,
      inputId = "metric_view_mode",
      choices = metric_choices,
      selected = current_metric_view
    )
  }, ignoreInit = TRUE)

  selected_start_date <- reactive({
    window_start_date(
      end_date = Sys.Date(),
      amount = input$window_amount,
      unit = input$window_unit
    )
  })

  selected_window_label <- reactive({
    format_window_label(
      amount = input$window_amount,
      unit = input$window_unit
    )
  })

  selected_window_days <- reactive({
    as.integer(Sys.Date() - selected_start_date()) + 1L
  })

  cached_rain <- reactive({
    data_version()

    query_cached_rainfall(
      location_id = input$location_id,
      start_date = selected_start_date(),
      end_date = Sys.Date(),
      aggregate = input$rain_view_mode,
      db_path = db_path
    )
  })

  cached_metric <- reactive({
    data_version()

    query_cached_metric(
      location_id = input$location_id,
      metric_id = input$metric_id,
      start_date = selected_start_date(),
      end_date = Sys.Date(),
      aggregate = input$metric_view_mode,
      db_path = db_path
    )
  })

  metric_latest <- reactive({
    data_version()

    query_latest_metric_values(
      location_id = input$location_id,
      metric_id = input$metric_id,
      db_path = db_path
    )
  })

  output$metricTitle <- renderText({
    selected_metric()$label
  })

  output$syncControls <- renderUI({
    if (is.null(api_headers)) {
      return(
        div(
          class = "help-block",
          helpText(
            "This app is reading the local SQLite cache only. Add token4 to data/secrets and run",
            "`Rscript scripts/update_rain_db.R`",
            "to refresh rain plus the second-panel weather metrics."
          ),
          helpText(
            "Rain can be backfilled. Temperature, humidity, wind and pressure come from the rolling observation feed, so sync that script daily if you want a continuous history."
          )
        )
      )
    }

    tagList(
      actionButton("sync_now", "Sync location from API"),
      div(
        class = "help-block",
        helpText(
          "This refresh pulls historical rain plus the latest station observations into the same SQLite dataset."
        )
      )
    )
  })

  observeEvent(input$sync_now, {
    req(!is.null(api_headers))

    location <- selected_location()
    result <- tryCatch(
      withProgress(
        message = sprintf("Syncing %s into SQLite", location$label[1]),
        value = 0.3,
        {
          sync_location_weather(
            location_id = input$location_id,
            db_path = db_path,
            headers = api_headers,
            initial_backfill_days = max(21L, selected_window_days() + 7L)
          )
        }
      ),
      error = function(error) {
        last_sync_message(
          sprintf("Last sync failed: %s", conditionMessage(error))
        )
        NULL
      }
    )

    if (is.null(result)) {
      return()
    }

    latest_observed_at <- result$latest_observed_at[1]
    if (is.na(latest_observed_at) || !nzchar(latest_observed_at)) {
      latest_observed_at <- "no data returned"
    }

    last_sync_message(
      sprintf(
        paste(
          "Last sync: %s rows written",
          "(rain %s, observations %s).",
          "Cache now reaches %s."
        ),
        format(result$rows_written[1], big.mark = ","),
        format(result$rain_rows_written[1], big.mark = ","),
        format(result$observation_rows_written[1], big.mark = ","),
        latest_observed_at
      )
    )
    data_version(data_version() + 1L)
  })

  output$cacheStatus <- renderText({
    data_version()

    status_text <- describe_cache_status(
      location_id = input$location_id,
      db_path = db_path,
      locations = locations
    )

    if (!nzchar(last_sync_message())) {
      return(status_text)
    }

    paste(status_text, last_sync_message(), sep = "\n\n")
  })

  output$rainPlot <- renderPlot({
    plot_data <- cached_rain()

    shiny::validate(
      shiny::need(
        nrow(plot_data) > 0,
        "No cached rainfall for this period yet. Run the sync script or use the API sync button if credentials are configured."
      )
    )

    if (input$hide_zero) {
      plot_data <- plot_data[
        is.na(plot_data$rain_mm) | plot_data$rain_mm > 0,
        ,
        drop = FALSE
      ]
    }

    shiny::validate(
      shiny::need(
        nrow(plot_data) > 0,
        "No non-zero rainfall in this window. Untick 'Hide zero rainfall' if you want to inspect dry periods too."
      )
    )

    plot_cached_rainfall(
      rain_data = plot_data,
      view = input$rain_view_mode,
      hide_zero = FALSE,
      main = sprintf(
        "%s - %s",
        selected_location()$label[1],
        selected_window_label()
      )
    )
  })

  output$metricPlot <- renderPlot({
    plot_data <- cached_metric()
    metric <- selected_metric()

    shiny::validate(
      shiny::need(
        nrow(plot_data) > 0,
        sprintf(
          "No cached %s data for this window yet. Run the sync script more frequently if you want a continuous history for that metric.",
          tolower(metric$label)
        )
      )
    )

    plot_cached_metric(
      metric_data = plot_data,
      metric_id = input$metric_id,
      view = input$metric_view_mode,
      main = sprintf(
        "%s - %s - %s",
        selected_location()$label[1],
        metric$label,
        selected_window_label()
      )
    )
  })

  output$metricLatest <- renderTable({
    latest_data <- metric_latest()
    if (!nrow(latest_data)) {
      return(NULL)
    }

    names(latest_data) <- c("Station ID", "Station", "Observed At", "Metric", "Label", "Unit", "Value")
    latest_data[, c("Station", "Observed At", "Value", "Unit")]
  }, striped = TRUE, spacing = "s", digits = 2)
}


shinyApp(ui = ui, server = server)