Server.Frontend.Tracker: add tracker list overviewHEADmain

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