diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/Server.hs | 15 | ||||
| -rw-r--r-- | lib/Server/ControlRoom.hs | 6 | ||||
| -rw-r--r-- | lib/Server/GTFS_RT.hs | 3 |
3 files changed, 14 insertions, 10 deletions
diff --git a/lib/Server.hs b/lib/Server.hs index 7fdfd71..d6e9955 100644 --- a/lib/Server.hs +++ b/lib/Server.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleContexts #-} @@ -7,14 +8,14 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE DataKinds #-} -- Implementation of the API. This module is the main point of the program. module Server (application) where import Control.Concurrent.STM (TQueue, TVar, atomically, - newTQueue, newTVar, readTQueue, - readTVar, writeTQueue, writeTVar, newTVarIO) + newTQueue, newTVar, newTVarIO, + readTQueue, readTVar, writeTQueue, + writeTVar) import Control.Monad (forever, unless, void, when) import Control.Monad.Catch (handle) import Control.Monad.Extra (ifM, maybeM, unlessM, whenJust, @@ -23,8 +24,8 @@ import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Logger (LoggingT, logWarnN) import Control.Monad.Reader (forM) import Control.Monad.Trans (lift) -import qualified Data.Aeson as A import Data.Aeson ((.=)) +import qualified Data.Aeson as A import qualified Data.ByteString.Char8 as C8 import Data.Coerce (coerce) import Data.Functor ((<&>)) @@ -45,7 +46,9 @@ import Fmt ((+|), (|+)) import qualified Network.WebSockets as WS import Servant (Application, ServerError (errBody), err401, - err404, serve, throwError, serveDirectoryFileServer) + err404, serve, + serveDirectoryFileServer, + throwError) import Servant.API (NoContent (..), (:<|>) (..)) import Servant.Server (Handler, hoistServer) import Servant.Swagger (toSwagger) @@ -90,7 +93,7 @@ server gtfs@GTFS{..} Metrics{..} subscribers dbpool settings = handleDebugAPI :<|> (handleStations :<|> handleTimetable :<|> handleTimetableStops :<|> handleTrip :<|> handleRegister :<|> handleTrainPing (throwError err401) :<|> handleWS :<|> handleSubscribe :<|> handleDebugState :<|> handleDebugTrain - :<|> handleDebugRegister :<|> gtfsRealtimeServer gtfs dbpool) + :<|> handleDebugRegister :<|> pure gtfsFile :<|> gtfsRealtimeServer gtfs dbpool) :<|> metrics :<|> serveDirectoryFileServer (serverConfigAssets settings) :<|> pure (unsafePerformIO (toWaiAppPlain (ControlRoom gtfs dbpool settings))) diff --git a/lib/Server/ControlRoom.hs b/lib/Server/ControlRoom.hs index 9cde587..8fef7f9 100644 --- a/lib/Server/ControlRoom.hs +++ b/lib/Server/ControlRoom.hs @@ -31,8 +31,8 @@ import qualified Data.Map as M import Data.Pool (Pool) import Data.Text (Text) import qualified Data.Text as T -import Data.Time (UTCTime (..), getCurrentTime, - utctDay, addDays) +import Data.Time (UTCTime (..), addDays, + getCurrentTime, utctDay) import Data.Time.Calendar (Day) import Data.Time.Format.ISO8601 (iso8601Show) import Data.UUID (UUID) @@ -194,7 +194,7 @@ getTrainsR = do (day, isToday) <- liftIO $ getCurrentTime <&> utctDay <&> \today -> case maybeDay of Just day -> (day, day == today) - Nothing -> (today, True) + Nothing -> (today, True) let prevday = (T.pack . iso8601Show . addDays (-1)) day let nextday = (T.pack . iso8601Show . addDays 1) day diff --git a/lib/Server/GTFS_RT.hs b/lib/Server/GTFS_RT.hs index 984e19d..5b485df 100644 --- a/lib/Server/GTFS_RT.hs +++ b/lib/Server/GTFS_RT.hs @@ -91,7 +91,8 @@ import Data.UUID (t import qualified Data.Vector as V import Extrapolation (Extrapolator (extrapolateAtPosition, extrapolateAtSeconds), LinearExtrapolator (..)) -import GTFS (Depth (..), showTimeWithSeconds) +import GTFS (Depth (..), + showTimeWithSeconds) import GTFS.Realtime.TripUpdate (TripUpdate (TripUpdate)) import Server.Util (Service, secondsNow) |