notid/integreat
1
0
Fork 0
Code Issues Pull Requests 5 Actions Packages Projects Releases Wiki Activity

feat(ledger): make the Prime Cost Report readable against real ledger data

Browse Source 
Rendering the report against a restored production database turned up
three things the tests could not have told me, and one they should have.

**Payroll posts on a pay run, not on a week.** A journal entry carries
the date it was posted, so a client paying every fortnight puts a
fortnight of labour on a single day. Against weekly columns the trend
read `—, 56.7%, —, 52.5%, -19.5%`, which is noise. Against fortnightly
columns the same client reads 18% to 27%. Hence the period control:
weekly, bi-weekly or four weeks, set to whatever the client's pay cycle
actually is.

**Zero is a claim, and it was the wrong one.** A period with no payroll
posted used to print 0.0% labour. No restaurant runs a week on no
labour; the pay run simply has not landed yet. That now reads as an em
dash, the trend line joins across the gap rather than diving to the
floor, and the footnote says what to do about it.

**A detail line printed larger than its own subtotal.** Averages
dropped empty periods from the denominator, so a band posting every
second period averaged over four periods while the total it rolled into
averaged over eight — $23,923 of "Payroll - General" inside $12,035 of
"Payroll". Money now averages across every period and ratios still
average only the periods they are known for, which is the distinction
that was missing.

The one the tests should have caught: the shared cell renderer calls
`dollars-0?` on a value before nil-punning it, so any nil cell was an
NPE at render time rather than a blank. Guarded, along with its
`:percent` branch, which also printed `%27.2` — sign on the wrong side.
Nothing else in the codebase reaches that branch.

Also here, in service of it being read rather than merely correct: a
summary strip with the latest labour percentage, what it usually runs
at, the change between them and a trend sparkline; a % of sales column
beside the average, as the workbook has; detail lines indented under
their subtotals; and an opt-in `height` on the shared table so a short
report stops reserving 70vh it does not use.

11 tests, 41 assertions.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
Bryce
2026-08-18 23:50:00 -07:00
parent 359508ea9f
commit 250bf0ea7f
3 changed files with 440 additions and 154 deletions
Download Patch File Download Diff File Expand all files Collapse all files

381
src/clj/auto_ap/ssr/ledger/prime_cost.clj
View File

@@ -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

134
src/clj/auto_ap/ssr/ledger/report_table.clj
View File

@@ -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))}))

79
test/clj/auto_ap/ssr/ledger/prime_cost_test.clj
View File

@@ -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")))))