Build cached weather app and sync tooling

.gitignore

@@ -0,0 +1,10 @@
+*.swp
+*.swo
+*.swj
+*.swk
+*.swl
+*.swm
+*.swn
+data/*.sqlite
+data/*.sqlite-shm
+data/*.sqlite-wal

DESCRIPTION

@@ -1,15 +1,22 @@
 Package: beaumontmeteo
-Title: What the Package Does (One Line, Title Case)
+Title: Cache Local Weather Observations for Beaumont
 Version: 0.0.0.9000
 Authors@R: 
     person("First", "Last", , "first.last@example.com", role = c("aut", "cre"),
            comment = c(ORCID = "YOUR-ORCID-ID"))
-Description: What the package does (one paragraph).
+Description: Shiny app and helper functions to cache Meteo France rainfall
+    and station observation metrics locally and browse them without
+    re-querying the API every time.
 License: `use_mit_license()`, `use_gpl3_license()` or friends to pick a
     license
 Encoding: UTF-8
+Imports:
+    httr,
+    shiny,
+    shinycssloaders
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Suggests: 
     testthat (>= 3.0.0)
+SystemRequirements: sqlite3
 Config/testthat/edition: 3

R/getStationData.R

@@ -1,12 +1,23 @@
-getStationData <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPClim/v1/",timesleep=5,base="https://public-api.meteofrance.fr") {
+get_dpclim_period_bounds <- function(start_date, end_date) {
     start_date <- as.Date(start_date)
     end_date <- as.Date(end_date)
-    url <- httr::modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m"))
-    # Format dates in ISO8601 format
-    formatted_start_date <- format(start_date, "%Y-%m-%dT00:00:00Z", tz = "GMT")
-    formatted_end_date <- format(end_date, "%Y-%m-%dT00:00:00Z", tz = "GMT")
 
-    parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date)
+    list(
+        start = format(start_date, "%Y-%m-%dT00:00:00Z", tz = "GMT"),
+        end = format(end_date + 1L, "%Y-%m-%dT00:00:00Z", tz = "GMT")
+    )
+}
+
+
+getStationData <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPClim/v1/",timesleep=5,base="https://public-api.meteofrance.fr") {
+    url <- httr::modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m"))
+    period_bounds <- get_dpclim_period_bounds(start_date, end_date)
+
+    parameters <- list(
+        "id-station" = station_id,
+        "date-deb-periode" = period_bounds$start,
+        "date-fin-periode" = period_bounds$end
+    )
 
     # Create the URL with parameters to ask for the csv file
     url_query_file <- httr::modify_url(url, query = parameters)
@@ -45,14 +56,14 @@ getStationData <- function(start_date, end_date, station_id,headers ,dpclim = "p
 
 
 getStationDataDPObs <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPClim/v1/",timesleep=5,base="https://public-api.meteofrance.fr") {
-    start_date <- as.Date(start_date)
-    end_date <- as.Date(end_date)
     url <- httr::modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m"))
-    # Format dates in ISO8601 format
+    period_bounds <- get_dpclim_period_bounds(start_date, end_date)
-    formatted_start_date <- format(start_date, "%Y-%m-%dT00:00:00Z", tz = "GMT")
-    formatted_end_date <- format(end_date, "%Y-%m-%dT00:00:00Z", tz = "GMT")
 
-    parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date)
+    parameters <- list(
+        "id-station" = station_id,
+        "date-deb-periode" = period_bounds$start,
+        "date-fin-periode" = period_bounds$end
+    )
 
     # Create the URL with parameters to ask for the csv file
     url_query_file <- httr::modify_url(url, query = parameters)
@@ -90,14 +101,14 @@ getStationDataDPObs <- function(start_date, end_date, station_id,headers ,dpclim
 }
 
 getStationDataTemp <- function(start_date, end_date, station_id,headers ,dpclim = "public/DPClim/v1/",timesleep=5,base="https://public-api.meteofrance.fr") {
-    start_date <- as.Date(start_date)
-    end_date <- as.Date(end_date)
     url <- httr::modify_url(base,path = paste0(dpclim,"commande-station/infrahoraire-6m"))
-    # Format dates in ISO8601 format
+    period_bounds <- get_dpclim_period_bounds(start_date, end_date)
-    formatted_start_date <- format(start_date, "%Y-%m-%dT00:00:00Z", tz = "GMT")
-    formatted_end_date <- format(end_date, "%Y-%m-%dT00:00:00Z", tz = "GMT")
 
-    parameters <- list("id-station" = station_id, "date-deb-periode" = formatted_start_date, "date-fin-periode" = formatted_end_date)
+    parameters <- list(
+        "id-station" = station_id,
+        "date-deb-periode" = period_bounds$start,
+        "date-fin-periode" = period_bounds$end
+    )
 
     # Create the URL with parameters to ask for the csv file
     url_query_file <- httr::modify_url(url, query = parameters)

README.md

@@ -1,8 +1,89 @@
 # Beaumontmeteo
 
-Quick and dirty R interface for meteofrance API.
+Shiny app and helper scripts to cache Meteo France station data around Beaumont in a local SQLite database.
 
-project perso to monitor rain in the Beaumont and elsewhere.
+## What is stored
 
-you need api keys and stuff and I am not sure how it all works but yeah, one day I'll clean all.
+The cache now uses one unified dataset called `weather_measurements` inside `data/rain_history.sqlite`.
 
+Each row stores:
+
+- location,
+- station,
+- observation timestamp,
+- metric id,
+- numeric value,
+- source metadata.
+
+That means rain, temperature, humidity, wind and pressure can all be compared on the same time axis later.
+
+## App
+
+Run from the project root:
+
+```r
+shiny::runApp()
+```
+
+The UI now has two panels:
+
+- a rain panel backed by historical `DPClim` rainfall,
+- a second panel backed by the same SQLite dataset, with a selector for temperature and other station metrics.
+
+## Syncing the cache
+
+Put your Meteo France API key in `data/secrets` as `token4`, then run:
+
+```bash
+Rscript scripts/update_rain_db.R
+```
+
+For a slow historical rainfall backfill into the same SQLite dataset:
+
+```bash
+Rscript scripts/backfill_two_years.R
+```
+
+Useful options:
+
+- `update_rain_db.R --location=vignasses`
+- `update_rain_db.R --location=vignasses,la_mure`
+- `update_rain_db.R --days=60`
+- `update_rain_db.R --db-path=/somewhere/else/rain.sqlite`
+- `backfill_two_years.R --location=vignasses`
+- `backfill_two_years.R --db-path=/somewhere/else/rain.sqlite`
+- `backfill_two_years.R --chunk-days=30`
+- `backfill_two_years.R --resume=false`
+- `backfill_two_years.R --between-chunk-sleep=20`
+
+## Important note about frequency
+
+Historical rain can be backfilled from the climatology endpoint, so a weekly sync is fine there.
+
+Temperature, humidity, wind and pressure come from the rolling station observation feed. To keep those metrics continuous in the database, run the sync daily rather than weekly.
+
+## Cron examples
+
+Daily full weather sync:
+
+```bash
+0 7 * * * cd /path/to/beaumontmeteo && Rscript scripts/update_rain_db.R >> /tmp/beaumontmeteo-sync.log 2>&1
+```
+
+If you only care about rain history, the same script can still be run weekly because rainfall is backfilled on each sync.
+
+## Why SQLite
+
+SQLite is a good fit here because this is a local, read-heavy app with a small periodic write job.
+
+- No database server to install or operate.
+- One file to move, back up and inspect.
+- Proper indexed queries and deduplication, unlike CSV or RDS files.
+- The app still works offline once data has been cached.
+
+If this ever becomes a shared multi-user service with concurrent writers, Postgres would be the next upgrade.
+
+## Notes
+
+- The database path can be overridden with `BEAUMONT_RAIN_DB`.
+- The repo ignores `data/*.sqlite` so the cache file stays local.

app.R

@@ -1,96 +1,493 @@
 # Load necessary libraries
 library(shiny)
-library(jsonlite)
 library(httr)
-library(shinycssloaders) # For the spinner
+library(shinycssloaders)
 
-# Assuming you have your custom functions in a file called 'your_functions.R'
+invisible(lapply(
+  list.files(path = "R", pattern = "\\.R$", full.names = TRUE),
+  source
+))
 
-# List all R files in the directory and source them
+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") {
-lapply(list.files(path = "R", pattern = "\\.R$", full.names = T), source)
+  switch(
-
+    unit,
-source("data/secrets")
+    days = list(label = "Past days", max = 60L, value = 10L),
-
+    months = list(label = "Past months", max = 24L, value = 6L),
-# Create a Bearer token header
+    years = list(label = "Past years", max = 10L, value = 1L),
-headers.default <- add_headers(
+    list(label = "Past days", max = 60L, value = 10L)
-  accept = "*/*",
-  apikey = token4
   )
