Files
integreat/src/clj/auto_ap/ssr/ledger/balance_sheet.clj
2024-10-18 21:00:50 -07:00

467 lines
24 KiB
Clojure

(ns auto-ap.ssr.ledger.balance-sheet
(:require
[amazonica.aws.s3 :as s3]
[auto-ap.datomic
:refer [conn pull-many]]
[auto-ap.graphql.utils :refer [assert-can-see-client]]
[auto-ap.ledger :refer [build-account-lookup]]
[auto-ap.ledger.reports :as l-reports]
[auto-ap.logging :as alog]
[auto-ap.pdf.ledger :refer [table->pdf]]
[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.components :as com]
[auto-ap.ssr.form-cursor :as fc]
[auto-ap.ssr.hx :as hx]
[auto-ap.ssr.svg :as svg]
[auto-ap.ssr.ui :refer [base-page]]
[auto-ap.ssr.utils
:refer [apply-middleware-to-all-handlers clj-date-schema
html-response modal-response unspecified-transformer
wrap-form-4xx-2 wrap-merge-prior-hx wrap-schema-enforce]]
[auto-ap.time :as atime]
[bidi.bidi :as bidi]
[clj-pdf.core :as pdf]
[clj-time.coerce :as coerce]
[clj-time.core :as t]
[clojure.java.io :as io]
[clojure.string :as str]
[config.core :refer [env] :as env]
[datomic.api :as dc]
[hiccup.util :as hu]
[iol-ion.utils :refer [by]]
[malli.core :as mc])
(:import
[java.util UUID]
[org.apache.commons.io.output ByteArrayOutputStream]))
(def default-read
'[:journal-entry/amount
:journal-entry/alternate-description
:journal-entry/source
:journal-entry/external-id
:db/id
[:journal-entry/date :xform clj-time.coerce/from-date]
{:journal-entry/vendor [:vendor/name :db/id]
:journal-entry/original-entity [:invoice/invoice-number
:invoice/source-url
:transaction/description-original :db/id]
:journal-entry/client [:client/name :client/code :db/id]
:journal-entry/line-items [:journal-entry-line/debit
:journal-entry-line/location
:journal-entry-line/running-balance
:journal-entry-line/credit
{:journal-entry-line/account [:account/name :db/id :account/numeric-code
:bank-account/name :bank-account/numeric-code
{[:account/type :xform iol-ion.query/ident] [:db/ident :db/id]}
{:account/client-overrides [:account-client-override/name
{:account-client-override/client [:db/id]}]}
{[:bank-account/type :xform iol-ion.query/ident]
[:db/ident :db/id]}]}]}])
(def query-schema (mc/schema
[:maybe [:and [:map
[:client {:unspecified/value :all}
[:or
[:enum :all]
[:vector {:coerce? true :min 1 }
[:entity-map {:pull [:db/id :client/name]}]]
]]
[:date {:unspecified/fn atime/local-now}
clj-date-schema]
[:comparison-date {:optional true}
[:maybe clj-date-schema]]
[:include-comparison {:optional true :default false}
[ :boolean {:decode/string {:enter #(if (= % "on") true
(boolean %))}}]]]
[:fn {:error/message "required"
:error/path [:comparison-date]}
(fn [x]
(if (and (not (:comparison-date x))
(:include-comparison x))
false
true))]]]))
(defn cell [{:keys [width investigate-url other-style]} c]
(let [cell-contents (cond
(= :dollar (:format c))
(format "$%,.2f" (if (iol-ion.query/dollars-0? (:value c))
0.0
(:value c)))
(= :percent (:format c))
(format "%%%.1f" (if (iol-ion.query/dollars-0? (:value c))
0.0
(:value c)))
:else
(str (:value c)))
cell-contents (if (:filters c)
(com/link {:hx-get (hu/url investigate-url
(cond-> {}
(:numeric-code (:filters c)) (assoc :numeric-code (into [] (:numeric-code (:filters c))))
(:date-range (:filters c)) (assoc :end-date (atime/unparse-local (:date-range (:filters c))
atime/normal-date))
(:client-id (:filters c)) (assoc :client-id (:client-id (:filters c))))
)}
cell-contents)
cell-contents)]
[:td.px-4.py-2
(cond-> {:style (cond-> {:width (str width "em")}
other-style (merge other-style))}
(:border c) (update :style
(fn [s]
(->> (:border c)
(map
(fn [b]
[(keyword (str "border-" (name b))) "1px solid black"])
)
(into s))))
(:colspan c) (assoc :col-span (:colspan c))
(:align c) (assoc :align (:align c))
(= :dollar (:format c)) (assoc :align :right)
(= :percent (:format c)) (assoc :align :right)
(:bold c) (assoc-in [:style :font-weight] "bold")
(:color c) (assoc-in [:style :color] (str "rgb("
(str/join ","
(:color c))
")"))
true (assoc-in [:style :background-color] (str "rgb("
(str/join ","
(or (:bg-color c) [255 255 255]))
")")))
cell-contents]))
(defn cell-count [table]
(let [counts (map count (:rows table))]
(if (seq counts)
(apply max counts)
0)))
(defn table [{:keys [table widths investigate-url warning]}]
(let [cell-count (cell-count table)]
(com/content-card {:class "inline-block overflow-scroll"}
[:div {:class "overflow-scroll h-[70vh] m-4 inline-block"}
(when warning [:div.rounded.bg-red-50.text-red-800.p-4.m-2
warning])
(-> [:table {:class "text-sm text-left text-gray-500 dark:text-gray-400"}
[:thead {:class "text-xs text-gray-800 uppercase bg-gray-50 dark:bg-gray-700 dark:text-gray-400 font-bold"}
(map
(fn [header-row header]
(into
[:tr {:class " dark:border-gray-600 hover:bg-gray-100 dark:hover:bg-gray-700"}]
(map
(fn [w header i]
(cell {:width w
:investigate-url investigate-url
:other-style {:position "sticky"
:top (* header-row (+ 22 18))}} header))
widths
header
(range))))
(range)
(:header table))]]
(conj
(-> [:tbody {:style {}}]
(into
(for [[i row] (map vector (range) (:rows table))]
[:tr {:class " dark:border-gray-600 hover:bg-gray-100 dark:hover:bg-gray-700"}
(for [[i c] (map vector (range) (take cell-count
(reduce
(fn [[acc cnt] cur]
(if (>= (+ cnt (:colspan cur 1)) cell-count)
(reduced (conj acc cur))
[(conj acc cur) (+ cnt (:colspan cur 1))]))
[[] 0]
(concat row (repeat nil)))))]
(cell {:investigate-url investigate-url} c))]))
(conj [:tr (for [i (range cell-count)]
(cell {:investigate-url investigate-url} {:value " "}))]))))])))
(defn concat-tables [tables]
(let [[first & rest] tables]
{:header (:header first)
:rows (concat (:rows first)
[[]]
(mapcat
(fn [table]
(-> (:header table)
(into (:rows table))
(conj [])))
rest))}))
;; TODO
;; 1. Rerender form when running
;; 2. Don't throw crazy errors when missing a field
;; 3. General cleanup of the patterns in run-balance-sheet
;; 4. Review ledger dialog
(defn get-report [{ {:keys [date comparison-date include-comparison client] :as qp} :query-params :as request}]
(when (and date client)
(let [client (if (= :all client) (take 5 (:clients request)) client)
client-ids (map :db/id client)
_ (doseq [client-id client-ids]
(assert-can-see-client (:identity request) client-id))
end-date (coerce/to-date date)
comparable-date (coerce/to-date comparison-date)
lookup-account (->> client-ids
(map (fn build-lookup [client-id]
[client-id (build-account-lookup client-id)]))
(into {}))
data (cond-> {:balance-sheet-accounts (into []
(mapcat
(fn calculate-accounts [client-id ]
(for [
[client-id account-id location debits credits balance count] (iol-ion.query/detailed-account-snapshot (dc/db conn) client-id end-date)
:let [account ( (or (lookup-account client-id) {}) account-id)]]
{:client-id client-id
:account-id account-id
:location location
:debits debits
:credits credits
:count count
:amount balance
:account-type (:account_type account)
:numeric-code (:numeric_code account)
:name (:name account) }))
client-ids))}
(and include-comparison comparison-date)
(assoc :comparable-balance-sheet-accounts
(into []
(mapcat
(fn calculate-accounts [client-id ]
(for [
[client-id account-id location debits credits balance count] (iol-ion.query/detailed-account-snapshot (dc/db conn) client-id comparable-date)
:let [account ( (or (lookup-account client-id) {}) account-id)]]
{:client-id client-id
:account-id account-id
:location location
:debits debits
:credits credits
:count count
:amount balance
:account-type (:account_type account)
:numeric-code (:numeric_code account)
:name (:name account) }))
client-ids)))
)
args (assoc (:query-params request)
:periods (filter identity (cond-> [date]
include-comparison (conj comparison-date))))
clients (pull-many (dc/db conn) [:client/code :client/name :db/id] client-ids)
data (concat (->> (:balance-sheet-accounts data)
(map (fn [b]
(assoc b
:period (:date args)))))
(->> (:comparable-balance-sheet-accounts data)
(map (fn [b]
(assoc b
:period (:comparison-date args))))))
pnl-data (l-reports/->PNLData args data (by :db/id :client/code clients))
report (l-reports/summarize-balance-sheet pnl-data) ]
(alog/info ::balance-sheet :params args)
{:data report
:report report})))
(defn maybe-trim-clients [request client ]
(if (= :all client)
(cond-> {:client (take 5 (:clients request))}
(> (count (:clients request)) 20)
(assoc :warning "You requested a report with more than 20 clients. This report will only contain the first 20."))
{:client client}))
(defn balance-sheet* [{ {:keys [date comparison-date include-comparison client] } :query-params :as request}]
[:div#report
(when (and date client)
(let [{:keys [client warning]} (maybe-trim-clients request client)
{:keys [data report]} (get-report (assoc-in request [:query-params :client] client))
client-count (count (set (map :client-id (:data data)))) ]
(list
[:div.text-2xl.font-bold.text-gray-600 (str "Balance Sheet - " (str/join ", " (map :client/name client))) ]
(table {:widths (cond-> (into [30 ] (repeat 13 client-count))
(:include-comparison (:args data)) (into (repeat 13 (* 2 client-count))))
:investigate-url (bidi.bidi/path-for ssr-routes/only-routes ::route/investigate)
:table report
:warning (not-empty (str/join "\n " (filter not-empty [warning (:warning report)])))} ))))])
(defn form* [request]
(let [params (merge (:query-params request) (:form-params request) {})]
(fc/start-form
params
(:form-errors request)
[:div#balance-sheet-form.flex.flex-col.gap-4.mt-4
[:div.flex.gap-8
[:form {:hx-get (bidi.bidi/path-for ssr-routes/only-routes ::route/run-balance-sheet)
:hx-target "#balance-sheet-form"
:hx-swap "outerHTML"
:hx-disabled-elt "find fieldset"}
[:fieldset
[:div.flex.gap-8 {:x-data (hx/json {:comparison (boolean (:include-comparison params))})}
(fc/with-field :client
(com/validated-inline-field
{:label "Customers" :errors (fc/field-errors)}
(com/multi-typeahead {:name (fc/field-name)
:placeholder "Search for companies..."
:class "w-64"
:id "client"
:url (bidi/path-for ssr-routes/only-routes :company-search)
:value (fc/field-value)
:value-fn :db/id
:content-fn :client/name})))
(fc/with-field :date
(com/validated-inline-field {:label "Date"
:errors (fc/field-errors)}
(com/date-input {:placeholder "12/21/2020"
:name (fc/field-name)
:value (some->
(or (fc/field-value) (t/now))
(atime/unparse-local atime/normal-date))})))
(fc/with-field :include-comparison
(com/toggle {:x-model "comparison" :name (fc/field-name) :checked (boolean (fc/field-value))} "Compare"))
[:div (hx/alpine-appear {:x-show "comparison"})
(fc/with-field :comparison-date
(com/validated-inline-field {:label "Previous Date"
:errors (fc/field-errors)}
(com/date-input {:placeholder "12/21/2020"
:name (fc/field-name)
:value (some-> (or (fc/field-value) (t/plus (t/now) (t/years -1)))
(atime/unparse-local atime/normal-date))})))]
(com/button {:color :primary :class "w-32"}
"Run")
(com/button {:formaction (bidi.bidi/path-for ssr-routes/only-routes ::route/export-balance-sheet) } "Export PDF")]]] ]
(balance-sheet* request)])))
(defn form [request]
(html-response (form* request)
:headers {"hx-retarget" "#balance-sheet-form"
"hx-push-url" (str "?" (:query-string request))}))
(defn balance-sheet [request]
(base-page
request
(com/page {:nav com/main-aside-nav
:client-selection (:client-selection request)
:clients (:clients request)
:client (:client request)
:identity (:identity request)
:request request}
(apply com/breadcrumbs {} [[:a {:href (bidi/path-for ssr-routes/only-routes ::route/page)}
"Ledger"]])
(form* request))
"Balance Sheet"))
(defn make-balance-sheet-pdf [request report]
(let [ output-stream (ByteArrayOutputStream.)
client-count (count (or (seq (:client (:query-params request)))
(seq (:client (:form-params request)))))]
(pdf/pdf
(-> [{:left-margin 10 :right-margin 10 :top-margin 15 :bottom-margin 15
:size :letter
:font {:size 6
:ttf-name "fonts/calibri-light.ttf"}}
[:heading (str "Balance Sheet - " (str/join ", " (map :client/name (or (seq (:client (:query-params request)))
(seq (:client (:form-params request)))))))]]
(conj [:paragraph {:color [128 0 0] :size 9} (:warning report)])
(conj
(table->pdf report
(cond-> (into [30 ] (repeat client-count 13))
(or (:include-comparison (:query-params request))
(:include-comparison (:form-params request))) (into (repeat (* 2 client-count) 13))))))
output-stream)
(.toByteArray output-stream)))
(defn join-names [client-ids]
(str/replace (->> client-ids (pull-many (dc/db conn) [:client/name]) (map :client/name) (str/join "-")) #"[^\w]" "_" ))
(defn balance-sheet-args->name [request]
(let [date (atime/unparse-local
(:date (:query-params request))
atime/iso-date)
name (->> request :query-params :client (map :db/id) join-names)]
(format "Balance-sheet-%s-for-%s" date name)))
(defn print-balance-sheet [request]
(let [uuid (str (UUID/randomUUID))
pdf-data (make-balance-sheet-pdf request (:report (get-report request)))
name (balance-sheet-args->name request)
key (str "reports/balance-sheet/" uuid "/" name ".pdf")
url (str "https://" (:data-bucket env) "/" key)]
(s3/put-object :bucket-name (:data-bucket env/env)
:key key
:input-stream (io/make-input-stream pdf-data {})
:metadata {:content-length (count pdf-data)
:content-type "application/pdf"})
@(dc/transact conn
[{:report/name name
:report/client (map :db/id (:client (:query-params request)))
:report/key key
:report/url url
:report/creator (:user (:identity request))
:report/created (java.util.Date.)}])
{:report/name name
:report/url url }))
;; TODO PRINT WARNING
(defn export [request]
(modal-response
(com/modal {}
(com/modal-card
{}
"Ready!"
(com/modal-body {}
[:div.flex.flex-col.mt-4.space-y-4.items-center
[:a {:href (:report/url (print-balance-sheet request))}
[:div.w-24.h-24.bg-green-50.rounded-full.p-4.text-green-300 {:class " hover:scale-110 transition duration-100"}
svg/download]]
[:span.text-gray-800
"Click "
(com/link {:href (:report/url (print-balance-sheet request))} "here")
" to download"]
])
nil))
:headers (-> {}
(assoc "hx-retarget" ".modal-stack")
(assoc "hx-reswap" "beforeend"))))
(def key->handler
(apply-middleware-to-all-handlers
(->
{::route/balance-sheet (-> balance-sheet
(wrap-schema-enforce :query-schema query-schema)
(wrap-form-4xx-2 balance-sheet))
::route/run-balance-sheet (-> form
(wrap-schema-enforce :query-schema query-schema)
(wrap-form-4xx-2 form))
::route/export-balance-sheet (-> export
(wrap-schema-enforce :query-schema query-schema)
(wrap-form-4xx-2 form))}
)
(fn [h]
(-> h
#_(wrap-merge-prior-hx)
(wrap-must {:activity :read :subject :balance-sheet})
(wrap-client-redirect-unauthenticated)))))