blob: 23bbdb93033ef30fd0b90e6d3c5269014efe90ac (
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
|
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE QuasiQuotes #-}
module Server.Frontend.Tracker (getTrackerViewR) where
import Data.Coerce (coerce)
import Data.Functor ((<&>))
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
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)
|]
|
