From fb960c660357f9cd4dca57be1325e4ecbb50f649 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Tue, 29 Nov 2022 16:38:21 +0100
Subject: controlroom: show tripShortName instead of tripId

since the ids really should be internal to the gtfs, and not needed in
"normal" contexts.
---
 lib/GTFS.hs               |  5 +++++
 lib/Server/ControlRoom.hs | 23 +++++++++++++++--------
 2 files changed, 20 insertions(+), 8 deletions(-)

(limited to 'lib')

diff --git a/lib/GTFS.hs b/lib/GTFS.hs
index 1fda897..8ff87db 100644
--- a/lib/GTFS.hs
+++ b/lib/GTFS.hs
@@ -639,3 +639,8 @@ runsToday :: MonadIO m => GTFS -> TripID -> m Bool
 runsToday gtfs trip = do
   today <- liftIO getCurrentTime <&> utctDay
   pure (runsOnDay gtfs trip today)
+
+tripName :: Trip a b -> Text
+tripName Trip{..} = case tripShortName of
+  Just name -> name
+  Nothing -> tripTripID
diff --git a/lib/Server/ControlRoom.hs b/lib/Server/ControlRoom.hs
index b1948f2..f291d82 100644
--- a/lib/Server/ControlRoom.hs
+++ b/lib/Server/ControlRoom.hs
@@ -162,8 +162,8 @@ getTrainsR = do
     [whamlet|
 <h1>Trains on #{day}
 <section><ol>
-  $forall Trip{..} <- trips
-    <li><a href="@{TrainViewR tripTripID day}">#{tripTripID}</a>
+  $forall trip@Trip{..} <- trips
+    <li><a href="@{TrainViewR tripTripID day}">#{tripName trip}</a>
         : #{stopDeparture (V.head tripStops)} #{stationName (stopStation (V.head tripStops))}
 |]
 
@@ -184,7 +184,7 @@ getTrainViewR trip day = do
         mr <- getMessageRender
         setTitle (toHtml (""+|mr MsgTrip|+" "+|tripTripID|+" "+|mr Msgon|+" "+|day|+"" :: Text))
         [whamlet|
-<h1>_{MsgTrip} <a href="@{TripViewR tripTripID}">#{tripTripID}</a> _{Msgon} <a href="@?{(TrainsR, [("day", T.pack (iso8601Show day))])}">#{day}</a>
+<h1>_{MsgTrip} <a href="@{TripViewR tripTripID}">#{tripName res}</a> _{Msgon} <a href="@?{(TrainsR, [("day", T.pack (iso8601Show day))])}">#{day}</a>
 <section>
   <h2>_{MsgLive}
   <p><strong>_{MsgLastPing}: </strong>
@@ -246,8 +246,8 @@ getTripsViewR = do
     [whamlet|
 <h1>List of Trips
 <section><ul>
-  $forall Trip{..} <- trips
-    <li><a href="@{TripViewR tripTripID}">#{tripTripID}</a>
+  $forall trip@Trip{..} <- trips
+    <li><a href="@{TripViewR tripTripID}">#{tripName trip}</a>
       : #{stopDeparture (V.head tripStops)} #{stationName (stopStation (V.head tripStops))}
 |]
 
@@ -257,8 +257,13 @@ getTripViewR tripId = do
   GTFS{..} <- getYesod <&> getGtfs
   case M.lookup tripId trips of
     Nothing -> notFound
-    Just Trip{..} -> defaultLayout [whamlet|
-<h1>Trip #{tripTripID}
+    Just trip@Trip{..} -> defaultLayout [whamlet|
+<h1>Trip #{tripName trip}
+<section>
+  <h2>Info
+  <p><strong>_{MsgtripId}:</strong> #{tripTripID}
+  <p><strong>_{MsgtripHeadsign}:</strong> #{mightbe tripHeadsign}
+  <p><strong>_{MsgtripShortname}:</strong> #{mightbe tripShortName}
 <section>
   <h2>Stops
   <ol>
@@ -339,7 +344,9 @@ announceForm day tripId = renderDivs $ Announcement
   <*> aopt urlField (fieldSettingsLabel MsgMaybeWeblink) Nothing
   <*> lift (liftIO getCurrentTime <&> Just)
 
-
+mightbe :: Maybe Text -> Text
+mightbe (Just a) = a
+mightbe Nothing = ""
 
 --- some orphans to make hamlet easier to deal with
 instance ToMarkup Time where
-- 
cgit v1.2.3