aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/GTFS.hs6
-rw-r--r--lib/Server/GTFS_RT.hs17
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