|
| 1 | +(ns ^:deprecated excel-clj.deprecated |
| 2 | + "To provide some minimal backwards compatibility with v1.x" |
| 3 | + (:require [excel-clj.cell :as cell] |
| 4 | + [excel-clj.tree :as tree] |
| 5 | + [clojure.string :as string] |
| 6 | + [taoensso.encore :as enc])) |
| 7 | + |
| 8 | + |
| 9 | +(defn- best-guess-row-format |
| 10 | + "Try to guess appropriate formatting based on column name and cell value." |
| 11 | + [row-data column] |
| 12 | + (let [column' (string/lower-case column) |
| 13 | + val (get row-data column)] |
| 14 | + (cond |
| 15 | + (and (string? val) (> (count val) 75)) |
| 16 | + {:wrap-text true} |
| 17 | + |
| 18 | + (or (string/includes? column' "percent") (string/includes? column' "%")) |
| 19 | + {:data-format :percent} |
| 20 | + |
| 21 | + (string/includes? column' "date") |
| 22 | + {:data-format :ymd :alignment :left} |
| 23 | + |
| 24 | + (decimal? val) |
| 25 | + {:data-format :accounting} |
| 26 | + |
| 27 | + :else nil))) |
| 28 | + |
| 29 | + |
| 30 | +(def ^:private default-header-style |
| 31 | + (constantly |
| 32 | + {:border-bottom :thin :font {:bold true}})) |
| 33 | + |
| 34 | + |
| 35 | +(defn ^:deprecated table |
| 36 | + "Build a sheet grid from the provided collection of tabular data, where each |
| 37 | + item has the format {Column Name, Cell Value}. |
| 38 | + If provided |
| 39 | + headers is an ordered coll of column names |
| 40 | + header-style is a function header-name => style map for the header. |
| 41 | + data-style is a function that takes (datum-map, column name) and returns |
| 42 | + a style specification or nil for the default style." |
| 43 | + [tabular-data & {:keys [headers header-style data-style] |
| 44 | + :or {data-style (constantly {})}}] |
| 45 | + (let [;; add the headers either in the order they're provided or in the order |
| 46 | + ;; of (seq) on the first datum |
| 47 | + headers (let [direction (if (> (count (last tabular-data)) |
| 48 | + (count (first tabular-data))) |
| 49 | + reverse identity) |
| 50 | + hs (or headers (sequence (comp (mapcat keys) (distinct)) |
| 51 | + (direction tabular-data)))] |
| 52 | + (assert (not-empty hs) "Table headers are not empty.") |
| 53 | + hs) |
| 54 | + ;; A little hack to keep track of which numbers excel will right |
| 55 | + ;; justify, and therefore which headers to right justify by default |
| 56 | + numeric? (volatile! #{}) |
| 57 | + data-cell (fn [col-name row] |
| 58 | + (let [style (enc/nested-merge |
| 59 | + (or (data-style row col-name) {}) |
| 60 | + (best-guess-row-format row col-name))] |
| 61 | + (when (or (= (:data-format style) :accounting) |
| 62 | + (number? (get row col-name ""))) |
| 63 | + (vswap! numeric? conj col-name)) |
| 64 | + (cell/style (get row col-name) style))) |
| 65 | + getters (map (fn [col-name] #(data-cell col-name %)) headers) |
| 66 | + header-style (or header-style |
| 67 | + ;; Add right alignment if it's an accounting column |
| 68 | + (fn [name] |
| 69 | + (cond-> (default-header-style name) |
| 70 | + (@numeric? name) |
| 71 | + (assoc :alignment :right))))] |
| 72 | + (cons |
| 73 | + (map (fn [x] (cell/style x (header-style x))) headers) |
| 74 | + (map (apply juxt getters) tabular-data)))) |
| 75 | + |
| 76 | + |
| 77 | +(def default-tree-formatters |
| 78 | + {0 {:font {:bold true} :border-bottom :medium} |
| 79 | + 1 {:font {:bold true}} |
| 80 | + 2 {:indention 2} |
| 81 | + 3 {:font {:italic true} :alignment :right}}) |
| 82 | + |
| 83 | + |
| 84 | +(def default-tree-total-formatters |
| 85 | + {0 {:font {:bold true} :border-top :medium} |
| 86 | + 1 {:border-top :thin :border-bottom :thin}}) |
| 87 | + |
| 88 | + |
| 89 | +(defn old->new-tree [[title tree]] |
| 90 | + (let [branch? (complement (fn [x] (and (vector? x) (map? (second x))))) |
| 91 | + children #(when (vector? %) (second %))] |
| 92 | + (tree/tree branch? children tree first second))) |
| 93 | + |
| 94 | + |
| 95 | +(defn ^:deprecated tree |
| 96 | + "Build a sheet grid from the provided tree of data |
| 97 | + [Tree Title [[Category Label [Children]] ... [Category Label [Children]]]] |
| 98 | + with leaves of the shape [Category Label {:column :value}]. |
| 99 | + E.g. The assets section of a balance sheet might be represented by the tree |
| 100 | + [:balance-sheet |
| 101 | + [:assets |
| 102 | + [[:current-assets |
| 103 | + [[:cash {2018 100M, 2017 90M}] |
| 104 | + [:inventory {2018 1500M, 2017 1200M}]]] |
| 105 | + [:investments {2018 50M, 2017 45M}]]]] |
| 106 | + If provided, the formatters argument is a function that takes the integer |
| 107 | + depth of a category (increases with nesting) and returns a cell format for |
| 108 | + the row, and total-formatters is the same for rows that are totals." |
| 109 | + [core-table with-title t & {:keys [headers formatters total-formatters |
| 110 | + min-leaf-depth data-format] |
| 111 | + :or {formatters default-tree-formatters |
| 112 | + total-formatters default-tree-total-formatters |
| 113 | + min-leaf-depth 2 |
| 114 | + data-format :accounting}}] |
| 115 | + (let [title (first t) |
| 116 | + t (old->new-tree t) |
| 117 | + fmts (into (sorted-map) formatters) |
| 118 | + total-fmts (into (sorted-map) total-formatters) |
| 119 | + get' (fn [m k] (or (get m k) (val (last m))))] |
| 120 | + (with-title title |
| 121 | + (core-table |
| 122 | + (into [""] (remove #{""}) (or headers (keys (tree/fold + t)))) |
| 123 | + (tree/table |
| 124 | + ;; Insert total rows below nodes with children |
| 125 | + (fn render [parent node depth] |
| 126 | + (if-not (tree/leaf? node) |
| 127 | + (let [combined (tree/fold + node) |
| 128 | + empty-row (zipmap (keys combined) (repeat nil))] |
| 129 | + (concat |
| 130 | + ; header |
| 131 | + [(cell/style |
| 132 | + (assoc empty-row "" (name parent)) |
| 133 | + (get' fmts depth))] |
| 134 | + ; children |
| 135 | + (tree/table render node) |
| 136 | + ; total row |
| 137 | + (when (> (count node) 1) |
| 138 | + [(cell/style (assoc combined "" "") (get' total-fmts depth))]))) |
| 139 | + ; leaf |
| 140 | + [(cell/style (assoc node "" (name parent)) |
| 141 | + (get' fmts (max min-leaf-depth depth)))])) |
| 142 | + t))))) |
0 commit comments