{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} module Server.Frontend.SpaceTime (getSpaceTimeDiagramR, mkSpaceTimeDiagram, mkSpaceTimeDiagramHandler) where import Server.Frontend.Routes import Control.Monad (forM, when) import Data.Coerce (coerce) import Data.Function (on, (&)) import Data.Functor ((<&>)) import Data.Graph (path) import Data.List import qualified Data.Map as M import Data.Maybe (catMaybes, mapMaybe) import Data.Text (Text) import qualified Data.Text as T import Data.Time (Day, UTCTime (..), getCurrentTime) import qualified Data.Vector as V import Fmt ((+|), (|+)) import GHC.Float (double2Int, int2Double) import GTFS (Seconds (unSeconds)) import qualified GTFS import Persist import Server.Util (getTzseries) import Text.Blaze.Html (Html) import Text.Read (readMaybe) import Yesod getSpaceTimeDiagramR :: Handler Html getSpaceTimeDiagramR = do req <- getRequest day <- case lookup "day" (reqGetParams req) >>= (readMaybe . T.unpack) of Just day -> pure day Nothing -> liftIO $ getCurrentTime <&> utctDay mkSpaceTimeDiagramHandler day >>= \case Nothing -> notFound Just widget -> defaultLayout [whamlet|