Fix bug with merging existing merged cells

A merged cell can only be merged again if all of it is selected.

src/bean/grid.cljs

@@ -1,5 +1,6 @@
 (ns bean.grid
   (:require [bean.area :as area]
+            [bean.tables :as tables]
             [bean.code-errors :as code-errors]
             [bean.deps :as deps]
             [bean.errors :as errors]
@@ -211,15 +212,19 @@
                  sheet)]
     (set-cell-style sheet* address :merged-with merge-with)))
 
-;; TODO: when a cell is merged
-;; if any of the cells is a label, make the merged cell a label also
 (defn merge-cells [sheet {:keys [start end] :as area}]
-  (let [addresses (area/area->addresses area)]
-    (if (some #(get-cell-style sheet % :merged-with) addresses)
-      sheet
+  (let [addresses (area/area->addresses area)
+        merged-already (map #(get-cell-style sheet % :merged-with) addresses)
+        all-merged-addresses (mapcat #(get-cell-style
+                                       sheet
+                                       (get-cell-style sheet % :merged-with)
+                                       :merged-addresses) merged-already)]
+    (if (every? #(get addresses %) all-merged-addresses)
       (->  (reduce #(merge-cell %1 %2 start) sheet addresses)
            (set-cell-style start :merged-until end)
-           (set-cell-style start :merged-addresses addresses)))))
+           (set-cell-style start :merged-addresses addresses)
+           (tables/merge-labels start addresses))
+      sheet)))
 
 (defn unmerge-cells [sheet addresses]
   (->> addresses

src/bean/tables.cljs

@@ -45,6 +45,22 @@
 (defn get-table [sheet table-name]
   (get-in sheet [:tables table-name]))
 
+(defn- get-label [sheet table-name rc]
+  (get-in sheet [:tables table-name :labels rc]))
+
+(defn merge-labels [sheet start addresses]
+  (if-let [table-name (cell-table start sheet)]
+    (let [is-label? (get-label sheet table-name start)
+          other-labels? (and (not is-label?)
+                             (some #(get-label sheet table-name %) addresses))
+          label (or is-label? other-labels?)]
+      (if label
+        (-> sheet
+            (remove-labels table-name addresses)
+            (add-label table-name start (:dirn label) (:color label)))
+        sheet))
+    sheet))
+
 (defn- last-row [[r c] sheet]
   (+ r (dec (area/cell-h sheet [r c]))))
 

test/bean/grid_test.cljs

@@ -338,4 +338,28 @@
                                                 :merged-until [1 2]
                                                 :merged-addresses #{[0 0] [0 1] [0 2] [1 0] [1 1] [1 2]}}))
       (is (= (area/cell-h sheet [0 0]) 2))
-      (is (= (area/cell-w sheet [0 0]) 3)))))
+      (is (= (area/cell-w sheet [0 0]) 3))))
+
+  (testing "Merges existing merged cells only if the full merged cell is in the area"
+    (let [sheet (-> (new-sheet (repeat 5 (repeat 5 "")) "")
+                    eval-sheet
+                    (grid/merge-cells {:start [0 0] :end [1 1]})
+                    (grid/merge-cells {:start [1 1] :end [1 2]}))]
+      (is (= (select-keys (get-in sheet [:grid 0 0 :style])
+                          [:merged-with :merged-until])
+             {:merged-with [0 0]
+              :merged-until [1 1]}))
+      (is (= (select-keys (get-in (grid/merge-cells sheet {:start [0 0] :end [1 2]})
+                                  [:grid 0 0 :style])
+                          [:merged-with :merged-until])
+             {:merged-with [0 0]
+              :merged-until [1 2]}))))
+
+  (testing "Merges labels into a single label"
+    (let [table-name "A table"
+          sheet (-> (new-sheet (repeat 5 (repeat 5 "")) "")
+                    eval-sheet
+                    (tables/make-table table-name {:start [0 0] :end [2 2]})
+                    (tables/add-label table-name [1 1] :top)
+                    (grid/merge-cells {:start [0 1] :end [1 1]}))]
+      (is (= (get-in sheet [:tables table-name :labels]) {[0 1] {:dirn :top :color nil}})))))