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 +++++++++++++++--------
 messages/en.msg           |  3 +++
 3 files changed, 23 insertions(+), 8 deletions(-)

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
diff --git a/messages/en.msg b/messages/en.msg
index ac6aca0..161b716 100644
--- a/messages/en.msg
+++ b/messages/en.msg
@@ -7,6 +7,9 @@ MaybeWeblink: Link (optional)
 TripOnDay tripId@Text day@String: #{tripId} on #{day}
 on: on
 Trip: Trip
+tripId: Trip Id
+tripHeadsign: Headsign
+tripShortname: Short Name
 SwitchLanguage: Switch language to:
 Switch: Switch
 Stops: Stops
-- 
cgit v1.2.3