diff --git a/src/clj/auto_ap/ssr/ledger/prime_cost.clj b/src/clj/auto_ap/ssr/ledger/prime_cost.clj index 69d972a2..9b7f0d1e 100644 --- a/src/clj/auto_ap/ssr/ledger/prime_cost.clj +++ b/src/clj/auto_ap/ssr/ledger/prime_cost.clj @@ -1,8 +1,8 @@ (ns auto-ap.ssr.ledger.prime-cost - "Prime Cost Report — what a restaurant sold against what it paid people to sell it, by week. + "Prime Cost Report — what a restaurant sold against what it paid people to sell it. Neither figure is interesting alone; the ratio between them is, and it only reads as a trend, - which is why this shows eight weeks rather than one range. + which is why this shows eight periods rather than one range. The two halves come from deliberately different places. **Payroll is read from the ledger**, because that is where payroll lands once it has been coded to an account — taken from anywhere @@ -14,6 +14,12 @@ payroll bands so that agreement is structural rather than a coincidence that survives until somebody edits one of the two lists. + Reading payroll from the ledger has one consequence worth stating: a journal entry carries the + date it was posted, not the span it covers, so a client paying every fortnight puts a fortnight + of labour on a single day. Against weekly columns that reads as one enormous week beside one + empty one. Hence the period control — set it to the length of the client's pay cycle and the + labour line lands where the sales it bought are. + Replaces the PCR Detail sheet of the `Bi-Weekly` workbook." (:require [auto-ap.datomic :refer [conn]] @@ -33,14 +39,28 @@ [bidi.bidi :as bidi] [clj-time.coerce :as coerce] [clj-time.core :as time] + [clojure.string :as str] [datomic.api :as dc] [malli.core :as mc])) -(def weeks-shown +(def periods-shown "Eight, as the workbook this replaces used — about the shortest run in which a labour-percentage - trend is readable through ordinary weekly noise." + trend is readable through ordinary noise." 8) +(def period-lengths + "Selectable column widths, in weeks. Longer columns exist to match a client's pay cycle; see the + namespace docstring for why that matters." + [{:value "1" :label "Weekly" :weeks 1} + {:value "2" :label "Bi-weekly" :weeks 2} + {:value "4" :label "Four weeks" :weeks 4}]) + +(def default-period "1") + +(defn weeks-per-period [period] + (or (:weeks (first (filter #(= period (:value %)) period-lengths))) + 1)) + (def payroll-bands "`[[label from to] ...]` for payroll, taken from the shared ledger groupings rather than restated here, so this report and the profit and loss can never disagree about what counts as payroll." @@ -58,15 +78,17 @@ (when (and code (>= code from) (<= code to)) label)) payroll-bands)) -(defn week-windows - "`[{:starts :ends}]` for the `weeks-shown` weeks ending at `end-date`, most recent first. +(defn period-windows + "`[{:starts :ends}]` for the `periods-shown` periods of `weeks` weeks ending at `end-date`, most + recent first. - `:ends` is exclusive, so weeks tile and no day is counted twice at a boundary." - [end-date] - (let [end (coerce/to-date-time end-date)] - (for [i (range weeks-shown)] - {:starts (time/minus end (time/weeks (inc i))) - :ends (time/minus end (time/weeks i))}))) + `:ends` is exclusive, so periods tile and no day is counted twice at a boundary." + ([end-date] (period-windows end-date 1)) + ([end-date weeks] + (let [end (coerce/to-date-time end-date)] + (for [i (range periods-shown)] + {:starts (time/minus end (time/weeks (* weeks (inc i)))) + :ends (time/minus end (time/weeks (* weeks i)))})))) ;; --------------------------------------------------------------------------- ;; Sales — the reconciled daily summaries @@ -118,10 +140,12 @@ ;; --------------------------------------------------------------------------- (defn payroll-in-window - "`{:total n :by-band {band-label n}}` of payroll cost for `client-ids` over `[starts ends)`. + "`{:total n :by-band {band-label n} :posted? bool}` of payroll cost for `client-ids` over + `[starts ends)`. - Cost is debits less credits, so a payroll correction posted as a credit reduces the week rather - than counting as more labour." + Cost is debits less credits, so a payroll correction posted as a credit reduces the period rather + than counting as more labour. `:posted?` records whether any payroll line existed at all, which + is not the same question as whether the cost came to zero." [db client-ids starts ends] (let [{:keys [from to]} payroll-range rows (dc/q '[:find ?code ?debit ?credit @@ -143,7 +167,7 @@ (let [cost (- (or debit 0.0) (or credit 0.0))] (cond-> (update acc :total + cost) (band-for code) (update-in [:by-band (band-for code)] (fnil + 0.0) cost)))) - {:total 0.0 :by-band {}} + {:total 0.0 :by-band {} :posted? (boolean (seq rows))} rows))) ;; --------------------------------------------------------------------------- @@ -155,21 +179,37 @@ (/ part whole))) (defn get-report-data - "One column per week, most recent first, each carrying its own sales and payroll." - [db client-ids end-date] - (for [{:keys [starts ends]} (week-windows end-date)] - (let [sales (sales-in-window db client-ids starts ends) - payroll (payroll-in-window db client-ids starts ends)] - {:starts starts - :ends ends - :sales sales - :payroll payroll - :labor-ratio (ratio (:total payroll) (:total sales))}))) + "One column per period, most recent first, each carrying its own sales and payroll." + ([db client-ids end-date] (get-report-data db client-ids end-date 1)) + ([db client-ids end-date weeks] + (for [{:keys [starts ends]} (period-windows end-date weeks)] + (let [sales (sales-in-window db client-ids starts ends) + payroll (payroll-in-window db client-ids starts ends)] + {:starts starts + :ends ends + :sales sales + :payroll payroll + :labor-ratio (when (:posted? payroll) + (ratio (:total payroll) (:total sales)))})))) -(defn average [xs] +(defn average + "Mean of the values that exist, ignoring the ones that do not. + + For a ratio, a missing period is genuinely unknown and has to be left out of the denominator." + [xs] (let [xs (remove nil? xs)] (when (seq xs) (/ (reduce + 0.0 xs) (count xs))))) +(defn per-period + "Mean over every period, counting one with nothing posted as zero. + + Money is not a ratio: a band that only posts every second period still averages across all of + them. Dropping the empty periods from the denominator would let a detail line print larger than + the subtotal it is part of." + [xs] + (when (seq xs) + (/ (reduce + 0.0 (map #(or % 0.0) xs)) (count xs)))) + (defn category-rows "Sales categories present anywhere in the trend, largest average first. @@ -178,75 +218,258 @@ [columns] (->> (into #{} (mapcat (comp keys :by-category :sales)) columns) (map (fn [n] {:label n :values (map #(get-in % [:sales :by-category n]) columns)})) - (sort-by #(- (or (average (:values %)) 0.0))))) + (sort-by #(- (or (per-period (:values %)) 0.0))))) + +(defn headline + "The three numbers a manager actually opens this report for: the latest labour percentage, what + it normally runs at, and which way it moved." + [columns] + (let [current (first columns) + ratios (keep :labor-ratio columns) + trend (average (rest ratios))] + {:current (:labor-ratio current) + :current-sales (get-in current [:sales :total]) + :current-payroll (get-in current [:payroll :total]) + :trend trend + :delta (when (and (:labor-ratio current) trend) + (- (:labor-ratio current) trend))})) ;; --------------------------------------------------------------------------- ;; Rendering — the shared ledger report table, so this reads like its siblings ;; --------------------------------------------------------------------------- -(defn- money-row [label values & {:keys [bold]}] - (into [(cond-> {:value label} bold (assoc :bold true)) - (cond-> {:value (average values) :format :dollar} bold (assoc :bold true))] - (for [v values] - (cond-> {:value (or v 0.0) :format :dollar} bold (assoc :bold true))))) +(def ^:private hot [185 28 28]) ; labour running above its own trend +(def ^:private cool [21 128 61]) ; below +(def ^:private plain [17 24 39]) -(defn- percent-row [label values sales & {:keys [bold]}] - (into [(cond-> {:value label} bold (assoc :bold true)) - (cond-> {:value (ratio (average values) (average sales)) :format :percent} - bold (assoc :bold true))] - (for [[v s] (map vector values sales)] - (cond-> {:value (ratio v s) :format :percent} bold (assoc :bold true))))) +(defn- heat + "Colour for a labour percentage, judged against the trend rather than a fixed target, since the + right percentage differs by concept and this report should not pretend to know it." + [r trend] + (cond + (or (nil? r) (nil? trend) (zero? trend)) plain + (> r (* trend 1.05)) hot + (< r (* trend 0.95)) cool + :else plain)) + +(defn- label-cell + "Detail lines sit under their subtotal. The indent is non-breaking spaces because the cell + renderer emits the label as text into a `td`, where ordinary leading whitespace collapses away." + [label & {:keys [bold indent]}] + (cond-> {:value (if indent (str "   " label) label)} + bold (assoc :bold true))) + +(defn- figure + "A numeric cell. The value is always a number, never nil: the shared cell renderer runs + `dollars-0?` on it before any nil-punning of its own, so a nil here is an NPE at render time + rather than a blank cell." + [v fmt & {:keys [bold color]}] + (cond-> {:value (or v 0.0) :format fmt} + bold (assoc :bold true) + color (assoc :color color))) + +(def ^:private no-value + "An em dash, for a period where the number does not exist — as distinct from being zero." + {:value "—" :align :right}) + +(defn- money-row + "Label, average per period, that average's share of sales, then a column per period." + [label values sales & {:keys [bold indent]}] + (into [(label-cell label :bold bold :indent indent) + (figure (per-period values) :dollar :bold bold) + (figure (ratio (per-period values) (per-period sales)) :percent)] + (for [v values] (figure v :dollar :bold bold)))) + +(defn- ratio-row + "The headline row: payroll as a percentage of the sales it bought. + + A period with no payroll posted gets an em dash rather than 0.0%. Zero labour against real sales + is not something a restaurant does; it means the pay run has not landed in the ledger yet, and + printing 0.0% would state the opposite." + [columns] + (let [ratios (map :labor-ratio columns) + trend (average ratios)] + (into [(label-cell "Payroll as % of sales" :bold true) + (figure trend :percent :bold true) + {:value ""}] + (for [r ratios] + (if (nil? r) + (assoc no-value :bold true) + (figure r :percent :bold true :color (heat r trend))))))) + +(defn period-label + "`Aug 1` for a one-week column, `Jul 25 – Aug 7` for a longer one — the span, when the span is + not obvious from the header alone." + [{:keys [starts ends]}] + (let [last-day (time/minus ends (time/days 1)) + short "MMM d"] + (if (time/before? starts (time/minus last-day (time/days 6))) + (str (atime/unparse-local starts short) " – " (atime/unparse-local last-day short)) + (atime/unparse-local last-day short)))) (defn report-table "`{:header :rows}` in the shape `auto-ap.ssr.ledger.report-table/table` renders." [columns] (let [sales-totals (map #(get-in % [:sales :total]) columns) payroll-totals (map #(get-in % [:payroll :total]) columns)] - {:header [(into [{:value "" :bold true} {:value "Average" :bold true}] - (for [c columns] - {:value (atime/unparse-local (time/minus (:ends c) (time/days 1)) - atime/normal-date) - :bold true}))] + {:header [(into [{:value "" :bold true} + {:value "Average" :bold true} + {:value "% of sales" :bold true}] + (for [c columns] {:value (period-label c) :bold true}))] :rows (concat - [(money-row "Sales" sales-totals :bold true)] + [(money-row "Sales" sales-totals sales-totals :bold true)] (for [{:keys [label values]} (category-rows columns)] - (money-row label values)) - [(money-row "Payroll" payroll-totals :bold true)] + (money-row label values sales-totals :indent true)) + [[] ; a blank row, so sales and payroll read as two blocks rather than one long list + (money-row "Payroll" payroll-totals sales-totals :bold true)] (for [[label] payroll-bands :let [values (map #(get-in % [:payroll :by-band label]) columns)] :when (some some? values)] - (money-row label values)) - [(percent-row "Payroll as % of sales" payroll-totals sales-totals :bold true)])})) + (money-row label values sales-totals :indent true)) + [[] + (ratio-row columns)])})) + +;; --------------------------------------------------------------------------- +;; The card +;; --------------------------------------------------------------------------- + +(defn- percent-str [r] + (if r (format "%.1f%%" (* 100.0 r)) "—")) + +(defn- stat + "One figure in the summary strip, big enough to read from across a desk." + [{:keys [label value hint color]}] + [:div {:class "flex-1 min-w-[9rem] px-5 py-4 rounded-lg bg-gray-50 dark:bg-gray-700"} + [:div {:class "text-xs uppercase tracking-wide text-gray-500 dark:text-gray-400"} label] + [:div {:class (str "text-2xl font-bold tabular-nums " (or color "text-gray-900 dark:text-white"))} + value] + (when hint [:div {:class "text-xs text-gray-500 dark:text-gray-400 mt-0.5"} hint])]) + +(def ^:private spark-w 190) +(def ^:private spark-h 40) + +(defn spark-points + "`[[x y] ...]` for the labour percentages, oldest on the left, scaled to fill the box. + + Periods with no payroll posted contribute no point, so the line joins across a gap rather than + diving to the floor and inventing a good week." + [columns] + (let [ratios (reverse (map :labor-ratio columns)) + present (keep identity ratios)] + (when (> (count present) 1) + (let [lo (apply min present) + span (max 1e-9 (- (apply max present) lo)) + steps (max 1 (dec (count ratios)))] + (keep-indexed + (fn [i r] + (when r + [(+ 3 (* (- spark-w 6) (/ (double i) steps))) + (- (- spark-h 3) (* (- spark-h 6) (/ (- r lo) span)))])) + ratios))))) + +(defn- sparkline + "The labour trend as a shape, for the reader who wants the direction before the numbers." + [columns] + (when-let [pts (spark-points columns)] + (let [[lx ly] (last pts)] + [:svg {:viewBox (str "0 0 " spark-w " " spark-h) + :width spark-w :height spark-h + :class "text-gray-400 dark:text-gray-500 mt-1" + :role "img" + :aria-label "Labour as a percentage of sales, oldest period on the left"} + [:polyline {:points (str/join " " (map (fn [[x y]] (str x "," y)) pts)) + :fill "none" :stroke "currentColor" :stroke-width "1.5" + :stroke-linejoin "round" :stroke-linecap "round"}] + [:circle {:cx lx :cy ly :r "2.5" :class "text-gray-700 dark:text-gray-200" + :fill "currentColor"}]]))) + +(defn- summary-strip [columns] + (let [{:keys [current current-sales current-payroll trend delta]} (headline columns) + latest (first columns)] + [:div {:class "flex flex-wrap gap-3 mb-5"} + (stat {:label "Labour, latest period" + :value (percent-str current) + :hint (period-label latest) + :color (cond + (nil? delta) nil + (pos? delta) "text-red-700 dark:text-red-400" + :else "text-green-700 dark:text-green-400")}) + (stat {:label "Usual" + :value (percent-str trend) + :hint (str "prior " (dec periods-shown) " periods")}) + (stat {:label "Change" + :value (if delta + (format "%+.1f pts" (* 100.0 delta)) + "—") + :hint (if delta "against the usual" "no payroll posted yet") + :color (cond + (nil? delta) nil + (pos? delta) "text-red-700 dark:text-red-400" + :else "text-green-700 dark:text-green-400")}) + (stat {:label "Sales, latest period" + :value (format "$%,.0f" (or current-sales 0.0)) + :hint (format "on $%,.0f of payroll" (or current-payroll 0.0))}) + (when-let [line (sparkline columns)] + [:div {:class "flex-1 min-w-[11rem] px-5 py-4 rounded-lg bg-gray-50 dark:bg-gray-700"} + [:div {:class "text-xs uppercase tracking-wide text-gray-500 dark:text-gray-400"} + "Labour trend"] + line + [:div {:class "text-xs text-gray-500 dark:text-gray-400 mt-0.5"} "oldest to latest"]])])) + +(defn- footnote [] + [:p {:class "text-xs text-gray-500 dark:text-gray-400 mt-4 max-w-3xl"} + "Sales are net revenue from the daily sales summaries — discounts and returns subtract, and tax, " + "tips and tender are excluded. Payroll is the ledger's payroll accounts, debits less credits, on " + "the date each entry was posted. A period showing " + [:span {:class "font-medium"} "—"] + " had no payroll posted at all; if that alternates, set the period to the client's pay cycle."]) (defn prime-cost-card* [{:keys [request columns]}] - (com/content-card - {:class "w-full" :id "prime-cost-report"} - [:div {:class "flex flex-col px-8 py-8 space-y-3"} - [:h1.text-2xl.mb-1.font-bold "Prime Cost Report"] - [:p {:class "text-sm text-gray-600 mb-3"} - "Payroll from the ledger, sales from the daily summaries, by week."] + (let [params (:query-params request)] + (com/content-card + {:class "w-full" :id "prime-cost-report"} + [:div {:class "flex flex-col px-8 py-8"} + [:h1.text-2xl.font-bold "Prime Cost Report"] + [:p {:class "text-sm text-gray-600 dark:text-gray-400 mt-1 mb-5"} + "Sales against the payroll that earned them, over " + (str periods-shown) + " periods. Payroll from the ledger, sales from the daily summaries."] - [:form {:hx-get (bidi/path-for ssr-routes/only-routes ::route/run-prime-cost) - :hx-target "#prime-cost-report" - :hx-swap "outerHTML"} - (fc/start-form - (:query-params request) - (:form-errors request) - [:div.flex.gap-2 - (fc/with-field :end-date - (com/validated-field {:label "Week ending" - :errors (fc/field-errors)} - [:div {:class "w-64"} - (com/date-input {:name (fc/field-name) - :class "w-64" - :value (some-> (fc/field-value) - (atime/unparse-local atime/normal-date))})])) - (com/button {:color :primary :class "self-center w-24"} "Run")])] + [:form {:hx-get (bidi/path-for ssr-routes/only-routes ::route/run-prime-cost) + :hx-target "#prime-cost-report" + :hx-swap "outerHTML" + :class "mb-6"} + (fc/start-form + params + (:form-errors request) + [:div {:class "flex flex-wrap gap-3 items-end"} + (fc/with-field :end-date + (com/validated-field {:label "Period ending" :errors (fc/field-errors)} + [:div {:class "w-48"} + (com/date-input {:name (fc/field-name) + :class "w-48" + :value (some-> (fc/field-value) + coerce/to-date-time + (atime/unparse-local atime/normal-date))})])) + (fc/with-field :period + (com/validated-field {:label "Period length" :errors (fc/field-errors)} + [:div {:class "w-40"} + (com/select {:name (fc/field-name) + :class "w-40" + :value (or (fc/field-value) default-period) + :options (map (juxt :value :label) period-lengths)})])) + [:div {:class "pb-1"} + (com/button {:color :primary :class "w-24"} "Run")]])] - (if (seq columns) - (table {:table (report-table columns) - :widths (into [14 8] (repeat weeks-shown 8))}) - [:div {:class "text-gray-600"} "Choose a week-ending date to run the report."])])) + (if (seq columns) + [:div + (summary-strip columns) + (table {:table (report-table columns) + :widths (into [16 9 7] (repeat periods-shown 9)) + :height "max-h-[70vh]"}) + (footnote)] + [:div {:class "text-gray-600 dark:text-gray-400 py-6"} + "Choose a period-ending date and run the report."])]))) (defn page [request] (base-page @@ -262,19 +485,21 @@ (prime-cost-card* {:request request :columns nil})) "Prime Cost Report")) -(defn run [{{:keys [end-date]} :query-params :as request}] +(defn run [{{:keys [end-date period]} :query-params :as request}] (let [client-ids (extract-client-ids (:clients request) (:client-id request) (when (:client-code request) [:client/code (:client-code request)])) columns (when end-date - (get-report-data (dc/db conn) client-ids end-date))] + (get-report-data (dc/db conn) client-ids end-date + (weeks-per-period (or period default-period))))] (html-response (prime-cost-card* {:request request :columns columns})))) (def query-schema (mc/schema [:maybe [:map - [:end-date {:optional true} [:maybe clj-date-schema]]]])) + [:end-date {:optional true} [:maybe clj-date-schema]] + [:period {:optional true} [:maybe (into [:enum] (map :value period-lengths))]]]])) (def key->handler (apply-middleware-to-all-handlers diff --git a/src/clj/auto_ap/ssr/ledger/report_table.clj b/src/clj/auto_ap/ssr/ledger/report_table.clj index 0c6d556b..65b4cddd 100644 --- a/src/clj/auto_ap/ssr/ledger/report_table.clj +++ b/src/clj/auto_ap/ssr/ledger/report_table.clj @@ -1,4 +1,4 @@ -(ns auto-ap.ssr.ledger.report-table +(ns auto-ap.ssr.ledger.report-table (:require [auto-ap.ssr.components :as com] [auto-ap.time :as atime] @@ -7,22 +7,21 @@ [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)) + (format "$%,.2f" (if (or (nil? (:value c)) + (query/dollars-0? (:value c))) 0.0 (:value c))) - - + (= :percent (:format c)) - (format "%%%.1f" (if (query/dollars-0? (:value c)) + (format "%.1f%%" (if (or (nil? (:value c)) + (query/dollars-0? (:value c))) 0.0 - (* 100.0 (or (:value c) 0.0)))) - + (* 100.0 (:value c)))) + :else (str (:value c))) cell-contents (if (:filters c) @@ -32,8 +31,7 @@ (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)))) - )} + (:client-id (:filters c)) (assoc :client-id (:client-id (:filters c)))))} cell-contents) cell-contents)] [:td.px-4.py-2 @@ -44,10 +42,9 @@ (fn [s] (->> (:border c) (map - (fn [b] - [(keyword (str "border-" (name b))) "1px solid black"]) - ) - (into s)))) + (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) @@ -57,10 +54,10 @@ (str/join "," (:color c)) ")")) - true (assoc-in [:style :background-color] (str "rgb(" - (str/join "," - (or (:bg-color c) [255 255 255])) - ")"))) + true (assoc-in [:style :background-color] (str "rgb(" + (str/join "," + (or (:bg-color c) [255 255 255])) + ")"))) cell-contents])) @@ -70,49 +67,52 @@ (apply max counts) 0))) -(defn table [{:keys [table widths investigate-url warning]}] +(defn table [{:keys [table widths investigate-url warning height]}] (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 " "}))]))))]))) + (com/content-card {:class "inline-block overflow-scroll"} + ;; `height` is a Tailwind height class, defaulting to the fixed 70vh the long + ;; reports need. A short report can pass `max-h-[70vh]` and then takes only + ;; the room it uses, rather than leaving a blank pane below itself. + [:div {:class (str "overflow-scroll m-4 inline-block " (or height "h-[70vh]"))} + (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] @@ -120,8 +120,8 @@ :rows (concat (:rows first) [[]] (mapcat - (fn [table] - (-> (:header table) - (into (:rows table)) - (conj []))) - rest))})) + (fn [table] + (-> (:header table) + (into (:rows table)) + (conj []))) + rest))})) diff --git a/test/clj/auto_ap/ssr/ledger/prime_cost_test.clj b/test/clj/auto_ap/ssr/ledger/prime_cost_test.clj index 0acfdbb1..98edcc77 100644 --- a/test/clj/auto_ap/ssr/ledger/prime_cost_test.clj +++ b/test/clj/auto_ap/ssr/ledger/prime_cost_test.clj @@ -24,17 +24,29 @@ :journal-entry-line/date date :journal-entry-line/debit debit}) -(deftest week-windows-tile-without-gaps - (testing "each week ends where the next begins, so no day is counted twice or missed" - (let [ws (sut/week-windows week-ending)] - (is (= sut/weeks-shown (count ws))) +(deftest period-windows-tile-without-gaps + (testing "each period ends where the next begins, so no day is counted twice or missed" + (let [ws (sut/period-windows week-ending)] + (is (= sut/periods-shown (count ws))) (is (= (coerce/to-date week-ending) (coerce/to-date (:ends (first ws)))) "the newest window ends at the requested date") (is (every? (fn [[newer older]] (= (:starts newer) (:ends older))) (partition 2 1 ws)) "windows abut") (is (apply > (map (comp coerce/to-long :starts) ws)) - "most recent first")))) + "most recent first"))) + (testing "a longer period widens each column without leaving a gap between them" + (let [ws (sut/period-windows week-ending 2)] + (is (= sut/periods-shown (count ws))) + (is (= 14 (time/in-days (time/interval (:starts (first ws)) (:ends (first ws)))))) + (is (every? (fn [[newer older]] (= (:starts newer) (:ends older))) + (partition 2 1 ws)))))) + +(deftest period-length-select-maps-to-weeks + (testing "the query param the form submits resolves to a column width" + (is (= 1 (sut/weeks-per-period "1"))) + (is (= 2 (sut/weeks-per-period "2"))) + (is (= 1 (sut/weeks-per-period nil)) "an absent or unknown period falls back to weekly"))) (deftest payroll-bands-come-from-the-shared-ledger-groupings (testing "the bands are the ledger's, not a second list that can drift from the P&L" @@ -132,11 +144,30 @@ :ledger-mapped/account "food-rev"}]}]) (let [columns (sut/get-report-data (dc/db conn) [test-client-id] week-ending) current (first columns)] - (is (= sut/weeks-shown (count columns))) + (is (= sut/periods-shown (count columns))) (is (= 0.25 (:labor-ratio current)) "250 of labour against 1000 of sales") (is (nil? (:labor-ratio (second columns))) "a week with no sales has no ratio rather than a divide-by-zero"))))) +(deftest a-period-with-no-payroll-posted-has-no-ratio + (testing "payroll posted on a pay-period date leaves neighbouring weeks empty, and an empty week + must read as unknown rather than as 0% labour" + (let [{:strs [test-client-id]} (setup-test-data [])] + @(dc/transact conn [(account "food-rev" 40111) + {:sales-summary/client test-client-id + :sales-summary/date in-week + :sales-summary/client+date [test-client-id in-week] + :sales-summary/items + [{:sales-summary-item/category "Gyros" + :ledger-mapped/amount 1000.0 + :ledger-mapped/ledger-side :ledger-side/credit + :ledger-mapped/account "food-rev"}]}]) + (let [current (first (sut/get-report-data (dc/db conn) [test-client-id] week-ending))] + (is (= 1000.0 (get-in current [:sales :total])) "the sales are real") + (is (false? (get-in current [:payroll :posted?]))) + (is (nil? (:labor-ratio current)) + "no payroll line exists, so the ratio is unknown, not zero"))))) + (deftest report-table-renders-a-column-per-week-plus-label-and-average (testing "the table lines up with its header" (let [{:strs [test-client-id]} (setup-test-data [])] @@ -151,7 +182,37 @@ :ledger-mapped/account "food-rev"}]}]) (let [{:keys [header rows]} (sut/report-table (sut/get-report-data (dc/db conn) [test-client-id] week-ending)) - width (+ 2 sut/weeks-shown)] + width (+ 3 sut/periods-shown)] (is (= width (count (first header)))) - (is (every? #(= width (count %)) rows) - "every row is the same width as the header, or the table skews"))))) + (is (every? #(= width (count %)) (remove empty? rows)) + "every populated row is the same width as the header, or the table skews"))))) + +(deftest the-trend-line-skips-periods-with-no-payroll + (testing "a period with no payroll posted contributes no point, so the line joins across the gap + rather than diving to the floor and drawing a week that never happened" + (let [columns [{:labor-ratio 0.30} {:labor-ratio nil} {:labor-ratio 0.20}]] + (is (= 2 (count (sut/spark-points columns)))))) + (testing "a single readable period is not a trend" + (is (nil? (sut/spark-points [{:labor-ratio 0.30} {:labor-ratio nil}]))))) + +(deftest a-detail-line-never-averages-larger-than-its-subtotal + (testing "money averages over every period, so a band posting every second period is not divided + by a smaller denominator than the total it rolls up into" + (is (= 500.0 (sut/per-period [1000.0 nil 1000.0 nil])) + "the empty periods still count") + (is (= 1000.0 (sut/average [1000.0 nil 1000.0 nil])) + "a ratio, by contrast, only averages the periods it is known for")) + (testing "on real-shaped data the payroll bands sum to no more than the payroll total" + (let [{:strs [test-client-id]} (setup-test-data [])] + @(dc/transact conn [(account "foh" 63200) + (jel test-client-id "foh" in-week 1400.0)]) + (let [{:keys [rows]} (sut/report-table + (sut/get-report-data (dc/db conn) [test-client-id] week-ending)) + average-of (fn [label] + (->> rows + (filter #(= label (-> (str (:value (first %))) + (clojure.string/replace "\u00a0" "") + (clojure.string/trim)))) + first second :value))] + (is (= (average-of "Payroll") (average-of "63000-66000 Payroll - FOH")) + "one band carrying all the payroll averages exactly what the total does")))))