utils.cljs

(ns ulysses.utils
  (:require-macros [cljs.core.async.macros :refer [go-loop]])
  (:require [clojure.string :as string]
            [clojure.walk :refer [keywordize-keys]]
            [clojure.set :refer [rename-keys]]
            [cljs.core.async :refer [chan put! <! close! timeout sliding-buffer]]
            [re-frame.core :as re-frame :refer [dispatch]]
            [ulysses.config :as config]
            [ulysses.lib.moment :as m]
            [faker.name]
            [ajax.core]))

;; ----------------------------------------------------------------------------
;; general
;; ----------------------------------------------------------------------------

(defn noop
  "do nothing; return nil"
  [& args]
  nil)

(defn boolean? [x]
  (or (true? x) (false? x)))

(defn ptr
  "print x, then return it. useful for
  debugging inside threading macros or map"
  [x]
  (println x)
  x)

(defn ptr-first
  "print (first x), then return x. useful for
  debugging sequences inside threading macros"
  [x]
  (println (first x))
  x)

(defn remap
  "map the values of a hashmap"
  [f m]
  (into {} (for [[k v] m] [k (f v)])))

(defn remap-k
  "map the keys of a hashmap, given key and value"
  [f m]
  (into {} (for [[k v] m] [(f k v) v])))

(defn remap-v
  "map the values of a hashmap, given key and value"
  [f m]
  (into {} (for [[k v] m] [k (f k v)])))

