|
|
@@ -60,7 +60,6 @@
|
|
|
(throw (ex-info (str "No uuid found for page " (pr-str (:block/name m)))
|
|
|
{:page m})))))
|
|
|
|
|
|
-
|
|
|
(defn- update-block-tags
|
|
|
[block tag-classes page-names-to-uuids]
|
|
|
(if (seq (:block/tags block))
|
|
|
@@ -93,7 +92,9 @@
|
|
|
supported for a long time and cause invalid built-in pages"
|
|
|
[:now :later :doing :done :canceled :cancelled :in-progress :todo :wait :waiting])
|
|
|
|
|
|
-(defn- infer-property-schema [prop-val prop refs]
|
|
|
+(defn- infer-property-schema
|
|
|
+ "Return inferred :block/schema map. nil means don't set schema"
|
|
|
+ [prop-val prop refs {:keys [property-schemas property-changes]}]
|
|
|
;; Explicitly fail an unexpected case rather cause silent downstream failures
|
|
|
(when (and (coll? prop-val) (not (every? string? prop-val)))
|
|
|
(throw (ex-info "Import cannot infer schema of unknown property value"
|
|
|
@@ -103,40 +104,52 @@
|
|
|
(set/subset? prop-val
|
|
|
(set (keep #(when (:block/journal? %) (:block/original-name %)) refs))))
|
|
|
:date
|
|
|
- (db-property-type/infer-property-type-from-value prop-val))]
|
|
|
- (cond-> {:type prop-type}
|
|
|
- (#{:page :date} prop-type)
|
|
|
- ;; Assume :many for now as detecting that detecting property values across files are consistent
|
|
|
- ;; isn't possible yet
|
|
|
- (assoc :cardinality :many))))
|
|
|
+ (db-property-type/infer-property-type-from-value prop-val))
|
|
|
+ schema (cond-> {:type prop-type}
|
|
|
+ (#{:page :date} prop-type)
|
|
|
+ ;; Assume :many for now as detecting that detecting property values across files are consistent
|
|
|
+ ;; isn't possible yet
|
|
|
+ (assoc :cardinality :many))]
|
|
|
+ (if-let [prev-type (get-in @property-schemas [prop :type])]
|
|
|
+ (do (when-not (= prev-type prop-type)
|
|
|
+ (prn :PROP-TYPE-CHANGE prev-type :-> prop-type prop)
|
|
|
+ (swap! property-changes assoc prop {:type {:from prev-type :to prop-type}})
|
|
|
+ (when (not= prev-type :default)
|
|
|
+ ;; TODO: Throw error or notification when all are fixed that can be
|
|
|
+ (prn "Import detected property value change it can't fix" {:old prev-type :new prop-type :property prop})))
|
|
|
+ nil)
|
|
|
+ (do (swap! property-schemas assoc prop schema)
|
|
|
+ schema))))
|
|
|
|
|
|
(defn- update-block-refs
|
|
|
"Updates the attributes of a block ref as this is where a new page is defined. Also
|
|
|
updates block content effected by refs"
|
|
|
- [block page-names-to-uuids {:keys [whiteboard?]}]
|
|
|
+ [block page-names-to-uuids {:keys [whiteboard?] :as options}]
|
|
|
(let [ref-to-ignore? (if whiteboard?
|
|
|
#(and (map? %) (:block/uuid %))
|
|
|
#(and (vector? %) (= :block/uuid (first %))))]
|
|
|
(if (seq (:block/refs block))
|
|
|
(cond-> block
|
|
|
true
|
|
|
- (update :block/refs
|
|
|
- (fn [refs]
|
|
|
- (mapv (fn [ref]
|
|
|
- (if (ref-to-ignore? ref)
|
|
|
- ref
|
|
|
- (let [prop-val (get (apply dissoc (:block/properties block) ignored-built-in-properties)
|
|
|
- (keyword (:block/name ref)))]
|
|
|
- (cond-> (assoc ref :block/format :markdown)
|
|
|
- (and prop-val
|
|
|
- (not (get db-property/built-in-properties (keyword (:block/name ref))))
|
|
|
- ;; Ignore templates as they don't directly map to properties and don't
|
|
|
- ;; have representative property values
|
|
|
- (not (contains? (:block/properties block) :template)))
|
|
|
- (merge {:block/type "property"
|
|
|
- :block/schema (infer-property-schema prop-val (keyword (:block/name ref)) refs)})))))
|
|
|
- refs)))
|
|
|
- ;; check for now until :block/pre-block? is removed
|
|
|
+ (update
|
|
|
+ :block/refs
|
|
|
+ (fn [refs]
|
|
|
+ (mapv (fn [ref]
|
|
|
+ (if (ref-to-ignore? ref)
|
|
|
+ ref
|
|
|
+ (let [prop-val (get (apply dissoc (:block/properties block) ignored-built-in-properties)
|
|
|
+ (keyword (:block/name ref)))]
|
|
|
+ (cond-> (assoc ref :block/format :markdown)
|
|
|
+ (and prop-val
|
|
|
+ (not (get db-property/built-in-properties (keyword (:block/name ref))))
|
|
|
+ ;; Ignore templates as they don't directly map to properties and don't
|
|
|
+ ;; have representative property values
|
|
|
+ (not (contains? (:block/properties block) :template)))
|
|
|
+ (merge (when-let [schema (infer-property-schema prop-val (keyword (:block/name ref)) refs options)]
|
|
|
+ {:block/type "property"
|
|
|
+ :block/schema schema}))))))
|
|
|
+ refs)))
|
|
|
+ ;; check for now until :block/pre-block? is removed
|
|
|
(:block/content block)
|
|
|
(update :block/content
|
|
|
db-content/page-ref->special-id-ref
|
|
|
@@ -168,29 +181,36 @@
|
|
|
val)]))
|
|
|
(into {})))
|
|
|
|
|
|
-(defn- update-user-property-values [props user-page-properties prop-name->uuid]
|
|
|
+(defn- update-user-property-values [props user-page-properties prop-name->uuid property-changes]
|
|
|
(->> props
|
|
|
(map (fn [[prop val]]
|
|
|
[prop
|
|
|
- (if (contains? user-page-properties prop)
|
|
|
+ (cond
|
|
|
+ (= :default (get-in @property-changes [prop :type :from]))
|
|
|
+ (str val)
|
|
|
+ (contains? user-page-properties prop)
|
|
|
;; assume for now a ref's :block/name can always be translated by lc helper
|
|
|
(set (map (comp prop-name->uuid common-util/page-name-sanity-lc) val))
|
|
|
+ :else
|
|
|
val)]))
|
|
|
(into {})))
|
|
|
|
|
|
-(defn- update-block-properties
|
|
|
+(defn- cached-prop-name->uuid [db page-names-to-uuids k]
|
|
|
+ (or (get page-names-to-uuids (name k))
|
|
|
+ (get-pid db k)
|
|
|
+ (throw (ex-info (str "No uuid found for page " (pr-str k))
|
|
|
+ {:page k}))))
|
|
|
+
|
|
|
+(defn- update-block-properties*
|
|
|
"Updates block property names and values and removes old built-in properties"
|
|
|
- [*props db page-names-to-uuids {:keys [whiteboard?]}]
|
|
|
+ [*props db page-names-to-uuids {:keys [whiteboard? property-changes]}]
|
|
|
(let [prop-name->uuid (if whiteboard?
|
|
|
(fn prop-name->uuid [k]
|
|
|
(or (get-pid db k)
|
|
|
(throw (ex-info (str "No uuid found for page " (pr-str k))
|
|
|
{:page k}))))
|
|
|
(fn prop-name->uuid [k]
|
|
|
- (or (get page-names-to-uuids (name k))
|
|
|
- (get-pid db k)
|
|
|
- (throw (ex-info (str "No uuid found for page " (pr-str k))
|
|
|
- {:page k})))))
|
|
|
+ (cached-prop-name->uuid db page-names-to-uuids k)))
|
|
|
dissoced-props (into ignored-built-in-properties
|
|
|
;; TODO: Add import support for these dissoced built-in properties
|
|
|
[:title :id :created-at :updated-at
|
|
|
@@ -204,39 +224,45 @@
|
|
|
(cond-> props
|
|
|
(seq (select-keys props db-property/built-in-properties-keys))
|
|
|
(update-built-in-property-values db)
|
|
|
- (seq user-page-properties)
|
|
|
- (update-user-property-values user-page-properties prop-name->uuid)
|
|
|
+ (or (seq user-page-properties) (seq @property-changes))
|
|
|
+ (update-user-property-values user-page-properties prop-name->uuid property-changes)
|
|
|
true
|
|
|
(update-keys prop-name->uuid)))))
|
|
|
|
|
|
(defn- update-block-macros
|
|
|
- [block db page-names-to-uuids options]
|
|
|
+ [block db page-names-to-uuids]
|
|
|
(if (seq (:block/macros block))
|
|
|
(update block :block/macros
|
|
|
(fn [macros]
|
|
|
(mapv (fn [m]
|
|
|
(-> m
|
|
|
- (update :block/properties #(update-block-properties % db page-names-to-uuids options))
|
|
|
+ (update :block/properties
|
|
|
+ (fn [props]
|
|
|
+ (update-keys props #(cached-prop-name->uuid db page-names-to-uuids %))))
|
|
|
(assoc :block/uuid (d/squuid))))
|
|
|
macros)))
|
|
|
block))
|
|
|
|
|
|
+(defn- update-block-properties [block db page-names-to-uuids options]
|
|
|
+ (if (:block/pre-block? block)
|
|
|
+ ;; FIXME: Remove when page properties are supported
|
|
|
+ (assoc block :block/properties {})
|
|
|
+ (update-in block [:block/properties] #(update-block-properties* % db page-names-to-uuids options))))
|
|
|
+
|
|
|
(defn- convert-to-db-block
|
|
|
[db block tag-classes page-names-to-uuids options]
|
|
|
(prn ::block block)
|
|
|
- (let [update-block-props (fn update-block-props [props]
|
|
|
- (update-block-properties props db page-names-to-uuids options))]
|
|
|
+ (let [options' (assoc options
|
|
|
+ ;; map of detected property-changes
|
|
|
+ :property-changes (atom {}))]
|
|
|
(-> block
|
|
|
- (update-block-macros db page-names-to-uuids options)
|
|
|
- ;; needs to come before properties are updated
|
|
|
- (update-block-refs page-names-to-uuids options)
|
|
|
- ((fn [block']
|
|
|
- (if (:block/pre-block? block')
|
|
|
- ;; FIXME: Remove when page properties are supported
|
|
|
- (assoc block' :block/properties {})
|
|
|
- (update-in block' [:block/properties] update-block-props))))
|
|
|
+ (update-block-macros db page-names-to-uuids)
|
|
|
+ ;; needs to come before update-block-properties
|
|
|
+ (update-block-refs page-names-to-uuids options')
|
|
|
+ (update-block-properties db page-names-to-uuids options')
|
|
|
(update-block-tags tag-classes page-names-to-uuids)
|
|
|
add-missing-timestamps
|
|
|
+ ;; ((fn [x] (prn :BLOCKZ x) x))
|
|
|
;; TODO: org-mode content needs to be handled
|
|
|
(assoc :block/format :markdown)
|
|
|
;; TODO: pre-block? can be removed once page properties are imported
|
|
|
@@ -277,8 +303,11 @@
|
|
|
|
|
|
* :extract-options - Options map to pass to extract/extract
|
|
|
* :user-options - User provided options that alter how a file is converted to db graph
|
|
|
-* :page-tags-uuid - uuid of pageTags property"
|
|
|
- [conn file content {:keys [extract-options user-options page-tags-uuid]}]
|
|
|
+* :page-tags-uuid - uuid of pageTags property
|
|
|
+* :property-schemas - atom of property schemas inferred. Useful for tracking property schema changes
|
|
|
+ across files"
|
|
|
+ [conn file content {:keys [extract-options user-options page-tags-uuid property-schemas]
|
|
|
+ :or {property-schemas (atom {})}}]
|
|
|
(let [format (common-util/get-format file)
|
|
|
tag-classes (set (map string/lower-case (:tag-classes user-options)))
|
|
|
extract-options' (merge {:block-pattern (common-config/get-block-pattern format)
|
|
|
@@ -309,7 +338,9 @@
|
|
|
:block/format :markdown
|
|
|
;; fixme: missing properties
|
|
|
:block/properties {(get-pid @conn :ls-type) :whiteboard-page})))))
|
|
|
- blocks (map #(convert-to-db-block @conn % tag-classes page-names-to-uuids {:whiteboard? (some? (seq whiteboard-pages))})
|
|
|
+ blocks (map #(convert-to-db-block @conn % tag-classes page-names-to-uuids
|
|
|
+ {:whiteboard? (some? (seq whiteboard-pages))
|
|
|
+ :property-schemas property-schemas})
|
|
|
(:blocks extracted))
|
|
|
;; Build indices
|
|
|
pages-index (map #(select-keys % [:block/name]) pages)
|
Gabriel Horner