From a4045a5b0a898042cd78eba9b22550c965a1bbd9 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 27 Aug 2022 01:45:12 +0200
Subject: controlroom: lots of pretty little knobs

(also some database schema changes, for good measure)
---
 lib/Server/GTFS_RT.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

(limited to 'lib/Server/GTFS_RT.hs')

diff --git a/lib/Server/GTFS_RT.hs b/lib/Server/GTFS_RT.hs
index d771736..dfdd1eb 100644
--- a/lib/Server/GTFS_RT.hs
+++ b/lib/Server/GTFS_RT.hs
@@ -51,8 +51,8 @@ import           GTFS.Realtime.VehiclePosition              as VP (VehiclePositi
 import           Persist                                    (Announcement (..),
                                                              EntityField (..),
                                                              Key (..),
-                                                             RunningTrip (..),
-                                                             TripPing (..),
+                                                             Running (..),
+                                                             TrainPing (..),
                                                              runSql)
 import           Servant.API                                ((:<|>) (..))
 import           Text.ProtocolBuffers                       (Utf8 (Utf8),
@@ -115,15 +115,15 @@ gtfsRealtimeServer gtfs dbpool = handleServiceAlerts :<|> handleTripUpdates :<|>
           -- TODO: how to propagate delay values to next stops?
           pure undefined
         handleVehiclePositions = runSql dbpool $ do
-          (running :: [Entity RunningTrip]) <- selectList [] []
+          (running :: [Entity Running]) <- selectList [] []
           pings <- forM running $ \(Entity key entity) -> do
-            selectFirst [TripPingToken ==. key] [] <&> fmap (, entity)
+            selectFirst [TrainPingToken ==. key] [] <&> fmap (, entity)
           dFeedMessage $ Seq.fromList $ mkPosition <$> catMaybes pings
-          where mkPosition (Entity (TripPingKey key) TripPing{..}, RunningTrip{..}) =
+          where mkPosition (Entity (TrainPingKey key) TrainPing{..}, Running{..}) =
                   (dFeedEntity (toUtf8 . T.pack . show $ key))
                   { FE.vehicle = Just $ VehiclePosition
-                    { trip = Just (dTripDescriptor runningTripTripNumber Nothing)
-                    , VP.vehicle = case runningTripVehicle of
+                    { trip = Just (dTripDescriptor runningTrip Nothing)
+                    , VP.vehicle = case runningVehicle of
                         Nothing -> Nothing
                         Just trainset -> Just $ VehicleDescriptor
                              { VD.id = Nothing
@@ -132,8 +132,8 @@ gtfsRealtimeServer gtfs dbpool = handleServiceAlerts :<|> handleTripUpdates :<|>
                              , VD.ext'field = defaultValue
                              }
                     , position = Just $ Position
-                      { latitude = double2Float tripPingLat
-                      , longitude = double2Float tripPingLong
+                      { latitude = double2Float trainPingLat
+                      , longitude = double2Float trainPingLong
                       , odometer = Nothing
                       , speed = Nothing
                       , bearing = Nothing
@@ -143,7 +143,7 @@ gtfsRealtimeServer gtfs dbpool = handleServiceAlerts :<|> handleTripUpdates :<|>
                     , current_stop_sequence = Nothing
                     , stop_id = Nothing
                     , current_status = Nothing
-                    , timestamp = Just (toStupidTime tripPingTimestamp)
+                    , timestamp = Just (toStupidTime trainPingTimestamp)
                     , congestion_level = Nothing
                     , occupancy_status = Nothing
                     , occupancy_percentage = Nothing
-- 
cgit v1.2.3