background.cljs 14.3 KB
Newer Older
1
(ns relevance.background
2
  (:require [cljs.core.async :refer [>! <!]]
3
            [clojure.walk :refer [keywordize-keys]]
4
            [relevance.data :as data]
5
            [relevance.io :as io]
6
            [relevance.migrations :as migrations]
7
            [relevance.order :refer [time-score sort-by-root]]
8
            [relevance.utils :refer [on-channel url-key host-key hostname is-http? ms-day]]
9
            [relevance.settings :refer [default-settings]]
10
            [khroma.alarms :as alarms]
11
            [khroma.context-menus :as menus]
12
            [khroma.idle :as idle]
13
            [khroma.log :as console]
14
            [khroma.tabs :as tabs]
15 16
            [khroma.runtime :as runtime]
            [khroma.windows :as windows]
17
            [re-frame.core :refer [dispatch reg-event-db subscribe dispatch-sync]]
18
            [khroma.extension :as ext]
19
            [khroma.browser-action :as browser]
20
            [khroma.storage :as storage])
21
  (:require-macros [cljs.core.async.macros :refer [go go-loop]]))
22 23 24 25



;;;;-------------------------------------
26
;;;; Settings
27 28
;;;;-------------------------------------

29

30
(def window-alarm "window-alarm")
31
(def relevant-tab-keys [:windowId :id :active :url :start-time :title :favIconUrl :audible])
32
(def select-tab-keys #(select-keys % relevant-tab-keys))
33

34
(defn now [] (.now js/Date))
35

36

37 38 39 40
;;;;-------------------------------------
;;;; Functions
;;;;-------------------------------------

41 42 43 44 45 46 47 48 49 50
(defn accumulate-preserve-icons
  "Accumulates all site times from url-times while preserving the
  icons stored on site-data"
  [url-times site-data]
  (->>
    ;; Accumulate site times but preserve the icons we had before
    (data/accumulate-site-times url-times)
    (map #(vector (key %)
                  (assoc (val %) :icon (get-in site-data [(key %) :icon]))))
    (into {})))
51 52 53 54 55 56 57 58 59 60 61 62

(defn check-window-status
  "Checks if we have any focused window, and compares it against the
  window id for the active tab. If they do not match, it dispatches
  a ::window-focus message"
  [tab]
  (go
    (let [last-focused (<! (windows/get-last-focused {:populate false}))]
      (when (and (:focused last-focused)
                 (not= (:id last-focused) (:windowId tab)))
        (dispatch [::window-focus {:windowId (:id last-focused)}])))))

63

64 65 66 67 68 69
(defn hook-to-channels
  "Hooks up to the various events we'll need to set up to.
  We won't call it until after the initial import is done, so that we
  don't end up receiving events when we don't yet have the environment
  set up to handle them."
  []
70 71
  ;; We should use dispatch for anything that does not absolutely require
  ;; immediate handling, to avoid interferring with the regular initialization
72 73 74 75 76
  ;; and event flow.
  ;;
  ;; In this case, I'm using dispatch-sync only for log-content, which has no
  ;; effect on app-state, and for on-suspend, which we want to handle
  ;; immediately.
77 78
  (on-channel alarms/on-alarm dispatch ::on-alarm)
  (on-channel browser/on-clicked dispatch ::on-clicked-button)
79
  (on-channel runtime/on-message dispatch ::on-message)
80 81 82 83 84
  (on-channel runtime/on-suspend dispatch-sync :suspend)
  (on-channel runtime/on-suspend-canceled dispatch-sync :log-content)
  (on-channel tabs/on-activated dispatch ::tab-activated)
  (on-channel tabs/on-updated dispatch ::tab-updated)
  (on-channel windows/on-focus-changed dispatch ::window-focus)
85
  (on-channel menus/on-clicked dispatch ::on-clicked-menu)
86 87
  (idle/set-detection-interval 60)
  (on-channel idle/on-state-changed dispatch :idle-state-change))
88

