Commit 6c832fae authored by Ricardo J. Mendez's avatar Ricardo J. Mendez

Major time tracking changes, data migration

- Renamed key-from-url -> url-key
- Renamed track-time -> track-url-time
- New :instance-id is now assigned on migration if missing
- track-url-time will no longer add the :favIconUrl to the data, it
  should go on the site
- We will track total site time by the hostname, disregarding the port
- Migrating data to v1
-- Removes favIconUrl
-- Adds initial total site time
- Added total site time to the display

https://app.asana.com/0/50978096561390/61724380527532
parent 5aaee40b
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
(:require [cljs.core.async :refer [>! <!]] (:require [cljs.core.async :refer [>! <!]]
[relevance.data :as data] [relevance.data :as data]
[relevance.io :as io] [relevance.io :as io]
[relevance.utils :refer [on-channel key-from-url]] [relevance.utils :refer [on-channel url-key]]
[khroma.alarms :as alarms] [khroma.alarms :as alarms]
[khroma.context-menus :as menus] [khroma.context-menus :as menus]
[khroma.idle :as idle] [khroma.idle :as idle]
...@@ -12,7 +12,8 @@ ...@@ -12,7 +12,8 @@
[khroma.windows :as windows] [khroma.windows :as windows]
[re-frame.core :refer [dispatch register-sub register-handler subscribe dispatch-sync]] [re-frame.core :refer [dispatch register-sub register-handler subscribe dispatch-sync]]
[khroma.extension :as ext] [khroma.extension :as ext]
[khroma.browser-action :as browser]) [khroma.browser-action :as browser]
[relevance.migrations :as migrations])
(:require-macros [cljs.core.async.macros :refer [go go-loop]])) (:require-macros [cljs.core.async.macros :refer [go go-loop]]))
...@@ -31,6 +32,7 @@ ...@@ -31,6 +32,7 @@
(def select-tab-keys #(select-keys % relevant-tab-keys)) (def select-tab-keys #(select-keys % relevant-tab-keys))
(def url-time-path [:data :url-times]) (def url-time-path [:data :url-times])
(def site-time-path [:data :site-times])
;;;;------------------------------------- ;;;;-------------------------------------
;;;; Functions ;;;; Functions
...@@ -86,7 +88,7 @@ ...@@ -86,7 +88,7 @@
(defn sort-tabs! [window-id url-times] (defn sort-tabs! [window-id url-times]
(go (go
(let [tabs (->> (:tabs (<! (windows/get window-id))) (let [tabs (->> (:tabs (<! (windows/get window-id)))
(map #(assoc % :time (or (:time (get url-times (key-from-url (:url %)))) (map #(assoc % :time (or (:time (get url-times (url-key (:url %))))
(- 2000 (:index %))))) (- 2000 (:index %)))))
(sort-by #(* -1 (:time %))) (sort-by #(* -1 (:time %)))
(map-indexed #(hash-map :index %1 (map-indexed #(hash-map :index %1
...@@ -114,25 +116,23 @@ ...@@ -114,25 +116,23 @@
(register-handler (register-handler
:data-load :data-load
(fn [app-state [_ new-data]] (fn [app-state [_ loaded]]
(console/trace "New data on load" new-data) (let [new-data (migrations/migrate-to-latest loaded)]
;; Create a new id if we don't have one (console/trace "Data load" loaded "migrated" new-data)
(when (empty? (:instance-id new-data)) ;; Save the migrated data we just received
(dispatch [:data-set :instance-id (.-uuid (random-uuid))])) (io/save new-data)
;; Save the data we just received ;; Process the suspend info
(io/save new-data) (let [suspend-info (:suspend-info new-data)
;; Process the suspend info old-tab (:active-tab suspend-info)
(let [suspend-info (:suspend-info new-data) current-tab (:active-tab app-state)
old-tab (:active-tab suspend-info) is-same? (and (= (:id old-tab) (:id current-tab))
current-tab (:active-tab app-state) (= (:url old-tab) (:url current-tab))
is-same? (and (= (:id old-tab) (:id current-tab)) (= (:windowId old-tab) (:windowId current-tab)))]
(= (:url old-tab) (:url current-tab)) (if is-same?
(= (:windowId old-tab) (:windowId current-tab)))] (dispatch [:handle-activation old-tab (:start-time old-tab)])
(if is-same? (dispatch [:handle-deactivation old-tab (:time suspend-info)])))
(dispatch [:handle-activation old-tab (:start-time old-tab)]) (-> app-state
(dispatch [:handle-deactivation old-tab (:time suspend-info)]))) (assoc :data (dissoc new-data :suspend-info))))))
(-> app-state
(assoc :data (assoc new-data :suspend-info nil)))))
(register-handler (register-handler
...@@ -292,12 +292,13 @@ ...@@ -292,12 +292,13 @@
(register-handler (register-handler
:track-time :track-time
(fn [app-state [_ tab time]] (fn [app-state [_ tab time]]
(let [url-times (or (get-in app-state url-time-path) {}) (let [data (:data app-state)
new-times (data/track-time url-times tab time (now))] url-times (data/track-url-time (or (:url-times data) {}) tab time (now))
site-times (data/track-site-time (or (:site-times data) {}) tab time (now))
new-data (assoc data :url-times url-times :site-times site-times)]
(console/trace time " milliseconds spent at " tab) (console/trace time " milliseconds spent at " tab)
(when (not= url-times new-times) (io/save new-data)
(dispatch [:data-set :url-times new-times])) (assoc app-state :data new-data)
app-state
))) )))
(register-handler (register-handler
......
(ns relevance.data (ns relevance.data
(:require [relevance.utils :refer [key-from-url]])) (:require [relevance.utils :refer [url-key host-key hostname]]))
(defn track-time (defn track-url-time
"Receives a time database, a tab record and a time to track, and returns new "Receives a url time database, a tab record and a time to track, and returns
time database which is the result of adding the time to the URL. It also new time database which is the result of adding the time to the URL. It also
timestamps the record with the timestamp received." timestamps the record with the timestamp received."
[url-times tab time timestamp] [url-times tab time timestamp]
(let [url (or (:url tab) "") (let [url (or (:url tab) "")
url-key (key-from-url url) id (url-key url)
url-time (or (get url-times url-key) url-time (or (get url-times id)
{:url url {:url url
:time 0 :time 0
:timestamp 0}) :timestamp 0})
;; Don't track two messages too close together track? (not= 0 id)
track? (not= 0 url-key)
new-time (assoc url-time :time (+ (:time url-time) time) new-time (assoc url-time :time (+ (:time url-time) time)
:title (:title tab) :title (:title tab)
:favIconUrl (:favIconUrl tab)
:timestamp timestamp)] :timestamp timestamp)]
(if track? (if track?
(assoc url-times url-key new-time) (assoc url-times id new-time)
url-time))) url-time)))
\ No newline at end of file
(defn track-site-time
"Receives a site time database, a tab record and a time to track, and returns
new time database which is the result of adding the time to the site. It also
timestamps the record with the timestamp received, and adds the favIconUrl of
the tab as the one for the entire site."
[site-times tab time timestamp]
(let [host (hostname (or (:url tab) ""))
id (host-key host)
site-time (or (get site-times id)
{:host host
:time 0
:timestamp 0})
track? (not= 0 id)
new-time (assoc site-time :time (+ (:time site-time) time)
:favIconUrl (:favIconUrl tab)
:timestamp timestamp)]
(if track?
(assoc site-times id new-time)
site-time)))
\ No newline at end of file
(ns relevance.io (ns relevance.io
(:require [relevance.utils :refer [to-transit from-transit key-from-url]] (:require [relevance.utils :refer [to-transit from-transit url-key]]
[cljs.core.async :refer [<!]] [cljs.core.async :refer [<!]]
[khroma.storage :as storage]) [khroma.storage :as storage])
(:require-macros [cljs.core.async.macros :refer [go]])) (:require-macros [cljs.core.async.macros :refer [go]]))
......
(ns relevance.migrations
(:require [relevance.utils :refer [url-key host-key hostname]]))
(defn accumulate-site-times [url-times]
(->>
(group-by #(hostname (:url %)) (vals url-times))
(into {} (map #(vector (host-key (key %))
(hash-map :host (key %)
:time (apply + (map :time (val %)))
:favIconUrl (:favIconUrl (first (val %))))
)))
))
(defn migrate
"Migrates a data set from its version to the next one. Returns the same
data set if it cannot apply any migration."
[data]
(condp = (:data-version data)
nil (->
data
(assoc :instance-id (or (:instance-id data)
(.-uuid (random-uuid))))
(assoc :data-version 1)
(assoc :url-times (into {} (map #(vector (key %)
(dissoc (val %) :favIconUrl))
(:url-times data))))
(assoc :site-times (accumulate-site-times (:url-times data))))
data
))
(defn migrate-to-latest
"Takes a data set and interates on it until no more version migrations can be applied"
[data]
(loop [to-migrate data]
(let [migrated (migrate to-migrate)]
(if (not= migrated to-migrate)
(recur migrated)
migrated))))
\ No newline at end of file
...@@ -25,7 +25,19 @@ ...@@ -25,7 +25,19 @@
(transit/read (transit/reader :json) transit-data)) (transit/read (transit/reader :json) transit-data))
(defn key-from-url (defn hostname
"Returns the host name for a URL, disregarding port and protocol"
[url]
(when url
(-> (dommy/create-element :a)
(dommy/set-attr! :href url)
(.-hostname)))
)
(defn host-key [host]
(hash-string host))
(defn url-key
"Shortens a URL to remove anchor and protocol, and returns an integer based on "Shortens a URL to remove anchor and protocol, and returns an integer based on
the result." the result."
[url] [url]
......
(ns relevance.startpage (ns relevance.startpage
(:require [relevance.io :as io] (:require [relevance.io :as io]
[relevance.utils :refer [key-from-url time-display]] [relevance.utils :refer [url-key time-display]]
[dommy.core :refer-macros [sel sel1] :as dommy] [dommy.core :refer-macros [sel sel1] :as dommy]
[khroma.runtime :as runtime] [khroma.runtime :as runtime]
[khroma.log :as console] [khroma.log :as console]
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
[database node] [database node]
(let [parent (.-parentNode node) (let [parent (.-parentNode node)
href (.-href parent) href (.-href parent)
id (key-from-url href) id (url-key href)
data (get database id) data (get database id)
time (:time data) time (:time data)
root-item (-> parent .-parentNode .-parentNode .-parentNode) ; Yeah, hacky as fuck root-item (-> parent .-parentNode .-parentNode .-parentNode) ; Yeah, hacky as fuck
......
(ns relevance.display (ns relevance.display
(:require [relevance.utils :refer [on-channel from-transit time-display]] (:require [relevance.utils :refer [on-channel from-transit time-display host-key hostname]]
[cljs.core.async :refer [>! <!]] [cljs.core.async :refer [>! <!]]
[cljs.core :refer [random-uuid]] [cljs.core :refer [random-uuid]]
[cljsjs.react-bootstrap] [cljsjs.react-bootstrap]
...@@ -67,7 +67,7 @@ ...@@ -67,7 +67,7 @@
;; of loading it and importing it. ;; of loading it and importing it.
(io/save-raw transit-data #(runtime/send-message :reload-data)) (io/save-raw transit-data #(runtime/send-message :reload-data))
(-> app-state (-> app-state
(assoc-in [:ui-state :section] :time-track) (assoc-in [:ui-state :section] :url-times)
(assoc-in [:app-state :import] nil)) (assoc-in [:app-state :import] nil))
)) ))
...@@ -78,7 +78,7 @@ ...@@ -78,7 +78,7 @@
;; Fake a ::storage-changed message to load the data from storage ;; Fake a ::storage-changed message to load the data from storage
(go (dispatch [::storage-changed {:changes {:data {:newValue (:data (<! (storage/get)))}}}])) (go (dispatch [::storage-changed {:changes {:data {:newValue (:data (<! (storage/get)))}}}]))
{:app-state {} {:app-state {}
:ui-state {:section :time-track}})) :ui-state {:section :url-times}}))
(register-handler (register-handler
...@@ -133,12 +133,13 @@ ...@@ -133,12 +133,13 @@
[:a {:class "navbar-brand" :href "http://numergent.com" :target "_blank"} "Relevance"]] [:a {:class "navbar-brand" :href "http://numergent.com" :target "_blank"} "Relevance"]]
[:div {:class "collapse navbar-collapse", :id "bs-example-navbar-collapse-1"} [:div {:class "collapse navbar-collapse", :id "bs-example-navbar-collapse-1"}
[:ul {:class "nav navbar-nav"} [:ul {:class "nav navbar-nav"}
[navbar-item "View times per page" :time-track @section] [navbar-item "Times per page" :url-times @section]
[navbar-item "Times per site" :site-times @section]
] ]
#_ [:form {:class "navbar-form navbar-left", :role "search"} #_[:form {:class "navbar-form navbar-left", :role "search"}
[:div {:class "form-group"} [:div {:class "form-group"}
[:input {:type "text", :class "form-control", :placeholder "Search"}]] [:input {:type "text", :class "form-control", :placeholder "Search"}]]
[:button {:type "submit", :class "btn btn-default"} "Submit"]] [:button {:type "submit", :class "btn btn-default"} "Submit"]]
[:ul {:class "nav navbar-nav navbar-right"} [:ul {:class "nav navbar-nav navbar-right"}
[navbar-item "Export" :export @section] [navbar-item "Export" :export @section]
[navbar-item "Import" :import @section]]]]]))) [navbar-item "Import" :import @section]]]]])))
...@@ -166,14 +167,13 @@ ...@@ -166,14 +167,13 @@
:on-click (:action @modal-info)} (:action-label @modal-info)] :on-click (:action @modal-info)} (:action-label @modal-info)]
]]))) ]])))
(defn list-urls [tabs] (defn list-urls [urls site-data]
(->> (->>
tabs urls
(sort-by :index)
(map-indexed (map-indexed
(fn [i tab] (fn [i tab]
(let [url (:url tab) (let [url (:url tab)
favicon (:favIconUrl tab)] favicon (:favIconUrl (get site-data (host-key (hostname url))))]
^{:key i} ^{:key i}
[:tr [:tr
[:td {:class "col-sm-1"} (time-display (:time tab))] [:td {:class "col-sm-1"} (time-display (:time tab))]
...@@ -187,8 +187,9 @@ ...@@ -187,8 +187,9 @@
[:td {:class "col-sm-5"} url]]))))) [:td {:class "col-sm-5"} url]])))))
(defn div-timetrack [] (defn div-urltimes []
(let [url-times (subscribe [:data :url-times]) (let [url-times (subscribe [:data :url-times])
site-times (subscribe [:data :site-times])
url-values (reaction (filter-tabs (vals @url-times))) url-values (reaction (filter-tabs (vals @url-times)))
to-list (reaction (sort-by #(* -1 (:time %)) @url-values))] to-list (reaction (sort-by #(* -1 (:time %)) @url-values))]
(fn [] (fn []
...@@ -201,7 +202,38 @@ ...@@ -201,7 +202,38 @@
[:th "Title"] [:th "Title"]
[:th "URL"]]] [:th "URL"]]]
[:tbody [:tbody
(list-urls @to-list)] (list-urls @to-list @site-times)]
]])
))
(defn div-sitetimes []
(let [site-times (subscribe [:data :site-times])
sites (reaction (vals @site-times))
to-list (reaction (sort-by #(* -1 (:time %)) @sites))]
(fn []
[:div
[:div {:class "page-header"} [:h2 "Times"]]
[:table {:class "table table-striped table-hover"}
[:thead
[:tr
[:th "#"]
[:th "Site"]]]
[:tbody
(->>
@to-list
(map-indexed
(fn [i site]
(let [url (:host site)
favicon (:favIconUrl site)]
^{:key i}
[:tr
[:td {:class "col-sm-1"} (time-display (:time site))]
[:td {:class "col-sm-6"} (if favicon
[:img {:src favicon
:width 16
:height 16}])
url]
]))))]
]]) ]])
)) ))
...@@ -239,7 +271,8 @@ ...@@ -239,7 +271,8 @@
(def component-dir {:export data-export (def component-dir {:export data-export
:import data-import :import data-import
:time-track div-timetrack}) :url-times div-urltimes
:site-times div-sitetimes})
(defn main-section [] (defn main-section []
......
This diff is collapsed.
(ns relevance.test.migrations (ns relevance.test.migrations
(:require [cljs.test :refer-macros [deftest testing is]] (:require [cljs.test :refer-macros [deftest testing is are]]
[relevance.migrations :as migrations]
[relevance.utils :as utils] [relevance.utils :as utils]
)) ))
(def initial-test-data (def base-data
{:instance-id "67b5c8eb-ae97-42ad-b6bc-803ac7e31221" {:instance-id "67b5c8eb-ae97-42ad-b6bc-803ac7e31221"
:suspend-info nil :suspend-info nil
:url-times {1274579744 :url-times {1274579744
...@@ -41,7 +42,38 @@ ...@@ -41,7 +42,38 @@
(deftest validate-key-fn (deftest validate-key-fn
(doseq [[k v] (:url-times initial-test-data)] (testing "Make sure our test ids are still valid"
(is (= k (utils/key-from-url (:url v))) (str "URL " (:url v))))) (doseq [[k v] (:url-times base-data)]
(is (= k (utils/url-key (:url v))) (str "URL " (:url v))))))
(deftest test-migrations
(testing "Empty migration"
(let [new-data (migrations/migrate {})
without-id (dissoc new-data :instance-id)]
(is (string? (:instance-id new-data)))
(is (= without-id {:data-version 1, :url-times {}, :site-times {}}))
))
(testing "v1 migration"
(let [v1 (migrations/migrate base-data)]
(is (not= v1 base-data))
(is (= 5 (count v1)) "We should have received five keys")
(are [k] (some? (k v1)) :url-times :instance-id :data-version :site-times)
(is (= (:instance-id v1) (:instance-id base-data)) "Instance id should be preserved")
(is (= 1 (:data-version v1)) "Data should have been tagged with the version")
(doseq [[k v] (:url-times v1)]
(is (integer? k))
(is (nil? (:favIconUrl v)))
)
(is (= (:site-times v1) {-331299663 {:host "developer.chrome.com" :time 1018982 :favIconUrl "https://developer.chrome.com/favicon.ico"}
-967938826 {:host "www.polygon.com" :time 14711 :favIconUrl "https://cdn2.vox-cdn.com/community_logos/42931/favicon.ico"}
-1466097211 {:host "lanyrd.com" :time 5617 :favIconUrl nil}
-915908674 {:host "www.kitco.com" :time 4432 :favIconUrl nil}})
"Site data should have been aggregated")
;; Test recurrent migration
(is (= v1 (migrations/migrate-to-latest base-data)) "Migrating all the way to the latest should yield the same v1 data")
(is (= v1 (migrations/migrate-to-latest v1)) "Migrating all the way to the latest should yield the same v1 data")
(is (not= base-data (migrations/migrate-to-latest base-data)) "Migration loop should have returned a different data set")
))
)
...@@ -5,29 +5,29 @@ ...@@ -5,29 +5,29 @@
(deftest test-key-from-url (deftest test-key-from-url
(is (= (utils/key-from-url "http://localhost/") (is (= (utils/url-key "http://localhost/")
(utils/key-from-url "https://localhost/")) (utils/url-key "https://localhost/"))
"Key should disregard protocol") "Key should disregard protocol")
(is (= (utils/key-from-url "https://localhost") (is (= (utils/url-key "https://localhost")
(utils/key-from-url "https://localhost/")) (utils/url-key "https://localhost/"))
"Key should disregard trailing slashes") "Key should disregard trailing slashes")
(is (= (utils/key-from-url "https://localhost#hash") (is (= (utils/url-key "https://localhost#hash")
(utils/key-from-url "https://localhost/#hash")) (utils/url-key "https://localhost/#hash"))
"Key should disregard trailing hashtags") "Key should disregard trailing hashtags")
(is (= (utils/key-from-url "https://LOCALHOST") (is (= (utils/url-key "https://LOCALHOST")
(utils/key-from-url "https://localhost")) (utils/url-key "https://localhost"))
"Key is not case-sensitive") "Key is not case-sensitive")
(is (= (utils/key-from-url "https://LOCALHOST/someUrl#hash") (is (= (utils/url-key "https://LOCALHOST/someUrl#hash")
(hash-string "localhost/someUrl")) (hash-string "localhost/someUrl"))
"Our hash calculations are consistent with hash-string") "Our hash calculations are consistent with hash-string")
(is (not= (utils/key-from-url "https://localhost?q=v") (is (not= (utils/url-key "https://localhost?q=v")
(utils/key-from-url "https://localhost?q=")) (utils/url-key "https://localhost?q="))
"Key should respect query strings") "Key should respect query strings")
(is (not= (utils/key-from-url "https://localhost.com/path") (is (not= (utils/url-key "https://localhost.com/path")
(utils/key-from-url "https://localhost.com/Path")) (utils/url-key "https://localhost.com/Path"))
"Path is case-sensitive") "Path is case-sensitive")
;; Let's confirm we actually return a consistent integer for some known values ;; Let's confirm we actually return a consistent integer for some known values
(are [k url] (= k (utils/key-from-url url)) (are [k url] (= k (utils/url-key url))
-20650657 "https://LOCALHOST/someUrl#hash" -20650657 "https://LOCALHOST/someUrl#hash"
-380467869 "http://google.com" -380467869 "http://google.com"
-380467869 "https://google.com" -380467869 "https://google.com"
...@@ -56,3 +56,19 @@ ...@@ -56,3 +56,19 @@
124076042 "1d 10h" 124076042 "1d 10h"
248996042 "2d 21h" 248996042 "2d 21h"
)) ))
(deftest test-host
(are [url name] (= (utils/hostname url) name)
"https://www.google.com/some?q=v" "www.google.com"
"https://www.Google.com/some?q=v" "www.google.com"
"https://WWW.GOOGLE.COM/some?q=v" "www.google.com"
"http://WWW.GOOGLE.COM/some?q=v" "www.google.com"
"https://GOOGLE.COM:443/some?q=v" "google.com"
"https://GOOGLE.COM:3000/some?q=v" "google.com" ; host would have included the port
"http://numergent.com/tag/khroma" "numergent.com"
"about:blank" ""
"chrome://extensions/?id=okhigbflgnbihoiokilagelkalkcigfp" "extensions"
"chrome-extension://okhigbflgnbihoiokilagelkalkcigfp/index.html" "okhigbflgnbihoiokilagelkalkcigfp"
"" ""
nil nil
))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment