Add merged cells support with simple tests

scripts/coverage

@@ -5,4 +5,5 @@ lein cloverage \
     --codecov \
     --html \
     --runner :midje \
-    --ns-exclude-regex "zero-one.fxl.google-sheets"
+    --ns-exclude-regex "zero-one.fxl.google-sheets" \
+    --exclude-call "clojure.spec.alpha/keys"

src/zero_one/fxl/core.clj

@@ -10,16 +10,23 @@
 
 ;; Utility Functions
 (defn ->cell [maybe-cell]
-  (merge defaults/cell maybe-cell))
+  (list
+    (merge defaults/cell maybe-cell)))
 
 (defn max-col [cells]
   (->> cells
-       (map (comp :col :coord))
+       (map
+         (juxt (comp :col :coord)
+               (comp :last-col :coord)))
+       (#(filter some? (flatten %)))
        (apply max -1)))
 
 (defn max-row [cells]
   (->> cells
-       (map (comp :row :coord))
+       (map
+         (juxt (comp :row :coord)
+               (comp :last-row :coord)))
+       (#(filter some? (flatten %)))
        (apply max -1)))
 
 (defn zip-with-index [coll]
@@ -82,11 +89,30 @@
            (vector k v)))))))
 
 ;; Helper Functions: Relative Coords
-(defn- shift-cell [dir shift cell]
+(def merged-cell? write-xlsx/merged-cell?)
+
+(defn- shift-plain-cell [dir shift cell]
   (let [old-index (get-in cell [:coord dir])
         new-index (max 0 (+ old-index shift))]
     (assoc-in cell [:coord dir] new-index)))
 
+(defn- shift-merged-cell [dir shift cell]
+  (let [first-key  (keyword (str "first-" (symbol dir)))
+        last-key   (keyword (str "last-" (symbol dir)))
+        old-index1 (get-in cell [:coord first-key])
+        old-index2 (get-in cell [:coord last-key])
+        new-index1 (max 0 (+ old-index1 shift))
+        new-index2 (max 0 (+ old-index2 shift))]
+    ;;TODO: rename and do i need max?
+    (-> cell
+        (assoc-in [:coord first-key] new-index1) 
+        (assoc-in [:coord last-key] new-index2))))
+
+(defn- shift-cell [dir shift cell]
+  (if (merged-cell? cell)
+    (shift-merged-cell dir shift cell)
+    (shift-plain-cell dir shift cell)))
+
 (defn shift-right [shift cell]
   (shift-cell :col shift cell))
 
@@ -114,7 +140,7 @@
   ([shift cells]
    (concat-right
      cells
-     [(->cell {:coord {:row 0 :col (dec shift)} :style {}})])))
+     (->cell {:coord {:row 0 :col (dec shift)} :style {}}))))
 
 (defn concat-below
   ([] nil)
@@ -131,7 +157,7 @@
   ([shift cells]
    (concat-below
      cells
-     [(->cell {:coord {:row (dec shift) :col 0} :style {}})])))
+     (->cell {:coord {:row (dec shift) :col 0} :style {}}))))
 
 (defn pad-table [cells]
   (let [coords    (->> cells (map :coord) set)

src/zero_one/fxl/read_xlsx.clj

@@ -104,20 +104,51 @@
          (mapcat ->seq)
          (mapcat ->seq))))
 
