aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lib/Server/GTFS_RT.hs19
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