blob: e3d88ba107f680572053af1e65c456acad5d8a21 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
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)
|]
|
