Simplifies a lot by using cursors

This commit is contained in:
2023-10-20 00:12:42 -07:00
parent 174c428405
commit ce8fa027b2
6 changed files with 381 additions and 173 deletions

View File

@@ -122,3 +122,9 @@ htmx.defineExtension('trigger-filter', {
initDatepicker = function(elem) {
elem.dp = new Datepicker(elem, {format: "mm/dd/yyyy", autohide: true});
}
countRows = function(id) {
var table = document.querySelector(id);
var rows = table.querySelectorAll("tbody tr");
return rows.length;
}

137
src/clj/auto_ap/cursor.clj Normal file
View File

@@ -0,0 +1,137 @@
(ns auto-ap.cursor
(:import (clojure.lang IDeref Atom ILookup Counted IFn AFn Indexed ISeq Seqable)))
; TODO not sure if these methods are needed at all; ICursor is used solely as a marker right now
(defprotocol ICursor
(path [cursor])
(state [cursor]))
(defprotocol ITransact
(-transact! [cursor f]))
(declare to-cursor cursor?)
(deftype ValCursor [value state path]
IDeref
(deref [_]
(get-in @state path value))
ICursor
(path [_] path)
(state [_] state)
ITransact
(-transact! [_ f]
(get-in
(swap! state (if (empty? path) f #(update-in % path f)))
path)))
(deftype MapCursor [value state path]
Counted
(count [_]
(count (get-in @state path value)))
ICursor
(path [_] path)
(state [_] state)
IDeref
(deref [_]
(get-in @state path value))
IFn
(invoke [this key]
(get this key))
(invoke [this key defval]
(get this key defval))
(applyTo [this args]
(AFn/applyToHelper this args))
ILookup
(valAt [obj key]
(.valAt obj key nil))
(valAt [_ key defv]
(let [value (get-in @state path value)]
(to-cursor (get value key defv) state (conj path key) defv)))
ITransact
(-transact! [cursor f]
(get-in
(swap! state (if (empty? path) f #(update-in % path f)))
path))
Seqable
(seq [this]
(for [[k v] @this]
[k (to-cursor v state (conj path k) nil)])))
(deftype VecCursor [value state path]
Counted
(count [_]
(count (get-in @state path)))
ICursor
(path [_] path)
(state [_] state)
IDeref
(deref [_]
(get-in @state path))
IFn
(invoke [this i]
(nth this i))
(applyTo [this args]
(AFn/applyToHelper this args))
ILookup
(valAt [this i]
(nth this i))
(valAt [this i not-found]
(nth this i not-found))
Indexed
(nth [_ i]
(let [value (get-in @state path value)]
(to-cursor (nth value i) state (conj path i) nil)))
(nth [_ i not-found]
(let [value (get-in @state path value)]
(to-cursor (nth value i not-found) state (conj path i) not-found)))
ITransact
(-transact! [cursor f]
(get-in
(swap! state (if (empty? path) f #(update-in % path f)))
path))
Seqable
(seq [this]
(for [[v i] (map vector @this (range))]
(to-cursor v state (conj path i) nil))))
(defn- to-cursor
([v state path value]
(cond
(cursor? v) v
(map? v) (MapCursor. value state path)
(vector? v) (VecCursor. value state path)
:else (ValCursor. value state path)
)))
(defn cursor? [c]
"Returns true if c is a cursor."
(satisfies? ICursor c))
(defn cursor [v]
"Creates cursor from supplied value v. If v is an ordinary
data structure, it is wrapped into atom. If v is an atom,
it is used directly, so all changes by cursor modification
functions are reflected in supplied atom reference."
(to-cursor (if (instance? Atom v) @v v)
(if (instance? Atom v) v (atom v))
[] nil))
(defn transact! [cursor f]
"Changes value beneath cursor by passing it to a single-argument
function f. Old value will be passed as function argument. Function
result will be the new value."
(-transact! cursor f))
(defn update! [cursor v]
"Replaces value supplied by cursor with value v."
(-transact! cursor (constantly v)))

View File

@@ -45,7 +45,8 @@
[datomic.api :as dc]
[hiccup2.core :as hiccup]
[iol-ion.query :refer [ident]]
[malli.core :as mc]))
[malli.core :as mc]
[auto-ap.cursor :as cursor]))
;; TODO with dependencies, I really don't like that you have to be ultra specific in what
;; you want to include, and generating the routes and interconnection is weird too.
@@ -57,6 +58,27 @@
;; TODO better generation of names?
(def ^:dynamic *errors*)
(def ^:dynamic *prev-cursor* nil)
(def ^:dynamic *cursor* nil)
(defmacro with-cursor [cursor & rest]
`(binding [*prev-cursor* (or *cursor* ~cursor)]
(binding [*cursor* ~cursor]
~@rest)))
(defn cursor-name []
(apply path->name2 (cursor/path *cursor*)))
(defn cursor-value []
@*cursor*)
(defn cursor-errors []
(:errors (get
(meta @*prev-cursor*)
(last (cursor/path *cursor*)))))
(defn filters [request]
[:form {"hx-trigger" "change delay:500ms, keyup changed from:.hot-filter delay:1000ms"
@@ -271,21 +293,21 @@
bank-account-id))
(defn transaction-rule-save [{:keys [form-params request-method identity] :as request}]
(let [entity (cond-> form-params
(= :post request-method) (assoc :db/id "new")
true (assoc :transaction-rule/note (entity->note form-params)))
_ (doseq [[{:transaction-rule-account/keys [account location]} i] (map vector (:transaction-rule/accounts entity) (range))
:let [account-location (pull-attr (dc/db conn) :account/location account)]
:when (and account-location (not= account-location location))]
(field-validation-error (str "must be " account-location)
[:transaction-rule/accounts i :transaction-rule-account/location]
:form entity))
(let [entity (cond-> form-params
(= :post request-method) (assoc :db/id "new")
true (assoc :transaction-rule/note (entity->note form-params)))
_ (doseq [[{:transaction-rule-account/keys [account location]} i] (map vector (:transaction-rule/accounts entity) (range))
:let [account-location (pull-attr (dc/db conn) :account/location account)]
:when (and account-location (not= account-location location))]
(field-validation-error (str "must be " account-location)
[:transaction-rule/accounts i :transaction-rule-account/location]
:form entity))
total (reduce +
0.0
(map :transaction-rule-account/percentage
(:transaction-rule/accounts entity)))
_ (when-not (dollars= 1.0 total)
_ (when-not (dollars= 1.0 total)
(form-validation-error (format "Expense accounts total (%d%%) must add to 100%%" (int (* 100.0 total)))
:form entity))
@@ -344,64 +366,65 @@
(defn- transaction-rule-account-row*
[transaction-rule account]
(com/data-grid-row {}
(let [account-name (path->name2 :transaction-rule/accounts (:db/id account) :transaction-rule-account/account)
location-name (path->name2 :transaction-rule/accounts (:db/id account) :transaction-rule-account/location)]
(let [account-name (with-cursor (:transaction-rule-account/account account)
(cursor-name))]
(list
(com/data-grid-cell {}
[:div {:hx-trigger (hx/trigger-field-change :name "transaction-rule/client"
:from "#edit-form")
:hx-include "#edit-form"
:hx-vals (hx/vals {:name account-name})
:hx-ext "rename-params"
:hx-rename-params-ex (hx/json {:transaction-rule/client "client-id"
:name "name"
account-name "value"})
:hx-get (str (bidi/path-for ssr-routes/only-routes :admin-transaction-rule-account-typeahead))
:hx-swap "innerHTML"}
(account-typeahead* {:value (:transaction-rule-account/account account)
:client-id (:db/id (:transaction-rule/client transaction-rule))
:name account-name})
(com/field-errors {:source account
:key :transaction-rule-account/account})])
(com/data-grid-cell {}
[:div [:div {:hx-trigger (hx/triggers
(hx/trigger-field-change :name "transaction-rule/client"
:from "#edit-form")
(hx/trigger-field-change :name account-name
:from "#edit-form"))
:hx-include "#edit-form"
:hx-vals (hx/vals {:name location-name})
:hx-ext "rename-params"
:hx-rename-params-ex (hx/json {"transaction-rule/client" "client-id"
account-name "account-id"
"name" "name"
location-name "value"})
:hx-get (bidi/path-for ssr-routes/only-routes :admin-transaction-rule-location-select)
:hx-swap "innerHTML"}
(location-select* {:name location-name
:account-location (:account/location (cond->> (:transaction-rule-account/account account)
(nat-int? (:transaction-rule-account/account account)) (dc/pull (dc/db conn)
'[:account/location])))
:client-locations (:client/locations (:transaction-rule/client transaction-rule))
:value (:transaction-rule-account/location account)})]
(com/field-errors {:source account
:key :transaction-rule-account/location})])
(com/data-grid-cell (com/money-input {:name (format "transaction-rule/accounts[%s][transaction-rule-account/percentage]" (:db/id account))
:class "w-16"
:value (some-> account
:transaction-rule-account/percentage
(* 100 )
(long ))})
(com/field-errors {:source account
:key :transaction-rule-account/percentage}))))
(with-cursor (:db/id account)
(com/hidden {:name (cursor-name)
:value (cursor-value)}))
(with-cursor (:transaction-rule-account/account account)
(com/data-grid-cell {}
[:div {:hx-trigger (hx/trigger-field-change :name "transaction-rule/client"
:from "#edit-form")
:hx-include "#edit-form"
:hx-vals (hx/vals {:name account-name})
:hx-ext "rename-params"
:hx-rename-params-ex (hx/json {:transaction-rule/client "client-id"
:name "name"
account-name "value"})
:hx-get (str (bidi/path-for ssr-routes/only-routes :admin-transaction-rule-account-typeahead))
:hx-swap "innerHTML"}
(account-typeahead* {:value (cursor-value)
:client-id (:db/id (:transaction-rule/client transaction-rule))
:name (cursor-name)})
(com/errors {:errors (cursor-errors)})]))
(with-cursor (:transaction-rule-account/location account)
(com/data-grid-cell {}
[:div [:div {:hx-trigger (hx/triggers
(hx/trigger-field-change :name "transaction-rule/client"
:from "#edit-form")
(hx/trigger-field-change :name account-name
:from "#edit-form"))
:hx-include "#edit-form"
:hx-vals (hx/vals {:name (cursor-name)})
:hx-ext "rename-params"
:hx-rename-params-ex (hx/json {"transaction-rule/client" "client-id"
account-name "account-id"
"name" "name"
(cursor-name) "value"})
:hx-get (bidi/path-for ssr-routes/only-routes :admin-transaction-rule-location-select)
:hx-swap "innerHTML"}
(location-select* {:name (cursor-name)
:account-location (:account/location (cond->> (:transaction-rule-account/account @account)
(nat-int? (:transaction-rule-account/account @account)) (dc/pull (dc/db conn)
'[:account/location])))
:client-locations (:client/locations (:transaction-rule/client transaction-rule))
:value (cursor-value)})]
(com/errors {:errors (cursor-errors)})]
))
(with-cursor (:transaction-rule-account/percentage account)
(com/data-grid-cell (com/money-input {:name (cursor-name)
:class "w-16"
:value (some-> (cursor-value)
(* 100 )
(long ))})
(com/errors {:errors (cursor-errors)})))))
(com/data-grid-cell
(com/a-icon-button
{"_" (hiccup/raw "on click halt the event then transition the closest <tr />'s opacity to 0 then remove closest <tr />")
:href "#"}
svg/x))))
(defn dialog* [& {:keys [ entity form-params]}]
(com/modal
{:modal-class "max-w-4xl"}
@@ -415,121 +438,151 @@
form-params)
[:fieldset {:class "hx-disable" :hx-disinherit "hx-target"}
[:div.space-y-6
(when-let [id (:db/id entity)]
(com/hidden {:name "db/id"
:value id}))
(com/field {:label "Client"}
[:div.w-96
(com/typeahead {:name "transaction-rule/client"
:class "w-96"
:placeholder "Search..."
:url (bidi/path-for ssr-routes/only-routes :company-search)
:id (str "form-client-search")
:value (:transaction-rule/client entity)
:value-fn (some-fn :db/id identity)
:content-fn (fn [c] (cond->> c
(nat-int? c) (dc/pull (dc/db conn) '[:client/name])
true :client/name))})])
(with-cursor (cursor/cursor entity)
[:div.space-y-2
(when-let [id (:db/id entity)]
(com/hidden {:name "db/id"
:value id}))
(with-cursor (:transaction-rule/client *cursor*)
(com/validated-field
{:label "Client"
:errors (cursor-errors)}
[:div.w-96
(com/typeahead {:name (cursor-name)
:class "w-96"
:placeholder "Search..."
:url (bidi/path-for ssr-routes/only-routes :company-search)
:id (str "form-client-search")
:value (cursor-value)
:value-fn (some-fn :db/id identity)
:content-fn (fn [c] (cond->> c
(nat-int? c) (dc/pull (dc/db conn) '[:client/name])
true :client/name))})]))
(com/field {:label "Bank Account"}
[:div#bank-account-spot.w-96 {:hx-get (bidi/path-for ssr-routes/only-routes :bank-account-typeahead)
:hx-trigger (hx/trigger-field-change :name "transaction-rule/client"
:from "#edit-form")
:hx-swap "innerHTML"
:hx-ext "rename-params"
:hx-include "#edit-form"
:hx-vals (hx/vals {:name "transaction-rule/bank-account"})
:hx-rename-params-ex (cheshire/generate-string {"transaction-rule/client" "client-id"
"name" "name"})}
(bank-account-typeahead* {:client-id ((some-fn :db/id identity) (:transaction-rule/client entity))
:name "transaction-rule/bank-account"
:value (:transaction-rule/bank-account entity)})
(com/field-errors {:source entity
:key :transaction-rule/bank-account})])
(with-cursor (:transaction-rule/bank-account *cursor*)
(com/validated-field {:label "Bank Account"
:errors (cursor-errors)}
[:div#bank-account-spot.w-96 {:hx-get (bidi/path-for ssr-routes/only-routes :bank-account-typeahead)
:hx-trigger (hx/trigger-field-change :name "transaction-rule/client"
:from "#edit-form")
:hx-swap "innerHTML"
:hx-ext "rename-params"
:hx-include "#edit-form"
:hx-vals (hx/vals {:name (cursor-name)})
:hx-rename-params-ex (cheshire/generate-string {"transaction-rule/client" "client-id"
"name" "name"})}
(bank-account-typeahead* {:client-id ((some-fn :db/id identity) (:transaction-rule/client entity))
:name (cursor-name)
:value (cursor-value)})]))
(com/field {:label "Description"
:error-source entity
:error-key :transaction-rule/description}
(com/text-input {:name "transaction-rule/description"
"_" (hiccup/raw "on load call me.focus()")
:placeholder "HOME DEPOT"
:class "w-96"
:value (:transaction-rule/description entity)}))
(with-cursor (:transaction-rule/description *cursor*)
(com/validated-field {:label "Description"
:errors (cursor-errors)}
(com/text-input {:name (cursor-name)
:placeholder "HOME DEPOT"
:class "w-96"
:value (cursor-value)})))
(com/field {:label "Amount"}
[:div.flex.gap-2
(with-cursor (:transaction-rule/amount-gte *cursor*)
[:div.flex.flex-col
(com/money-input {:name (cursor-name)
:placeholder ">="
:class "w-24"
:value (cursor-value)})
(com/errors {:errors (cursor-errors)})])
(with-cursor (:transaction-rule/amount-lte *cursor*)
[:div.flex.flex-col
(com/money-input {:name (cursor-name)
:placeholder "<="
:class "w-24"
:value (cursor-value)})
(com/errors {:errors (cursor-errors)})])])
(com/field {:label "Day of month"}
[:div.flex.gap-2
(with-cursor (:transaction-rule/dom-gte *cursor*)
[:div.flex.flex-col
(com/int-input {:name (cursor-name)
:placeholder ">="
:class "w-24"
:value (cursor-value)})
(com/errors {:errors (cursor-errors)})])
(with-cursor (:transaction-rule/dom-lte *cursor*)
[:div.flex.flex-col
(com/int-input {:name (cursor-name)
:placeholder ">="
:class "w-24"
:value (cursor-value)})
(com/errors {:errors (cursor-errors)})])])
(com/field {:label "Amount"}
[:div.flex.gap-2
(com/money-input {:name "transaction-rule/amount-gte"
:placeholder ">="
:class "w-24"
:value (:transaction-rule/amount-gte entity)})
(com/money-input {:name "transaction-rule/amount-lte"
:placeholder "<="
:class "w-24"
:value (:transaction-rule/amount-lte entity)})])
[:h2.text-lg "Outcomes"]
(with-cursor (:transaction-rule/vendor *cursor*)
(com/validated-field {:label "Assign Vendor"
:errors (cursor-errors)}
[:div.w-96
(com/typeahead {:name (cursor-name)
:placeholder "Search..."
:url (bidi/path-for ssr-routes/only-routes :vendor-search)
:id (str "form-vendor-search")
:value (cursor-value)
:value-fn (some-fn :db/id identity)
:content-fn (some-fn :vendor/name #(pull-attr (dc/db conn) :vendor/name %))})]))
(com/field {:label "Day of month"}
[:div.flex.gap-2
(com/int-input {:name "transaction-rule/dom-gte"
:placeholder ">="
:class "w-24"
:value (:transaction-rule/dom-gte entity)})
(com/int-input {:name "transaction-rule/dom-lte"
:placeholder "<="
:class "w-24"
:value (:transaction-rule/dom-lte entity)})])
[:h2.text-lg "Outcomes"]
(com/field {:label "Assign Vendor"
:error-source entity
:error-key :transaction-rule/vendor}
[:div.w-96
(com/typeahead {:name "transaction-rule/vendor"
:placeholder "Search..."
:url (bidi/path-for ssr-routes/only-routes :vendor-search)
:id (str "form-vendor-search")
:value (:transaction-rule/vendor entity)
:value-fn (some-fn :db/id identity)
:content-fn (some-fn :vendor/name #(pull-attr (dc/db conn) :vendor/name %))})])
(com/data-grid {:headers [(com/data-grid-header {}
"Account")
(com/data-grid-header {:class "w-32"} "Location")
(com/data-grid-header {:class "w-16"} "%")
(com/data-grid-header {:class "w-16"})]
:id "transaction-rule-account-table"}
(for [tra (:transaction-rule/accounts entity)]
(transaction-rule-account-row* entity tra)))
(com/field-errors {:source entity
:key :transaction-rule/accounts})
(com/a-button {:hx-get (bidi/path-for ssr-routes/only-routes
:admin-transaction-rule-new-account)
:hx-include "#edit-form"
:hx-ext "rename-params"
:hx-rename-params-ex (cheshire/generate-string {"transaction-rule/client" "client-id"})
:hx-target "#transaction-rule-account-table tbody"
:hx-swap "beforeend"}
"New account")
(com/radio {:options (ref->radio-options "transaction-approval-status")
:value (:transaction-rule/transaction-approval-status entity)
:name (path->name2 :transaction-rule/transaction-approval-status)})
[:div#form-errors [:span.error-content
(com/field-errors {:source entity})]]
(com/button {:color :primary :form "edit-form" :type "submit"}
"Save")]]]
(with-cursor (:transaction-rule/accounts *cursor*)
(list
(com/data-grid {:headers [(com/data-grid-header {}
"Account")
(com/data-grid-header {:class "w-32"} "Location")
(com/data-grid-header {:class "w-16"} "%")
(com/data-grid-header {:class "w-16"})]
:id "transaction-rule-account-table"}
(for [tra *cursor*]
(with-cursor tra
(transaction-rule-account-row* entity tra))))
(com/errors {:errors (cursor-errors)})))
(com/a-button {:hx-get (bidi/path-for ssr-routes/only-routes
:admin-transaction-rule-new-account)
:hx-include "#edit-form"
:hx-ext "rename-params"
:hx-rename-params-ex (cheshire/generate-string {"transaction-rule/client" "client-id"
"index" "index"})
:hx-vals (hiccup/raw "js:{index: countRows(\"#transaction-rule-account-table\")}")
:hx-target "#transaction-rule-account-table tbody"
:hx-swap "beforeend"}
"New account")
(with-cursor (:transaction-rule/transaction-approval-status *cursor*)
(com/radio {:options (ref->radio-options "transaction-approval-status")
:value (cursor-value)
:name (cursor-name)}))
[:div#form-errors [:span.error-content
(com/errors {:errors (:errors (meta entity))})]]
(com/button {:color :primary :form "edit-form" :type "submit"}
"Save")])]]
[:div])))
(defn new-account [{{:keys [client-id]} :query-params}]
(html-response
(transaction-rule-account-row*
{:transaction-rule/client (dc/pull (dc/db conn) '[:client/name :client/locations :db/id]
client-id)}
{:db/id (str (java.util.UUID/randomUUID))
:transaction-rule-account/location "shared"})))
(defn new-account [{{:keys [client-id index]} :query-params}]
(let [transaction-rule {:transaction-rule/client (dc/pull (dc/db conn) '[:client/name :client/locations :db/id]
client-id)
:transaction-rule/accounts (conj (into [] (repeat (inc index) {} ))
{:db/id (str (java.util.UUID/randomUUID))
:transaction-rule-account/location "Shared"})}]
(html-response
(with-cursor (cursor/cursor transaction-rule)
(with-cursor (:transaction-rule/accounts *cursor*)
(with-cursor (nth *cursor* index)
(transaction-rule-account-row*
;; TODO store a pointer to the "head " cursor for errors instead of nesting them
;; makes it so you don't have to do this
transaction-rule
*cursor*
)))))))
;; TODO check to see if it should be called "Shared" or "shared" for the value
(defn location-select [{{:keys [name account-id client-id value] :as qp} :query-params}]
(html-response (location-select* {:name name
@@ -574,7 +627,7 @@
(def transaction-rule-schema (mc/schema
[:map
[:db/id {:optional true} [:maybe entity-id]]
[:transaction-rule/client {:optional true} [:maybe entity-id]]
[:transaction-rule/client entity-id]
[:transaction-rule/description [:and regex
[:string {:min 3}]]]
[:transaction-rule/bank-account [:maybe entity-id]]
@@ -599,7 +652,8 @@
:admin-transaction-rule-new-account (-> new-account
(wrap-schema-decode :query-schema [:map
[:client-id {:optional true}
[:maybe entity-id]]])
[:maybe entity-id]]
[:index nat-int?]])
wrap-admin wrap-client-redirect-unauthenticated)
:admin-transaction-rule-location-select (-> location-select
(wrap-schema-decode :query-schema [:map

View File

@@ -33,6 +33,8 @@
(def typeahead inputs/typeahead-)
(def field-errors inputs/field-errors-)
(def field inputs/field-)
(def validated-field inputs/validated-field-)
(def errors inputs/errors-)
(def left-aside aside/left-aside-)
(def company-aside-nav aside/company-aside-nav-)

View File

@@ -122,5 +122,13 @@ c.clearChoices();
(field-errors- {:source (:error-source params)
:key (:error-key params)}))])
(defn errors- [{:keys [errors]}]
[:p.mt-2.text-xs.text-red-600.dark:text-red-500.h-4 (str/join ", " errors)])
(defn validated-field- [params & rest]
(field- (dissoc params :errors)
rest
(errors- {:errors (:errors params)})))
(defn hidden- [{:keys [name value]}]
[:input {:type "hidden" :value value :name name}])

View File

@@ -117,8 +117,9 @@
(def map->db-id-decoder
{:enter (fn [x]
(into []
(for [[k v] x]
(assoc v :db/id (cond (and (string? k) (re-find #"^\d+$" k))
(for [[k v] (sort-by (comp #(Long/parseLong %) name first) x)]
v
#_(assoc v :db/id (cond (and (string? k) (re-find #"^\d+$" k))
(Long/parseLong k)
(keyword? k)
(name k)