(ns auto-ap.ssr.ledger.new (:require [auto-ap.datomic :refer [audit-transact conn pull-attr]] [auto-ap.datomic.accounts :as d-accounts] [auto-ap.datomic.accounts :as a] [auto-ap.logging :as alog] [auto-ap.permissions :refer [wrap-must]] [auto-ap.routes.ledger :as route] [auto-ap.routes.utils :refer [wrap-client-redirect-unauthenticated]] [auto-ap.ssr-routes :as ssr-routes] [auto-ap.ssr.common-handlers :refer [add-new-entity-handler]] [auto-ap.ssr.components :as com] [auto-ap.ssr.form-cursor :as fc] [auto-ap.ssr.hx :as hx] [auto-ap.ssr.ledger.common :as ledger.common] [auto-ap.ssr.nested-form-params :refer [wrap-nested-form-params]] [auto-ap.ssr.svg :as svg] [auto-ap.ssr.utils :refer [apply-middleware-to-all-handlers check-allowance check-location-belongs clj-date-schema entity-id html-response modal-response money strip wrap-form-4xx-2 wrap-schema-enforce]] [auto-ap.time :as atime] [bidi.bidi :as bidi] [clj-time.coerce :as coerce] [clojure.string :as str] [datomic.api :as dc] [iol-ion.query :refer [dollars=]] [iol-ion.utils :refer [remove-nils]]) (:import [java.util UUID])) (def new-ledger-schema [:and [:map [:db/id {:optional true} [:maybe entity-id]] [:journal-entry/client {:optional false} [:entity-map {:pull [:db/id :client/name :client/locations] }]] [:journal-entry/date clj-date-schema] [:journal-entry/memo {:optional true} [:maybe [ :string {:decode/string strip}]]] [:journal-entry/vendor {:optional false :default nil} [:entity-map {:pull [:db/id :vendor/name] }]] [:journal-entry/amount {:min 0.01} money] [:journal-entry/line-items [:vector {:coerce? true} [:and [:map [:journal-entry-line/account [:and [:entity-map {:pull a/default-read }] [:fn {:error/message "Not an allowed account."} (fn check-allow [x] (check-allowance (:db/id x) :account/default-allowance))]]] [:journal-entry-line/debit {:optional true :default nil} [:maybe money]] [:journal-entry-line/credit {:optional true :default nil} [:maybe money]] [:journal-entry-line/location :string]] [:fn {:error/fn (fn [r x] (:type r)) :error/path [:invoice-expense-account/location]} (fn [iea] (check-location-belongs (:journal-entry-line/location iea) (:journal-entry-line/account iea)))]]]]] [:fn {:error/message "Debits and Credits must add up to amount"} (fn [je] (and (dollars= (:journal-entry/amount je) (->> je :journal-entry/line-items (map :journal-entry-line/debit) (filter identity) (reduce + 0.0))) (dollars= (:journal-entry/amount je) (->> je :journal-entry/line-items (map :journal-entry-line/credit) (filter identity) (reduce + 0.0)))))]]) (defn- account-typeahead* [{:keys [name value client-id x-model]}] [:div.flex.flex-col (com/typeahead {:name name :placeholder "Search..." :url (str (bidi/path-for ssr-routes/only-routes :account-search) "?client-id=" client-id) :id name :x-model x-model :value value :content-fn (fn [value] (when value (str (:account/numeric-code value) " - " (:account/name (d-accounts/clientize value client-id)))))})]) (defn- location-select* [{:keys [name account-location client-locations value]}] (com/select {:options (into [["" ""]] (cond account-location [[account-location account-location]] :else (for [c (seq client-locations)] [c c]))) :name name :value value :class "w-full"})) (defn location-select [{{:keys [name account-id client-id value] :as qp} :query-params}] (html-response (location-select* {:name name :value value :account-location (some->> account-id (pull-attr (dc/db conn) :account/location)) :client-locations (some->> client-id (pull-attr (dc/db conn) :client/locations))}))) (defn- line-item-row* [account client client-locations] (com/data-grid-row (-> {:x-data (hx/json {:accountId (or (:db/id (fc/field-value (:journal-entry-line/account account))) (fc/field-value (:journal-entry-line/account account))) :location (fc/field-value (:journal-entry-line/location account)) :show (boolean (not (fc/field-value (:new? account))))}) :data-key "show" :x-ref "p"} hx/alpine-mount-then-appear) (let [account-name (fc/field-name (:journal-entry-line/account account))] (list (fc/with-field :db/id (com/hidden {:name (fc/field-name) :value (fc/field-value)})) (fc/with-field :journal-entry-line/account (com/data-grid-cell {} (com/validated-field {:errors (fc/field-errors)} [:div {:hx-trigger "changed" :hx-target "next div" :hx-vals (format "js:{name: '%s', 'client-id': event.detail.clientId || '', value: event.detail.accountId || ''}" account-name) :hx-get (str (bidi/path-for ssr-routes/only-routes ::route/account-typeahead)) :x-init "$watch('clientId', cid => $dispatch('changed', $data));"}] (account-typeahead* {:value (fc/field-value) :client-id (:db/id client) :name (fc/field-name) :x-model "accountId"})))) (fc/with-field :journal-entry-line/location (com/data-grid-cell {} (com/validated-field {:errors (fc/field-errors) :x-data (hx/json {:location (fc/field-value)})} ;; TODO make this thing into a component [:div {:hx-trigger "changed" :hx-target "next *" :hx-swap "outerHTML" :x-hx-val:account-id "accountId" :x-hx-val:client-id "clientId" :x-hx-val:value "location" :hx-vals (hx/json {:name (fc/field-name)}) :hx-get (bidi/path-for ssr-routes/only-routes ::route/location-select) :x-dispatch:changed "[clientId, accountId]"}] (location-select* {:name (fc/field-name) :account-location (:account/location (:journal-entry-line/account @account)) :client-locations client-locations :x-model "location" :value (fc/field-value)})))) (fc/with-field :journal-entry-line/debit (com/data-grid-cell {} (com/validated-field {:errors (fc/field-errors)} (com/money-input {:name (fc/field-name) :class "w-16" :value (fc/field-value)})))) (fc/with-field :journal-entry-line/credit (com/data-grid-cell {} (com/validated-field {:errors (fc/field-errors)} (com/money-input {:name (fc/field-name) :class "w-16" :value (fc/field-value)})))))) (com/data-grid-cell {:class "align-top"} (com/a-icon-button {"@click.prevent.stop" "show=false; setTimeout(() => $refs.p.remove(), 500)"} svg/x)))) (defn account-typeahead [{{:keys [name value client-id] :as qp} :query-params}] (html-response (account-typeahead* {:name name :value (dc/pull (dc/db conn) a/default-read value) :client-id client-id :x-model "accountId"}))) (defn form* [request] (alog/peek :FP (:form-errors request)) (let [client (some-> request :form-params :journal-entry/client) client-locations (some-> client :client/locations) extant? false] ;;TODO (fc/start-form (:form-params request) (:form-errors request) [:div.flex.gap-4.flex-col {:x-data (hx/json {:clientId (or (:db/id (fc/field-value (:journal-entry/client fc/*current*))) (:db/id (:client request))) :vendorId (:db/id (fc/field-value (:journal-entry/vendor fc/*current*)))})} (fc/with-field :journal-entry/client (if (or (:client request) extant?) (com/hidden {:name (fc/field-name) :value (:db/id (:client request))}) [:div.w-96 (com/validated-field {:label "Client" :errors (fc/field-errors)} [:div.w-96 (com/typeahead {:name (fc/field-name) :error? (fc/error?) :class "w-96" :placeholder "Search..." :url (bidi/path-for ssr-routes/only-routes :company-search) :value (fc/field-value) :value-fn :db/id :content-fn :client/name :x-model "clientId"})])])) (fc/with-field :journal-entry/date (com/validated-field {:label "Date" :errors (fc/field-errors)} [:div {:class "w-24"} (com/date-input {:value (some-> (fc/field-value) (atime/unparse-local atime/normal-date)) :name (fc/field-name) :error? (fc/field-errors) :placeholder "1/1/2024"})])) (fc/with-field :journal-entry/vendor (com/validated-field {:label "Vendor" :errors (fc/field-errors)} [:div.w-96 (com/typeahead {:name (fc/field-name) :error? (fc/error?) :disabled (boolean (-> request :multi-form-state :snapshot :db/id)) :class "w-96" :placeholder "Search..." :url (bidi/path-for ssr-routes/only-routes :vendor-search) :value (fc/field-value) :value-fn :db/id :content-fn :vendor/name})])) (fc/with-field :journal-entry/amount (com/validated-field {:label "Total" :errors (fc/field-errors)} [:div {:class "w-16"} (com/money-input {:value (-> (fc/field-value)) :name (fc/field-name) :class "w-24" :error? (fc/field-errors) :placeholder "212.44"})])) (fc/with-field :journal-entry/memo [:div.w-96 (com/validated-field {:label "Memo" :errors (fc/field-errors)} [:div.w-96 (com/text-input {:name (fc/field-name) :error? (fc/error?) :class "w-96" :placeholder "A custom note" :url (bidi/path-for ssr-routes/only-routes :company-search) :value (fc/field-value) })])]) (fc/with-field :journal-entry/line-items (com/validated-field {:errors (fc/field-errors)} (com/data-grid {:headers [(com/data-grid-header {} "Account") (com/data-grid-header {:class "w-32"} "Location") (com/data-grid-header {:class "w-16"} "Debit") (com/data-grid-header {:class "w-16"} "Credit") (com/data-grid-header {:class "w-16"})]} (fc/cursor-map #(line-item-row* % client client-locations)) (com/data-grid-new-row {:colspan 5 :hx-get (bidi/path-for ssr-routes/only-routes ::route/new-line-item) :index (count (fc/field-value)) :tr-params (hx/bind-alpine-vals {} {"client-id" "clientId"})} "New account"))))]))) (defn new [request] (modal-response (com/modal {:hx-target "this" :hx-indicator "this"} [:form {:hx-post (bidi/path-for ssr-routes/only-routes ::route/new-submit)} (com/modal-card {:class "md:h-[800px] md:w-[750px] flex-col relative" :error (when (vector? (:form-errors request)) (str/join ", "(:form-errors request) ))} [:div "New ledger entry"] [:div.overflow-y-scroll.relative (form* request)] [:div (com/button {:color :primary} "Save")])]))) (defn new-submit [request] (let [id (:db/id (:form-params request)) entity (cond-> (-> (:form-params request) (update :journal-entry/date coerce/to-date) (update :journal-entry/client :db/id) (update :journal-entry/vendor :db/id) (update :journal-entry/line-items (fn [lis] (mapv #(remove-nils (-> % (update :journal-entry-line/account :db/id) (assoc :journal-entry-line/client (-> request :form-params :journal-entry/client :db/id) :journal-entry-line/date (-> request :form-params :journal-entry/date coerce/to-date)))) lis))) (assoc :journal-entry/external-id (str "manual-" (UUID/randomUUID)))) (= :post (:request-method request)) (assoc :db/id "new")) {:keys [tempids]} (audit-transact [[:upsert-entity entity] {:db/id (-> request :form-params :journal-entry/client :db/id) :client/ledger-last-change (iol-ion.tx.upsert-ledger/current-date (dc/db conn))}] (:identity request)) updated-entity (dc/pull (dc/db conn) ledger.common/default-read (or (get tempids (:db/id entity)) (:db/id entity)))] (html-response (ledger.common/row* identity updated-entity {:flash? true :request request}) :headers (cond-> {"hx-trigger" "modalclose"} (= :put (:request-method request)) (assoc "hx-retarget" (format "#entity-table tr[data-id=\"%d\"]" id) "hx-reswap" "outerHTML") (= :post (:request-method request)) (assoc "hx-retarget" "#entity-table tbody" "hx-reswap" "afterbegin"))))) (def key->handler (apply-middleware-to-all-handlers (-> {::route/new (-> new #_(wrap-schema-enforce :query-schema query-schema) #_(wrap-form-4xx-2 profit-and-loss)) ::route/account-typeahead (-> account-typeahead (wrap-schema-enforce :query-schema [:map [:name :string] [:client-id {:optional true} [:maybe entity-id]] [:value {:optional true} [:maybe entity-id]]])) ::route/new-submit (-> new-submit (wrap-schema-enforce :form-schema new-ledger-schema) (wrap-form-4xx-2 new)) ::route/location-select (-> location-select (wrap-schema-enforce :query-schema [:map [:name :string] [:client-id {:optional true} [:maybe entity-id]] [:account-id {:optional true} [:maybe entity-id]]])) ::route/new-line-item (-> (add-new-entity-handler [:journal-entry/line-items] (fn render [cursor request] (line-item-row* cursor (:client-id (:query-params request)) (some->> (:client-id (:query-params request)) (pull-attr (dc/db conn) :client/locations))))) (wrap-schema-enforce :query-schema [:map [:client-id {:optional true} [:maybe entity-id]]]))}) (fn [h] (-> h #_(wrap-merge-prior-hx) (wrap-must {:activity :edit :subject :ledger}) (wrap-nested-form-params) (wrap-client-redirect-unauthenticated)))))