1 files changed, 85 insertions, 0 deletions
diff --git a/lib/Server/Frontend/Tracker.hs b/lib/Server/Frontend/Tracker.hs
new file mode 100644
index 0000000..e3d88ba
--- /dev/null
+++ b/lib/Server/Frontend/Tracker.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE QuasiQuotes    #-}
+
+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)
+import qualified Data.UUID                       as UUID
+import           Database.Esqueleto.Experimental hiding ((<&>))
+import           Persist
+import           Server.Frontend.Routes          (FrontendMessage (..), Handler,
+                                                  Route (..), Widget)
+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
+    tracker <- from (table @Tracker)
+    where_ (tracker ^. TrackerName ==. val name)
+    pure tracker)
+  >>= \case
+    Nothing -> notFound
+    Just (Entity trackerId Tracker{..}) -> do
+
+      (maybeStatus, maybePing) <- runDB $ do
+        status <- selectOne do
+          status <- from (table @TrackerStatus)
+          where_ (status ^. TrackerStatusTracker ==. val trackerId)
+          orderBy [desc $ status ^. TrackerStatusTimestamp]
+          pure status
+        ping <- selectOne do
+          ping <- from (table @Ping)
+          where_ (ping ^. PingTrackerId ==. val trackerId)
+          orderBy [desc $ ping ^. PingTimestamp]
+          pure ping
+        pure (status, ping)
+
+      -- TODO: leaflet map; auto updates?
+      defaultLayout [whamlet|
+        <h1> _{MsgTracker name}
+        <em> (#{trackerId})
+        <section>
+          <h2> _{MsgLastTrackerStatus}
+          $maybe Entity _ TrackerStatus{..} <- maybeStatus
+            LocationPermission: #{show $ statusLocationPermission trackerStatusStatus} <br>
+            BatteryOptimisations: #{show $ statusBatteryOptimizations trackerStatusStatus} <br>
+            Phone in power save mode: #{show $ statusPhonePowerSaveMode trackerStatusStatus}
+          $nothing
+            <em>Status unknown
+        <section>
+          <h2> _{MsgLastTrackerPosition}
+          $maybe Entity _ Ping{..} <- maybePing
+            Position: #{show pingGeopos} <br>
+            Timestamp: #{show pingTimestamp} <br>
+            $maybe ticketId <- pingTicket
+              Ticket: <a href="@{TicketViewR (coerce ticketId)}">#{UUID.toText (coerce ticketId)}</a>
+            $nothing
+              Ticket: (no assigned ticket)
+          $nothing
+            (none)
+        |]