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