diff options
| -rw-r--r-- | lib/Server/GTFS_RT.hs | 19 |
1 files changed, 12 insertions, 7 deletions
diff --git a/lib/Server/GTFS_RT.hs b/lib/Server/GTFS_RT.hs index 5b485df..70f3c63 100644 --- a/lib/Server/GTFS_RT.hs +++ b/lib/Server/GTFS_RT.hs @@ -4,7 +4,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} module Server.GTFS_RT (gtfsRealtimeServer) where @@ -18,7 +17,8 @@ import qualified Data.ByteString.Char8 as import Data.ByteString.Lazy (fromStrict) import Data.Functor ((<&>)) import qualified Data.Map as M -import Data.Maybe (catMaybes) +import Data.Maybe (catMaybes, + mapMaybe) import Data.Pool (Pool) import Data.Sequence (Seq) import qualified Data.Sequence as Seq @@ -43,12 +43,15 @@ import Database.Persist (E import Database.Persist.Postgresql (SqlBackend) import GHC.Float (double2Float, int2Double) -import GTFS (GTFS (..), +import GTFS (Depth (..), + GTFS (..), Seconds (..), Stop (..), Trip (..), TripID, + showTimeWithSeconds, stationId, + toSeconds, toUTC, tripsOnDay) import GTFS.Realtime.Alert as AL (Alert (..)) @@ -91,8 +94,6 @@ import Data.UUID (t import qualified Data.Vector as V import Extrapolation (Extrapolator (extrapolateAtPosition, extrapolateAtSeconds), LinearExtrapolator (..)) -import GTFS (Depth (..), - showTimeWithSeconds) import GTFS.Realtime.TripUpdate (TripUpdate (TripUpdate)) import Server.Util (Service, secondsNow) @@ -160,13 +161,17 @@ gtfsRealtimeServer gtfs@GTFS{..} dbpool = handleServiceAlerts :<|> handleTripUpd Just anchors -> pure $ Just (tripId, trip, anchors) - dFeedMessage $ Seq.fromList $ fmap (mkTripUpdate today nowSeconds) anchors + dFeedMessage $ Seq.fromList $ mapMaybe (mkTripUpdate today nowSeconds) anchors where mkTripUpdate today nowSeconds (tripId :: Text, Trip{..} :: Trip Deep Deep, anchors) = let lastCall = extrapolateAtSeconds LinearExtrapolator anchors nowSeconds stations = tripStops <&> (\stop@Stop{..} -> (, stop) <$> extrapolateAtPosition LinearExtrapolator anchors (int2Double stopSequence)) + (lastAnchor, lastStop) = V.last (V.catMaybes stations) + stillRunning = trainAnchorDelay lastAnchor + toSeconds (stopArrival lastStop) tzseries today + < nowSeconds + 5 * 60 -- note: these IDs should be stable across iterations, so just do tripId + runningday. TODO: breaks in case of cross-midnight? - in (dFeedEntity (Utf8 $ fromStrict (encodeUtf8 tripId <> "-" <> C8.pack (iso8601Show today)))) + in if not stillRunning then Nothing else Just + (dFeedEntity (Utf8 $ fromStrict (encodeUtf8 tripId <> "-" <> C8.pack (iso8601Show today)))) { FE.trip_update = Just $ TripUpdate { TU.trip = dTripDescriptor tripId (Just today) (Just $ toUtf8 $ T.pack $ showTimeWithSeconds $ stopDeparture $ V.head tripStops) -- TODO will break if cross-midnight train , TU.vehicle = Nothing |