diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/GTFS.hs | 6 | ||||
| -rw-r--r-- | 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 |