+}
 
-# Load station data
 
-# Define UI for application
+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)
+}
+
 ui <- fluidPage(
   tags$head(
     tags$style(HTML("
-      #main {
-        height: 100vh; /* Full height of the viewport */
-        overflow-y: auto; /* Scroll if content overflows */
-      }
       .container-fluid {
-        height: 100vh; /* Full height of the viewport */
+        max-width: 1480px;
-        display: flex;
-        flex-direction: column;
       }
-      .row {
+      .status-block {
-        flex-grow: 1;
+        margin-top: 16px;
-        display: flex;
+        padding: 12px;
+        background: #f6f8f9;
+        border: 1px solid #d9e1e5;
+        border-radius: 6px;
       }
-      .col-sm-8 {
+      .help-block {
-        flex-grow: 1; /* Allow the main panel to grow */
+        margin-top: 12px;
+      }
+      .panel-card {
+        min-height: 100%;
+        padding: 16px;
+        background: #fbfcfd;
+        border: 1px solid #d9e1e5;
+        border-radius: 8px;
+      }
+      .panel-title {
+        margin-top: 0;
       }
     "))
   ),
 
-  # Application title
+  titlePanel("Beaumont Weather Cache"),
-  titlePanel("Beaumont aka SECMONT"),
 
-  # Sidebar for user inputs
   sidebarLayout(
     sidebarPanel(
-      width=2,
+      width = 3,
-      numericInput(inputId = "daysBefore", label = "Nb jour à  check:", value=10, min=1)
+      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")
+      )
     ),
 
-    # Main panel for displaying plot
     mainPanel(
+      width = 9,
+      fluidRow(
+        column(
           width = 6,
-     withSpinner( plotOutput("dataPlot"))
+          div(
+            class = "panel-card",
+            h3(class = "panel-title", "Rain"),
+            withSpinner(plotOutput("rainPlot", height = "420px")),
+            h4("Daily rain totals"),
+            tableOutput("dailySummary")
+          )
+        ),
+        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")
+          )
+        )
+      )
     )
   )
 )
 
