From e84f2967a3252f474d9618fb19df6f571c3bc762 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 3 Dec 2022 14:27:49 +0100
Subject: unreasonably stupid and probably unnecessary code

(but maybe google will like it)
---
 lib/GTFS.hs           |  6 ++++++
 lib/Server/GTFS_RT.hs | 17 ++++++++++++-----
 2 files changed, 18 insertions(+), 5 deletions(-)

diff --git a/lib/GTFS.hs b/lib/GTFS.hs
index 3935caa..b83db0f 100644
--- a/lib/GTFS.hs
+++ b/lib/GTFS.hs
@@ -127,6 +127,12 @@ toSeconds (Time seconds _ _) tzseries refday =
   where timezone = timeZoneFromSeries tzseries reftime
         reftime = UTCTime refday (fromInteger $ toInteger seconds)
 
+-- | convert a time to a UTCTime, using the timezone valid on the refday.
+-- Note that this will may fail to be correct in case of trips going across midnight
+toUTC :: Time -> TimeZoneSeries -> Day -> UTCTime
+toUTC time tzseries refday =
+  UTCTime refday (fromInteger $ toInteger $ unSeconds $ toSeconds time tzseries refday)
+
 
 -- | Times in GTFS are given without timezone info, which is handled
 -- seperately (as an attribute of the stop / the agency). We attach that information
diff --git a/lib/Server/GTFS_RT.hs b/lib/Server/GTFS_RT.hs
index 20e6fa7..9da9be9 100644
--- a/lib/Server/GTFS_RT.hs
+++ b/lib/Server/GTFS_RT.hs
@@ -28,7 +28,8 @@ import           Data.Text.Encoding                                           (e
 import           Data.Time.Calendar                                           (Day,
                                                                                toGregorian)
 import           Data.Time.Clock                                              (UTCTime (utctDay),
-                                                                               getCurrentTime)
+                                                                               getCurrentTime,
+                                                                               addUTCTime)
 import           Data.Time.Clock.POSIX                                        (getPOSIXTime)
 import           Data.Time.Clock.System                                       (SystemTime (systemSeconds),
                                                                                getSystemTime,
@@ -46,7 +47,7 @@ import           GTFS                                                         (G
                                                                                Seconds (..),
                                                                                Stop (..),
                                                                                Trip (..),
-                                                                               stationId,
+                                                                               stationId, toUTC,
                                                                                TripID,
                                                                                tripsOnDay)
 import           GTFS.Realtime.Alert                                          as AL (Alert (..))
@@ -110,7 +111,7 @@ toStupidDate date = toUtf8
           where ndigits = length (show num)
 
 -- | basically unix timestamps, raw (because why not i guess)
-toStupidTime :: UTCTime -> Word64
+toStupidTime :: Num i => UTCTime -> i
 toStupidTime = fromIntegral . systemSeconds . utcToSystemTime
 
 gtfsRealtimeServer :: GTFS -> Pool SqlBackend -> Service GtfsRealtimeAPI
@@ -171,9 +172,15 @@ gtfsRealtimeServer gtfs@GTFS{..} dbpool = handleServiceAlerts :<|> handleTripUpd
                              { STU.stop_sequence = Just (fromIntegral stopSequence)
                              , STU.stop_id = Just (toUtf8 $ stationId stopStation)
                              , STU.arrival = Just (
-                                 defaultValue { STE.delay = Just $ fromIntegral $ unSeconds $ trainAnchorDelay, STE.uncertainty = Just 60 })
+                                 defaultValue
+                                 { STE.delay = Just $ fromIntegral $ unSeconds $ trainAnchorDelay
+                                 , STE.time = Just $ (toStupidTime (addUTCTime (fromIntegral $ unSeconds trainAnchorDelay) (toUTC stopArrival tzseries today)))
+                                 , STE.uncertainty = Just 60 })
                              , STU.departure = Just (
-                                 defaultValue { STE.delay = Just $ fromIntegral $ unSeconds $ trainAnchorDelay, STE.uncertainty = Just 60 })
+                                 defaultValue
+                                 { STE.delay = Just $ fromIntegral $ unSeconds $ trainAnchorDelay
+                                 , STE.time = Just $ (toStupidTime (addUTCTime (fromIntegral $ unSeconds trainAnchorDelay) (toUTC stopDeparture tzseries today)))
+                                 , STE.uncertainty = Just 60 })
                              , STU.departure_occupancy_status = Nothing
                              , STU.schedule_relationship = Just SR.SCHEDULED
                              , STU.stop_time_properties = Nothing
-- 
cgit v1.2.3