aboutsummaryrefslogtreecommitdiff
path: root/lib/Server/Frontend/Tracker.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Server/Frontend/Tracker.hs')
-rw-r--r--lib/Server/Frontend/Tracker.hs22
1 files changed, 21 insertions, 1 deletions
diff --git a/lib/Server/Frontend/Tracker.hs b/lib/Server/Frontend/Tracker.hs
index 23bbdb9..e3d88ba 100644
--- a/lib/Server/Frontend/Tracker.hs
+++ b/lib/Server/Frontend/Tracker.hs
@@ -1,9 +1,11 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE QuasiQuotes #-}
-module Server.Frontend.Tracker (getTrackerViewR) where
+module Server.Frontend.Tracker (getTrackerViewR, getTrackersR) where
import Data.Coerce (coerce)
+import Data.Function ((&))
import Data.Functor ((<&>))
+import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time (getCurrentTime)
@@ -16,6 +18,24 @@ import Yesod hiding (update, (=.), (==.))
import OwnTracks.Status
+
+getTrackersR :: Handler Html
+getTrackersR = do
+ trackers <- runDB $ select do
+ (t :& p) <- from $
+ (table @Tracker) `LeftOuterJoin` (table @Ping)
+ `on` \(t :& p) -> just (t ^. TrackerId) ==. p ?. PingTrackerId
+ pure (t, p)
+ & fmap associateJoin
+
+ defaultLayout [whamlet|
+ <h1> Trackers
+ <section>
+ <ul>
+ $forall (trackerId, (Tracker{..}, status)) <- M.toList trackers
+ <li><a href="@{TrackerViewR trackerName}">#{trackerName}</a>
+ |]
+
getTrackerViewR :: Text -> Handler Html
getTrackerViewR name =
runDB (selectOne do