diff options
| -rw-r--r-- | lib/Server/ControlRoom.hs | 121 | ||||
| -rw-r--r-- | messages/de.msg | 13 | ||||
| -rw-r--r-- | messages/en.msg | 3 | ||||
| -rw-r--r-- | tracktrain.cabal | 2 |
4 files changed, 95 insertions, 44 deletions
diff --git a/lib/Server/ControlRoom.hs b/lib/Server/ControlRoom.hs index e3af33f..9ebea42 100644 --- a/lib/Server/ControlRoom.hs +++ b/lib/Server/ControlRoom.hs @@ -46,8 +46,10 @@ import Persist (AmendmentStatus, Announcement (..), runSql) import Server.Util (Service) import Text.Blaze.Html (ToMarkup (..)) +import Text.Blaze.Internal (MarkupM(Empty)) import Text.ProtocolBuffers (Default (defaultValue)) import Text.Read (readMaybe) +import Text.Shakespeare.Text import Yesod import Yesod.Form @@ -72,25 +74,61 @@ mkYesod "ControlRoom" [parseRoutes| /trip/#TripID TripViewR GET |] +emptyMarkup :: MarkupM a -> Bool +emptyMarkup (Empty _) = True +emptyMarkup _ = False + instance Yesod ControlRoom where approot = ApprootMaster (\cr -> getBaseurl cr) defaultLayout w = do - p <- widgetToPageContent w + PageContent{..} <- widgetToPageContent w msgs <- getMessages + withUrlRenderer [hamlet| $newline never $doctype 5 <html> <head> - <title>Tracktrain #{pageTitle p} - $maybe description <- pageDescription p + <title> + $if emptyMarkup pageTitle + Tracktrain + $else + #{pageTitle} + $maybe description <- pageDescription <meta name="description" content="#{description}"> - ^{pageHead p} + ^{pageHead} + <style> + section { + border: 1px solid black; + padding: 1rem; + margin: 2rem; + padding-top: 0; + } + body { + max-width: 50rem; + margin: auto; + } + form { + width:100%; + display: grid; + gap: 1rem; + } + label { + grid-column: 1; + } + form div { + display: grid; + grid-template-columns: 50% 50%; + width:100%; + } + input { + grid-column: 2; + } <body> $forall (status, msg) <- msgs <p class="message #{status}">#{msg} - ^{pageBody p} + ^{pageBody} |] @@ -117,7 +155,7 @@ getTrainsR = do defaultLayout $ do [whamlet| <h1>Trains on #{day} -<ol> +<section><ol> $forall Trip{..} <- trips <li><a href="@{TrainViewR tripTripID day}">#{tripTripID}</a> : #{stopDeparture (V.head tripStops)} #{stationName (stopStation (V.head tripStops))} @@ -131,34 +169,41 @@ getTrainViewR trip day = do Nothing -> notFound Just res@Trip{..} -> do anns <- runDB $ selectList [ AnnouncementTrip ==. trip, AnnouncementDay ==. day ] [] - defaultLayout [whamlet| -<h1><a href="@{TripViewR tripTripID}">#{tripTripID}</a> _{Msgon} <a href="@?{(TrainsR, [("day", T.pack (iso8601Show day))])}">#{day}</a> -<h2>_{MsgAnnouncements} -<ul> - $forall Entity (AnnouncementKey uuid) Announcement{..} <- anns - <li><em>#{announcementHeader}: #{announcementMessage}</em> <a href="@{DelAnnounceR uuid}">delete</a> - $if null anns - <li><em>(_{MsgNone})</em> -<h3>_{MsgNewAnnouncement} -<form method=post action=@{AnnounceR trip day} enctype=#{enctype}> - ^{widget} - <button>Submit -<h2>_{MsgStops} -<ol> - $forall Stop{..} <- tripStops - <div>(#{stopSequence}) #{stopArrival} #{stationName stopStation} - -<h2>Vehicle Position -<div> Todo! + defaultLayout $ 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> +<section> + <h2>_{MsgAnnouncements} + <ul> + $forall Entity (AnnouncementKey uuid) Announcement{..} <- anns + <li><em>#{announcementHeader}: #{announcementMessage}</em> <a href="@{DelAnnounceR uuid}">delete</a> + $if null anns + <li><em>(_{MsgNone})</em> + <h3>_{MsgNewAnnouncement} + <form method=post action=@{AnnounceR trip day} enctype=#{enctype}> + ^{widget} + <button>Submit +<section> + <h2>_{MsgStops} + <ol> + $forall Stop{..} <- tripStops + <li> #{stopArrival} #{stationName stopStation} +<section> + <h2>Vehicle Position + <div> Todo! |] getTripsViewR :: Handler Html getTripsViewR = do GTFS{..} <- getYesod <&> getGtfs - defaultLayout [whamlet| + defaultLayout $ do + setTitle "List of Trips" + [whamlet| <h1>List of Trips -<ul> +<section><ul> $forall Trip{..} <- trips <li><a href="@{TripViewR tripTripID}">#{tripTripID}</a> : #{stopDeparture (V.head tripStops)} #{stationName (stopStation (V.head tripStops))} @@ -172,13 +217,15 @@ getTripViewR tripId = do Nothing -> notFound Just Trip{..} -> defaultLayout [whamlet| <h1>Trip #{tripTripID} -<h2>Stops -<ol> - $forall Stop{..} <- tripStops - <div>(#{stopSequence}) #{stopArrival} #{stationName stopStation} -<h2>Dates -<ul> - TODO! +<section> + <h2>Stops + <ol> + $forall Stop{..} <- tripStops + <div>(#{stopSequence}) #{stopArrival} #{stationName stopStation} +<section> + <h2>Dates + <ul> + TODO! |] @@ -212,10 +259,10 @@ getDelAnnounceR uuid = do announceForm :: Day -> TripID -> Html -> MForm Handler (FormResult Announcement, Widget) announceForm day tripId = renderDivs $ Announcement <$> pure tripId - <*> areq textField "Header" Nothing - <*> areq textField "Text" Nothing + <*> areq textField (fieldSettingsLabel MsgHeader) Nothing + <*> areq textField (fieldSettingsLabel MsgText) Nothing <*> pure day - <*> aopt urlField "Link" Nothing + <*> aopt urlField (fieldSettingsLabel MsgMaybeWeblink) Nothing <*> lift (liftIO getCurrentTime <&> Just) diff --git a/messages/de.msg b/messages/de.msg index bf5ba92..66abf54 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -1,11 +1,12 @@ -Announcements: Informationen +Announcements: Hinweise None: nichts -NewAnnouncement: Neue Information -Header: Kurz -Text: Lang -Link: Link +NewAnnouncement: Neuer Hinweis +Header: Überschrift +Text: Text +MaybeWeblink: Link (optional) TripOnDay tripId day: #{tripId} an #{day} -on: an +on: am +Trip: Fahrt SwitchLanguage: Sprache wechseln Switch: wechseln Stops: Stationen diff --git a/messages/en.msg b/messages/en.msg index f9c5c8c..d8b3be3 100644 --- a/messages/en.msg +++ b/messages/en.msg @@ -3,9 +3,10 @@ None: none NewAnnouncement: New Announcement Header: Header Text: Text -Link: Link +MaybeWeblink: Link (optional) TripOnDay tripId@Text day@String: #{tripId} on #{day} on: on +Trip: Trip SwitchLanguage: Switch language to: Switch: Switch Stops: Stops diff --git a/tracktrain.cabal b/tracktrain.cabal index b02e9a5..a0e4c13 100644 --- a/tracktrain.cabal +++ b/tracktrain.cabal @@ -77,6 +77,7 @@ library , servant-swagger , servant-docs , servant-websockets + , shakespeare , websockets , lens , persistent @@ -95,6 +96,7 @@ library , yesod , yesod-form , blaze-html + , blaze-markup hs-source-dirs: lib exposed-modules: GTFS , Server |