handlers.cljs

(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.utils :refer [document-size
                                   window-size
                                   valid-request-id?
                                   window-scroll-position
                                   clean-incoming-grant-op
                                   clean-incoming-grant-ops
                                   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
        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
              (-> response
                  :faculty
                  parse-int-id
                  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])))