space time diagrams: real time & time zones

1 files changed, 36 insertions, 29 deletions

diff --git a/lib/Server/Frontend/Tickets.hs b/lib/Server/Frontend/Tickets.hs
index 43f24aa..ef80d42 100644
--- a/lib/Server/Frontend/Tickets.hs
+++ b/lib/Server/Frontend/Tickets.hs
@@ -15,39 +15,41 @@ module Server.Frontend.Tickets
 
 import           Server.Frontend.Routes
 
-import           Config                   (ServerConfig (..), UffdConfig (..))
-import           Control.Monad            (forM, forM_, join)
-import           Control.Monad.Extra      (maybeM)
-import           Control.Monad.IO.Class   (MonadIO (liftIO))
-import           Data.Coerce              (coerce)
-import           Data.Function            (on, (&))
-import           Data.Functor             ((<&>))
-import           Data.List                (lookup, nubBy)
-import           Data.List.NonEmpty       (nonEmpty)
-import           Data.Map                 (Map)
-import qualified Data.Map                 as M
-import           Data.Maybe               (catMaybes, fromJust, isJust)
-import           Data.Text                (Text)
-import qualified Data.Text                as T
-import           Data.Time                (UTCTime (..), addDays,
-                                           getCurrentTime, utctDay)
-import           Data.Time.Calendar       (Day)
-import           Data.Time.Format.ISO8601 (iso8601Show)
-import           Data.UUID                (UUID)
-import qualified Data.UUID                as UUID
-import qualified Data.Vector              as V
-import           Extrapolation            (Extrapolator (..),
-                                           LinearExtrapolator (..))
-import           Fmt                      ((+|), (|+))
-import           GHC.Float                (int2Double)
+import           Config                    (ServerConfig (..), UffdConfig (..))
+import           Control.Monad             (forM, forM_, join)
+import           Control.Monad.Extra       (maybeM)
+import           Control.Monad.IO.Class    (MonadIO (liftIO))
+import           Data.Coerce               (coerce)
+import           Data.Function             (on, (&))
+import           Data.Functor              ((<&>))
+import           Data.List                 (lookup, nubBy)
+import           Data.List.NonEmpty        (nonEmpty)
+import           Data.Map                  (Map)
+import qualified Data.Map                  as M
+import           Data.Maybe                (catMaybes, fromJust, isJust)
+import           Data.Text                 (Text)
+import qualified Data.Text                 as T
+import           Data.Time                 (UTCTime (..), addDays,
+                                            getCurrentTime, utctDay)
+import           Data.Time.Calendar        (Day)
+import           Data.Time.Format.ISO8601  (iso8601Show)
+import           Data.UUID                 (UUID)
+import qualified Data.UUID                 as UUID
+import qualified Data.Vector               as V
+import           Extrapolation             (Extrapolator (..),
+                                            LinearExtrapolator (..))
+import           Fmt                       ((+|), (|+))
+import           GHC.Float                 (int2Double)
 import qualified GTFS
-import           Numeric                  (showFFloat)
+import           Numeric                   (showFFloat)
 import           Persist
-import           Server.Util              (Service, secondsNow)
-import           Text.Read                (readMaybe)
+import           Server.Frontend.SpaceTime (mkSpaceTimeDiagram,
+                                            mkSpaceTimeDiagramHandler)
+import           Server.Util               (Service, secondsNow)
+import           Text.Read                 (readMaybe)
 import           Yesod
 import           Yesod.Auth
-import           Yesod.Auth.Uffd          (UffdUser (..), uffdClient)
+import           Yesod.Auth.Uffd           (UffdUser (..), uffdClient)
 
 
 getTicketsR :: Handler Html
@@ -61,6 +63,8 @@ getTicketsR = do
       Just day -> (day, day == today)
       Nothing  -> (today, True)
 
+  maybeSpaceTime <- mkSpaceTimeDiagramHandler day
+
   let prevday = (T.pack . iso8601Show . addDays (-1))  day
   let nextday = (T.pack . iso8601Show . addDays 1) day
   gtfs <- getYesod <&> getGtfs
@@ -94,6 +98,9 @@ $maybe name <- mdisplayname
          : _{Msgdep} #{stopDeparture (head stops)} #{stationName startStation} → #{ticketHeadsign}
    $if null tickets
      <li style="text-align: center"><em>(_{MsgNone})</em>
+$maybe spaceTime <- maybeSpaceTime
+  <section>
+    ^{spaceTime}
 <section>
   <h2>_{MsgAccordingToGtfs}
   <form method=post action="@{GtfsTicketImportR day}" enctype=#{enctype}>