aboutsummaryrefslogtreecommitdiff
path: root/lib/Server
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Server')
-rw-r--r--lib/Server/Frontend/Ticker.hs18
-rw-r--r--lib/Server/Frontend/Tickets.hs75
-rw-r--r--lib/Server/GTFS_RT.hs10
-rw-r--r--lib/Server/Ingest.hs20
-rw-r--r--lib/Server/Subscribe.hs37
5 files changed, 83 insertions, 77 deletions
diff --git a/lib/Server/Frontend/Ticker.hs b/lib/Server/Frontend/Ticker.hs
index 7fc2874..8813200 100644
--- a/lib/Server/Frontend/Ticker.hs
+++ b/lib/Server/Frontend/Ticker.hs
@@ -1,15 +1,15 @@
-{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE QuasiQuotes #-}
module Server.Frontend.Ticker (tickerWidget, postTickerAnnounceR, postTickerDeleteR) where
-import Data.Functor ((<&>))
-import Data.Time (getCurrentTime)
-import Persist (EntityField (TickerAnnouncementArchived),
- TickerAnnouncement (..))
-import Server.Frontend.Routes (FrontendMessage (..), Handler,
- Route (..), Widget)
-import Yesod hiding ((==.), (=.), update)
-import Database.Esqueleto.Experimental hiding ((<&>))
+import Data.Functor ((<&>))
+import Data.Time (getCurrentTime)
+import Database.Esqueleto.Experimental hiding ((<&>))
+import Persist (EntityField (TickerAnnouncementArchived),
+ TickerAnnouncement (..))
+import Server.Frontend.Routes (FrontendMessage (..), Handler,
+ Route (..), Widget)
+import Yesod hiding (update, (=.), (==.))
tickerAnnounceForm
diff --git a/lib/Server/Frontend/Tickets.hs b/lib/Server/Frontend/Tickets.hs
index fc7d777..76146df 100644
--- a/lib/Server/Frontend/Tickets.hs
+++ b/lib/Server/Frontend/Tickets.hs
@@ -1,8 +1,8 @@
+{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE BlockArguments #-}
module Server.Frontend.Tickets
( getTicketsR
@@ -16,47 +16,50 @@ 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.Frontend.SpaceTime (mkSpaceTimeDiagram,
- mkSpaceTimeDiagramHandler)
-import Server.Frontend.Ticker (tickerWidget)
-import Server.Util (Service, secondsNow)
-import Text.Read (readMaybe)
-import Yesod hiding ((==.), (||.), delete, update, (=.))
+import Server.Frontend.SpaceTime (mkSpaceTimeDiagram,
+ mkSpaceTimeDiagramHandler)
+import Server.Frontend.Ticker (tickerWidget)
+import Server.Util (Service, secondsNow)
+import Text.Read (readMaybe)
import qualified Yesod
+import Yesod hiding (delete, update, (=.),
+ (==.), (||.))
import Yesod.Auth
-import Yesod.Auth.Uffd (UffdUser (..), uffdClient)
+import Yesod.Auth.Uffd (UffdUser (..), uffdClient)
-import Database.Esqueleto.Experimental hiding ((<&>), on) -- , on, delete, update, (=.))
+import Database.Esqueleto.Experimental (asc, associateJoin, orderBy,
+ where_, (:&) (..), (^.))
+import Database.Esqueleto.Experimental hiding (on, (<&>))
import qualified Database.Esqueleto.Experimental as E
-import Database.Esqueleto.Experimental ((^.), (:&)(..), where_, orderBy, asc, associateJoin)
getTicketsR :: Handler Html
getTicketsR = do
diff --git a/lib/Server/GTFS_RT.hs b/lib/Server/GTFS_RT.hs
index 532af89..4b16a5b 100644
--- a/lib/Server/GTFS_RT.hs
+++ b/lib/Server/GTFS_RT.hs
@@ -8,6 +8,7 @@
module Server.GTFS_RT (gtfsRealtimeServer) where
import API (GtfsRealtimeAPI)
+import Config (ServerConfig (..))
import Control.Lens ((&), (.~))
import Control.Monad (forM)
import Control.Monad.Extra (mapMaybeM)
@@ -45,16 +46,15 @@ import GTFS (Depth (..), GTFS (..),
toSeconds, toUTC, tripsOnDay)
import Persist (Announcement (..),
EntityField (..), Key (..),
- Station (..), Stop (..),
- Ticket (..), TrackerId (..),
- Tracker (..), TrainAnchor (..),
- Ping (..), latitude,
+ Ping (..), Station (..),
+ Stop (..), Ticket (..),
+ Tracker (..), TrackerId (..),
+ TrainAnchor (..), latitude,
longitude, runSql)
import qualified Proto.GtfsRealtime as RT
import qualified Proto.GtfsRealtime_Fields as RT
import Servant.API ((:<|>) (..))
import Server.Util (Service, secondsNow)
-import Config (ServerConfig (..))
-- | formats a day in the "stupid" format used by gtfs realtime
toStupidDate :: Day -> Text
diff --git a/lib/Server/Ingest.hs b/lib/Server/Ingest.hs
index 363088c..8e122a7 100644
--- a/lib/Server/Ingest.hs
+++ b/lib/Server/Ingest.hs
@@ -13,9 +13,9 @@ import Control.Monad.Catch (handle)
import Control.Monad.Extra (ifM, mapMaybeM, whenJust,
whenJustM)
import Control.Monad.IO.Class (MonadIO (liftIO))
-import Control.Monad.Logger (LoggingT, logInfoN,
- logErrorN,
- logWarnN, logDebugN)
+import Control.Monad.Logger (LoggingT, logDebugN,
+ logErrorN, logInfoN,
+ logWarnN)
import Control.Monad.Reader (ReaderT)
import qualified Data.Aeson as A
import qualified Data.ByteString.Char8 as C8
@@ -37,7 +37,8 @@ import Fmt ((+|), (|+))
import qualified GTFS
import qualified Network.WebSockets as WS
import Persist
-import Servant (err400, err401, throwError)
+import Servant (err400, err401,
+ throwError)
import Servant.Server (Handler)
import Server.Util (ServiceM, getTzseries,
utcToSeconds)
@@ -49,20 +50,21 @@ import Data.ByteString (ByteString)
import Data.ByteString.Lazy (toStrict)
import Data.Foldable (find, minimumBy)
import Data.Function (on, (&))
+import Data.Maybe (fromJust)
import qualified Data.Text as T
import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries)
import qualified Data.UUID as UUID
+import Database.Esqueleto.Experimental (from, selectOne, table,
+ val, where_, (^.))
+import qualified Database.Esqueleto.Experimental as E
import Extrapolation (Extrapolator (..),
LinearExtrapolator (..),
euclid)
import GHC.Generics (Generic)
import GTFS (seconds2Double)
+import OwnTracks hiding (Ping)
import Prometheus (decGauge, incGauge)
import Server.Base (ServerState)
-import OwnTracks hiding (Ping)
-import Database.Esqueleto.Experimental (selectOne, where_, (^.), table, from, val)
-import qualified Database.Esqueleto.Experimental as E
-import Data.Maybe (fromJust)
handleTrackerRegister
:: Pool SqlBackend
@@ -128,7 +130,7 @@ handleOwntracksMessage
handleOwntracksMessage dbpool subscribers cfg maybeUser device msg = do
user <- case maybeUser of
Just user -> pure user
- Nothing -> throwError err401
+ Nothing -> throwError err401
-- TODO: maybe get the basic json here, and put it into a log-msg table?
diff --git a/lib/Server/Subscribe.hs b/lib/Server/Subscribe.hs
index 5b0edb5..86b67a6 100644
--- a/lib/Server/Subscribe.hs
+++ b/lib/Server/Subscribe.hs
@@ -1,25 +1,26 @@
-{-# LANGUAGE BlockArguments#-}
+{-# LANGUAGE BlockArguments #-}
module Server.Subscribe where
-import Conduit (MonadIO (..))
-import Control.Concurrent.STM (atomically, newTQueue, readTQueue,
- readTVar, writeTVar)
-import Control.Exception (handle)
-import Control.Monad.Extra (forever, whenJust)
-import qualified Data.Aeson as A
-import qualified Data.ByteString.Char8 as C8
-import Data.Coerce (coerce)
-import Data.Functor ((<&>))
-import Data.Map (Map)
-import qualified Data.Map as M
+import Conduit (MonadIO (..))
+import Control.Concurrent.STM (atomically, newTQueue,
+ readTQueue, readTVar,
+ writeTVar)
+import Control.Exception (handle)
+import Control.Monad.Extra (forever, whenJust)
+import qualified Data.Aeson as A
+import qualified Data.ByteString.Char8 as C8
+import Data.Coerce (coerce)
+import Data.Functor ((<&>))
+import Data.Map (Map)
+import qualified Data.Map as M
import Data.Pool
-import Data.UUID (UUID)
-import Database.Persist.Sql (SqlBackend)
-import qualified Network.WebSockets as WS
+import Data.UUID (UUID)
+import Database.Esqueleto.Experimental hiding ((<&>))
+import Database.Persist.Sql (SqlBackend)
+import qualified Network.WebSockets as WS
import Persist
-import Server.Base (ServerState)
-import Server.Util (ServiceM)
-import Database.Esqueleto.Experimental hiding ((<&>))
+import Server.Base (ServerState)
+import Server.Util (ServiceM)
handleSubscribe
:: Pool SqlBackend
generated by cgit v1.2.3 (git 2.25.1) at 2026-04-16 19:22:44 +0000