-# Define server logic required to generate and plot data
-server <- function(input, output) {
-  # Reactive expression to fetch data based on input and display spinner while loading
 
+server <- function(input, output, session) {
+  api_headers <- load_api_headers()
+  data_version <- reactiveVal(0L)
+  last_sync_message <- reactiveVal("")
 
-  # Render the plot
+  selected_location <- reactive({
-  output$dataPlot <- renderPlot({
+    get_rain_location(input$location_id, locations = locations)
-    startdate <- format(Sys.Date() - input$daysBefore, "%Y-%m-%d")
-    vignass.coor=c(44.8550665,5.8441789)
-    allstations <- read.csv("data/allstations.csv")
-    test1 <- getAllFromCoord(vignass.coor, start_date = startdate, end_date = format(Sys.Date(), "%Y-%m-%d"), allstations, headers = headers.default,btw_station_sleep = .5,within_statio_sleep = 1)
-    
-    # Prepare colors
-    cols <- palette.colors()[1:length(unique(test1$Nom_usuel))]
-    names(cols) <- unique(test1$Nom_usuel)
-    
-    # Filter data
-    testsep <- test1
-    testsep[testsep[,3] == 0 & !is.na(testsep[,3]), c(3,4)] <- NA
-    
-    plot(getDate(testsep[,2]), testsep[,3], pch = 20, col = adjustcolor(cols[testsep$Nom_usuel], .4), cex = 1.3, ylim = c(0, 8))
-    
-    # Add legend
-    legend("topleft", col = cols, legend = names(cols), pch = 20, cex = 1)
-    
-    # Highlight specific date
-    abline(v = as.numeric(as.POSIXlt("2024-08-07", format = "%Y-%m-%d")), lwd = 3, col = "red")
   })
+
+  selected_metric <- reactive({
+    get_weather_metric(input$metric_id)
+  })
+
+  observeEvent(input$window_unit, {
+    settings <- get_window_slider_config(input$window_unit)
+    current_value <- if (is.null(input$window_amount)) {
+      settings$value
+    } else {
+      as.integer(input$window_amount)
     }
 
-# Run the application 
+    updateSliderInput(
+      session = session,
+      inputId = "window_amount",
+      label = settings$label,
+      min = 1,
+      max = settings$max,
+      value = min(max(current_value, 1L), settings$max),
+      step = 1
+    )
+  }, 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
+    )
+  })
+
+  daily_summary <- reactive({
+    data_version()
+
+    query_cached_rainfall(
+      location_id = input$location_id,
+      start_date = selected_start_date(),
+      end_date = Sys.Date(),
+      aggregate = "daily",
+      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$dailySummary <- renderTable({
+    summary_data <- daily_summary()
+    if (!nrow(summary_data)) {
+      return(NULL)
+    }
+
+    names(summary_data) <- c("Station ID", "Station", "Day", "Metric", "Label", "Unit", "Rain")
+    summary_data[, c("Station", "Day", "Rain")]
+  }, striped = TRUE, spacing = "s", digits = 2)
+
+  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)

scripts/backfill_two_years.R

@@ -0,0 +1,299 @@
+command_line_args <- commandArgs(trailingOnly = TRUE)
+
+parse_cli_args <- function(args) {
+  parsed <- list()
+
+  for (arg in args) {
+    if (!grepl("^--", arg)) {
+      next
+    }
+
+    parts <- strsplit(sub("^--", "", arg), "=", fixed = TRUE)[[1]]
+    key <- parts[1]
+    value <- if (length(parts) > 1) paste(parts[-1], collapse = "=") else TRUE
+    parsed[[key]] <- value
+  }
+
+  parsed
+}
+
+
+parse_flag <- function(value, default = FALSE) {
+  if (is.null(value)) {
+    return(default)
+  }
+
+  normalized <- tolower(as.character(value))
+  if (normalized %in% c("true", "t", "1", "yes", "y")) {
+    return(TRUE)
+  }
+  if (normalized %in% c("false", "f", "0", "no", "n")) {
+    return(FALSE)
+  }
+
+  default
+}
+
+
+sleep_with_message <- function(seconds, reason) {
+  seconds <- as.numeric(seconds)
+
+  if (!is.finite(seconds) || seconds <= 0) {
+    return(invisible(NULL))
+  }
+
+  cat(sprintf("%s Sleeping %.1f seconds.\n", reason, seconds))
+  Sys.sleep(seconds)
+}
+
+
+script_file_arg <- grep("^--file=", commandArgs(FALSE), value = TRUE)
+script_path <- normalizePath(sub("^--file=", "", script_file_arg[1]), winslash = "/")
+project_root <- normalizePath(file.path(dirname(script_path), ".."), winslash = "/")
+
+setwd(project_root)
+invisible(lapply(
+  list.files(path = "R", pattern = "\\.R$", full.names = TRUE),
+  source
+))
+
+args <- parse_cli_args(command_line_args)
+db_path <- if (!is.null(args[["db-path"]])) {
+  normalizePath(args[["db-path"]], winslash = "/", mustWork = FALSE)
+} else {
+  default_rain_db_path()
+}
+
+location_ids <- if (!is.null(args[["location"]])) {
+  strsplit(args[["location"]], ",", fixed = TRUE)[[1]]
+} else {
+  get_rain_locations()$location_id
+}
+
+days_back <- if (!is.null(args[["days"]])) {
+  as.integer(args[["days"]])
+} else {
+  730L
+}
+
+chunk_days <- if (!is.null(args[["chunk-days"]])) {
+  as.integer(args[["chunk-days"]])
+} else {
+  30L
+}
+
+btw_station_sleep <- if (!is.null(args[["btw-station-sleep"]])) {
+  as.numeric(args[["btw-station-sleep"]])
+} else {
+  4
+}
+
+within_station_sleep <- if (!is.null(args[["within-station-sleep"]])) {
+  as.numeric(args[["within-station-sleep"]])
+} else {
+  10
+}
+
+between_chunk_sleep <- if (!is.null(args[["between-chunk-sleep"]])) {
+  as.numeric(args[["between-chunk-sleep"]])
+} else {
+  20
+}
+
+between_location_sleep <- if (!is.null(args[["between-location-sleep"]])) {
+  as.numeric(args[["between-location-sleep"]])
+} else {
+  60
+}
+
+resume <- parse_flag(args[["resume"]], default = TRUE)
+end_date <- if (!is.null(args[["end-date"]])) {
+  as.Date(args[["end-date"]])
+} else {
+  Sys.Date() - 1L
+}
+
+headers <- load_api_headers()
+if (is.null(headers)) {
+  stop("No API credentials found. Add token4 to data/secrets before running the backfill.")
+}
+
+allstations <- load_station_catalog()
+locations <- get_rain_locations()
+ensure_weather_db(db_path)
+
+cat("Starting slow historical backfill.\n")
+cat(sprintf("Database: %s\n", db_path))
+cat(sprintf("Locations: %s\n", paste(location_ids, collapse = ", ")))
+cat(sprintf("Rainfall window: last %s days ending on %s\n", days_back, as.character(end_date)))
+cat(sprintf("Chunk size: %s days\n", chunk_days))
+cat(sprintf("Sleep between stations: %.1f seconds\n", btw_station_sleep))
+cat(sprintf("Sleep while waiting for station files: %.1f seconds\n", within_station_sleep))
+cat(sprintf("Sleep between chunks: %.1f seconds\n", between_chunk_sleep))
+cat(sprintf("Sleep between locations: %.1f seconds\n", between_location_sleep))
+cat(sprintf("Resume mode: %s\n\n", if (resume) "on" else "off"))
+
+overall_start_date <- end_date - days_back + 1L
+results <- vector("list", length(location_ids))
+
+for (location_index in seq_along(location_ids)) {
+  location_id <- location_ids[location_index]
+  location_label <- get_rain_location(location_id, locations = locations)$label[1]
+
+  location_start_date <- overall_start_date
+  if (resume) {
+    resume_start_date <- get_sync_start_date(
+      location_id = location_id,
+      db_path = db_path,
+      end_date = end_date,
+      initial_backfill_days = days_back,
+      overlap_days = 1L,
+      metric_id = "rain_6m"
+    )
+    location_start_date <- as.Date(max(location_start_date, resume_start_date))
+  }
+
+  if (location_start_date > end_date) {
+    cat(sprintf("[%s] %s already has data up to %s. Skipping.\n", location_id, location_label, as.character(end_date)))
+    status <- get_location_cache_status(location_id, db_path = db_path)
+    results[[location_index]] <- data.frame(
+      location_id = location_id,
+      start_date = as.character(location_start_date),
+      end_date = as.character(end_date),
+      chunk_days = chunk_days,
+      rows_fetched = 0L,
+      rows_written = 0L,
+      latest_observed_at = status$latest_observed_at[1],
+      status = "up_to_date",
+      message = "",
+      stringsAsFactors = FALSE
+    )
+    next
+  }
+
+  ranges <- split_sync_ranges(
+    start_date = location_start_date,
+    end_date = end_date,
+    chunk_days = chunk_days
+  )
+
+  cat(sprintf("[%s] Backfilling %s from %s to %s in %s chunk(s).\n",
+    location_id,
+    location_label,
+    as.character(location_start_date),
+    as.character(end_date),
+    nrow(ranges)
+  ))
+
+  location_rows_fetched <- 0L
+  location_rows_written <- 0L
+  location_status <- "ok"
+  location_message <- ""
+
+  for (range_index in seq_len(nrow(ranges))) {
+    chunk_start <- ranges$start_date[range_index]
+    chunk_end <- ranges$end_date[range_index]
+
+    cat(sprintf(
+      "[%s] Chunk %s/%s: %s -> %s\n",
+      location_id,
+      range_index,
+      nrow(ranges),
+      as.character(chunk_start),
+      as.character(chunk_end)
+    ))
+
+    chunk_result <- tryCatch(
+      {
+        raw_data <- fetch_rainfall_from_api(
+          location_id = location_id,
+          start_date = chunk_start,
+          end_date = chunk_end,
+          headers = headers,
+          allstations = allstations,
+          locations = locations,
+          btw_station_sleep = btw_station_sleep,
+          within_station_sleep = within_station_sleep
+        )
+
+        weather_data <- normalise_rainfall_data(
+          raw_data = raw_data,
+          location_id = location_id
+        )
+
+        rows_written <- upsert_weather_measurements(
+          weather_data = weather_data,
+          db_path = db_path
+        )
+
+        list(
+          rows_fetched = nrow(weather_data),
+          rows_written = rows_written,
+          status = "ok",
+          message = ""
+        )
+      },
+      error = function(error) {
+        list(
+          rows_fetched = 0L,
+          rows_written = 0L,
+          status = "error",
+          message = conditionMessage(error)
+        )
+      }
+    )
+
+    location_rows_fetched <- location_rows_fetched + chunk_result$rows_fetched
+    location_rows_written <- location_rows_written + chunk_result$rows_written
+
+    cat(sprintf(
+      "[%s] Chunk result: fetched %s rows, wrote %s rows.\n",
+      location_id,
+      format(chunk_result$rows_fetched, big.mark = ","),
+      format(chunk_result$rows_written, big.mark = ",")
+    ))
+
+    if (!identical(chunk_result$status, "ok")) {
+      location_status <- "error"
+      location_message <- chunk_result$message
+      cat(sprintf("[%s] Stopping because of error: %s\n", location_id, location_message))
+      break
+    }
+
+    if (range_index < nrow(ranges)) {
+      sleep_with_message(
+        seconds = between_chunk_sleep,
+        reason = sprintf("[%s] Chunk complete.", location_id)
+      )
+    }
+  }
+
+  status <- get_location_cache_status(location_id, db_path = db_path)
+  results[[location_index]] <- data.frame(
+    location_id = location_id,
+    start_date = as.character(location_start_date),
+    end_date = as.character(end_date),
+    chunk_days = chunk_days,
+    rows_fetched = location_rows_fetched,
+    rows_written = location_rows_written,
+    latest_observed_at = status$latest_observed_at[1],
+    status = location_status,
+    message = location_message,
+    stringsAsFactors = FALSE
+  )
+
+  if (location_index < length(location_ids)) {
+    sleep_with_message(
+      seconds = between_location_sleep,
+      reason = sprintf("[%s] Location complete.", location_id)
+    )
+  }
+}
+
+results <- do.call(rbind, results)
+cat("\nBackfill summary:\n")
+print(results, row.names = FALSE)
+
+if (any(results$status == "error")) {
+  stop("At least one location failed during the historical backfill.")
+}

scripts/update_rain_db.R

@@ -0,0 +1,66 @@
+command_line_args <- commandArgs(trailingOnly = TRUE)
+
+parse_cli_args <- function(args) {
+  parsed <- list()
+
+  for (arg in args) {
+    if (!grepl("^--", arg)) {
+      next
+    }
+
+    parts <- strsplit(sub("^--", "", arg), "=", fixed = TRUE)[[1]]
+    key <- parts[1]
+    value <- if (length(parts) > 1) paste(parts[-1], collapse = "=") else TRUE
+    parsed[[key]] <- value
+  }
+
+  parsed
+}
+
+
+script_file_arg <- grep("^--file=", commandArgs(FALSE), value = TRUE)
+script_path <- normalizePath(sub("^--file=", "", script_file_arg[1]), winslash = "/")
+project_root <- normalizePath(file.path(dirname(script_path), ".."), winslash = "/")
+
+setwd(project_root)
+invisible(lapply(
+  list.files(path = "R", pattern = "\\.R$", full.names = TRUE),
+  source
+))
+
+args <- parse_cli_args(command_line_args)
+db_path <- if (!is.null(args[["db-path"]])) {
+  normalizePath(args[["db-path"]], winslash = "/", mustWork = FALSE)
+} else {
+  default_rain_db_path()
+}
+
+location_ids <- if (!is.null(args[["location"]])) {
+  strsplit(args[["location"]], ",", fixed = TRUE)[[1]]
+} else {
+  get_rain_locations()$location_id
+}
+
+initial_backfill_days <- if (!is.null(args[["days"]])) {
+  as.integer(args[["days"]])
+} else {
+  21L
+}
+
+headers <- load_api_headers()
+if (is.null(headers)) {
+  stop("No API credentials found. Add token4 to data/secrets before running the sync.")
+}
+
+results <- sync_all_weather_locations(
+  location_ids = location_ids,
+  db_path = db_path,
+  headers = headers,
+  initial_backfill_days = initial_backfill_days
+)
+
+print(results, row.names = FALSE)
+
+if (any(results$status == "error")) {
+  stop("At least one location failed to sync.")
+}

tests/testthat/test-getStationData.R

@@ -1,19 +1,37 @@
-library(jsonlite)
+testthat::skip_if_not(
-library(httr)
+  identical(tolower(Sys.getenv("BEAUMONT_RUN_LIVE_API_TESTS", "false")), "true"),
-
+  "Set BEAUMONT_RUN_LIVE_API_TESTS=true to run live Meteo France API tests."
-
-source(file.path(here::here(),"secrets"))
-# Create a Bearer token header
-headers.default <- add_headers(
-  accept = "*/*",
-  apikey = token2
 )
 
-test_that("get station return something right", 
+testthat::skip_if_not(
-{
+  file.exists(file.path("data", "secrets")),
- test=getStationData(start_date="2024-06-24",end_date="2024-08-14",station_id="38269004",headers=headers.default)
+  "Live API tests require data/secrets."
- if(!is.null(test)){testthat::expect_length(test,3)}
+)
- else testthat::expect_null(test)
+
+library(httr)
+
+source(file.path("R", "request.R"))
+source(file.path("R", "getStationData.R"))
+
+secret_env <- new.env(parent = baseenv())
+sys.source(file.path("data", "secrets"), envir = secret_env)
+
+headers.default <- add_headers(
+  accept = "*/*",
+  apikey = secret_env$token2
+)
+
+test_that("get station return something right", {
+  test <- getStationData(
+    start_date = "2024-06-24",
+    end_date = "2024-08-14",
+    station_id = "38269004",
+    headers = headers.default
+  )
+
+  if (!is.null(test)) {
+    testthat::expect_length(test, 3)
+  } else {
+    testthat::expect_null(test)
+  }
 })
-
-

tests/testthat/test-rain-db.R

@@ -0,0 +1,180 @@
+source(testthat::test_path("..", "..", "R", "rain_db.R"))
+
+test_that("normalise_rainfall_data converts API payload into unified metric rows", {
+  raw_data <- data.frame(
+    POSTE = c("1001", "1001"),
+    DATE = c(202401020000, 202401020006),
+    RR6 = c(0, 1.5),
+    Nom_usuel = c("Station A", "Station A"),
+    stringsAsFactors = FALSE
+  )
+
+  cache_rows <- normalise_rainfall_data(
+    raw_data = raw_data,
+    location_id = "vignasses",
+    fetched_at = as.POSIXct("2026-04-08 09:00:00", tz = "UTC")
+  )
+
+  expect_identical(
+    names(cache_rows),
+    c(
+      "location_id",
+      "station_id",
+      "station_name",
+      "observed_at",
+      "observed_day",
+      "metric_id",
+      "metric_label",
+      "unit",
+      "source_name",
+      "value_num",
+      "fetched_at"
+    )
+  )
+  expect_equal(cache_rows$metric_id[1], "rain_6m")
+  expect_equal(cache_rows$observed_at[2], "2024-01-02T00:06:00Z")
+  expect_equal(cache_rows$fetched_at[1], "2026-04-08T09:00:00Z")
+})
+
+
+test_that("normalise_observation_package_data extracts temperature and other metrics", {
+  raw_data <- data.frame(
+    geo_id_insee = c("1001", "1001"),
+    validity_time = c("2026-04-08T09:24:00Z", "2026-04-08T09:30:00Z"),
+    t = c(293.15, 294.15),
+    td = c(289.15, 290.15),
+    u = c(40, 42),
+    ff = c(1.5, 2.0),
+    fxi10 = c(3.5, 4.0),
+    pres = c(101325, 101425),
+    pmer = c(101525, 101625),
+    stringsAsFactors = FALSE
+  )
+
+  cache_rows <- normalise_observation_package_data(
+    raw_data = raw_data,
+    location_id = "vignasses",
+    station_name = "Station A",
+    fetched_at = as.POSIXct("2026-04-08 10:00:00", tz = "UTC")
+  )
+
+  expect_true(all(c(
+    "air_temperature",
+    "dew_point",
+    "humidity",
+    "wind_speed",
+    "wind_gust",
+    "station_pressure",
+    "sea_level_pressure"
+  ) %in% unique(cache_rows$metric_id)))
+  expect_equal(cache_rows$value_num[cache_rows$metric_id == "air_temperature"][1], 20)
+  expect_equal(cache_rows$value_num[cache_rows$metric_id == "station_pressure"][1], 1013.2)
+})
+
+
+test_that("SQLite cache upserts and queries multiple metrics from one dataset", {
+  skip_if_not(nzchar(Sys.which("sqlite3")), "sqlite3 is required for cache tests.")
+
+  db_path <- tempfile(fileext = ".sqlite")
+  on.exit(unlink(c(db_path, paste0(db_path, c("-shm", "-wal")))), add = TRUE)
+
+  ensure_weather_db(db_path)
+
+  rain_rows <- normalise_rainfall_data(
+    raw_data = data.frame(
+      POSTE = c("1001", "1001"),
+      DATE = c(202401020000, 202401020006),
+      RR6 = c(1.25, 0.5),
+      Nom_usuel = c("Station A", "Station A"),
+      stringsAsFactors = FALSE
+    ),
+    location_id = "vignasses",
+    fetched_at = as.POSIXct("2026-04-08 09:00:00", tz = "UTC")
+  )
+
+  obs_rows <- normalise_observation_package_data(
+    raw_data = data.frame(
+      geo_id_insee = c("1001", "1001"),
+      validity_time = c("2024-01-02T00:00:00Z", "2024-01-02T06:00:00Z"),
+      t = c(293.15, 295.15),
+      u = c(40, 44),
+      ff = c(1.5, 2.5),
+      pres = c(101325, 101225),
+      stringsAsFactors = FALSE
+    ),
+    location_id = "vignasses",
+    station_name = "Station A",
+    fetched_at = as.POSIXct("2026-04-08 09:00:00", tz = "UTC")
+  )
+
+  expect_equal(upsert_weather_measurements(rain_rows, db_path), 2)
+  expect_true(upsert_weather_measurements(obs_rows, db_path) >= 6)
+
+  updated_rain <- rain_rows[1, , drop = FALSE]
+  updated_rain$value_num <- 2
+  expect_true(upsert_rainfall_observations(updated_rain, db_path) >= 1)
+
+  rain_raw <- query_cached_rainfall(
+    location_id = "vignasses",
+    start_date = "2024-01-02",
+    end_date = "2024-01-02",
+    aggregate = "raw",
+    db_path = db_path
+  )
+
+  rain_daily <- query_cached_rainfall(
+    location_id = "vignasses",
+    start_date = "2024-01-02",
+    end_date = "2024-01-02",
+    aggregate = "daily",
+    db_path = db_path
+  )
+
+  temperature_raw <- query_cached_metric(
+    location_id = "vignasses",
+    metric_id = "air_temperature",
+    start_date = "2024-01-02",
+    end_date = "2024-01-02",
+    aggregate = "raw",
+    db_path = db_path
+  )
+
+  temperature_daily <- query_cached_metric(
+    location_id = "vignasses",
+    metric_id = "air_temperature",
+    start_date = "2024-01-02",
+    end_date = "2024-01-02",
+    aggregate = "daily",
+    db_path = db_path
+  )
+
+  latest_temperature <- query_latest_metric_values(
+    location_id = "vignasses",
+    metric_id = "air_temperature",
+    db_path = db_path
+  )
+
+  expect_equal(nrow(rain_raw), 2)
+  expect_equal(rain_raw$rain_mm[1], 2)
+  expect_equal(rain_daily$rain_mm[1], 2.5)
+  expect_equal(nrow(temperature_raw), 2)
+  expect_equal(temperature_daily$value_num[1], 21)
+  expect_equal(latest_temperature$value_num[1], 22)
+  expect_equal(
+    as.character(get_sync_start_date("vignasses", db_path, end_date = as.Date("2024-01-10"))),
+    "2024-01-01"
+  )
+})
+
+
+test_that("sync ranges are chunked predictably", {
+  ranges <- split_sync_ranges(
+    start_date = as.Date("2024-01-01"),
+    end_date = as.Date("2024-05-15"),
+    chunk_days = 60L
+  )
+
+  expect_equal(nrow(ranges), 3)
+  expect_equal(as.character(ranges$start_date[1]), "2024-01-01")
+  expect_equal(as.character(ranges$end_date[3]), "2024-05-15")
+})

tests/testthat/test-script-helpers.R

@@ -16,6 +16,20 @@ test_that("sourced getStationData handles request failure without attached httr"
 })
 
 
+test_that("DPClim period bounds include the full end day", {
+  helper_env <- new.env(parent = globalenv())
+  sys.source(testthat::test_path("..", "..", "R", "getStationData.R"), envir = helper_env)
+
+  bounds <- helper_env$get_dpclim_period_bounds(
+    start_date = "2024-08-09",
+    end_date = "2024-09-07"
+  )
+
+  expect_identical(bounds$start, "2024-08-09T00:00:00Z")
+  expect_identical(bounds$end, "2024-09-08T00:00:00Z")
+})
+
+
 test_that("getAllFromCoord returns NULL when every station fetch fails", {
   helper_env <- new.env(parent = globalenv())
   sys.source(testthat::test_path("..", "..", "R", "getAllFromCoord.R"), envir = helper_env)