feat: add holidays for all countries

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(filter_events)
 export(get_calendar)
+export(get_holidays)
 export(get_month_name)
 export(get_moon_phases)
 export(get_weekday_name)

R/get_holidays.R

@@ -0,0 +1,104 @@
+#' Get holidays for a given country and a given year
+#'
+#' @description
+#' Scraps the site <https://www.timeanddate.com> to retrieve holidays data.
+#'
+#' @param country a `character` of length 1. The name of the country 
+#'   (e.g. `'France'`).
+#'
+#' @param year either an `integer` or a `character` of length 1. Must have 4 
+#'   characters (e.g. '2024' and not '24').
+#'   
+#' @return A `data.frame` with the following columns:
+#' - `date`: the date of the holiday (`YYYY-MM-DD`),
+#' - `name`: the name of the holiday (`character`).
+#' 
+#' @export
+#'
+#' @examples
+#' ## Get holidays for France in 2024 ----
+#' get_holidays("France", 2024)
+
+get_holidays <- function(country, year) {
+
+  ## Check args ----
+
+  if (missing(country)) {
+    stop("Argument 'country' is required", call. = FALSE)
+  }
+
+  if (!is.character(country)) {
+    stop("Argument 'country' must be a character", call. = FALSE)
+  }
+
+  if (length(country) != 1) {
+    stop("Argument 'country' must be of length 1", call. = FALSE)
+  }
+
+  if (missing(year)) {
+    stop("Argument 'year' is required", call. = FALSE)
+  }
+
+  if (!is.character(year) && !is.numeric(year)) {
+    stop("Argument 'year' must be either a character or an integer", 
+         call. = FALSE)
+  }
+
+  if (length(year) != 1) {
+    stop("Argument 'year' must be of length 1", call. = FALSE)
+  }
+
+  if (nchar(year) != 4) {
+    stop("Argument 'year' must be of the form 'YYYY'", call. = FALSE)
+  }
+
+
+  ## Change user agent ----
+
+  ua <- paste0("Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:124.0) ",
+               "Gecko/20100101 Firefox/124.0")
+
+
+  ## Switch to US locale ----
+
+  lc_time    <- Sys.getlocale("LC_TIME")
+  on.exit(Sys.setlocale("LC_TIME", lc_time), add = TRUE)
+  Sys.setlocale("LC_TIME", "en_US.UTF-8")
+
+
+  ## Get data ----
+
+  url <- paste0("https://www.timeanddate.com/holidays/", 
+                tolower(country), "/", year)
+
+  page <- httr::GET(url, 
+                    httr::add_headers(`Accept-Language` = "en"),
+                    httr::user_agent(ua))
+
+  if (httr::status_code(page) != 200) {
+    stop("Unable to retrieve holidays. Check country name or check your ", 
+         "internet connexion or wait a few minutes", call. = FALSE)
+  }
+
+  content <- httr::content(page)
+
+
+  ## Clean data ----
+
+  content <- rvest::html_nodes(content, ".table")
+  content <- rvest::html_table(content, fill = TRUE)
+  content <- data.frame(content)
+  content <- content[-1, c(1, 3:4)]
+  content <- content[grep("national", tolower(content$"Type")), -3]
+
+  content$"Date" <- paste(content$"Date", year)
+  content$"Date" <- as.character(as.Date(content$"Date", format = "%d %b %Y"))
+
+  colnames(content) <- tolower(colnames(content))
+
+  content$"name" <- gsub(" / .*", "", content$"name")
+
+  content <- content[!duplicated(content$"date"), ]
+
+  content
+}

R/plot_calendar.R

@@ -36,6 +36,9 @@
 #'   See examples below. Depending on the OS and the locale, the output can be
 #'   weird.
 #' 
+#' @param country a `character` of length 1. The name of the country 
+#'   (e.g. `'France'`) used to retrieve holidays. Default is `NULL`.
+#'   
 #' @param moon a `logical`. If `TRUE` (default) adds new/full moon glyph.
 #'   
 #' @return No return value. The calendar will exported as a `pdf` file in 
@@ -52,7 +55,7 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
                           month = format(Sys.Date(), "%m"), 
                           path = getwd(), filename = NULL, title = NULL, 
                           events = NULL, weekend = FALSE, palette = "#990000",
-                          lang = NULL, moon = TRUE) {
+                          lang = NULL, country = NULL, moon = TRUE) {
 
   ## Check year ----
 
@@ -215,7 +218,6 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
   ## Get calendar data ----
 
   calendar <- get_calendar(year, month, weekend, lang = lang)
-  offs     <- days_off(year)
 
 
   ## Create title ----
@@ -225,6 +227,13 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
   }
 
 
+  ## Get holidays ----
+
+  if (!is.null(country)) {
+    offs <- get_holidays(country, year)
+  }
+
+
   ## Get moon phases dates ----
 
   if (moon) {
@@ -317,6 +326,7 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
          lwd     = 0.75,
          xpd     = TRUE)
 
+
     ## Add weekend ----
 
     if (calendar[i, "en_weekday"] %in% c("Saturday", "Sunday")) {
@@ -333,24 +343,27 @@ plot_calendar <- function(year = format(Sys.Date(), "%Y"),
 
     ## Add holidays ----
 
-    if (calendar[i, "date"] %in% offs$"date") {
-
-      rect(xleft   = calendar[i, "x"] - 1,
-           xright  = calendar[i, "x"],
-           ybottom = calendar[i, "y"] - 1,
-           ytop    = calendar[i, "y"],
-           col     = "#efefef",
-           lwd     = 0.75,
-           xpd     = TRUE)
-
-      text(x      = calendar[i, "x"] - 0.50,
-           y      = calendar[i, "y"] - 0.85,
-           labels = paste0("OFF\n", offs[which(offs$"date" == 
-                                                 calendar[i, "date"]), 
-                                         "event"]),
-           cex    = 0.65,
-           font   = 2,
-           col    = "#666666")
+    if (!is.null(country)) {
+
+      if (calendar[i, "date"] %in% offs$"date") {
+
+        rect(xleft   = calendar[i, "x"] - 1,
+             xright  = calendar[i, "x"],
+             ybottom = calendar[i, "y"] - 1,
+             ytop    = calendar[i, "y"],
+             col     = "#efefef",
+             lwd     = 0.75,
+             xpd     = TRUE)
+
+        text(x      = calendar[i, "x"] - 0.50,
+             y      = calendar[i, "y"] - 0.85,
+             labels = paste0("OFF\n", offs[which(offs$"date" == 
+                                                   calendar[i, "date"]), 
+                                           "name"]),
+             cex    = 0.65,
+             font   = 2,
+             col    = "#666666")
+      } 
     }