From 2b1a1888210caecbfc66b85b58ef9cd760a73800 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sat, 3 Sep 2022 00:20:45 +0200
Subject: init onboard-unit

---
 lib/Server/ControlRoom.hs | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

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

diff --git a/lib/Server/ControlRoom.hs b/lib/Server/ControlRoom.hs
index 9b61828..86f8deb 100644
--- a/lib/Server/ControlRoom.hs
+++ b/lib/Server/ControlRoom.hs
@@ -75,6 +75,8 @@ mkYesod "ControlRoom" [parseRoutes|
 /token/block/#Token TokenBlock GET
 /trips TripsViewR GET
 /trip/#TripID TripViewR GET
+/obu OnboardUnitMenuR GET
+/obu/#TripID/#Day OnboardUnitR GET
 |]
 
 emptyMarkup :: MarkupM a -> Bool
@@ -308,6 +310,25 @@ getTokenBlock token = do
       redirect (TrainViewR runningTrip runningDay)
     Nothing -> notFound
 
+getOnboardUnitMenuR :: Handler Html
+getOnboardUnitMenuR = do
+  day <- liftIO getCurrentTime <&> utctDay
+  gtfs <- getYesod <&> getGtfs
+  let trips = tripsOnDay gtfs day
+  defaultLayout $ do
+    [whamlet|
+<h1>_{MsgOBU}
+<section>
+  _{MsgChooseTrain}
+  $forall Trip{..} <- trips
+    <hr>
+    <a href="@{OnboardUnitR tripTripID day}">
+      #{tripTripID}: #{stationName (stopStation (V.head tripStops))} #{stopDeparture (V.head tripStops)}
+|]
+
+getOnboardUnitR :: TripID -> Day -> Handler Html
+getOnboardUnitR tripId day =
+  defaultLayout $(whamletFile "site/obu.hamlet")
 
 announceForm :: Day -> TripID -> Html -> MForm Handler (FormResult Announcement, Widget)
 announceForm day tripId = renderDivs $ Announcement
-- 
cgit v1.2.3