-
Notifications
You must be signed in to change notification settings - Fork 128
/
spreadsheet.clj
600 lines (513 loc) · 20.2 KB
/
spreadsheet.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
(ns dk.ative.docjure.spreadsheet
(:import
(java.io FileOutputStream FileInputStream InputStream OutputStream)
(java.util Date Calendar)
(org.apache.poi.xssf.usermodel XSSFWorkbook)
(org.apache.poi.hssf.usermodel HSSFWorkbook)
(org.apache.poi.ss.usermodel Workbook Sheet Cell Row
FormulaError
WorkbookFactory DateUtil
IndexedColors CellStyle Font
CellValue Drawing CreationHelper)
(org.apache.poi.ss.util CellReference AreaReference)))
(defmacro assert-type [value expected-type]
`(when-not (isa? (class ~value) ~expected-type)
(throw (IllegalArgumentException.
(format "%s is invalid. Expected %s. Actual type %s, value: %s"
(str '~value) ~expected-type (class ~value) ~value)))))
;; not used
(defn cell-reference [^Cell cell]
(.formatAsString (CellReference. (.getRowIndex cell) (.getColumnIndex cell))))
(defmulti read-cell-value (fn [^CellValue cv date-format?] (.getCellType cv)))
(defmethod read-cell-value Cell/CELL_TYPE_BOOLEAN [^CellValue cv _] (.getBooleanValue cv))
(defmethod read-cell-value Cell/CELL_TYPE_STRING [^CellValue cv _] (.getStringValue cv))
(defmethod read-cell-value Cell/CELL_TYPE_NUMERIC [^CellValue cv date-format?]
(if date-format?
(DateUtil/getJavaDate (.getNumberValue cv))
(.getNumberValue cv)))
(defmethod read-cell-value Cell/CELL_TYPE_ERROR [^CellValue cv _]
(keyword (.name (FormulaError/forInt (.getErrorValue cv)))))
(defmulti read-cell #(.getCellType ^Cell %))
(defmethod read-cell Cell/CELL_TYPE_BLANK [_] nil)
(defmethod read-cell Cell/CELL_TYPE_STRING [^Cell cell] (.getStringCellValue cell))
(defmethod read-cell Cell/CELL_TYPE_FORMULA [^Cell cell]
(let [evaluator (.. cell getSheet getWorkbook
getCreationHelper createFormulaEvaluator)
cv (.evaluate evaluator cell)]
(if (and (= Cell/CELL_TYPE_NUMERIC (.getCellType cv))
(DateUtil/isCellDateFormatted cell))
(.getDateCellValue cell)
(read-cell-value cv false))))
(defmethod read-cell Cell/CELL_TYPE_BOOLEAN [^Cell cell] (.getBooleanCellValue cell))
(defmethod read-cell Cell/CELL_TYPE_NUMERIC [^Cell cell]
(if (DateUtil/isCellDateFormatted cell)
(.getDateCellValue cell)
(.getNumericCellValue cell)))
(defmethod read-cell Cell/CELL_TYPE_ERROR [^Cell cell]
(keyword (.name (FormulaError/forInt (.getErrorCellValue cell)))))
(defn load-workbook-from-stream
"Load an Excel workbook from a stream.
The caller is required to close the stream after loading is completed."
[^InputStream stream]
(WorkbookFactory/create stream))
(defn load-workbook-from-file
"Load an Excel .xls or .xlsx workbook from a file."
[^String filename]
(with-open [stream (FileInputStream. filename)]
(load-workbook-from-stream stream)))
(defn load-workbook-from-resource
"Load an Excel workbook from a named resource.
Used when reading from a resource on a classpath
as in the case of running on an application server."
[^String resource]
(let [url (clojure.java.io/resource resource)]
(with-open [stream (.openStream url)]
(load-workbook-from-stream stream))))
(defmulti load-workbook "Load an Excel .xls or .xlsx workbook from an InputStream." class)
(defmethod load-workbook String
[filename]
(load-workbook-from-file filename))
(defmethod load-workbook InputStream
[stream]
(load-workbook-from-stream stream))
(defn save-workbook-into-stream!
"Save the workbook into a stream.
The caller is required to close the stream after saving is completed."
[^OutputStream stream ^Workbook workbook]
(assert-type workbook Workbook)
(.write workbook stream))
(defn save-workbook-into-file!
"Save the workbook into a file."
[^String filename ^Workbook workbook]
(assert-type workbook Workbook)
(with-open [file-out (FileOutputStream. filename)]
(.write workbook file-out)))
(defmulti save-workbook!
"Save the workbook into a stream or a file.
In the case of saving into a stream, the caller is required
to close the stream after saving is completed."
(fn [x _] (class x)))
(defmethod save-workbook! OutputStream
[stream workbook]
(save-workbook-into-stream! stream workbook))
(defmethod save-workbook! String
[filename workbook]
(save-workbook-into-file! filename workbook))
(defn sheet-seq
"Return a lazy seq of the sheets in a workbook."
[^Workbook workbook]
(assert-type workbook Workbook)
(for [idx (range (.getNumberOfSheets workbook))]
(.getSheetAt workbook idx)))
(defn sheet-name
"Return the name of a sheet."
[^Sheet sheet]
(assert-type sheet Sheet)
(.getSheetName sheet))
(defn- find-sheet
[matching-fn ^Workbook workbook]
(assert-type workbook Workbook)
(->> (sheet-seq workbook)
(filter matching-fn)
first))
(defmulti select-sheet
"Select a sheet from the workbook by name, regex or arbitrary predicate"
(fn [predicate ^Workbook workbook]
(class predicate)))
(defmethod select-sheet String
[name ^Workbook workbook]
(find-sheet #(= name (sheet-name %)) workbook))
(defmethod select-sheet java.util.regex.Pattern
[regex-pattern ^Workbook workbook]
(find-sheet #(re-find regex-pattern (sheet-name %)) workbook))
(defmethod select-sheet :default
[matching-fn ^Workbook workbook]
(find-sheet matching-fn workbook))
(defn row-seq
"Return a lazy sequence of the rows in a sheet."
[^Sheet sheet]
(assert-type sheet Sheet)
(iterator-seq (.iterator sheet)))
(defn- cell-seq-dispatch [x]
(cond
(isa? (class x) Row) :row
(isa? (class x) Sheet) :sheet
(seq? x) :coll
:else :default))
(defmulti cell-seq
"Return a seq of the cells in the input which can be a sheet, a row, or a collection
of one of these. The seq is ordered ordered by sheet, row and column."
cell-seq-dispatch)
(defmethod cell-seq :row [^Row row] (iterator-seq (.iterator row)))
(defmethod cell-seq :sheet [sheet] (for [row (row-seq sheet)
cell (cell-seq row)]
cell))
(defmethod cell-seq :coll [coll] (for [x coll,
cell (cell-seq x)]
cell))
(defn into-seq
[^Iterable sheet-or-row]
(vec (for [item (iterator-seq (.iterator sheet-or-row))] item)))
(defn- project-cell [column-map ^Cell cell]
(let [colname (-> cell
.getColumnIndex
org.apache.poi.ss.util.CellReference/convertNumToColString
keyword)
new-key (column-map colname)]
(when new-key
{new-key (read-cell cell)})))
(defn select-columns
"Takes two arguments: column hashmap and a sheet. The column hashmap
specifies the mapping from spreadsheet columns dictionary keys:
its keys are the spreadsheet column names and the values represent
the names they are mapped to in the result.
For example, to select columns A and C as :first and :third from the sheet
(select-columns {:A :first, :C :third} sheet)
=> [{:first \"Value in cell A1\", :third \"Value in cell C1\"} ...] "
[column-map ^Sheet sheet]
(assert-type sheet Sheet)
(vec
(for [row (into-seq sheet)]
(->> (map #(project-cell column-map %) row)
(apply merge)))))
(defn string-cell? [^Cell cell]
(= Cell/CELL_TYPE_STRING (.getCellType cell)))
(defn- date-or-calendar? [value]
(let [cls (class value)]
(or (isa? cls Date) (isa? cls Calendar))))
(defn apply-date-format! [^Cell cell ^String format]
(let [workbook (.. cell getSheet getWorkbook)
date-style (.createCellStyle workbook)
format-helper (.getCreationHelper workbook)]
(.setDataFormat date-style
(.. format-helper createDataFormat (getFormat format)))
(.setCellStyle cell date-style)))
(defmulti set-cell! (fn [^Cell cell val] (type val)))
(defmethod set-cell! String [^Cell cell val]
(do
(if (= (.getCellType cell) Cell/CELL_TYPE_FORMULA) (.setCellType cell Cell/CELL_TYPE_STRING))
(.setCellValue cell ^String val)))
(defmethod set-cell! Number [^Cell cell val]
(do
(if (= (.getCellType cell) Cell/CELL_TYPE_FORMULA) (.setCellType cell Cell/CELL_TYPE_NUMERIC))
(.setCellValue cell (double val))))
(defmethod set-cell! Boolean [^Cell cell val]
(do
(if (= (.getCellType cell) Cell/CELL_TYPE_FORMULA) (.setCellType cell Cell/CELL_TYPE_BOOLEAN))
(.setCellValue cell ^Boolean val)))
(defmethod set-cell! Date [^Cell cell val]
(do
(if (= (.getCellType cell) Cell/CELL_TYPE_FORMULA) (.setCellType cell Cell/CELL_TYPE_NUMERIC))
(.setCellValue cell ^Date val)
(apply-date-format! cell "m/d/yy")))
(defmethod set-cell! nil [^Cell cell val]
(let [^String null nil]
(do
(if (= (.getCellType cell) Cell/CELL_TYPE_FORMULA) (.setCellType cell Cell/CELL_TYPE_BLANK))
(.setCellValue cell null))))
(defn add-row! [^Sheet sheet values]
(assert-type sheet Sheet)
(let [row-num (if (= 0 (.getPhysicalNumberOfRows sheet))
0
(inc (.getLastRowNum sheet)))
row (.createRow sheet row-num)]
(doseq [[column-index value] (map-indexed #(list %1 %2) values)]
(set-cell! (.createCell row column-index) value))
row))
(defn add-rows! [^Sheet sheet rows]
"Add rows to the sheet. The rows is a sequence of row-data, where
each row-data is a sequence of values for the columns in increasing
order on that row."
(assert-type sheet Sheet)
(doseq [row rows]
(add-row! sheet row)))
(defn add-sheet!
"Add a new sheet to the workbook."
[^Workbook workbook name]
(assert-type workbook Workbook)
(.createSheet workbook name))
(defn create-workbook
"Create a new XLSX workbook. Sheet-name is a string name for the sheet. Data
is a vector of vectors, representing the rows and the cells of the rows.
Alternate sheet names and data to create multiple sheets.
(create-workbook \"SheetName1\" [[\"A1\" \"A2\"][\"B1\" \"B2\"]]
\"SheetName2\" [[\"A1\" \"A2\"][\"B1\" \"B2\"]] "
([sheet-name data]
(let [workbook (XSSFWorkbook.)
sheet (add-sheet! workbook sheet-name)]
(add-rows! sheet data)
workbook))
([sheet-name data & name-data-pairs]
;; incomplete pairs should not be allowed
{:pre [(even? (count name-data-pairs))]}
;; call single arity version to create workbook
(let [workbook (create-workbook sheet-name data)]
;; iterate through pairs adding sheets and rows
(doseq [[s-name data] (partition 2 name-data-pairs)]
(-> workbook
(add-sheet! s-name)
(add-rows! data)))
workbook)))
(defn create-xls-workbook
"Create a new XLS workbook with a single sheet and the data specified."
[sheet-name data]
(let [workbook (HSSFWorkbook.)
sheet (add-sheet! workbook sheet-name)]
(add-rows! sheet data)
workbook))
;******************************************************
; helpers for font and style creation
(defn color-index
"Returns color index from org.apache.ss.usermodel.IndexedColors
from lowercase keywords"
[colorkw]
(.getIndex (IndexedColors/valueOf (.toUpperCase (name colorkw)))))
(defn horiz-align
"Returns horizontal alignment"
[kw]
(case kw
:left CellStyle/ALIGN_LEFT
:right CellStyle/ALIGN_RIGHT
:center CellStyle/ALIGN_CENTER))
(defn vert-align
"Returns vertical alignment"
[kw]
(case kw
:top CellStyle/VERTICAL_TOP
:bottom CellStyle/VERTICAL_BOTTOM
:center CellStyle/VERTICAL_CENTER))
(defn border
"Returns border style"
[kw]
(case kw
:thin CellStyle/BORDER_THIN
:medium CellStyle/BORDER_MEDIUM
:thick CellStyle/BORDER_THICK))
(defmacro whens
"Processes any and all expressions whose tests evaluate to true.
Example:
(let [m (java.util.HashMap.)]
(whens
false (.put m :z 0)
true (.put m :a 1)
true (.put m :b 2)
nil (.put m :w 3))
m)
=> {:b=2, :a=1}
"
[& [test expr :as clauses]]
(when clauses
`(do (when ~test ~expr)
(whens ~@(nnext clauses)))))
;****************************************************
(defn create-font!
"Create a new font in the workbook with options:
:name font family (string)
:size font size (integer)
:color font color (keyword)
:bold true | false
:italic true | false
:underline true | false
Example:
(create-font! wb
{:name \"Arial\", :size 12, :color :blue,
:bold true, :underline true})
"
[^Workbook workbook options]
(assert-type workbook Workbook)
(let [f (.createFont workbook)
{:keys [name size color bold italic underline]} options]
(whens
name (.setFontName f name)
size (.setFontHeightInPoints f size)
color (.setColor f (color-index color))
bold (.setBoldweight f Font/BOLDWEIGHT_BOLD)
italic (.setItalic f true)
underline (.setUnderline f Font/U_SINGLE))
f))
(defprotocol IFontable
"A protocol that allows:
1. interchangeable use of fonts and maps of font options
2. getting fonts from either XLS or XLSX cell styles, which
normally requires distinct syntax."
(set-font [this style workbook])
(get-font [this workbook])
(as-font [this workbook]))
(extend-protocol IFontable
clojure.lang.PersistentArrayMap
(set-font [this ^CellStyle style workbook]
(.setFont style (create-font! workbook this)))
(as-font [this workbook] (create-font! workbook this))
org.apache.poi.ss.usermodel.Font
(set-font [this ^CellStyle style _] (.setFont style this))
(as-font [this _] this)
org.apache.poi.xssf.usermodel.XSSFCellStyle
(get-font [this _] (.getFont this))
org.apache.poi.hssf.usermodel.HSSFCellStyle
(get-font [this workbook] (.getFont this workbook)))
(defn create-cell-style!
"Create a new cell-style in the workbook from options:
:background background colour (as keyword)
:font font | fontmap (of font options)
:halign :left | :right | :center
:valign :top | :bottom | :center
:wrap true | false - controls text wrapping
:border-left :thin | :medium | :thick
:border-right :thin | :medium | :thick
:border-top :thin | :medium | :thick
:border-bottom :thin | :medium | :thick
Valid color keywords are the colour names defined in
org.apache.ss.usermodel.IndexedColors as lowercase keywords, eg.
:black, :white, :red, :blue, :light_green, :yellow, ...
Examples:
I.
(def f (create-font! wb {:name \"Arial\", :bold true, :italic true})
(create-cell-style! wb {:background :yellow, :font f, :halign :center,
:wrap true, :borders :thin})
II.
(create-cell-style! wb {:background :yellow, :halign :center,
:font {:name \"Arial\" :bold true :italic true},
:wrap true, :borders :thin})
"
([^Workbook workbook] (create-cell-style! workbook {}))
([^Workbook workbook styles]
(assert-type workbook Workbook)
(let [cs (.createCellStyle workbook)
{:keys [background font halign valign wrap
border-left border-right border-top
border-bottom borders]} styles]
(whens
font (set-font font cs workbook)
background (do (.setFillForegroundColor cs (color-index background))
(.setFillPattern cs CellStyle/SOLID_FOREGROUND))
halign (.setAlignment cs (horiz-align halign))
valign (.setVerticalAlignment cs (vert-align valign))
wrap (.setWrapText cs true)
border-left (.setBorderLeft cs (border border-left))
border-right (.setBorderRight cs (border border-right))
border-top (.setBorderTop cs (border border-top))
border-bottom (.setBorderBottom cs (border border-bottom)))
cs)))
(defn set-cell-style!
"Apply a style to a cell.
See also: create-cell-style!.
"
[^Cell cell ^CellStyle style]
(assert-type cell Cell)
(assert-type style CellStyle)
(.setCellStyle cell style)
cell)
(defn set-cell-comment!
"Creates a cell comment-box that displays a comment string
when the cell is hovered over. Returns the cell.
Options:
:font (font | fontmap - font applied to the comment string)
:width (int - width of comment-box in columns; default 1 cols)
:height (int - height of comment-box in rows; default 2 rows)
Example:
(set-cell-comment! acell \"This comment should\nspan two lines.\"
:width 2 :font {:bold true :size 12 :color blue})
"
[^Cell cell comment-str & {:keys [font width height]
:or {width 1, height 2}}]
(let [sheet (.getSheet cell)
wb (.getWorkbook sheet)
drawing (.createDrawingPatriarch sheet)
helper (.getCreationHelper wb)
anchor (.createClientAnchor helper)
c1 (.getColumnIndex cell)
c2 (+ c1 width)
r1 (.getRowIndex cell)
r2 (+ r1 height)]
(doto anchor
(.setCol1 c1) (.setCol2 c2) (.setRow1 r1) (.setRow2 r2))
(let [comment (.createCellComment drawing anchor)
rts (.createRichTextString helper comment-str)]
(when font
(let [^Font f (as-font font wb)] (.applyFont rts f)))
(.setString comment rts)
(.setCellComment cell comment))
cell))
(defn set-row-style!
"Apply a style to all the cells in a row.
Returns the row."
[^Row row ^CellStyle style]
(assert-type row Row)
(assert-type style CellStyle)
(doseq [^Cell c (cell-seq row)]
(.setCellStyle c style))
row)
(defn get-row-styles
"Returns a seq of the row's CellStyles."
[^Row row]
(map #(.getCellStyle ^Cell %) (cell-seq row)))
(defn set-row-styles!
"Apply a seq of styles to the cells in a row."
[^Row row styles]
(let [pairs (map list (cell-seq row) styles)]
(doseq [[^Cell c s] pairs]
(.setCellStyle c s))))
(defn row-vec
"Transform the row struct (hash-map) to a row vector according to the column order.
Example:
(row-vec [:foo :bar] {:foo \"Foo text\", :bar \"Bar text\"})
> [\"Foo text\" \"Bar text\"]
"
[column-order row]
(vec (map row column-order)))
(defn remove-row!
"Remove a row from the sheet."
[^Sheet sheet ^Row row]
(do
(assert-type sheet Sheet)
(assert-type row Row)
(.removeRow sheet row)
sheet))
(defn remove-all-rows!
"Remove all the rows from the sheet."
[sheet]
(doall
(for [row (doall (row-seq sheet))]
(remove-row! sheet row)))
sheet)
(defn- named-area-ref [^Workbook workbook n]
(let [index (.getNameIndex workbook (name n))]
(if (>= index 0)
(->> index
(.getNameAt workbook)
(.getRefersToFormula)
(AreaReference.))
nil)))
(defn- cell-from-ref [^Workbook workbook ^CellReference cref]
(let [row (.getRow cref)
col (int (.getCol cref))
sheet (->> cref (.getSheetName) (.getSheet workbook))]
(-> sheet (.getRow row) (.getCell col))))
(defn select-name
"Given a workbook and name (string or keyword) of a named range, select-name
returns a seq of cells or nil if the name could not be found."
[^Workbook workbook n]
(when-let [^AreaReference aref (named-area-ref workbook n)]
(map (partial cell-from-ref workbook) (.getAllReferencedCells aref))))
(defn select-cell
"Given a Sheet and a cell reference (A1), select-cell returns the cell
or nil if the cell could not be found"
[n ^Sheet sheet]
(let [cellref (CellReference. n)
row (.getRow cellref)
col (.getCol cellref)]
(try (.getCell (.getRow sheet row) col) (catch Exception e nil))))
(defn add-name! [^Workbook workbook n string-ref]
(let [the-name (.createName workbook)]
(.setNameName the-name (name n))
(.setRefersToFormula the-name string-ref)))
(defn cell-fn
"Turn a cell (ideally containing a formula) into a function. The returned function
will take a variable number of parameters, updating each of the inputcells in the
sheet with the supplied values and return the value of the cell outputcell.
Cell names are specified using Excel syntax, i.e. A2 or B12."
[outputcell ^Sheet sheet & inputcells]
(fn [& input] (do
(doseq [pair (seq (apply hash-map (interleave inputcells input)))]
(set-cell! (select-cell (first pair) sheet) (last pair)))
(read-cell (select-cell outputcell sheet)))))