639 lines
26 KiB
Clojure
639 lines
26 KiB
Clojure
(ns auto-ap.views.utils
|
|
(:require
|
|
[cemerick.url]
|
|
[cljs-time.coerce :as c]
|
|
[cljs-time.core :as t]
|
|
[cljs-time.format :as format]
|
|
[cljs.tools.reader.edn :as edn]
|
|
[clojure.spec.alpha :as s]
|
|
[clojure.string :as str]
|
|
[goog.crypt.base64 :as base64]
|
|
[re-frame.core :as re-frame]
|
|
[react-transition-group :as react-transition-group]
|
|
#_{:clj-kondo/ignore [:unused-namespace]}
|
|
[reagent.core :as reagent]
|
|
[reagent.core :as r]
|
|
[react :as react]
|
|
[auto-ap.entities.shared :as shared])
|
|
(:import
|
|
(goog.i18n NumberFormat)
|
|
(goog.i18n.NumberFormat Format)))
|
|
|
|
(def nff
|
|
(NumberFormat. Format/CURRENCY))
|
|
|
|
(defn nf
|
|
[num]
|
|
(.format nff (str num)))
|
|
|
|
(defn ->$ [x]
|
|
(nf x))
|
|
|
|
(defn- nf%
|
|
[num]
|
|
(.format (doto
|
|
(NumberFormat. Format/PERCENT)
|
|
(.setMaximumFractionDigits 1)
|
|
(.setMinimumFractionDigits 1))
|
|
(str num)))
|
|
|
|
(defn ->% [x]
|
|
(nf% x))
|
|
|
|
(defn ->short$ [x]
|
|
(cond
|
|
(nil? x)
|
|
nil
|
|
|
|
(int? x)
|
|
(str x)
|
|
|
|
(float? x)
|
|
(.toFixed x 2)
|
|
|
|
))
|
|
|
|
(defn active-when= [active-page candidate]
|
|
(when (= active-page candidate) " is-active"))
|
|
|
|
(defn active-when [active-page f & rest]
|
|
|
|
(when (apply f (into [active-page] rest)) " is-active"))
|
|
|
|
(def login-url
|
|
(let [client-id "264081895820-0nndcfo3pbtqf30sro82vgq5r27h8736.apps.googleusercontent.com"
|
|
redirect-uri (js/encodeURI (str (.-origin (.-location js/window)) "/api/oauth"))]
|
|
(str "https://accounts.google.com/o/oauth2/auth?access_type=online&client_id=" client-id "&redirect_uri=" redirect-uri "&response_type=code&max_auth_age=0&scope=https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.email+https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fuserinfo.profile")))
|
|
|
|
(defn dispatch-value-change [event]
|
|
(fn [e]
|
|
(.preventDefault e)
|
|
(re-frame/dispatch (conj event (.. e -target -value)))))
|
|
|
|
|
|
(defn delayed-dispatch [e]
|
|
(fn [_]
|
|
(js/setTimeout #(re-frame/dispatch e) 151)
|
|
false))
|
|
|
|
|
|
(defn dispatch-event [event]
|
|
(fn [e]
|
|
(when (.-stopPropagation e)
|
|
(.stopPropagation e)
|
|
(.preventDefault e))
|
|
(re-frame/dispatch-sync event)))
|
|
|
|
(defn dispatch-event-with-propagation [event]
|
|
(fn [_]
|
|
(re-frame/dispatch-sync event)))
|
|
|
|
(def pretty-long (format/formatter "MM/dd/yyyy HH:mm:ss"))
|
|
(def pretty (format/formatter "MM/dd/yyyy"))
|
|
(def standard (format/formatter "yyyy-MM-dd"))
|
|
|
|
(defn date->str
|
|
([d] (date->str d pretty))
|
|
([d format]
|
|
(when d
|
|
(format/unparse format d))))
|
|
|
|
(defn date-time->str [d]
|
|
(when d
|
|
(format/unparse pretty-long d)))
|
|
|
|
(defn str->date [d f]
|
|
(when d
|
|
(format/parse f d)))
|
|
|
|
(defn dispatch-date-change [event]
|
|
(fn [e]
|
|
(re-frame/dispatch (conj event
|
|
(if (str/blank? e)
|
|
e
|
|
(date->str (t/from-default-time-zone (c/from-date e)) standard))))))
|
|
|
|
(defn dispatch-cljs-date-change [event]
|
|
(fn [e]
|
|
(re-frame/dispatch (conj event
|
|
(if (str/blank? e)
|
|
e
|
|
(c/to-local-date e))))))
|
|
|
|
;; TODO inline on-changes causes each field to be rerendered each time. When we fix this
|
|
;; let's make sure that we find away not to trigger a re-render for every component any time any form field
|
|
;; changes
|
|
(defmulti do-bind (fn [_ {:keys [type]}]
|
|
type))
|
|
|
|
(defn with-keys [children]
|
|
(map-indexed (fn [i c] ^{:key i} c) children))
|
|
|
|
|
|
(def css-transition-group
|
|
(reagent/adapt-react-class react-transition-group/CSSTransition))
|
|
|
|
(def transition
|
|
(reagent/adapt-react-class react-transition-group/Transition))
|
|
|
|
(def transition-group
|
|
(reagent/adapt-react-class react-transition-group/TransitionGroup))
|
|
|
|
(def switch-transition
|
|
(reagent/adapt-react-class react-transition-group/SwitchTransition))
|
|
|
|
(defn appearing [{:keys [visible? enter-class exit-class timeout]}]
|
|
(let [final-state (reagent/atom visible?)]
|
|
(fn [{:keys [visible?]} & children]
|
|
[css-transition-group {:in visible? :class-names {:exit exit-class :enter enter-class} :timeout timeout :onEnter (fn [] (reset! final-state true )) :onExited (fn [] (reset! final-state false))}
|
|
(if (or @final-state visible?)
|
|
(first children)
|
|
[:span])])))
|
|
|
|
(defn appearing-group []
|
|
(let [children (r/children (r/current-component))]
|
|
(into [transition-group {:exit true
|
|
:enter true}
|
|
(for [child children]
|
|
^{:key (:key (meta child))}
|
|
[transition
|
|
{:timeout 200
|
|
:exit true
|
|
:in true #_ (= current-stack- (:key (meta child)))}
|
|
(clj->js (fn [state]
|
|
(r/as-element
|
|
[:div {:style {
|
|
:transition "opacity 150ms ease-in-out"
|
|
:opacity (cond
|
|
(= "entered" state)
|
|
1.0
|
|
|
|
(= "entering" state)
|
|
0.0
|
|
|
|
(= "exiting" state)
|
|
0.0
|
|
|
|
(= "exited" state)
|
|
0.0)}}
|
|
child])))])])))
|
|
|
|
|
|
(defn multi-field [{:keys [value]} ]
|
|
(let [value-repr (reagent/atom (mapv
|
|
(fn [x]
|
|
(assoc x :key (random-uuid) :new? false))
|
|
value))]
|
|
(fn [{:keys [template on-change allow-change? disable-new? disable-remove?]} ]
|
|
(let [value @value-repr
|
|
already-has-new-row? (= [:key :new?] (keys (last value)))
|
|
value (if (or already-has-new-row? disable-new?)
|
|
value
|
|
(conj value {:key (random-uuid)
|
|
:new? true}))]
|
|
[:div {:style {:margin-bottom "0.25em"}}
|
|
(for [[i override] (map vector (range) value)
|
|
:let [is-disabled? (if (= false allow-change?)
|
|
(not (boolean (:new? override)))
|
|
nil)]
|
|
]
|
|
^{:key (:key override)}
|
|
[:div.level {:style {:margin-bottom "0.25em"}}
|
|
[:div.level-left {:style {:padding "0.5em 1em"}
|
|
:class (cond
|
|
(and (= i (dec (count value)))
|
|
(:new? override))
|
|
"has-background-light"
|
|
|
|
(:new? override)
|
|
"has-background-info-light"
|
|
:else
|
|
"")}
|
|
(let [template (if (fn? template)
|
|
(template override)
|
|
template)]
|
|
|
|
[:<> (for [[idx template] (map vector (range ) template)]
|
|
^{:key idx}
|
|
|
|
[:div.level-item
|
|
(update template 1 assoc
|
|
:value (let [value (get-in override (get-in template [1 :field])) ;; TODO this is really ugly to support maps or strings
|
|
value (if (map? value)
|
|
(dissoc value :key :new?)
|
|
value)]
|
|
(if (= value {})
|
|
nil
|
|
value))
|
|
:disabled (or is-disabled? (get-in template [1 :disabled]))
|
|
:on-change (fn [e]
|
|
(reset! value-repr
|
|
(into []
|
|
(filter (fn [r]
|
|
(not= [:key :new?] (keys r)))
|
|
(assoc-in value
|
|
(into [i] (get-in template [1 :field]))
|
|
(let [this-value (if (and e (.. e -target))
|
|
(.. e -target -value )
|
|
e)]
|
|
(if (map? this-value)
|
|
(update this-value :key (fnil identity (random-uuid)))
|
|
this-value))))))
|
|
(on-change (mapv
|
|
(fn [v]
|
|
(dissoc v :new? :key))
|
|
@value-repr))))])
|
|
])
|
|
(when-not disable-remove?
|
|
[:div.level-item
|
|
[:a.button.level-item
|
|
{:disabled is-disabled?
|
|
:on-click (fn []
|
|
(when-not is-disabled?
|
|
(reset! value-repr (into []
|
|
(filter (fn [{:keys [key ]}]
|
|
(not= key (:key override)))
|
|
(filter (fn [r]
|
|
(not= [:key :new?] (keys r)))
|
|
value))))
|
|
|
|
(on-change (mapv
|
|
(fn [v]
|
|
(dissoc v :new? :key))
|
|
@value-repr))))}
|
|
[:span.icon [:span.icon-remove]]]])
|
|
]])]))))
|
|
|
|
|
|
|
|
(defmethod do-bind "select" [dom {:keys [field allow-nil? subscription event class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:on-change (dispatch-value-change (conj event field))
|
|
|
|
:value (or (get-in subscription field) "")
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)
|
|
options (if allow-nil?
|
|
(with-keys (conj rest [:option {:value nil}]))
|
|
(with-keys rest))]
|
|
(into [dom (dissoc keys :allow-nil?)] options)))
|
|
|
|
|
|
(defmethod do-bind "radio" [dom {:keys [field subscription event class value spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:on-change (dispatch-value-change (conj event field))
|
|
:checked (= (get-in subscription field) value)
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field ))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
(defmethod do-bind "checkbox" [dom {:keys [field subscription event class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:on-change (dispatch-event (-> event
|
|
(conj field)
|
|
(conj (not (get-in subscription field)))))
|
|
:checked (boolean (get-in subscription field))
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field ))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
(defmethod do-bind "multi-field" [dom {:keys [field event subscription class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:on-change (fn [value]
|
|
(re-frame/dispatch (conj (conj event field) value)))
|
|
:value (get-in subscription field)
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
|
|
|
|
(defmethod do-bind "typeahead-v3" [dom {:keys [field event subscription class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:on-change (fn [selected]
|
|
(re-frame/dispatch (conj (conj event field) selected))
|
|
#_(when text-field
|
|
(re-frame/dispatch (conj (conj (or text-event event) text-field) text-value))))
|
|
:value (get-in subscription field)
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
(defmethod do-bind "date" [dom {:keys [field event subscription class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
selected (get-in subscription field)
|
|
keys (assoc keys
|
|
:on-change (fn [v]
|
|
(re-frame/dispatch (-> event (conj field) (conj v))))
|
|
|
|
:value selected
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
(defmethod do-bind "expense-accounts" [dom {:keys [field event subscription class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:value (get-in subscription field)
|
|
:event (conj event field)
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
|
|
(defmethod do-bind "button-radio" [dom {:keys [field event subscription class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:value (get-in subscription field)
|
|
:on-change (fn [v]
|
|
(re-frame/dispatch (-> event (conj field) (conj v))))
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :event :subscription :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
(defmethod do-bind "number" [dom {:keys [field event subscription class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:on-change (fn [e]
|
|
(.preventDefault e)
|
|
(re-frame/dispatch (-> event
|
|
(conj field)
|
|
(conj (let [val (.. e -target -value)]
|
|
(cond (and val
|
|
(re-matches #"[\-]?(\d+)(\.\d{2})?" val))
|
|
(js/parseFloat val)
|
|
|
|
(str/blank? val )
|
|
nil
|
|
|
|
:else
|
|
val))))))
|
|
:value (get-in subscription field)
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
(defmethod do-bind "textarea->table" [dom {:keys [field event subscription class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:on-change (fn [x]
|
|
(re-frame/dispatch (-> event
|
|
(conj field)
|
|
(conj x))))
|
|
:value (get-in subscription field)
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
(defmethod do-bind "money" [dom {:keys [field event subscription class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:on-change (fn [x]
|
|
(re-frame/dispatch (-> event
|
|
(conj field)
|
|
(conj x))))
|
|
:value (get-in subscription field)
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
(defmethod do-bind :default [dom {:keys [field event subscription class spec] :as keys} & rest]
|
|
(let [field (if (keyword? field) [field] field)
|
|
event (if (keyword? event) [event] event)
|
|
keys (assoc keys
|
|
:on-change (dispatch-value-change (conj event field))
|
|
:value (get-in subscription field)
|
|
:class (str class
|
|
(when (and spec (not (s/valid? spec (get-in subscription field))))
|
|
" is-danger")))
|
|
keys (dissoc keys :field :subscription :event :spec)]
|
|
(into [dom keys] (with-keys rest))))
|
|
|
|
(defn bind-field [all]
|
|
(apply do-bind all))
|
|
|
|
|
|
|
|
(defn horizontal-field [label & controls]
|
|
[:div.field.is-horizontal
|
|
(when label
|
|
[:div.field-label
|
|
label
|
|
])
|
|
(into
|
|
[:div.field-body]
|
|
(with-keys (map (fn [x] [:div.field x]) controls)))])
|
|
|
|
(defn coerce-date [d]
|
|
(cond (and (string? d)
|
|
(some->> (re-find #"^(\d{4})" d)
|
|
second
|
|
(js/parseInt)
|
|
(#(> % 2000))))
|
|
(try
|
|
(c/to-date-time (t/to-default-time-zone (t/from-default-time-zone (str->date d standard))))
|
|
(catch js/Error _
|
|
nil))
|
|
|
|
(instance? goog.date.DateTime d)
|
|
(c/to-date-time (t/to-default-time-zone (t/from-default-time-zone d)))
|
|
|
|
(instance? goog.date.Date d)
|
|
(c/to-date-time d)
|
|
|
|
:else
|
|
nil ))
|
|
|
|
(defn date-picker-internal [params]
|
|
|
|
(let [[text set-text ] (react/useState (some-> params :value coerce-date (date->str standard)))
|
|
[value set-value ] (react/useState (some-> params :value coerce-date))
|
|
swap-external-value (fn [new-value]
|
|
((:on-change params)
|
|
(cond (= :text (:output params))
|
|
(some-> new-value (date->str standard))
|
|
|
|
(= :cljs-date (:output params))
|
|
new-value
|
|
|
|
:else
|
|
(c/to-date new-value))))]
|
|
(react/useEffect (fn []
|
|
(let [prop-date (some-> params :value coerce-date)]
|
|
(when (not (t/= prop-date
|
|
value))
|
|
(set-value prop-date)
|
|
(if prop-date
|
|
(set-text (date->str prop-date standard))
|
|
(set-text ""))))))
|
|
[:div.field.has-addons
|
|
[:div.control
|
|
[:input.input (assoc params
|
|
:value text
|
|
:on-change (fn [e]
|
|
|
|
(set-text (.. e -target -value))
|
|
;; if it's a perfect match, change it on the spot
|
|
;; especially important for calendar clicking, don't
|
|
;; want to wait for blur
|
|
(when (or (re-matches shared/date-regex (.. e -target -value))
|
|
(nil? (.. e -target -value)))
|
|
(swap-external-value (some-> (.. e -target -value) coerce-date))))
|
|
|
|
:on-blur (fn []
|
|
(swap-external-value (some-> text coerce-date))
|
|
(when (:on-blur params)
|
|
((:on-blur params))))
|
|
:type "date" :placeholder "12/1/2021")]
|
|
]]))
|
|
|
|
(defn date-picker []
|
|
[:f> date-picker-internal
|
|
(r/props (r/current-component))])
|
|
|
|
(defn local-now []
|
|
(t/to-default-time-zone (t/now)))
|
|
|
|
(defn local-today []
|
|
(t/at-midnight (t/to-default-time-zone (t/now))))
|
|
|
|
(def with-user
|
|
(re-frame/->interceptor
|
|
:id :with-user
|
|
:before (fn [context]
|
|
(-> context
|
|
(assoc-in [:coeffects :user] (get-in context [:coeffects :db :user]))))))
|
|
|
|
(def with-role
|
|
(re-frame/->interceptor
|
|
:id :with-role
|
|
:before (fn [context]
|
|
(-> context
|
|
(assoc-in [:coeffects :role] (-> (get-in context [:coeffects :db :user])
|
|
(str/split #"\.")
|
|
second
|
|
(base64/decodeString )
|
|
(#(.parse js/JSON % ))
|
|
(js->clj :keywordize-keys true)
|
|
:user/role))))))
|
|
|
|
(def with-is-admin?
|
|
(re-frame/->interceptor
|
|
:id :with-is-admin?
|
|
:before (fn [context]
|
|
(-> context
|
|
(assoc-in [:coeffects :is-admin?] (= "admin"
|
|
(-> (get-in context [:coeffects :db :user])
|
|
(str/split #"\.")
|
|
second
|
|
(base64/decodeString )
|
|
(#(.parse js/JSON % ))
|
|
(js->clj :keywordize-keys true)
|
|
:user/role)))))))
|
|
|
|
(defn query-params []
|
|
(reduce-kv
|
|
(fn [result k v]
|
|
(assoc result (keyword k) (edn/read-string v)))
|
|
{}
|
|
(:query (cemerick.url/url (.-location js/window)))))
|
|
|
|
|
|
(defn action-cell-width [cnt]
|
|
(str (inc (* cnt 51)) "px"))
|
|
|
|
(defn days-until [d]
|
|
(let [today (t/at-midnight (t/now))
|
|
d (t/at-midnight d)
|
|
in (if (t/after? today d)
|
|
(- (t/in-days (t/interval (t/minus d (t/days 1)) today)))
|
|
(t/in-days (t/interval today d )))]
|
|
in))
|
|
|
|
(defn copy-to-clipboard [text]
|
|
(let [el (js/document.createElement "textarea")]
|
|
|
|
(set! (.-value el) text)
|
|
(.appendChild js/document.body el)
|
|
(.select el)
|
|
(js/document.execCommand "copy")
|
|
(.removeChild js/document.body el)))
|
|
|
|
(defn account->match-text [x]
|
|
(str (:numeric-code x) " - " (:name x)))
|
|
|
|
(defn str->int [x]
|
|
(cond
|
|
(nil? x)
|
|
nil
|
|
|
|
(and (string? x)
|
|
(str/blank? x))
|
|
nil
|
|
|
|
(string? x)
|
|
(js/parseInt x)
|
|
|
|
:else
|
|
x))
|
|
|
|
|
|
(defn parse-jwt [jwt]
|
|
(when-let [json (some-> jwt
|
|
(str/split #"\.")
|
|
second
|
|
base64/decodeString)]
|
|
(js->clj (.parse js/JSON json) :keywordize-keys true)))
|
|
|
|
(defn coerce-float [f]
|
|
(cond (str/blank? f)
|
|
nil
|
|
|
|
(float? f)
|
|
f
|
|
|
|
(and (string? f)
|
|
(not (js/Number.isNaN (js/parseFloat f))))
|
|
(js/parseFloat f)
|
|
|
|
:else
|
|
nil))
|