aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorstuebinm2022-08-26 02:36:39 +0200
committerstuebinm2022-08-26 02:36:39 +0200
commit6fa510d35f0ca8738df7274bf6f02ad75a987f60 (patch)
treeb6772a90d5bdb58f195a9413edb83b838887a21f
parent4307e3aa7c42b7d28c552439e2d7fce232fe2598 (diff)
controlroom: some styling
Diffstat (limited to '')
-rw-r--r--lib/Server/ControlRoom.hs121
-rw-r--r--messages/de.msg13
-rw-r--r--messages/en.msg3
-rw-r--r--tracktrain.cabal2
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 17:40:28 +0000