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 @@
(:require [cljs.core.async :refer [>! <!]]
[relevance.data :as data]
[relevance.io :as io]
[relevance.utils :refer [on-channel key-from-url]]
[relevance.utils :refer [on-channel url-key]]
[khroma.alarms :as alarms]
[khroma.context-menus :as menus]
[khroma.idle :as idle]
......@@ -12,7 +12,8 @@
[khroma.windows :as windows]
[re-frame.core :refer [dispatch register-sub register-handler subscribe dispatch-sync]]
[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]]))
......@@ -31,6 +32,7 @@
(def select-tab-keys #(select-keys % relevant-tab-keys))
(def url-time-path [:data :url-times])
(def site-time-path [:data :site-times])
;;;;-------------------------------------
;;;; Functions
......@@ -86,7 +88,7 @@
(defn sort-tabs! [window-id url-times]
(go
(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 %)))))
(sort-by #(* -1 (:time %)))
(map-indexed #(hash-map :index %1
......@@ -114,12 +116,10 @@
(register-handler
:data-load
(fn [app-state [_ new-data]]
(console/trace "New data on load" new-data)
;; Create a new id if we don't have one
(when (empty? (:instance-id new-data))
(dispatch [:data-set :instance-id (.-uuid (random-uuid))]))
;; Save the data we just received
(fn [app-state [_ loaded]]
(let [new-data (migrations/migrate-to-latest loaded)]
(console/trace "Data load" loaded "migrated" new-data)
;; Save the migrated data we just received
(io/save new-data)
;; Process the suspend info
(let [suspend-info (:suspend-info new-data)
......@@ -132,7 +132,7 @@
(dispatch [:handle-activation old-tab (:start-time old-tab)])
(dispatch [:handle-deactivation old-tab (:time suspend-info)])))
(-> app-state
(assoc :data (assoc new-data :suspend-info nil)))))
(assoc :data (dissoc new-data :suspend-info))))))
(register-handler
......@@ -292,12 +292,13 @@
(register-handler
:track-time
(fn [app-state [_ tab time]]
(let [url-times (or (get-in app-state url-time-path) {})
new-times (data/track-time url-times tab time (now))]
(let [data (:data app-state)
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)
(when (not= url-times new-times)
(dispatch [:data-set :url-times new-times]))
app-state
(io/save new-data)
(assoc app-state :data new-data)
)))
(register-handler
......
(ns relevance.data
(:require [relevance.utils :refer [key-from-url]]))
(:require [relevance.utils :refer [url-key host-key hostname]]))
(defn track-time
"Receives a 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 URL. It also
(defn track-url-time
"Receives a url 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 URL. It also
timestamps the record with the timestamp received."
[url-times tab time timestamp]
(let [url (or (:url tab) "")
url-key (key-from-url url)
url-time (or (get url-times url-key)
id (url-key url)
url-time (or (get url-times id)
{:url url
:time 0
:timestamp 0})
;; Don't track two messages too close together
track? (not= 0 url-key)
track? (not= 0 id)
new-time (assoc url-time :time (+ (:time url-time) time)
:title (:title tab)
:favIconUrl (:favIconUrl tab)
:timestamp timestamp)]
(if track?
(assoc url-times url-key new-time)
(assoc url-times id new-time)
url-time)))
(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
(: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 [<!]]
[khroma.storage :as storage])
(: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 @@
(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
the result."
[url]
......
(ns relevance.startpage
(: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]
[khroma.runtime :as runtime]
[khroma.log :as console]
......@@ -17,7 +17,7 @@
[database node]
(let [parent (.-parentNode node)
href (.-href parent)
id (key-from-url href)
id (url-key href)
data (get database id)
time (:time data)
root-item (-> parent .-parentNode .-parentNode .-parentNode) ; Yeah, hacky as fuck
......
(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 :refer [random-uuid]]
[cljsjs.react-bootstrap]
......@@ -67,7 +67,7 @@
;; of loading it and importing it.
(io/save-raw transit-data #(runtime/send-message :reload-data))
(-> app-state
(assoc-in [:ui-state :section] :time-track)
(assoc-in [:ui-state :section] :url-times)
(assoc-in [:app-state :import] nil))
))
......@@ -78,7 +78,7 @@
;; Fake a ::storage-changed message to load the data from storage
(go (dispatch [::storage-changed {:changes {:data {:newValue (:data (<! (storage/get)))}}}]))
{:app-state {}
:ui-state {:section :time-track}}))
:ui-state {:section :url-times}}))
(register-handler
......@@ -133,9 +133,10 @@
[:a {:class "navbar-brand" :href "http://numergent.com" :target "_blank"} "Relevance"]]
[:div {:class "collapse navbar-collapse", :id "bs-example-navbar-collapse-1"}
[: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"}
[:input {:type "text", :class "form-control", :placeholder "Search"}]]
[:button {:type "submit", :class "btn btn-default"} "Submit"]]
......@@ -166,14 +167,13 @@
:on-click (:action @modal-info)} (:action-label @modal-info)]
]])))
(defn list-urls [tabs]
(defn list-urls [urls site-data]
(->>
tabs
(sort-by :index)
urls
(map-indexed
(fn [i tab]
(let [url (:url tab)
favicon (:favIconUrl tab)]
favicon (:favIconUrl (get site-data (host-key (hostname url))))]
^{:key i}
[:tr
[:td {:class "col-sm-1"} (time-display (:time tab))]
......@@ -187,8 +187,9 @@
[:td {:class "col-sm-5"} url]])))))
(defn div-timetrack []
(defn div-urltimes []
(let [url-times (subscribe [:data :url-times])
site-times (subscribe [:data :site-times])
url-values (reaction (filter-tabs (vals @url-times)))
to-list (reaction (sort-by #(* -1 (:time %)) @url-values))]
(fn []
......@@ -201,7 +202,38 @@
[:th "Title"]
[:th "URL"]]]
[: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 @@
(def component-dir {:export data-export
:import data-import
:time-track div-timetrack})
:url-times div-urltimes
:site-times div-sitetimes})
(defn main-section []
......
(ns relevance.test.data
(:require [cljs.test :refer-macros [deftest testing is are]]
[relevance.data :as data]
[relevance.migrations :as migrations]
[relevance.utils :as utils]
))
......@@ -9,59 +10,69 @@
(def test-db
{:instance-id "67b5c8eb-ae97-42ad-b6bc-803ac7e31221"
:suspend-info nil
:data-version 1
:url-times {-327774960
{:url "http://numergent.com/tags/khroma/",
:time 117300,
:timestamp 1445964037798,
:title "Khroma articles",
:favIconUrl "http://numergent.com/favicon.ico"}
:title "Khroma articles"}
-526558523
{:url "http://numergent.com/opensource/",
:time 27300,
:timestamp 1445964037798,
:title "Open source projects",
:favIconUrl "http://numergent.com/favicon.ico"}
:title "Open source projects"}
-2272190
{:url "http://lanyrd.com/conferences/",
:time 5617,
:timestamp 1446047687895,
:title "Conferences and events worldwide | Lanyrd",
:favIconUrl nil}
:title "Conferences and events worldwide | Lanyrd"}
-327358142
{:url "https://developer.chrome.com/extensions/contextMenus",
:time 901682,
:timestamp 1446028215734,
:title "chrome.contextMenus - Google Chrome",
:favIconUrl "https://www.google.com/images/icons/product/chrome-32.png"}
:title "chrome.contextMenus - Google Chrome"}
1917381154
{:url "http://www.kitco.com/market/",
:time 4432,
:timestamp 1446051494575,
:title "New York spot price Gold...",
:favIconUrl nil
:title "New York spot price Gold..."
}
}})
}
:site-times {971841386 {:favIconUrl "http://numergent.com/favicon.ico"
:time 144600
:host "numergent.com"}
-1466097211 {:favIconUrl nil
:time 5617
:host "lanyrd.com"}
-331299663 {:favIconUrl "https://www.google.com/images/icons/product/chrome-32.png"
:time 901682
:host "developer.chrome.com"}
-915908674 {:favIconUrl nil
:time 4432
:host "www.kitco.com"}}})
(deftest test-track-time
(deftest test-track-url-time
(testing "Add time to an existing tab"
(let [tab {:url "http://numergent.com/opensource/"
:title "Open source project details"
:favIconUrl "http://numergent.com/favicon.png"}
ts 1445964037799
result (data/track-time (:url-times test-db)
result (data/track-url-time (:url-times test-db)
tab
1234
ts)
tab-key (utils/key-from-url "http://numergent.com/opensource/")
item (get result tab-key)]
id (utils/url-key "http://numergent.com/opensource/")
item (get result id)]
(is result)
(is (= 5 (count result)) "We should get back the same number of elements")
(is item)
(are [k] (= (k item) (k tab)) :url :title :favIconUrl) ; All the keys should have been updated from the record we're sending
(is (nil? (:favIconUrl item)))
(are [k] (= (k item) (k tab)) :url :title) ; All the keys should have been updated from the record we're sending
(is (= ts (:timestamp item)) "Item should have been time-stamped")
(is (= 28534 (:time item)) "Time should have increased")
(doseq [other (dissoc result tab-key)]
(doseq [other (dissoc result id)]
(is (= (val other) (get (:url-times test-db) (key other))) "Other items should have remained untouched")
)
))
......@@ -70,16 +81,16 @@
:title "Numergent limited"
:favIconUrl "http://numergent.com/favicon.png"}
ts 1445964037799
result (data/track-time (:url-times test-db)
result (data/track-url-time (:url-times test-db)
tab
9001
ts)
tab-key (utils/key-from-url "http://numergent.com/")
tab-key (utils/url-key "http://numergent.com/")
item (get result tab-key)]
(is result)
(is (= 6 (count result)) "We should have an extra element")
(is item)
(are [k] (= (k item) (k tab)) :url :title :favIconUrl) ; All the keys should have been updated from the record we're sending
(are [k] (= (k item) (k tab)) :url :title) ; All the keys should have been updated from the record we're sending
(is (= ts (:timestamp item)) "Item should have been time-stamped")
(is (= 9001 (:time item)) "Time should have been assigned")
(doseq [other (dissoc result tab-key)]
......@@ -91,14 +102,82 @@
:title "Numergent limited"
:favIconUrl "http://numergent.com/favicon.png"}
ts 12345
result (data/track-time {} tab 9001 ts)
tab-key (utils/key-from-url "http://numergent.com/")
result (data/track-url-time {} tab 9001 ts)
tab-key (utils/url-key "http://numergent.com/")
item (get result tab-key)]
(is result)
(is (= 1 (count result)) "We should have an extra element")
(is item)
(are [k] (= (k item) (k tab)) :url :title :favIconUrl) ; All the keys should have been updated from the record we're sending
(are [k] (= (k item) (k tab)) :url :title) ; All the keys should have been updated from the record we're sending
(is (= ts (:timestamp item)) "Item should have been time-stamped")
(is (= 9001 (:time item)) "Time should have increased")
))
)
(deftest test-track-site-time
(testing "Add time to an empty database"
(let [tab {:url "http://numergent.com/opensource/"
:title "Open source project details"
:favIconUrl "http://numergent.com/favicon.png"}
ts 1445964037799
result (data/track-site-time {}
tab
1234
ts)
id (utils/host-key (utils/hostname "http://numergent.com/opensource/"))
item (get result id)]
(is result)
(is (= 1 (count result)) "We should get back a single element")
(is item)
(are [expected result] (= expected result)
(:favIconUrl tab) (:favIconUrl item)
"numergent.com" (:host item)
ts (:timestamp item)
1234 (:time item)))
)
(testing "Add time to an existing database for an existing site"
(let [tab {:url "http://numergent.com/opensource/index.html"
:title "Further open source project details"
:favIconUrl "http://numergent.com/newfavicon.png"}
ts 1445964037900
result (data/track-site-time (:site-times test-db)
tab
1234
ts)
id (utils/host-key (utils/hostname "http://numergent.com/opensource/"))
item (get result id)]
(is result)
(is (= 4 (count result)) "We should get back four sites")
(is item)
(are [expected result] (= expected result)
(:favIconUrl tab) (:favIconUrl item)
"numergent.com" (:host item)
ts (:timestamp item)
145834 (:time item))
(doseq [other (dissoc result id)]
(is (= (val other) (get (:site-times test-db) (key other))) "Other items should have remained untouched")
)))
(testing "Add time to an existing database for a new site"
(let [tab {:url "https://twitter.com/ArgesRic"
:title "ArgesRic"
:favIconUrl "https://abs.twimg.com/favicons/favicon.ico"}
ts 1445964037920
result (data/track-site-time (:site-times test-db)
tab
9001
ts)
id (utils/host-key (utils/hostname "https://twitter.com/EvenSomeOtherUrl"))
item (get result id)]
(is result)
(is (= 5 (count result)) "We should get back five sites")
(is item)
(are [expected result] (= expected result)
(:favIconUrl tab) (:favIconUrl item)
"twitter.com" (:host item)
ts (:timestamp item)
9001 (:time item))
(doseq [other (dissoc result id)]
(is (= (val other) (get (:site-times test-db) (key other))) "Other items should have remained untouched")
))
)
)
\ No newline at end of file
(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]
))
(def initial-test-data
(def base-data
{:instance-id "67b5c8eb-ae97-42ad-b6bc-803ac7e31221"
:suspend-info nil
:url-times {1274579744
......@@ -41,7 +42,38 @@
(deftest validate-key-fn
(doseq [[k v] (:url-times initial-test-data)]
(is (= k (utils/key-from-url (:url v))) (str "URL " (:url v)))))
(testing "Make sure our test ids are still valid"
(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 @@
(deftest test-key-from-url
(is (= (utils/key-from-url "http://localhost/")
(utils/key-from-url "https://localhost/"))
(is (= (utils/url-key "http://localhost/")
(utils/url-key "https://localhost/"))
"Key should disregard protocol")
(is (= (utils/key-from-url "https://localhost")
(utils/key-from-url "https://localhost/"))
(is (= (utils/url-key "https://localhost")
(utils/url-key "https://localhost/"))
"Key should disregard trailing slashes")
(is (= (utils/key-from-url "https://localhost#hash")
(utils/key-from-url "https://localhost/#hash"))
(is (= (utils/url-key "https://localhost#hash")
(utils/url-key "https://localhost/#hash"))
"Key should disregard trailing hashtags")
(is (= (utils/key-from-url "https://LOCALHOST")
(utils/key-from-url "https://localhost"))
(is (= (utils/url-key "https://LOCALHOST")
(utils/url-key "https://localhost"))
"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"))
"Our hash calculations are consistent with hash-string")
(is (not= (utils/key-from-url "https://localhost?q=v")
(utils/key-from-url "https://localhost?q="))
(is (not= (utils/url-key "https://localhost?q=v")
(utils/url-key "https://localhost?q="))
"Key should respect query strings")
(is (not= (utils/key-from-url "https://localhost.com/path")
(utils/key-from-url "https://localhost.com/Path"))
(is (not= (utils/url-key "https://localhost.com/path")
(utils/url-key "https://localhost.com/Path"))
"Path is case-sensitive")
;; 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"
-380467869 "http://google.com"
-380467869 "https://google.com"
......@@ -56,3 +56,19 @@
124076042 "1d 10h"
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