aboutsummaryrefslogtreecommitdiff
path: root/lib/Server/ControlRoom.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Server/ControlRoom.hs')
-rw-r--r--lib/Server/ControlRoom.hs21
1 files changed, 21 insertions, 0 deletions
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