From daf446f05fddc45803bffb34b1b2d24f58122802 Mon Sep 17 00:00:00 2001
From: Flavio Poletti <flavio.poletti@hotmail.ch>
Date: Thu, 17 Oct 2024 17:10:51 +0200
Subject: [PATCH] warn in set_servicepattern() if feed has no dates available

instead of erroring without an explicit message later on
---
 R/dates.R                     |  4 ++--
 R/frequencies.R               |  2 +-
 R/service.R                   |  5 +++++
 R/utils.R                     | 16 +++++++++++++++-
 tests/testthat/test-service.R |  3 +++
 5 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/R/dates.R b/R/dates.R
index 4b87417..244a79e 100644
--- a/R/dates.R
+++ b/R/dates.R
@@ -17,8 +17,8 @@
 #' @importFrom stats reshape
 #' @keywords internal
 set_dates_services <- function(gtfs_obj) {
-  has_calendar = feed_contains(gtfs_obj, "calendar") && nrow(gtfs_obj[["calendar"]]) > 0
-  has_calendar_dates = feed_contains(gtfs_obj, "calendar_dates") && nrow(gtfs_obj[["calendar_dates"]]) > 0
+  has_calendar = feed_has_non_empty_table(gtfs_obj, "calendar")
+  has_calendar_dates = feed_has_non_empty_table(gtfs_obj, "calendar_dates")
   
   # check date validity 
   if(!has_calendar && !has_calendar_dates) {
diff --git a/R/frequencies.R b/R/frequencies.R
index 615c1cb..c896b69 100644
--- a/R/frequencies.R
+++ b/R/frequencies.R
@@ -108,7 +108,7 @@ get_route_frequency <- function(gtfs_obj,
                                 service_ids = NULL) {
   total_departures <- median_headways <- mean_headways <- NULL
   n_departures <- mean_headway <- st_dev_headways <- stop_count <- NULL
-  if(feed_contains(gtfs_obj, "frequencies") && nrow(gtfs_obj$frequencies) > 0) {  
+  if(feed_has_non_empty_table(gtfs_obj, "frequencies")) {  
     message("A pre-calculated frequencies dataframe exists for this feed already, consider using that.") 
   } 
   departures_per_stop = get_stop_frequency(gtfs_obj, start_time, end_time, 
diff --git a/R/service.R b/R/service.R
index 0ad699e..73fecc0 100644
--- a/R/service.R
+++ b/R/service.R
@@ -18,6 +18,11 @@
 #' @importFrom rlang .data
 #' @export
 set_servicepattern <- function(gtfs_obj, id_prefix = "s_", hash_algo = "md5", hash_length = 7) {
+  if(!feed_has_non_empty_table(gtfs_obj, "calendar") && !feed_has_non_empty_table(gtfs_obj, "calendar_dates")) {
+    warning("No dates defined in feed")
+    return(gtfs_obj)
+  }
+  
   get_servicepattern_id <- function(dates) {
     hash <- digest(dates, hash_algo)
     id <- paste0(id_prefix, substr(hash, 0, hash_length))
diff --git a/R/utils.R b/R/utils.R
index 6838199..f940ead 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -8,6 +8,20 @@ feed_contains <- function(gtfs_obj, table_name) {
     (exists(".", where = gtfs_obj) && exists(table_name, where = gtfs_obj$.))
 }
 
+feed_has_non_empty_table <- function(gtfs_obj, table_name) {
+  if(exists(table_name, where = gtfs_obj)) {
+    if(nrow(gtfs_obj[[table_name]]) > 0) {
+      return(TRUE)
+    }
+  } else if(exists(".", where = gtfs_obj) && exists(table_name, where = gtfs_obj$.)) {
+    if(nrow(gtfs_obj[["."]][[table_name]]) > 0) {
+      return(TRUE)
+    }
+  }
+  return(FALSE)
+}
+
+
 #' Convert empty strings ("") to NA values in all gtfs tables
 #' 
 #' @param gtfs_obj gtfs feed (tidygtfs object)
@@ -55,7 +69,7 @@ gather_dt = function(df_wide, new_key_colname, new_val_colname,
                      value_colnames) {
   dt = as.data.table(df_wide)
   dt_melted = data.table::melt(dt, measure.vars = value_colnames,
-       variable.name = new_key_colname, value.name = new_val_colname)
+                               variable.name = new_key_colname, value.name = new_val_colname)
   
   return(dt_melted)
 }
diff --git a/tests/testthat/test-service.R b/tests/testthat/test-service.R
index f88834e..decfd93 100644
--- a/tests/testthat/test-service.R
+++ b/tests/testthat/test-service.R
@@ -11,6 +11,9 @@ test_that("set_servicepattern", {
   )
   g <- set_servicepattern(g)
   expect_equal(length(unique(g$.$servicepatterns$servicepattern_id)), length(unique(gtfs_orig$calendar$service_id)))
+  g$calendar <- g$calendar[0,]
+  g$calendar_dates <- g$calendar_dates[0,]
+  expect_warning(set_servicepattern(g), "No dates defined in feed")
 })
 
 test_that("set_servicepattern w/ more params", {