Permalink
Cannot retrieve contributors at this time
Name already in use
A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
ulysses-front/src/cljs/ulysses/handlers.cljs
Go to fileThis commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
510 lines (446 sloc)
14.2 KB
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns ulysses.handlers | |
(:require [re-frame.core :as re-frame :refer [register-handler dispatch]] | |
[clojure.set :as set] | |
[ulysses.config :as config] | |
[ulysses.db :as db] | |
[ulysses.lib.moment :as m] | |
[ulysses.lib.packer :refer [fit-words-memoized]] | |
[ulysses.components.misc :refer [inspector]] | |
[ulysses.utils :refer [document-size | |
window-size | |
valid-request-id? | |
window-scroll-position | |
clean-incoming-grant-op | |
clean-incoming-grant-ops | |
clean-incoming-faculty | |
clean-incoming-faculties | |
boolean? | |
hyphenate-keys | |
parse-int-id | |
str->int | |
json->clj | |
by-id | |
find-by-id | |
remove-by-id | |
merge-by-id | |
new-id | |
scroll-to | |
request | |
update-db-pagination | |
verify-user-poll-response | |
debounce-request-grant-ops | |
debounce-request-faculties-pool | |
debounce-request-workspace-save | |
validate-builder-filters]])) | |
;; ---------------------------------------------------------------------------- | |
;; general | |
;; ---------------------------------------------------------------------------- | |
(register-handler | |
:initialize-db | |
(fn [_ _] | |
db/default-db)) | |
(register-handler | |
:set-active-page | |
(fn [db [_ active-page route-params]] | |
; sub-dispatching based on page | |
(case active-page | |
:home (dispatch [:request-grant-ops-start]) | |
nil) | |
(assoc db :active-page active-page | |
:route-args (if (map? route-params) route-params {})))) | |
(register-handler | |
:not-found | |
(fn [db _] | |
(dispatch [:set-active-page :not-found]) | |
db)) | |
(register-handler | |
:window-resize | |
(fn [db _] | |
(let [ws (window-size) | |
ds (document-size)] | |
(if (and (= ws (:window-size db)) (= ds (:document-size db))) | |
db ; no change | |
(assoc db :window-size ws | |
:document-size ds))))) | |
(register-handler | |
:window-scroll | |
(fn [db _] | |
(assoc db :window-scroll-position (window-scroll-position)))) | |
(register-handler | |
:progress | |
(fn [db [_ progress-id progress]] | |
(-> db | |
(update :next-progress-id inc) | |
(update :progress | |
(fn [current] | |
(if (<= 100 progress) | |
(dissoc current progress-id) | |
(assoc current progress-id progress))))))) | |
(register-handler | |
:bad-response | |
(fn [db [_ response]] | |
db)) ; do nothing for now | |
;; ---------------------------------------------------------------------------- | |
;; user | |
;; ---------------------------------------------------------------------------- | |
(register-handler | |
:request-user-poll | |
(fn [db _] | |
(request db | |
[:login :poll] | |
:require-user? false | |
:progress? false | |
:handler #(dispatch [:receive-user-poll %]) | |
;; if server didn't respond or an error occurred, log out | |
:error-handler #(dispatch [:receive-user-poll false])))) | |
(register-handler | |
:receive-user-poll | |
(fn [db [_ response]] | |
(assoc db :user | |
(when (verify-user-poll-response response) | |
(:user response))))) | |
;; ---------------------------------------------------------------------------- | |
;; raw data | |
;; ---------------------------------------------------------------------------- | |
; faculty titles ---- | |
(register-handler | |
:request-faculty-titles | |
(fn [db _] | |
(request db | |
[:faculty :titles] | |
:handler #(dispatch [:receive-faculty-titles %])))) | |
(register-handler | |
:receive-faculty-titles | |
(fn [db [_ response]] | |
(if-not (vector? response) db | |
(assoc db :faculty-titles response)))) | |
; builder grant op ---- | |
(register-handler | |
:request-builder-grant-op | |
(fn [db [_ grant-op-id]] | |
(when (valid-request-id? grant-op-id) | |
(request db | |
[:funding grant-op-id] | |
:handler #(dispatch [:receive-builder-grant-op %]) | |
:error-handler #(dispatch [:nil-builder]))) | |
db)) | |
(register-handler | |
:receive-builder-grant-op | |
(fn [db [_ response]] | |
(assoc db :builder-grant-op | |
(-> response | |
:nih_rfa | |
clean-incoming-grant-op)))) | |
; faculties pool ---- | |
(register-handler | |
:request-faculties-pool | |
debounce-request-faculties-pool) | |
(register-handler | |
:receive-faculties-pool | |
(fn [db [_ response]] | |
(if-not (vector? response) db | |
(assoc db :builder-faculties-pool | |
(clean-incoming-faculties response))))) | |
; grant ops ---- | |
(register-handler | |
:request-grant-ops | |
debounce-request-grant-ops) | |
(register-handler | |
:request-grant-ops-start | |
(fn [db _] | |
(dispatch [:request-grant-ops 1]) | |
db)) | |
(register-handler | |
:receive-grant-ops | |
(fn [db [_ response]] | |
(scroll-to 0) | |
(-> db | |
(update-db-pagination response) | |
(assoc :grant-ops | |
(-> response | |
:data | |
clean-incoming-grant-ops))))) | |
; faculties ---- | |
(register-handler | |
:request-faculty | |
(fn [db [_ faculty-id]] | |
(request db | |
[:faculty :keywords faculty-id] | |
:handler #(dispatch [:receive-faculty %])))) | |
(register-handler | |
:receive-faculty | |
(fn [db [_ response]] | |
(-> db | |
(update :faculties | |
(fn [faculties] | |
(merge | |
faculties | |
(let [faculty (-> response | |
:faculty | |
clean-incoming-faculty)] | |
; memoize word cloud keyword sizes | |
(doall (fit-words-memoized (:keywords faculty))) | |
(-> faculty | |
list | |
by-id)))))))) | |
;; ---------------------------------------------------------------------------- | |
;; user data | |
;; ---------------------------------------------------------------------------- | |
;; workspace management ---- | |
(register-handler | |
:workspace-load-from-op | |
(fn [db [_ grant-op-id]] | |
(request db | |
[:workspace] | |
:params {:grant_op_id grant-op-id} | |
:method :get | |
:handler | |
(fn [{:keys [user current]}] ; TODO destructure default from here probably | |
;; receive user workspaces | |
(doseq [w user] | |
(dispatch [:workspace-receive w :dont-switch])) | |
;; switch to the last workspace according to backend | |
(dispatch [:workspace-switch current]))))) | |
; copy a workspace from :workspaces to :builder-workspace | |
(register-handler | |
:workspace-switch | |
(fn [db [_ workspace-id-maybe]] | |
(dispatch [:workspace-faculty-request]) | |
(if workspace-id-maybe | |
(if-let [target (find-by-id workspace-id-maybe (:workspaces db))] | |
(-> db | |
(assoc :builder-workspace target) | |
(assoc :builder-filters (:filters target))) | |
; TODO get default workspace | |
db) | |
; TODO get default workspace | |
db))) | |
(register-handler | |
:workspace-receive | |
(fn [db [_ response dont-switch? is-after-save?]] | |
(let [wbb (-> response | |
(hyphenate-keys) | |
(select-keys [:id :name | |
:grant-op-id :user-id | |
:updated-at :created-at | |
:faculties :filters]) | |
(update :filters | |
(fn [jstr] | |
(-> jstr | |
(json->clj :keywords) | |
(update :faculty-title-set set)))) | |
(update :faculties | |
(fn [faculties] | |
(map :id faculties)))) | |
valid-filters? (-> wbb :filters validate-builder-filters)] | |
(if-not valid-filters? db | |
(do | |
(when is-after-save? | |
(dispatch [:workspace-saved (:id wbb)])) | |
(when-not dont-switch? | |
(dispatch [:workspace-switch (:id wbb)])) | |
(update db :workspaces | |
(fn [ws] | |
(merge-by-id ws [wbb])))))))) | |
(register-handler | |
:workspace-save | |
debounce-request-workspace-save) | |
(register-handler | |
:workspace-saved | |
(fn [db [_ workspace-id]] | |
(update db :builder-workspaces-saved-timestamps | |
(fn [ts] | |
(assoc ts workspace-id (m/moment)))))) | |
(register-handler | |
:workspace-new-blank | |
(fn [db _] | |
(if-let [op (:builder-grant-op db)] | |
(request db | |
[:workspace] | |
:params {:grant_op_id (:id op)} | |
:method :post | |
:handler #(dispatch [:workspace-receive %])) | |
db))) | |
(register-handler | |
:workspace-new-default | |
(fn [db _] | |
(if-let [op (:builder-grant-op db)] | |
(request db | |
[:workspace :default] | |
:params {:grant_op_id (:id op)} | |
:method :post | |
:handler #(dispatch [:workspace-receive %])) | |
db))) | |
(register-handler | |
:workspace-new-duplicate | |
(fn [db _] | |
(let [op (:builder-grant-op db) | |
current (:builder-workspace db)] | |
(if (and op current) | |
(request db | |
[:workspace :duplicate] | |
:params {:grant_op_id (:id op) | |
:from (:id current)} | |
:method :post | |
:handler #(dispatch [:workspace-receive %])) | |
db)))) | |
(register-handler | |
:workspace-rename | |
(fn [db [_ name]] | |
(if-let [current (:builder-workspace db)] | |
(request db | |
[:workspace :name (:id current)] | |
:params {:name name} | |
:method :put | |
:handler #(dispatch [:workspace-receive %])) | |
db))) | |
; delete current workspace | |
(register-handler | |
:workspace-delete | |
(fn [db _] | |
(dispatch [:nil-workspace]) | |
(dispatch [:workspace-switch nil]) | |
(if-let [current (:builder-workspace db)] | |
(do | |
(request db | |
[:workspace (:id current)] | |
:method :delete) | |
(update db :workspaces | |
(fn [ws] | |
(vec (remove-by-id (:id current) ws))))) | |
db))) | |
;; workspace faculties management ---- | |
; request faculty in the current workspace | |
; that we don't already have in :faculties | |
(register-handler | |
:workspace-faculty-request | |
(fn [db _] | |
(when-let [current (:builder-workspace db)] | |
(let [fc (or (:faculties current) []) | |
faculties (:faculties db) | |
need (remove (partial contains? faculties) fc)] | |
(doseq [id need] | |
(dispatch [:request-faculty id])))) | |
db)) | |
(register-handler | |
:add-working-faculty | |
(fn [db [_ faculty-id]] | |
(dispatch [:request-faculty faculty-id]) | |
(dispatch [:workspace-save]) | |
(if-let [current (:builder-workspace db)] | |
(update db :builder-workspace | |
(fn [w] | |
(assoc w :faculties | |
(-> w | |
:faculties | |
(or []) | |
(set) | |
(conj faculty-id) | |
(vec))))) | |
; TODO create new workspace from default, | |
; then add this new working faculty | |
db))) | |
(register-handler | |
:remove-working-faculty | |
(fn [db [_ faculty-id]] | |
(dispatch [:nil-builder-workspace-faculty-hover]) | |
(dispatch [:workspace-save]) | |
(if-let [current (:builder-workspace db)] | |
(update db :builder-workspace | |
(fn [w] | |
(assoc w :faculties | |
(->> (or (:faculties w) []) | |
(remove #{faculty-id}) | |
(vec))))) | |
; TODO create new workspace from default, | |
; then add this new working faculty | |
db))) | |
;; home filters ---- | |
(register-handler | |
:home-filter-search | |
(fn [db [_ search-value]] | |
(dispatch [:request-grant-ops-start]) | |
(assoc-in db [:home-filters :search] search-value))) | |
(register-handler | |
:home-filter-mechanism-toggle | |
(fn [db [_ mechanism]] | |
(dispatch [:request-grant-ops-start]) | |
(update-in db [:home-filters :mechanisms mechanism] not))) | |
(register-handler | |
:home-filter-sort | |
(fn [db [_ sort]] | |
(dispatch [:request-grant-ops-start]) | |
(assoc-in db [:home-filters :sort] sort))) | |
(register-handler | |
:home-filter-sort-direction | |
(fn [db [_ sort-direction]] | |
(dispatch [:request-grant-ops-start]) | |
(assoc-in db [:home-filters :sort-direction] sort-direction))) | |
;; builder faculty pool filters ---- | |
(register-handler | |
:builder-filter-faculty-title-set | |
(fn [db [_ title-set]] | |
(dispatch [:request-faculties-pool]) | |
(dispatch [:workspace-save]) | |
(assoc-in db [:builder-filters :faculty-title-set] title-set))) | |
(register-handler | |
:builder-filter-faculty-years-uconn | |
(fn [db [_ years-uconn]] | |
(dispatch [:request-faculties-pool]) | |
(dispatch [:workspace-save]) | |
(assoc-in db [:builder-filters :faculty-years-uconn] | |
(or (str->int years-uconn) 0)))) | |
(register-handler | |
:builder-filter-faculty-metric | |
(fn [db [_ metric value]] | |
(dispatch [:workspace-save]) | |
(assoc-in db [:builder-filters :metrics metric] | |
value))) | |
;; builder faculty workspace hover ---- | |
(register-handler | |
:builder-workspace-faculty-hover | |
(fn [db [_ faculty-id]] | |
(assoc db :builder-workspace-faculty-hover | |
faculty-id))) | |
(register-handler | |
:nil-builder-workspace-faculty-hover | |
(fn [db _] | |
(assoc db :builder-workspace-faculty-hover | |
nil))) | |
;; builder nil ---- | |
(register-handler | |
:nil-workspace | |
(fn [db _] | |
(db/refresh-keys db | |
[:builder-workspace | |
:builder-workspace-faculties | |
:builder-workspace-faculty-hover]))) | |
(register-handler | |
:nil-builder | |
(fn [db _] | |
(db/refresh-keys db | |
[:builder-grant-op | |
:builder-faculties-pool | |
:builder-workspace | |
:builder-workspace-faculties | |
:builder-filters | |
:builder-workspace-faculty-hover]))) | |
;; ---------------------------------------------------------------------------- | |
;; interface | |
;; ---------------------------------------------------------------------------- | |
;; modal ---- | |
(register-handler | |
:modal | |
(fn [db [_ modal]] | |
(assoc db :modal modal))) | |
(register-handler | |
:modal-close | |
(fn [db _] | |
(db/refresh-keys db [:modal]))) | |
(register-handler | |
:modal-inspector | |
(fn [db [_ name content]] | |
(assoc db :modal | |
{:title [:span "Inspector View: " [:i name]] | |
:children | |
[inspector content]}))) |