-(defn- poi-cell->fxl-cell [workbook poi-cell]
-  (let [poi-row (.getRow poi-cell)]
-    {:coord {:row   (.getRowNum poi-row)
-             :col   (.getColumnIndex poi-cell)
-             :sheet (.. poi-row getSheet getSheetName)}
-     :value   (extract-cell-value poi-cell)
-     :formula (extract-cell-formula poi-cell)
-     :style   (extract-cell-style workbook poi-cell)}))
+(defn- extract-cell-coord [merged-cell-index poi-cell]
+  (let [common {:row (.getRowIndex poi-cell)
+                :col  (.getColumnIndex poi-cell)
+                :sheet (.. poi-cell getSheet getSheetName)}]
+    (if (contains? merged-cell-index common)
+      (get merged-cell-index common)
+      common)))
+
+(defn- poi-cell->fxl-cell [merged-cell-index workbook poi-cell]
+  {:coord   (extract-cell-coord merged-cell-index poi-cell)
+   :value   (extract-cell-value poi-cell)
+   :formula (extract-cell-formula poi-cell)
+   :style   (extract-cell-style workbook poi-cell)})
+
+(defn- sheet->merged-cell-index [sheet]
+  (let [merged-cells (.getMergedRegions sheet)
+        sheet-name   (.getSheetName sheet)]
+    (->> merged-cells
+         (map #(hash-map {:row       (.getFirstRow %)
+                          :col       (.getFirstColumn %)
+                          :sheet     sheet-name}
+                         {:first-row (.getFirstRow %)
+                          :first-col (.getFirstColumn %)
+                          :last-row  (.getLastRow %)
+                          :last-col  (.getLastColumn %)
+                          :sheet     sheet-name}))
+         (into {}))))
+
+(defn- extract-merged-cell-index [workbook]
+  (let [sheets (->> (range (.getNumberOfSheets workbook))
+                    (map #(.getSheetName workbook %))
+                    (map #(.getSheet workbook %)))]
+    (->> sheets
+         (map sheet->merged-cell-index)
+         (into {}))))
+
+(defn- extract-fxl-cells [workbook poi-cells]
+  (let [index (extract-merged-cell-index workbook)]
+    (map #(poi-cell->fxl-cell index workbook %) poi-cells)))
 
 (defn- throwable-read-xlsx! [path]
   (let [input-stream (FileInputStream. path)
         workbook     (XSSFWorkbook. input-stream)
         poi-cells    (extract-poi-cells workbook)
-        cells        (map #(poi-cell->fxl-cell workbook %) poi-cells)]
+        cells        (extract-fxl-cells workbook poi-cells)]
     (.close workbook)
     cells))
 

src/zero_one/fxl/specs.clj

@@ -11,11 +11,28 @@
 (def max-cols (int 1e4))
 (s/def ::row (s/and nat-int? #(<= % max-rows)))
 (s/def ::col (s/and nat-int? #(<= % max-cols)))
+;; For merged cells
+(s/def ::first-row (s/and nat-int? #(<= % max-rows)))
+(s/def ::first-col (s/and nat-int? #(<= % max-cols)))
+(s/def ::last-row (s/and nat-int? #(<= % max-rows)))
+(s/def ::last-col (s/and nat-int? #(<= % max-cols)))
 (s/def ::sheet string?)
-(s/def ::coord
+
+(s/def ::plain-coord
   (s/keys :req-un [::row ::col]
           :opt-un [::sheet]))
 
+(s/def ::merged-coord
+  (s/and
+   (s/keys :req-un [::first-row ::first-col ::last-row ::last-col]
+           :opt-un [::sheet])
+   #(<= (:first-row %) (:last-row %))
+   #(<= (:first-col %) (:last-col %))))
+
+(s/def ::coord
+  (s/or :merged ::merged-coord 
+        :plain ::plain-coord))
+
 ;; Cell Style
 ;;;; Font Style
 (s/def ::bold boolean?)

src/zero_one/fxl/write_xlsx.clj

@@ -10,7 +10,8 @@
   (:import
     (java.io FileOutputStream)
     (org.apache.poi.xssf.usermodel XSSFWorkbook)
-    (org.apache.poi.ss.usermodel FillPatternType FontUnderline)))
+    (org.apache.poi.ss.usermodel FillPatternType FontUnderline)
+    (org.apache.poi.ss.util CellRangeAddress)))
 
 ;; Apache POI Navigation
 (defn- get-or-create-sheet! [cell workbook]
@@ -19,12 +20,14 @@
         (.createSheet workbook sheet-name))))
 
 (defn- get-or-create-row! [cell xl-sheet]
-  (let [row-index (-> cell :coord :row)]
+  (let [row-index (or (-> cell :coord :row)
+                      (-> cell :coord :first-row))]
     (or (.getRow xl-sheet row-index)
         (.createRow xl-sheet row-index))))
 
 (defn- get-or-create-cell! [cell xl-row]
-  (let [col-index (-> cell :coord :col)]
+  (let [col-index (or (-> cell :coord :col)
+                      (-> cell :coord :first-col))]
     (or (.getCell xl-row col-index)
         (.createCell xl-row col-index))))
 
@@ -115,17 +118,34 @@
    :min-col-sizes (grouped-min-size :col cells)
    :cell-styles   (reduce #(accumulate-style-cache! workbook %1 %2) {} cells)})
 
+(defn- create-merged-region! [cell sheet]
+  (let [first-row (-> cell :coord :first-row)
+        first-col (-> cell :coord :first-col)
+        last-row  (-> cell :coord :last-row)
+        last-col  (-> cell :coord :last-col)
+        cell-range-address (CellRangeAddress.
+                             first-row last-row
+                             first-col last-col)]
+    (.addMergedRegion sheet cell-range-address)))
+
+(defn merged-cell? [cell]
+  (let [coord (:coord cell)]
+    (and (contains? coord :last-row)
+      (contains? coord :last-col))))
+
 (defn- set-cell-value-and-style! [context workbook cell]
   (let [sheet     (get-or-create-sheet! cell workbook)
         row       (get-or-create-row! cell sheet)
         poi-cell  (get-or-create-cell! cell row)
         style     ((:cell-styles context) (:style cell))]
     (.setCellValue poi-cell (ensure-settable (:value cell)))
     (.setCellFormula poi-cell (:formula cell))
-    (.setCellStyle poi-cell style)))
+    (.setCellStyle poi-cell style)
+    (when (merged-cell? cell)
+      (create-merged-region! cell sheet))))
 
 (defn- set-row-height! [workbook coord row-size]
-  (let [row-index (:row coord)
+  (let [row-index (or (:row coord) (:first-row coord))
         sheet     (.getSheet workbook (:sheet coord))
         row       (.getRow sheet row-index)]
     (.setHeightInPoints row (float row-size))))

test/zero_one/fxl/core_test.clj

@@ -77,7 +77,10 @@
                      {:coord {:row 3 :col 0 :sheet "S2"} :value true
                       :style {:row-size 10}}
                      {:coord {:row 3 :col 1 :sheet "S2"} :value false
-                      :style {:col-size 15}}]
+                      :style {:col-size 15}}
+                     {:coord {:first-row 3 :first-col 3
+                              :last-row 4  :last-col 4
+                              :sheet "S2"} :value "merged-cell"}]
         read-cells  (write-then-read-xlsx! write-cells)]
     (fact "Write and read cells should have the same count"
       (count read-cells) => (count write-cells))
@@ -118,7 +121,11 @@
         (contains? data-formats "@") => true))
     (fact "Non-builtin data format should be dropped"
       (let [data-formats (->> read-cells (map (comp :data-format :style)) set)]
-        (contains? data-formats "non-builtin") => false)))
+        (contains? data-formats "non-builtin") => false))
+    (fact "Merged cell should be preserved"
+      (let [coords (->> read-cells (map :coord) set)]
+        (contains? coords {:first-row 3 :first-col 3
+                           :last-row 4 :last-col 4 :sheet "S2"}))))
   (let [write-cells [{:coord {:row 0 :col 0} :value 12345 :style {}}
                      {:coord {:row 0 :col 0} :value "abc" :style {}}]
         read-cells  (write-then-read-xlsx! write-cells)]

test/zero_one/fxl/helpers_test.clj

@@ -34,8 +34,8 @@
       (:coord (fxl/shift-up (- 3) cell)) => {:row 8 :col 5})))
 
 (facts "On concat functions"
-  (let [cells (map fxl/->cell [{:value "abc" :coord {:row 0 :col 0}}
-                               {:value "xyz" :coord {:row 4 :col 4}}])]
+  (let [cells (flatten (map fxl/->cell [{:value "abc" :coord {:row 0 :col 0}}
+                                        {:value "xyz" :coord {:row 4 :col 4}}]))]
     (fact "Correct fxl/concat-right"
       (fxl/concat-right) => nil
       (fxl/concat-right cells) => cells

test/zero_one/fxl/specs_test.clj

@@ -24,6 +24,23 @@
   (fact "Should not allow negative coords"
     (fs/invalid? ::fs/coord {:row -1 :col 0}) => true))
 
+(facts "On fxl merged coord"
+  (fact "Should allow merged cell"
+    (fs/valid? ::fs/merged-coord {:first-row 0 :first-col 1
+                                  :last-row 1 :last-col 2}) => true)
+  (fact "Should allow merged cell w sheet"
+    (fs/valid? ::fs/merged-coord {:first-row 0 :first-col 1
+                                  :last-row 1 :last-col 2
+                                  :sheet "ABC"}) => true)
+  (fact "Should not allow negative merged cell area"
+    (fs/invalid? ::fs/merged-coord {:first-row 1 :first-col 1
+                                    :last-row 0 :last-col 0
+                                    :sheet "ABC"}) => true)
+  (fact "Should not allow only row and col"
+    (fs/invalid? ::fs/merged-coord {:first-row 0 :first-col 0}) => true)
+  (fact "Should not allow only lrow and lcol"
+    (fs/invalid? ::fs/merged-coord {:last-row 0 :last-col 0}) => true))
+
 (facts "On fxl data formats"
   (fact "Should allow example format"
     (fs/valid? ::fs/data-format "[h]:mm:ss") => true)