(defn hyphenate-keys
  "given a map, turn all underscores in keys into hyphens"
  [m]
  (remap-k (fn [k v] (-> k name (string/replace #"_" "-") keyword)) m))

(defn map-subels
  "reagent util: apply f to each item in collection,
  associating :key metadata (first tries :id of each el;
  defaults to default-key-i where i is position in coll)"
  [f coll]
  (map-indexed
    (fn [i el]
      ^{:key (or (:id el) (str "default-key-" i))}
      [f el])
    coll))

(defn str->int
  "string or integer to integer; nil if not possible"
  [s]
  (if (integer? s) s
    (when (and (string? s) (re-find #"^\d+$" s))
      (js/parseInt s))))

(defn clj->json
  "clojure data to json string"
  [a]
  (.stringify js/JSON (clj->js a)))

(defn json->clj
  "json string to clojure data. include :keywords to keywordize keys"
  [s & args]
  (-> (.parse js/JSON s)
      (js->clj)
      ((if (some #{:keywords} args)
         keywordize-keys identity))))

(defn url-encode-component
  "urlencode"
  [s]
  (js/encodeURIComponent (str s)))

(defn truncate-with-ellipsis
  "truncate a string if it's longer than n, and append ellipsis"
  ([s n]
   (truncate-with-ellipsis s n "..."))
  ([s n ellip]
   (if (>= n (count s)) s
    (-> s
        (subs 0 n)
        (string/trimr)
        (str ellip)))))

(defn find-by-id
  "find a map by :id within a seqable (of maps)"
  [id seqable]
  (let [id-int (str->int id)]
    (some
      #(when (= (:id %) id-int) %)
      seqable)))

(defn merge-by-id
  "merge multiple seqables of maps by :id; the rightmost having the highest preference"
  ([a b]
   (let [new-ids (map :id b)]
    (concat
      (remove #(-> % :id hash-set (some new-ids)) a)
      b)))
  ([& seqables]
   (reduce merge-by-id seqables)))

(defn remove-by-id
  "remove a map by :id within a seqable (of maps)"
  [id seqable]
  (let [id-int (str->int id)]
    (remove
      #(= id-int (:id %))
      seqable)))

(defn to-id-map
  "convert a list of maps with :id into a hashmap with :id keys"
  [seqable]
  (reduce
    (fn [a e]
      (assoc a (:id e) e))
    (hash-map)
    seqable))

(defn new-id
  "generate a new integer id, given a list of maps
  containing existing integer ids"
  [existing]
  (->> existing
       (map :id)
       (cons 0) ; default pre-inc
       (apply max)
       (inc)))

(defn map-lookup
  "map ids to elements retrieved from map,
  removing if not found"
  [m ids]
  (->> ids
       (map (partial get m))
       (remove nil?)))

(defn valid-request-id?
  "determines if either positive integer
  or positive integer string"
  [id]
  (->> id
       (str)
       (re-find #"^\d+$")
       (nil?)
       (not)))

(defn throttle [ms f]
  (let [c (chan (sliding-buffer 1))]
    (go-loop []
      (apply f (<! c))
      (<! (timeout ms))
      (recur))
    (fn [& args]
      (put! c (or args [])))))


;; this is not a windowed debounce, it is a paused debounce
;; (the timer is reset on each non-timer value)
(defn debounce [ms f]
  (let [in (chan)
        out (chan)]
    ; debounce in channel - based on https://gist.github.com/scttnlsn/9744501
    (go-loop [last-val nil]
      (let [val (if (nil? last-val) (<! in) last-val)
            timer (timeout ms)
            [new-val ch] (alts! [in timer])]
        (condp = ch
          timer (do (>! out val) (recur nil))
          in (if new-val (recur new-val) (close! out)))))

    ; call debounced function on the given function/handler
    (go-loop []
       (let [val (<! out)]
         (apply f val)
         (recur)))

    ;return in event channel
    in))

(def debounce-standard
  (partial debounce config/request-debounce-time))

;; ----------------------------------------------------------------------------
;; classes
;; ----------------------------------------------------------------------------

(defn classes-vector
  "same as classes, but a vector instead of a space-sep string"
  [& args]
  (reduce
    (fn [final h]
      (cond
        (nil? h) final
        (map? h) (into final
                  (apply classes-vector
                   (->> h
                        (vec)
                        (remove (comp false? second))
                        (map first))))
        (coll? h) (into final (apply classes-vector h))
        (keyword? h) (conj final (name h))
        (string? h) (conj final h)
        :else (conj final (str h))))
    []
    args))

(defn classes
  "make a string of classes intelligently.
  takes: string/keyword args or [recursive] seqs
  or maps (for switching).
  ex. (classes 'btn' :brown) => 'btn brown'
  ex. (classes ['btn' 'brown']) => 'btn brown'
  ex. (classes {['btn' 'blue'] true 'brown' false}) => 'btn blue'"
  [& args]
  (string/join " " (apply classes-vector args)))

(defn classes-attr
  "same as classes, but places in {:class CLASSES}"
  [& args]
  {:class (apply classes args)})

(defn btn-classes
  "make string of bootstrap button classes
   ex. (btn-classes \"sm\" \"block\") => \"btn btn-sm btn-block\""
  [& classes]
  (->> classes
       (apply classes-vector)
       (map (partial str "btn-"))
       (cons "btn")
       (string/join " ")))

;; ----------------------------------------------------------------------------
;; dom event handling
;; ----------------------------------------------------------------------------

(defn d-p
  "default-prevent a click handler (and forward event)"
  [f]
  (fn [e] (.preventDefault e) (f e)))

;; ----------------------------------------------------------------------------
;; dom info
;; ----------------------------------------------------------------------------

(defn window-size []
  "get the :width and :height of the current window"
  {:width (.-innerWidth js/window)
   :height (.-innerHeight js/window)})

(defn document-size
  "get the :width and :height of the current document"
  []
  (let [d js/document
        body (or (.-body d) #js {})
        de (or (.-documentElement d) #js {})]
    {:width (max
              (.-scrollWidth body) (.-offsetWidth body)
              (.-clientWidth de) (.-scrollWidth de) (.-offsetWidth de))
     :height (max
              (.-scrollHeight body) (.-offsetHeight body)
              (.-clientHeight de) (.-scrollHeight de) (.-offsetHeight de))}))

(defn window-scroll-position
  "get the :y (scrollTop) and :x (scrollLeft) of the current window"
  []
  (let [w js/window
        de (.-documentElement js/document)]
    {:x (or (.-pageXOffset w) (.-scrollLeft de) 0)
     :y (or (.-pageYOffset w) (.-scrollTop de) 0)}))

;; ----------------------------------------------------------------------------
;; misc helpers
;; ----------------------------------------------------------------------------

(defn mechanism-to-contextual
  "mechanism to contextual (as keyword) helper
  ex. :nsf => :info"
  [mechanism]
  (mechanism config/mechanism-contextuals))

(defn update-db-pagination
  "update db :page-current and :page-last given paginated response"
  [db {:keys [current_page last_page]}]
  (-> db
      (assoc :page-current current_page)
      (assoc :page-last last_page)))

(defn faculties-pool-params
  "make a pool request params map with titleSet[0..n] and yearsUconn"
  [db]
  (->> [:builder-filters :faculty-title-set]
       (get-in db)
       (map-indexed
         (fn [i t]
           (vector (str "titleSet[" i "]") t)))
       (into {})
       (merge {:yearsAtUconn
               (get-in db [:builder-filters :faculty-years-uconn])})))

(defn metric-maxes
  "given metrics builder filters (0-100) and faculties,
  return the maximum values for each metric"
  [metrics faculties]
  (let [fm (map :metrics faculties)]
    (remap-v
      (fn [metric _]
        (->> fm
             (map (fn [f] (get f metric)))
             (filter integer?)
             (apply max)))
      metrics)))

(defn verify-user-poll-response
  [response]
  (-> response :user :netid string/blank? not))

(defn validate-builder-filters
  [{:keys [faculty-title-set faculty-years-uconn metrics] :as filters}]
  (and
    ; general
    (map? filters)
    (= (-> filters keys set) #{:faculty-title-set :faculty-years-uconn :metrics})
    ; faculty title set
    (set? faculty-title-set)
    (every? string? faculty-title-set)
    ; faculty years uconn
    (integer? faculty-years-uconn)
    ; metrics
    (map? metrics)
    (= (-> metrics keys set)
       #{:publicationCount :grantCount :grantFunds
         :recentGrantCount :recentGrantFunds})
    (every? (every-pred integer? (partial <= 0) (partial >= 100)) (vals metrics))))

;; ----------------------------------------------------------------------------
;; data transforms
;; ----------------------------------------------------------------------------

(defn parse-int-id
  "convert :id to an integer if it's a string-integer"
  [e]
  (update e :id
    #(if (string? %) (str->int %) %)))

(defn clean-incoming-grant-op
  "keywordize keys, rename some keys, parse some dates,
  supplement with some fake data, etc"
  [grant-op]
  (-> grant-op
      (rename-keys {:foa_num :foa-num
                    :posted_date :posted-date
                    :open_date :open-date
                    :loi_due_dates :due-date
                    :application_due_dates :application-due-dates
                    :created_at :created-at
                    :update_at :updated-at})
      ; parse id as int
      (parse-int-id)
      ; parse dates as moment instances
      (update :due-date #(-> % (m/moment "MMMM D, YYYY")))
      ; NOTE they're all nih now, but remove this line eventually
      (assoc :funding-mechanism {:name "nih"})
      ; NOTE fake initial team for now
      (assoc :initial-team (->> (faker.name/names)
                                (take (+ 3 (rand-int 3))) ; between 3 and 6
                                (map-indexed #(hash-map :id %1 :name %2))))))

(defn clean-incoming-grant-ops
  [grant-ops]
  (map clean-incoming-grant-op grant-ops))

;; ----------------------------------------------------------------------------
;; requests
;; ----------------------------------------------------------------------------

(defn request
  "make an api request, with progress tracking"
  [db endpoint & {:keys [method
                         params
                         require-user?
                         progress?
                         handler
                         error-handler
                         finish]
                  :or {method :get
                       params nil
                       require-user? true
                       progress? true
                       handler noop
                       error-handler noop
                       finish noop}}]
  ; only allow requests if logged in or check is bypassed
  (when (or (not require-user?) (:user db))
    (let [progress-id (when progress? (:next-progress-id db))]
      (when progress?
        (dispatch [:progress progress-id 1]))
      (ajax.core/easy-ajax-request
        (string/join "/"
          (cons config/api-endpoint
            (map
              #(if (keyword? %) (name %) %)
              endpoint)))
        method
        {:params
         (when params
           (remap url-encode-component params))
         :with-credentials true
         :format :url
         :response-format :json
         :keywords? true
         :handler handler
         :error-handler
         (fn [e]
           (dispatch [:bad-response e]) ; general error handler
           (error-handler e)) ; user
         :finally
         (fn [e]
           (when progress?
             (dispatch [:progress progress-id 100])) ; complete progress
           (finish e))}))) ; user
  db) ; (no direct db change)

; grant ops requests

(def request-grant-ops-channel
  (debounce-standard
    (fn [db page]
      (let [filters (:home-filters db)]
        (request db
          [:funding]
          :params {:page page
                   :mechanisms (->> filters
                                    :mechanisms
                                    vec
                                    (filter #(-> % second))
                                    (map (comp name first))
                                    (string/join ","))
                   :search (:search filters)
                   :sort (:sort filters)
                   :sortDirection (:sort-direction filters)}
          :handler #(dispatch [:receive-grant-ops %]))))))

(defn debounce-request-grant-ops
  [db [_ page]]
  (put! request-grant-ops-channel [db page])
  db)

; faculty requests

(def request-faculties-pool-channel
  (debounce-standard
    (fn [db]
      (let [grant-op-id (-> db :route-args :grant-op-id)]
        (when (valid-request-id? grant-op-id)
          (request db
            [:faculty :pool]
            :params (merge {:fundingOppType "NihRfa"
                            :fundingOppId grant-op-id}
                           (faculties-pool-params db))
            :handler #(dispatch [:receive-faculties-pool %])))))))

(defn debounce-request-faculties-pool
  [db _]
  (put! request-faculties-pool-channel [db])
  db)

; workspace updates

(def request-workspace-save-channel
  (debounce-standard
    (fn [db]
      (if-let [current (:builder-workspace db)]
        (request db
          [:workspace (:id current)]
          :method :put
          :params {:faculties (clj->json (or (:faculties current) []))
                   :filters (clj->json (:builder-filters db))}
          :handler #(dispatch [:workspace-receive %]))
        db))))

(defn debounce-request-workspace-save
  [db _]
  (put! request-workspace-save-channel [db])
  db)

;; ----------------------------------------------------------------------------
;; direct dom mutations
;; ----------------------------------------------------------------------------

(defn scroll-to [y]
  (.scrollTo js/window 0 y))