fix: outdent blocks and re-enable outliner tests

related to #5604
This commit is contained in:
Tienson Qin
2022-06-08 13:06:10 +08:00
parent a2cfdfdf73
commit f4f1ff1ba2
3 changed files with 88 additions and 49 deletions

View File

@@ -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

View File

@@ -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) ;;;;;;;;;;;;;;;;

View File

@@ -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]