fix: disallow more strange parent child relationships

when setting Parent property. property and journal shouldn't be a parent
of any page right now, especially with pages of other types. Maybe
property and whiteboard can have hierarchies later

deps/db/src/logseq/db.cljs

@@ -76,6 +76,7 @@
              (throw e))))))))
 
 (def page? entity-util/page?)
+(def internal-page? entity-util/internal-page?)
 (def class? entity-util/class?)
 (def property? entity-util/property?)
 (def closed-value? entity-util/closed-value?)

deps/db/src/logseq/db/frontend/entity_util.cljs

@@ -16,6 +16,10 @@
   (contains? #{"page" "journal" "whiteboard" "class" "property" "hidden"}
              (:block/type block)))
 
+(defn internal-page?
+  [entity]
+  (= (:block/type entity) "page"))
+
 (defn class?
   [entity]
   (= (:block/type entity) "class"))

deps/outliner/src/logseq/outliner/property.cljs

@@ -25,15 +25,6 @@
     (throw (ex-info "Read-only property value shouldn't be edited"
                     {:property property-ident}))))
 
-(defn- throw-error-if-add-class-parent-to-page
-  [blocks entity]
-  (when (and (ldb/class? entity) (not (every? ldb/class? blocks)))
-    (throw (ex-info "Can't set a tag as a parent for non-tag page"
-                    {:type :notification
-                     :payload {:message "Can't set a tag as a parent for non-tag page"
-                               :type :warning}
-                     :blocks (map #(select-keys % [:db/id :block/title]) (remove ldb/class? blocks))}))))
-
 (defn- build-property-value-tx-data
   ([block property-id value]
    (build-property-value-tx-data block property-id value (= property-id :logseq.task/status)))
@@ -284,9 +275,9 @@
   (let [block-eids (map ->eid block-ids)
         property (d/entity @conn property-id)
         _ (when (= (:db/ident property) :logseq.property/parent)
-            (throw-error-if-add-class-parent-to-page
-             (map #(d/entity @conn %) block-eids)
-             (if (number? v) (d/entity @conn v) v)))
+            (outliner-validate/validate-parent-property
+             (if (number? v) (d/entity @conn v) v)
+             (map #(d/entity @conn %) block-eids)))
         _ (assert (some? property) (str "Property " property-id " doesn't exist yet"))
         property-type (get-in property [:block/schema :type] :default)
         _ (assert (some? v) "Can't set a nil property value must be not nil")

deps/outliner/src/logseq/outliner/validate.cljs

@@ -119,9 +119,9 @@
   (when (and (ldb/page? entity) (not (ldb/journal? entity))
              (common-date/normalize-date new-title nil))
     (throw (ex-info "Page can't be renamed to a journal"
-                      {:type :notification
-                       :payload {:message "This page can't be changed to a journal page"
-                                 :type :warning}}))))
+                    {:type :notification
+                     :payload {:message "This page can't be changed to a journal page"
+                               :type :warning}}))))
 
 (defn validate-block-title
   "Validates a block title when it has changed"
@@ -129,3 +129,17 @@
   (validate-built-in-pages existing-block-entity)
   (validate-unique-by-name-tag-and-block-type db new-title existing-block-entity)
   (validate-disallow-page-with-journal-name new-title existing-block-entity))
+
+(defn validate-parent-property
+  "Validates whether given parent and children are valid. Allows 'class' and
+  'page' types to have a relationship with their own type. May consider allowing more
+  page types if they don't cause systemic bugs"
+  [parent-ent child-ents]
+  (when (or (and (ldb/class? parent-ent) (not (every? ldb/class? child-ents)))
+            (and (ldb/internal-page? parent-ent) (not (every? ldb/internal-page? child-ents)))
+            (not ((some-fn ldb/class? ldb/internal-page?) parent-ent)))
+   (throw (ex-info "Can't set this page as a parent because the child page is a different type"
+                   {:type :notification
+                    :payload {:message "Can't set this page as a parent because the child page is a different type"
+                              :type :warning}
+                    :blocks (map #(select-keys % [:db/id :block/title]) (remove ldb/class? child-ents))}))))

deps/outliner/test/logseq/outliner/validate_test.cljs

@@ -1,5 +1,5 @@
 (ns logseq.outliner.validate-test
-  (:require [cljs.test :refer [deftest is]]
+  (:require [cljs.test :refer [deftest is are testing]]
             [datascript.core :as d]
             [logseq.outliner.validate :as outliner-validate]
             [logseq.db.test.helper :as db-test]))
@@ -70,20 +70,62 @@
           (find-block-by-content conn "Fruit")))
         "Allow class to have same name as a page")))
 
+(deftest validate-parent-property
+  (let [conn (db-test/create-conn-with-blocks
+              {:properties {:prop1 {:block/schema {:type :default}}}
+               :classes {:Class1 {} :Class2 {}}
+               :pages-and-blocks
+               [{:page {:block/title "page1"}}
+                {:page {:block/title "page2"}}]})
+        page1 (find-block-by-content conn "page1")
+        page2 (find-block-by-content conn "page2")
+        class1 (find-block-by-content conn "Class1")
+        class2 (find-block-by-content conn "Class2")
+        property (find-block-by-content conn "prop1")]
+
+    (testing "valid parent and child combinations"
+      (is (nil? (outliner-validate/validate-parent-property page1 [page2]))
+          "parent page to child page is valid")
+      (is (nil? (outliner-validate/validate-parent-property class1 [class2]))
+          "parent class to child class is valid"))
+
+    (testing "invalid parent and child combinations"
+      (are [parent child]
+           (thrown-with-msg?
+            js/Error
+            #"Can't set"
+            (outliner-validate/validate-parent-property parent [child]))
+
+        class1 page1
+        page1 class1
+        property page1
+        property class1))))
+
+;; Try as many of the validations against a new graph to confirm
+;; that validations make sense and are valid for a new graph
 (deftest new-graph-should-be-valid
-  (let [conn (db-test/create-conn)
-        pages (d/q '[:find [(pull ?b [*]) ...] :where [?b :block/title] [?b :block/type]] @conn)
-        validation-errors (atom {})]
-    (doseq [page pages]
-      (try
-        ;; Try as many of the relevant validations
-        (outliner-validate/validate-unique-by-name-tag-and-block-type @conn (:block/title page) page)
-        (outliner-validate/validate-page-title (:block/title page) {:node page})
-        (outliner-validate/validate-page-title-characters (:block/title page) {:node page})
-
-        (catch :default e
-          (if (= :notification (:type (ex-data e)))
-            (swap! validation-errors update (select-keys page [:block/title :db/ident :block/uuid]) (fnil conj []) e)
-            (throw e)))))
-    (is (= {} @validation-errors)
-        "Default pages shouldn't have any validation errors")))
+  (let [conn (db-test/create-conn)]
+
+    (testing "Validate pages"
+      (let [pages (d/q '[:find [(pull ?b [*]) ...] :where [?b :block/title] [?b :block/type]] @conn)
+            page-errors (atom {})]
+        (doseq [page pages]
+          (try
+            (outliner-validate/validate-unique-by-name-tag-and-block-type @conn (:block/title page) page)
+            (outliner-validate/validate-page-title (:block/title page) {:node page})
+            (outliner-validate/validate-page-title-characters (:block/title page) {:node page})
+
+            (catch :default e
+              (if (= :notification (:type (ex-data e)))
+                (swap! page-errors update (select-keys page [:block/title :db/ident :block/uuid]) (fnil conj []) e)
+                (throw e)))))
+        (is (= {} @page-errors)
+            "Default pages shouldn't have any validation errors")))
+
+    (testing "Validate property relationships"
+      (let [parent-child-pairs (d/q '[:find (pull ?parent [:block/title :block/type])
+                                      (pull ?child [:block/title :block/type])
+                                      :where [?child :logseq.property/parent ?parent]] @conn)]
+        (doseq [[parent child] parent-child-pairs]
+          (is (nil? (outliner-validate/validate-parent-property parent [child]))
+              (str "Parent and child page is valid: " (pr-str (:block/title parent)) " " (pr-str (:block/title child)))))))))