89 90 91 92 93 94 95 96 97 98
(defn open-results-tab []
  (go (let [ext-url (str (ext/get-url "/") "index.html")
            ;; We could just get the window-id from the tab, but that still
            ;; requires us to make an extra call for the other tabs
            window  (<! (windows/get-current))
            our-tab (first (filter #(= ext-url (:url %)) (:tabs window)))]
        (if our-tab
          (tabs/activate (:id our-tab))
          (tabs/create {:url ext-url})))))

99

100
(defn sort-tabs! [window-id app-state]
101
  (go
102 103
    (let [{:keys [settings data]} app-state
          {:keys [url-times site-times]} data
104 105 106 107
          tabs (sort-by-root (:tabs (<! (windows/get window-id)))
                             url-times
                             site-times
                             settings)]
108
      (doseq [tab tabs]
109 110
        (tabs/move (:id tab) {:index (:index tab)})))))

111

112 113 114 115 116 117

;;;;-------------------------------------
;;;; Handlers
;;;;-------------------------------------


118
(reg-event-db
119 120
  ::initialize
  (fn [_]
121
    (go
122
      (dispatch [:data-load (<! (io/load :data)) (or (<! (io/load :settings)) default-settings)])
123
      (dispatch [::window-focus {:windowId (:id (<! (windows/get-last-focused {:populate false})))}])
124
      ;; We should only hook to the channels once, so we do it during the :initialize handler
125 126 127 128 129 130 131
      (hook-to-channels)
      ;; Finally, if it's the first time on this version, show the intro page
      ;; We could probably hook to on-installed,
      (let [version    (get @runtime/manifest "version")
            last-shown (:last-initialized (<! (storage/get :last-initialized)))]
        (when (not= version last-shown)
          (open-results-tab)
132 133 134
          (storage/set {:last-initialized version}))))


135
    {:app-state {}}))
136 137


138
(reg-event-db
139
  :data-load
140 141
  (fn [app-state [_ data settings]]
    (let [migrated   (migrations/migrate-to-latest data)
142
          t          (now)
143
          ignore-set (:ignore-set settings)
144 145
          new-urls   (->
                       (:url-times migrated)
146
                       (data/clean-up-by-time (- t (* 3 ms-day)) 3)
147
                       (data/clean-up-by-time (- t (* 7 ms-day)) 30)
148
                       (data/clean-up-by-time (- t (* 14 ms-day)) 300)
149
                       (data/clean-up-by-time (- t (* 21 ms-day)) 600)
150
                       (data/clean-up-by-time (- t (* 30 ms-day)) 1800)
151
                       (data/clean-up-by-time (- t (* 45 ms-day)) 9000)
152 153 154
                       (data/clean-up-ignored ignore-set))
          site-data  (:site-times migrated)
          new-sites  (if (not= new-urls (:url-times migrated))
155
                       (accumulate-preserve-icons new-urls site-data)
156
                       site-data)
157 158 159
          new-data   (assoc migrated :url-times new-urls :site-times new-sites)]
      ; (console/trace "Data load" data "migrated" new-data)
      ; (console/trace "Settings" settings)
160
      ;; Save the migrated data we just received
161 162 163
      ;; We don't save the settings, since the background script does not really change them.
      ;; That's the UI's domain.
      (io/save :data new-data)
164 165 166 167 168 169 170 171 172 173
      ;; Process the suspend info
      (let [suspend-info (:suspend-info new-data)
            old-tab      (:active-tab suspend-info)
            current-tab  (:active-tab app-state)
            is-same?     (and (= (:id old-tab) (:id current-tab))
                              (= (:url old-tab) (:url current-tab))
                              (= (:windowId old-tab) (:windowId current-tab)))]
        (if is-same?
          (dispatch [:handle-activation old-tab (:start-time old-tab)])
          (dispatch [:handle-deactivation old-tab (:time suspend-info)])))
174
      (assoc app-state :data (dissoc new-data :suspend-info)
175 176
                       :settings settings))))

177 178


179
(reg-event-db
180 181
  :data-set
  (fn [app-state [_ key item]]
182
    (let [new-state (assoc-in app-state [:data key] item)]
183
      (io/save :data (:data new-state))
184 185
      new-state)))

186

187
(reg-event-db
188 189 190 191 192 193 194 195 196
  :delete-url
  (fn [app-state [_ url]]
    (let [data      (:data app-state)
          old-times (:url-times data)
          new-times (dissoc old-times (url-key url))
          changed?  (not= old-times new-times)
          new-data  (if changed?
                      (assoc data :url-times new-times
                                  :site-times (accumulate-preserve-icons new-times (:site-times data)))
197 198
                      data)]

199 200
      (when changed?
        (io/save :data new-data))
201 202
      (assoc app-state :data new-data))))

203

204
(reg-event-db
205
  :handle-activation
206
  (fn [app-state [_ tab start-time]]
207
    ; (console/trace "Handling activation" tab)
208
    (if tab
209 210 211 212 213 214
      (assoc app-state
        :active-tab
        (-> tab
            select-tab-keys
            (assoc :active true
                   :start-time (or start-time (now)))))
215 216 217
      app-state)))


218
(reg-event-db
219
  :handle-deactivation
220
  (fn
221 222
    ;; We get two parameters: the tab, and optionally the time at which it
    ;; was deactivated (which defaults to now)
223
    [app-state [_ tab end-time]]
224
    ; (console/trace " Deactivating " tab)
225
    (when (pos? (:start-time tab))
226 227
      (dispatch [:track-time tab (- (or end-time (now))
                                    (:start-time tab))]))
228
    app-state))
229 230


231
(reg-event-db
Ricardo J. Mendez's avatar
Ricardo J. Mendez committed
232 233
  :idle-state-change
  (fn [app-state [_ message]]
234 235 236 237
    (let [state      (:newState message)
          action     (if (= "active" state) :handle-activation :handle-deactivation)
          active-tab (if (= :handle-activation action)
                       (get-in app-state [:app-state :idle])
238 239
                       (:active-tab app-state))]

240
      ; (console/trace " State changed to " state action)
Ricardo J. Mendez's avatar
Ricardo J. Mendez committed
241 242 243
      ;; We only store the idle tabs on the app state if we actually idled any.
      ;; That way we avoid losing the originally stored idled tabs when we
      ;; first go from active->idle and then from idle->locked (the first one
244 245
      ;; would find tabs, the second one wouldn't and would overwrite the
      ;; original saved set with an empty list).
246 247 248 249 250 251
      (if active-tab
        (do
          (dispatch [action active-tab])
          (-> app-state
              (assoc-in [:app-state :idle] active-tab)
              (assoc :active-tab nil)))
252 253
        app-state))))

Ricardo J. Mendez's avatar
Ricardo J. Mendez committed
254 255


256
(reg-event-db
257
  ::on-alarm
258
  (fn [app-state [_ {:keys [alarm]}]]
259
    (when (= window-alarm (:name alarm))
260 261
      (check-window-status (:active-tab app-state)))
    app-state))
262

263

264
(reg-event-db
265
  ::on-clicked-button
266
  (fn [app-state [_ {:keys [tab]}]]
267
    ;; Force it to track the time up until now
268
    (let [active-tab (:active-tab app-state)]
269 270
      (dispatch [:handle-deactivation active-tab])
      (dispatch [:handle-activation active-tab]))
271
    (dispatch [:on-relevance-sort-tabs tab])
272
    app-state))
273

274

275
(reg-event-db
276
  ::on-clicked-menu
277
  (fn [app-state [_ {:keys [info tab]}]]
278
    (dispatch [(keyword (:menuItemId info)) tab])
279
    app-state))
280

281

282
(reg-event-db
283
  ::on-message
284
  (fn [app-state [_ payload]]
285 286 287
    (let [{:keys [message sender]} (keywordize-keys payload)
          {:keys [action data]} message]
      ; (console/log "GOT INTERNAL MESSAGE" message "from" sender)
288
      (case (keyword action)
289 290
        :reload-data (go (dispatch [:data-load (<! (io/load :data)) (<! (io/load :settings))]))
        :delete-url (dispatch [:delete-url data])
291
        (console/error "Nothing matched" message)))
292
    app-state))
293

294

295

296
(reg-event-db
297
  :on-relevance-show-data
298
  (fn [app-state [_]]
299
    (open-results-tab)
300
    app-state))
301 302


303
(reg-event-db
304
  :on-relevance-sort-tabs
305 306 307
  (fn [app-state [_ tab]]
    (sort-tabs! (:windowId tab) app-state)
    app-state))
308

309

310
(reg-event-db
311
  :suspend
312
  ;; The message itself is not relevant, we only care that we are being suspended
313
  (fn [app-state [_]]
314
    (dispatch [:data-set :suspend-info {:time       (now)
315 316
                                        :active-tab (:active-tab app-state)}])
    app-state))
317

Ricardo J. Mendez's avatar
Ricardo J. Mendez committed
318

319
(reg-event-db
320 321 322
  ::tab-activated
  (fn [app-state [_ {:keys [activeInfo]}]]
    (let [{:keys [tabId windowId]} activeInfo
323 324 325 326 327 328
          active-tab (:active-tab app-state)
          replace?   (= windowId (:windowId active-tab))]
      (if replace?
        (do
          (dispatch [:handle-deactivation active-tab])
          (go (dispatch [:handle-activation (<! (tabs/get tabId))]))
329 330 331
          (assoc app-state :active-tab nil))                ; :handle-activation is responsible for setting it
        app-state))))

332 333


334
(reg-event-db
335 336
  ::tab-updated
  (fn [app-state [_ {:keys [tabId tab]}]]
337 338 339 340 341
    (let [active-tab (:active-tab app-state)
          are-same?  (= tabId (:id active-tab))]
      (when (and are-same?
                 (:active tab)
                 (not= (:url active-tab)
342
                       (:url tab)))
343 344 345
        ; (console/trace " Tab URL changed while active " tab active-tab)
        (dispatch [:handle-deactivation active-tab])
        (dispatch [:handle-activation tab]))
346 347 348 349 350
      ;; We can receive multiple tab-updated messages one after the other, before
      ;; the dispatches above have had a change to handle activation/deactivation.
      ;; Therefore, I change the title and URL right away, in case this gets
      ;; triggered again and we compare it again (to avoid a double trigger of
      ;; the URL change condition above).
351 352
      (if are-same?
        (assoc app-state :active-tab (merge active-tab (select-keys tab [:title :url])))
353 354
        app-state))))

355

356

357
(reg-event-db
358
  :track-time
359
  (fn [app-state [_ tab time]]
360
    (let [data       (:data app-state)
361 362
          url-times  (data/track-url-time (or (:url-times data) {}) tab (quot time 1000) (now))
          site-times (data/track-site-time (or (:site-times data) {}) tab (quot time 1000) (now))
363
          new-data   (assoc data :url-times url-times :site-times site-times)]
364
      ; (console/trace time " milliseconds spent at " tab)
365
      (io/save :data new-data)
366 367
      (assoc app-state :data new-data))))

368

369
(reg-event-db
370 371
  ::window-focus
  (fn [app-state [_ {:keys [windowId]}]]
372
    ; (console/trace "Current window" windowId)
373
    (let [active-tab (:active-tab app-state)
374 375 376
          replacing? (not= windowId (:windowId active-tab))
          is-none?   (= windowId windows/none)]
      (when is-none?
377
        (alarms/create window-alarm {:periodInMinutes 1}))
378 379 380
      (if replacing?
        (do
          (dispatch [:handle-deactivation active-tab])
Ricardo J. Mendez's avatar
Ricardo J. Mendez committed
381
          (when-not is-none?
382
            (alarms/clear window-alarm)
383 384 385
            (go (dispatch [:handle-activation
                           (first (<! (tabs/query {:active true :windowId windowId})))])))
          (assoc app-state :active-tab nil))
386 387
        app-state))))

388 389 390 391 392 393 394


;;;;-------------------------------------
;;;; Initialization
;;;;-------------------------------------


Ricardo J. Mendez's avatar
Ricardo J. Mendez committed
395
(defn time-tracking []
396
  (dispatch-sync [::initialize])
397
  (go-loop
Ricardo J. Mendez's avatar
Ricardo J. Mendez committed
398 399
    [connections (runtime/on-connect)]
    (let [content (<! connections)]
400
      ; (console/log "--> Background received" (<! content))
401
      (>! content :background-ack)
402 403
      (recur connections))))

404

405

Ricardo J. Mendez's avatar
Ricardo J. Mendez committed
406
(defn ^:export main []
407 408
  (menus/remove-all)
  (menus/create {:id       :on-relevance-show-data
409
                 :title    "Show Relevance data"
410 411
                 :contexts ["browser_action"]})
  (time-tracking))
Ricardo J. Mendez's avatar
Ricardo J. Mendez committed
412 413

(main)