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]]
            [ajax.core :refer [easy-ajax-request]]
            [ulysses.config :as config]
            [ulysses.lib.moment :as m]
            [faker.name]))

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

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

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

(defn lazy-seq? [x]
  (instance? LazySeq x))

;; (native object? doesn't work for objects like js/window)
;; basically, this predicate asks "can i access a js property
;; on x without throwing an error?""
;; ex. (objectifiable? #js [1 2 3]) => true
;; ex. (objectifiable? #js {"foo" "bar"}) => true
;; ex. (objectifiable? [1 2 3]) => true
;; ex. (objectifiable? #{1 2 3}) => true
;; ex. (objectifiable? :foo) => true
;; ex. (objectifiable? nil) => false
;; ex. (objectifiable? true) => false
;; ex. (objectifiable? 3) => false
(defn objectifiable? [x]
  (instance? js/Object x))

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

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

(defn metas-equal?
  "determine if the element metadatas
  of two sequences are equal"
  [a b]
  (let [mm (partial map meta)]
    (= (mm a) (mm b))))

(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: make reagent element with component
  for each value in coll, while associating :key metadata
  (first try :id of each el; default to default-key-i
  where i is key in coll)"
  [component coll]
  (map-indexed
    (fn [i el]
      ^{:key (or (:id el) (str "default-key-" i))}
      [component 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 into-maybe
  "if target is a list or lazy sequence, return coll.
  otherwise, convert coll into the same type as target"
  [target coll]
  (let [list-or-lzs? ((some-fn list? lazy-seq?) target)
        f (if list-or-lzs? identity (partial into (empty target)))]
    (f coll)))

(defn by-id
  "convert a seqable of maps with :id into a
  hashmap with id keys and original map values.
  if there are multiple with the same :id,
  then it takes the last
  ex. (by-id [{:id 1} {:id 2}])
   => {1 {:id 1}, 2 {:id 2}}"
  [seqable]
  (->> seqable
       (group-by :id)
       (remap last)))

(defn find-by-id
  "find a map by :id within a seqable (of maps)"
  [id seqable]
  (when-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;
  the result taking on the type of the first"
  [a & more]
  (->> (apply (partial concat a) more)
       (by-id)
       (vals)
       (into-maybe a)))

(defn remove-by-id
  "remove a map by :id within a seqable (of maps)"
  [id seqable]
  (let [id-int (str->int id)]
    (->> seqable
         (remove #(= id-int (:id %)))
         (into-maybe 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?)
       (into-maybe ids)))

(defn valid-request-id?
  "determines if either positive integer
  or positive integer string"
  [id]
  (if (= (str id) "0")
    false
    (->> 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))

(defn wop
  "when obj is a javascript object, get property"
  [obj prop-name]
  (when (objectifiable? obj)
    (aget obj (name prop-name))))

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

(defn classes-vector
  "same as classes, but a vector instead of a space-sep string"
  [& args]
  (distinct
    (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))
          ((some-fn keyword? string? symbol?) h) (conj final (name h))
          :else (conj final (str h))))
      (vector)
      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 (or (wop js/window :innerWidth) 0)
   :height (or (wop js/window :innerHeight) 0)})

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

(defn window-scroll-position
  "get the :y (scrollTop) and :x (scrollLeft) of the current window"
  []
  (let [w js/window
        de (wop js/document :documentElement)
        ww (partial wop w)
        wde (partial wop de)]
    {: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]
  (get config/mechanism-contextuals mechanism))

(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 and faculties,
  return the maximum values for each metric across faculties"
  [metrics faculties]
  (let [fm (map :metrics faculties)]
    (remap-v
      (fn [metric _]
        (->> fm
             (map (fn [f] (get f metric)))
             (filter number?)
             (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
                    :updated_at :updated-at
                    :top_keywords :top-keywords
                    :keywordCloud :keyword-cloud})
      (dissoc :top-keywords)
      ; 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))

(defn clean-incoming-faculty
  [faculty]
  (-> faculty
      (rename-keys {:created_at :created-at
                    :updated_at :update-at
                    :year_hired :year-hired})
      (parse-int-id)
      (update :keywords
        (fn [kws]
          (when kws
            (map
              (fn [kw]
                {:keyword (:name kw)
                 :score (get-in kw [:pivot :score])})
              kws))))))

(defn clean-incoming-faculties
  [faculties]
  (map clean-incoming-faculty faculties))

;; ----------------------------------------------------------------------------
;; 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]))
      (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
          (fn [response]
            (dispatch [:workspace-receive response nil true])))
        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))