gtfs-rt: discard old trips from tripupdates feed

google maps complains about it otherwise

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