feat: get month & weekday names utilities

NAMESPACE

@@ -2,6 +2,8 @@
 
 export(filter_events)
 export(get_calendar)
+export(get_month_name)
+export(get_weekday_name)
 export(number_of_days)
 export(plot_calendar)
 importFrom(grDevices,cairo_pdf)

R/get_month_name.R

@@ -0,0 +1,68 @@
+#' Get the name of a month
+#'
+#' @param month an `integer` of length 1. The month to convert in letters.
+#' 
+#' @param lang a `character` of length 1. Used to change the default locale
+#'   (i.e. the language). Default is `NULL` (i.e. use the current locale).
+#'   See examples below. Depending on the OS and the locale, the output can be
+#'   weird.
+#'
+#' @return A `character` of length 1.
+#' 
+#' @export
+#'
+#' @examples
+#' get_month_name(month = 4)
+#' get_month_name(month = 4, lang = "spanish")
+#' get_month_name(month = 4, lang = "finnish")
+
+get_month_name <- function(month, lang = NULL) {
+
+  if (missing(month)) {
+    stop("Argument 'month' is required", call. = FALSE)
+  }
+
+  if (!is.numeric(month)) {
+    stop("Argument 'month' must be a numeric", call. = FALSE)
+  }
+
+  if (length(month) != 1) {
+    stop("Argument 'month' must be a numeric of length 1", call. = FALSE)
+  }
+
+  if (!(month %in% 1:12)) {
+    stop("Argument 'month' must be between 1 and 12", call. = FALSE)
+  }
+
+
+  ## Switch locale ----
+
+  if (!is.null(lang)) {
+
+    o_warn <- options()$"warn"
+
+    lc_time    <- Sys.getlocale("LC_TIME")
+    lc_ctype   <- Sys.getlocale("LC_CTYPE")
+    lc_collate <- Sys.getlocale("LC_COLLATE")
+
+    on.exit(options("warn" = o_warn), add = TRUE)
+    on.exit(Sys.setlocale("LC_TIME",    lc_time), add = TRUE)
+    on.exit(Sys.setlocale("LC_CTYPE",   lc_ctype), add = TRUE)
+    on.exit(Sys.setlocale("LC_COLLATE", lc_collate), add = TRUE)
+
+    options("warn" = -1)
+    Sys.setlocale("LC_TIME",    lang)
+    Sys.setlocale("LC_CTYPE",   lang)
+    Sys.setlocale("LC_COLLATE", lang)
+  }
+
+
+  ## Create date ----
+
+  day <- paste(1970, month, 1, sep = "-")
+
+
+  ## Get month name ----
+
+  tools::toTitleCase(format(as.Date(day), "%B"))
+}

R/get_weekday_name.R

@@ -0,0 +1,74 @@
+#' Get the weekday name of a date
+#'
+#' @param date either a `character` or a `Date` of length 1. The date to extract
+#'   the weekday name. See examples below.
+#' 
+#' @param format a `character` of length 1. Used to specify the format of the 
+#'   date. Default is `"%Y-%m-%d"` (i.e. 2024-12-25). See examples below.
+#' 
+#' @param lang a `character` of length 1. Used to change the default locale
+#'   (i.e. the language). Default is `NULL` (i.e. use the current locale).
+#'   See examples below. Depending on the OS and the locale, the output can be
+#'   weird.
+#'
+#' @return A `character` of length 1.
+#' 
+#' @export
+#'
+#' @examples
+#' get_weekday_name("2024-04-01")
+#' get_weekday_name("01/04/2024", format = "%d/%m/%Y")
+#' get_weekday_name("2024-04-01", lang = "spanish")
+#' get_weekday_name("2024-04-01", lang = "finnish")
+
+get_weekday_name <- function(date, format = "%Y-%m-%d", lang = NULL) {
+
+  if (missing(date)) {
+    stop("Argument 'date' is required", call. = FALSE)
+  }
+
+  if (!is.character(date) && !inherits(date, "Date")) {
+    stop("Argument 'date' must be either a character or a Date", call. = FALSE)
+  }
+
+  if (length(date) != 1) {
+    stop("Argument 'date' must be of length 1", call. = FALSE)
+  }
+
+  if (!inherits(date, "Date")) {
+    date <- as.Date(date, format = format)
+  }
+
+  if (any(is.na(date))) {
+    stop("Error in converting date. Please use the argument 'format' to ", 
+         "specify the appropriate format. See '?strptime' for further ", 
+         "information", call. = FALSE)
+  }
+
+
+  ## Switch locale ----
+
+  if (!is.null(lang)) {
+
+    o_warn <- options()$"warn"
+
+    lc_time    <- Sys.getlocale("LC_TIME")
+    lc_ctype   <- Sys.getlocale("LC_CTYPE")
+    lc_collate <- Sys.getlocale("LC_COLLATE")
+
+    on.exit(options("warn" = o_warn), add = TRUE)
+    on.exit(Sys.setlocale("LC_TIME",    lc_time), add = TRUE)
+    on.exit(Sys.setlocale("LC_CTYPE",   lc_ctype), add = TRUE)
+    on.exit(Sys.setlocale("LC_COLLATE", lc_collate), add = TRUE)
+
+    options("warn" = -1)
+    Sys.setlocale("LC_TIME",    lang)
+    Sys.setlocale("LC_CTYPE",   lang)
+    Sys.setlocale("LC_COLLATE", lang)
+  }
+
+
+  ## Get weekday name ----
+
+  tools::toTitleCase(format(as.Date(date), "%A"))
+}