Commit dac0f052 authored by Ricardo J. Mendez's avatar Ricardo J. Mendez

Somewhat messy time tracking, WIP

Logging it to the console, not yet storing it.

Moved application files to its own folder so I can have devcards
as well.
parent 66a91477
......@@ -4,24 +4,24 @@
:dependencies [[org.clojure/clojure "1.7.0"]
[org.clojure/clojurescript "1.7.122"]
[org.clojure/core.async "0.1.346.0-17112a-alpha"]
[cljs-ajax "0.3.14"]
[cljsjs/react-bootstrap "0.25.1-0" :exclusions [org.webjars.bower/jquery]]
[com.lucasbradstreet/cljs-uuid-utils "1.0.2"]
[khroma "0.1.0"]
[devcards "0.2.0-4"]
[khroma "0.2.0-SNAPSHOT"]
[prismatic/dommy "1.1.0"]
[re-frame "0.4.1" :exclusions [cljsjs/react]]
]
:source-paths ["src"]
:source-paths ["src/app" "src/devcards"]
:profiles {:dev {:plugins [[lein-cljsbuild "1.1.0"]
[lein-chromebuild "0.3.0"]]
:cljsbuild {:builds {:main
{:source-paths ["src"]
:compiler {:output-to "target/unpacked/booklet.js"
:output-dir "target/js"
:optimizations :whitespace
:closure-defines {booklet.core/api-uri "http://localhost/from-the-config"}
; :closure-defines {"booklet.core.api_uri" "http://localhost/from-the-config"}
:pretty-print true}}}}
:cljsbuild {:builds {:dev
{:source-paths ["src/app" "src/devcards"]
:compiler {:output-to "target/unpacked/booklet.js"
:output-dir "target/js"
:optimizations :whitespace
:pretty-print true
:devcards true}}}}
:chromebuild {:resource-paths ["resources/js"
"resources/html"
......
<!DOCTYPE html>
<html>
<head>
<title></title>
<meta charset="utf-8"/>
<meta name="viewport" content="width=device-width, initial-scale=1.0"/>
<!--
We need the following highlight pack embedded because otherwise devcards
attempt to do some inline execution, which Chrome does not like on
extensions.
-->
<script type="text/javascript" id="com-rigsomelight-code-highlighting" src="highlight.pack.js"></script>
<script type="text/javascript" src="booklet.js"></script>
<script type="text/javascript" src="devcards-init.js"></script>
</head>
<body>
</body>
</html>
This diff is collapsed.
booklet.devcards.main();
......@@ -23,7 +23,7 @@
"background.js",
"handler.js"
],
"persistent": false
"persistent": true
},
"manifest_version": 2
}
......
(ns booklet.background
(:require [cljs.core.async :refer [>! <!]]
[booklet.utils :refer [dispatch-on-channel]]
[khroma.log :as console]
[khroma.runtime :as runtime]
[khroma.windows :as windows]
[khroma.storage :as storage]
[khroma.idle :as idle]
[khroma.tabs :as tabs]
[reagent.core :as reagent]
[re-frame.core :refer [dispatch register-sub register-handler subscribe dispatch-sync]])
(:require-macros [cljs.core.async.macros :refer [go go-loop]]))
;;;;-------------------------------------
;;;; Functions
;;;;-------------------------------------
;; Let's track two values:
;; - How long a tab has been open
;; - How long was it active
;; Need to track active tabs, and from there credit the URL.
(defn now [] (.now js/Date))
(def relevant-tab-keys [:windowId :id :active :url :selected :start-time])
(def select-tab-keys #(select-keys % relevant-tab-keys))
(def add-tab-times #(assoc % :start-time (if (:active %) (now) 0)))
(def tab-data-path [:app-state :tab-tracking])
(def url-time-path [:data :urls])
(defn process-tab
"Filters a tab down to the relevant keys, and adds a start time which is
now if the tab is active, or 0 otherwise.
Keeping the time on the tab itself, since we may end up with multiple tabs
open to the same URL. Might make sense to track it all in one, using always
the last one... but for now I'm assuming that if you have it active in two
tabs, it's doubly important (you found it twice and forgot about it)."
[tab]
(->
tab
select-tab-keys
add-tab-times))
(defn process-tabs
"Take the tabs we have, filter them down and return them grouped by id."
[tabs]
(->>
tabs
(map process-tab)
(reduce #(assoc % (:id %2) %2) {})))
;;;;-------------------------------------
;;;; Handlers
;;;;-------------------------------------
(register-handler
:handle-activation
(fn [app-state [_ tab]]
(console/log "Handling activation" tab)
(if tab
(assoc-in app-state
(conj tab-data-path (:id tab))
(-> tab
select-tab-keys
(assoc :active true
:start-time (now))))
app-state)))
(register-handler
:handle-deactivation
(fn [app-state [_ tab removed?]]
(console/log "Deactivating" tab removed?)
(when (or (:active tab)
(< 0 (:start-time tab)))
(dispatch [:track-time (:url tab) (- (now) (:start-time tab))]))
(if removed?
app-state
(assoc-in app-state
(conj tab-data-path (:id tab))
(assoc tab :active false
:start-time 0)))))
(register-handler
::tab-activated
(fn [app-state [_ {:keys [activeInfo]}]]
(let [{:keys [tabId windowId]} activeInfo
all-tabs (get-in app-state tab-data-path)
prev-active (filter #(and (:active %)
(not= tabId (:id %))
(= windowId (:windowId %)))
(vals all-tabs))
]
;; Highly unlikely we'll have more than one active tab per window,
;; but let's handle it in case we missed an event
(doseq [tab prev-active]
(dispatch [:handle-deactivation tab]))
(dispatch [:handle-activation (get all-tabs tabId)])
(console/log "Activated" tabId "from window" windowId)
(console/log "Previously active" prev-active))
app-state))
(register-handler
::tab-created
(fn [app-state [_ {:keys [tab]}]]
(console/log "Created" tab)
(when (:active tab)
;; If we just created an active tab, make sure we go through the activation cycle
(dispatch [::tab-activated {:activeInfo {:tabId (:id tab)
:windowId (:windowId tab)}}]))
(assoc-in app-state
(conj tab-data-path (:id tab))
(process-tab tab))
))
(register-handler
::tab-removed
(fn [app-state [_ msg]]
(let [id (:tabId msg)
tabs (get-in app-state tab-data-path)
tab (get tabs id)]
(console/trace "Removed id:" id "Previous" tab (:active tab))
(dispatch [:handle-deactivation tab true]) ; We're not only deactivating it, we're destroying it
(assoc-in app-state tab-data-path (dissoc tabs id)))))
(register-handler
::tab-replaced
(fn [app-state [_ {:keys [added removed]}]]
;; When we get a tab-replaced, we only get two ids. We don't get any
;; other tab information. We'll treat this as a remove and a create,
;; and let those event handlers handle it.
(console/log "Replaced" added removed)
(dispatch [::tab-removed {:tabId removed}])
(go (dispatch [::tab-created {:tab (<! (tabs/get-tab added))}]))
app-state
))
(register-handler
::tab-updated
(fn [app-state [_ {:keys [tabId tab]}]]
(let [old-tab (get-in app-state (conj tab-data-path tabId))]
(when (and (:active tab)
(not= (:url old-tab)
(:url tab)))
(do
(console/log "Tab URL changed while active")
(dispatch [:handle-deactivation old-tab])
(dispatch [:handle-activation tab]))
)
;; TODO: Handle case where the url changed
)
(console/log "Updated" tabId tab (get-in app-state (conj tab-data-path tabId)))
app-state
))
(register-handler
:track-time
(fn [app-state [_ url time]]
(console/log time "milliseconds spent at" url)
app-state))
;; TODO
;; - Track URL state changes
;; - Log time spent on URL
;; TODO: Handle detached tabs, looks like we don't get an activate for them.
(register-handler
:start-tracking
(fn [app-state [_ tabs]]
(-> app-state
(assoc-in tab-data-path (process-tabs tabs))
(assoc-in url-time-path
(or (get-in app-state url-time-path) {})))))
(defn start-tracking []
(go (dispatch [:start-tracking (<! (tabs/query))])))
;;;;-------------------------------------
;;;; Initialization
;;;;-------------------------------------
(defn init-time-tracking []
(go (let [window (<! (windows/get-current))
state (<! (idle/query-state 30))]
(dispatch-sync [:initialize (:tabs window)])
(dispatch-sync [:idle-state-change {:newState state}])
(start-tracking)))
(dispatch-on-channel :log-content storage/on-changed)
(dispatch-on-channel ::tab-activated tabs/on-activated)
(dispatch-on-channel ::tab-created tabs/on-created)
(dispatch-on-channel ::tab-removed tabs/on-removed)
(dispatch-on-channel ::tab-updated tabs/on-updated)
(dispatch-on-channel ::tab-replaced tabs/on-replaced)
(idle/set-detection-interval 60)
(dispatch-on-channel :idle-state-change idle/on-state-changed))
(defn init []
(init-time-tracking)
(go-loop
[conns (runtime/on-connect)]
(let [content (<! conns)]
(console/log "On background. Got message: " (<! content))
(>! content "Hello from background"))
(recur conns)))
(ns booklet.core
(:require [ajax.core :refer [GET POST PUT]]
[booklet.utils :refer [dispatch-on-channel]]
[cljs.core.async :refer [>! <!]]
[cljs.core :refer [random-uuid]]
[cljsjs.react-bootstrap]
......@@ -220,15 +221,15 @@
(register-handler
:snapshot-post
(fn [app-state [_]]
(let [to-send (select-keys (:data app-state) [:instance-id :snapshots])]
(GET (str api-uri "/api/echo/" "hello")
{:handler #(console/log "GET Handler" %)
:error-handler #(console/log "GET Error" %)})
(POST (str api-uri "/api/snapshot/many")
{:params to-send
:handler #(dispatch [:snapshot-post-success (:snapshots to-send)])
:error-handler #(dispatch [:log-content %])})
)
#_(let [to-send (select-keys (:data app-state) [:instance-id :snapshots])]
(GET (str api-uri "/api/echo/" "hello")
{:handler #(console/log "GET Handler" %)
:error-handler #(console/log "GET Error" %)})
(POST (str api-uri "/api/snapshot/many")
{:params to-send
:handler #(dispatch [:snapshot-post-success (:snapshots to-send)])
:error-handler #(dispatch [:log-content %])})
)
app-state
)
)
......@@ -516,16 +517,6 @@
;;;; Chrome subscriptions
;;;;----------------------------
(defn dispatch-on-channel
"Dispatches msg when there's content received on the channel returned by
function chan-f."
[msg chan-f]
(go-loop
[channel (chan-f)]
(dispatch [msg (<! channel)])
(recur channel)
))
(defn mount-components []
(reagent/render-component [navbar] (.getElementById js/document "navbar"))
......
(ns booklet.utils
(:require [re-frame.core :refer [dispatch dispatch-sync]])
(:require-macros [cljs.core.async.macros :refer [go go-loop]]))
(defn dispatch-on-channel
"Dispatches msg when there's content received on the channel returned by
function chan-f."
[msg chan-f]
(go-loop
[channel (chan-f)]
(dispatch [msg (<! channel)])
(recur channel)
))
(ns booklet.background
(:require [cljs.core.async :refer [>! <!]]
[khroma.log :as console]
[khroma.runtime :as runtime]
[khroma.windows :as windows])
(:require-macros [cljs.core.async.macros :refer [go]]))
(defn init []
(go (let [conns (runtime/on-connect)
content (<! conns)]
(console/log "On background. Got message: " (<! content))
(>! content "Hello from background")
(init))))
(ns booklet.devcards
(:require [devcards.core :as core]
[khroma.log :as console]))
(defn ^:export main []
(console/log "Initializing UI...")
(core/start-devcard-ui!*))
\ No newline at end of file
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