Files
integreat/src/clj/auto_ap/ssr/ledger/report_table.clj
2024-11-11 21:39:36 -08:00

128 lines
7.0 KiB
Clojure

(ns auto-ap.ssr.ledger.report-table
(:require
[auto-ap.ssr.components :as com]
[auto-ap.time :as atime]
[clj-time.coerce :as coerce]
[clojure.string :as str]
[hiccup.util :as hu]
[iol-ion.query :as query]))
(defn cell [{:keys [width investigate-url other-style]} c]
(let [cell-contents (cond
(= :dollar (:format c))
(format "$%,.2f" (if (query/dollars-0? (:value c))
0.0
(:value c)))
(= :percent (:format c))
(format "%%%.1f" (if (query/dollars-0? (:value c))
0.0
(* 100.0 (or (:value c) 0.0))))
: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))))
(inst? (:date-range (:filters c))) (assoc :end-date (atime/unparse-local (coerce/to-date-time (:date-range (:filters c))) atime/normal-date))
(:end (:date-range (:filters c))) (assoc :end-date (atime/unparse-local (coerce/to-date-time (:end (:date-range (:filters c)))) atime/normal-date))
(:start (:date-range (:filters c))) (assoc :start-date (atime/unparse-local (coerce/to-date-time (:start (: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 :colspan (: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))}))