fix: outdent blocks and re-enable outliner tests

related to #5604

.github/workflows/build.yml

@@ -74,11 +74,10 @@ jobs:
       - name: Fetch yarn deps
         run: yarn install --frozen-lockfile
 
-      # TODO: Re-enable outliner.core-test when hang is fixed
       - name: Run ClojureScript tests
         run: |
           yarn cljs:test
-          node static/tests.js -r '^((?!(outliner.core-test)).)*$'
+          node static/tests.js
 
       # In this job because it depends on an npm package
       - name: Load nbb compatible namespaces

src/main/frontend/modules/outliner/core.cljs

@@ -469,7 +469,9 @@
                                      (> (count blocks) 1)
                                      (not move?)))
         blocks' (blocks-with-level blocks)
-        blocks' (fix-top-level-blocks blocks')
+        blocks' (if (= outliner-op ::paste)
+                  (fix-top-level-blocks blocks')
+                  blocks')
         insert-opts {:sibling? sibling?
                      :replace-empty-target? replace-empty-target?
                      :keep-uuid? keep-uuid?
@@ -709,51 +711,53 @@
   "Indent or outdent `blocks`."
   [blocks indent?]
   {:pre [(seq blocks) (boolean? indent?)]}
-  (let [first-block (db/entity (:db/id (first blocks)))
-        left (db/entity (:db/id (:block/left first-block)))
-        parent (:block/parent first-block)
-        db (db/get-db)
-        top-level-blocks (get-top-level-blocks blocks)
-        concat-tx-fn (fn [& results]
-                       {:tx-data (->> (map :tx-data results)
-                                      (apply util/concat-without-nil))
-                        :tx-meta (:tx-meta (first results))})
-        opts {:outliner-op :indent-outdent-blocks}]
-    (if indent?
-      (when (and left (not (page-first-child? first-block)))
-        (let [last-direct-child-id (db-model/get-block-last-direct-child db (:db/id left) false)
-              blocks' (drop-while (fn [b]
-                                    (= (:db/id (:block/parent b))
-                                       (:db/id left)))
-                                  top-level-blocks)]
-          (when (seq blocks')
-            (if last-direct-child-id
-              (let [last-direct-child (db/entity last-direct-child-id)
-                    result (move-blocks blocks' last-direct-child (merge opts {:sibling? true}))
-                    ;; expand `left` if it's collapsed
-                    collapsed-tx (when (:block/collapsed? left)
-                                   {:tx-data [{:db/id (:db/id left)
-                                               :block/collapsed? false}]})]
-                (concat-tx-fn result collapsed-tx))
-              (move-blocks blocks' left (merge opts {:sibling? false}))))))
-      (when (and parent (not (page-block? (db/entity (:db/id parent)))))
-        (let [blocks' (take-while (fn [b]
-                                    (not= (:db/id (:block/parent b))
-                                          (:db/id (:block/parent parent))))
-                                  top-level-blocks)
-              result (move-blocks blocks' parent (merge opts {:sibling? true}))]
-          (if (state/logical-outdenting?)
-            result
-            ;; direct outdenting (default behavior)
-            (let [last-top-block (db/pull (:db/id (last blocks')))
-                  right-siblings (->> (get-right-siblings (block last-top-block))
-                                      (map :data))]
-              (if (seq right-siblings)
-                (let [result2 (if-let [last-direct-child-id (db-model/get-block-last-direct-child db (:db/id last-top-block) false)]
-                                (move-blocks right-siblings (db/entity last-direct-child-id) (merge opts {:sibling? true}))
-                                (move-blocks right-siblings last-top-block (merge opts {:sibling? false})))]
-                  (concat-tx-fn result result2))
-                result))))))))
+  (let [non-consecutive-blocks (db-model/get-non-consecutive-blocks blocks)]
+    (when (empty? non-consecutive-blocks)
+      (let [first-block (db/entity (:db/id (first blocks)))
+            left (db/entity (:db/id (:block/left first-block)))
+            parent (:block/parent first-block)
+            db (db/get-db)
+            top-level-blocks (get-top-level-blocks blocks)
+            concat-tx-fn (fn [& results]
+                           {:tx-data (->> (map :tx-data results)
+                                          (apply util/concat-without-nil))
+                            :tx-meta (:tx-meta (first results))})
+            opts {:outliner-op :indent-outdent-blocks}]
+        (if indent?
+          (when (and left (not (page-first-child? first-block)))
+            (let [last-direct-child-id (db-model/get-block-last-direct-child db (:db/id left) false)
+                  blocks' (drop-while (fn [b]
+                                        (= (:db/id (:block/parent b))
+                                           (:db/id left)))
+                                      top-level-blocks)]
+              (when (seq blocks')
+                (if last-direct-child-id
+                  (let [last-direct-child (db/entity last-direct-child-id)
+                        result (move-blocks blocks' last-direct-child (merge opts {:sibling? true}))
+                        ;; expand `left` if it's collapsed
+                        collapsed-tx (when (:block/collapsed? left)
+                                       {:tx-data [{:db/id (:db/id left)
+                                                   :block/collapsed? false}]})]
+                    (concat-tx-fn result collapsed-tx))
+                  (move-blocks blocks' left (merge opts {:sibling? false}))))))
+          (when (and parent (not (page-block? (db/entity (:db/id parent)))))
+            (let [blocks' (take-while (fn [b]
+                                        (not= (:db/id (:block/parent b))
+                                              (:db/id (:block/parent parent))))
+                                      top-level-blocks)
+                  result (move-blocks blocks' parent (merge opts {:sibling? true}))]
+              (if (state/logical-outdenting?)
+                result
+                ;; direct outdenting (default behavior)
+                (let [last-top-block (db/pull (:db/id (last blocks')))
+                      right-siblings (->> (get-right-siblings (block last-top-block))
+                                          (map :data))]
+                  (if (seq right-siblings)
+                    (let [result2 (if-let [last-direct-child-id (db-model/get-block-last-direct-child db (:db/id last-top-block) false)]
+                                    (move-blocks right-siblings (db/entity last-direct-child-id) (merge opts {:sibling? true}))
+                                    (move-blocks right-siblings last-top-block (merge opts {:sibling? false})))]
+                      (concat-tx-fn result result2))
+                    result))))))))))
 
 ;;; ### write-operations have side-effects (do transactions) ;;;;;;;;;;;;;;;;
 

src/test/frontend/modules/outliner/core_test.cljs

@@ -179,6 +179,42 @@
       (outliner-core/indent-outdent-blocks! [(get-block 6) (get-block 9)] true))
     (is (= [4 5 6 9] (get-children 3)))))
 
+(deftest test-indent-blocks-regression-5604
+  (testing "
+  [22 [[2 [[3
+           [[4]
+            [5]
+            [6 [[7 [[8]]]]]
+            [9 [[10]
+                [11]]]]]]]
+      [12 [[13]                         ; outdents 13, 14, 15
+           [14]
+           [15]]]
+      [16 [[17]]]]]
+  "
+    (transact-tree! tree)
+    (outliner-tx/transact!
+      {:graph test-db}
+      (outliner-core/indent-outdent-blocks! [(get-block 13) (get-block 14) (get-block 15)] false))
+    (is (= [2 12 13 14 15 16] (get-children 22))))
+  (testing "
+  [22 [[2 [[3
+           [[4]
+            [5]
+            [6 [[7 [[8]]]]]
+            [9 [[10]
+                [11]]]]]]]
+      [12 [[13]                         ; outdents 13, 14
+           [14]
+           [15]]]
+      [16 [[17]]]]]
+  "
+    (transact-tree! tree)
+    (outliner-tx/transact!
+      {:graph test-db}
+      (outliner-core/indent-outdent-blocks! [(get-block 13) (get-block 14)] false))
+    (is (= [2 12 13 14 16] (get-children 22)))))
+
 (deftest test-outdent-blocks
   (testing "
   [1 [[2 [[3]
@@ -415,7 +451,7 @@
     (transact-random-tree!)
     (let [c1 (get-blocks-ids)
           *random-blocks (atom c1)]
-      (dotimes [_i 200]
+      (dotimes [_i 100]
         ;; (prn "random insert: " i)
         (let [blocks (gen-blocks)]
           (swap! *random-blocks (fn [old]