Fix page tags

This commit is contained in:
Tienson Qin
2020-07-21 17:46:30 +08:00
parent d73e405b9e
commit e4e5e7254b
7 changed files with 114 additions and 65 deletions

View File

@@ -481,7 +481,6 @@
(let [loaded? (or (loaded?)
(rum/react *loaded?))
current-repo (state/sub :git/current-repo)]
(prn "loaded? " loaded?)
(if loaded?
(let [current-file (rum/react *current-file)
current-file (or current-file

View File

@@ -991,11 +991,11 @@
(let [current-heading-uuid (:heading/uuid (:heading config))
;; exclude the current one, otherwise it'll loop forever
remove-headings (if current-heading-uuid [current-heading-uuid] nil)
query-result (rum/react (:query-atom state))
result (db/custom-query-result-transform query-result remove-headings)]
query-result (if-let [a (:query-atom state)]
(rum/react a))
result (if query-result
(db/custom-query-result-transform query-result remove-headings))]
[:div.custom-query.my-2
[:code (or (:query-title options)
"Query result: ")]
(if (seq result)
(->hiccup result (assoc config
:custom-query? true

View File

@@ -142,7 +142,7 @@
:page/name {:db/unique :db.unique/identity}
:page/file {:db/valueType :db.type/ref}
:page/directives {}
:page/links {}
:page/list {}
:page/alias {:db/valueType :db.type/ref
:db/cardinality :db.cardinality/many}
:page/tags {:db/valueType :db.type/ref
@@ -495,18 +495,19 @@
(defn custom-query
[query-string]
(try
(let [query (reader/read-string query-string)
[query inputs] (if (vector? (first query))
[`~(first query) (rest query)]
[`~query nil])
inputs (map resolve-input inputs)
repo (state/get-current-repo)
k [:custom query-string]]
(apply q repo k {} query inputs))
(catch js/Error e
(println "Query parsing failed: ")
(js/console.dir e))))
(when-not (string/blank? query-string)
(try
(let [query (reader/read-string query-string)
[query inputs] (if (vector? (first query))
[`~(first query) (rest query)]
[`~query nil])
inputs (map resolve-input inputs)
repo (state/get-current-repo)
k [:custom query-string]]
(apply q repo k {} query inputs))
(catch js/Error e
(println "Query parsing failed: ")
(js/console.dir e)))))
(defn custom-query-result-transform
[query-result remove-headings]
@@ -611,6 +612,25 @@
;; queries
(defn get-all-tags
[]
(let [repo (state/get-current-repo)]
(when (get-conn repo)
(some->>
(q repo [:tags] {}
'[:find ?name ?h ?p
:where
[?t :tag/name ?name]
(or
[?h :heading/tags ?t]
[?p :page/tags ?t])])
react
(seq)
;; (map first)
;; frequencies
;; (util/sort-by-value :desc)
))))
(defn- remove-journal-files
[files]
(remove
@@ -1177,12 +1197,16 @@
{:page/name alias})))
other-alias))
(:tags directives)
(assoc :page/tags
(map
(fn [tag]
{:tag/name (string/lower-case tag)})
(:tags directives))))))
(or (:tags directives) (:roam_tags directives))
(assoc :page/tags (let [tags (:tags directives)
roam-tags (:roam_tags directives)
tags (if (string? tags)
(string/split tags #",")
tags)
tags (->> (concat tags roam-tags)
(remove nil?)
(distinct))]
(util/->tags tags))))))
(->> (map first pages)
(remove nil?)))
pages (concat

View File

@@ -89,21 +89,9 @@
first
second))
(defn ->tags
[tags]
(->> (map (fn [tag]
(let [tag (-> (string/lower-case tag)
(string/replace #"\s+" "-"))]
(if (util/tag-valid? tag)
{:db/id tag
:tag/name tag})))
(remove nil? tags))
(remove nil?)
vec))
(defn with-refs
[{:keys [title body tags] :as heading}]
(let [tags (mapv :tag/name (->tags (map :tag/name tags)))
(let [tags (mapv :tag/name (util/->tags (map :tag/name tags)))
ref-pages (atom tags)]
(walk/postwalk
(fn [form]
@@ -130,7 +118,7 @@
[{:keys [title body tags] :as heading}]
(cond-> heading
(seq tags)
(assoc :tags (->tags tags))))
(assoc :tags (util/->tags tags))))
(defn extract-headings
[blocks last-pos encoded-content]

View File

@@ -26,19 +26,22 @@
(.parseJson js/window.Mldoc content (or config default-config))))
;; E.g "Foo Bar \"Bar Baz\""
(defn- sep-by-quote-or-space
(defn- sep-by-quote-or-space-or-comma
[s]
(some->>
(string/split s #"\"")
(remove string/blank?)
(map (fn [s]
(if (or (= " " (first s)) (= " " (last s)))
;; space separated tags
(string/split (string/trim s) #" ")
s)))
flatten
distinct
(map string/lower-case)))
(when s
(let [comma? (re-find #"," s)]
(some->>
(string/split s #"[\"|\,]{1}")
(remove string/blank?)
(map (fn [s]
(if (and (not comma?)
(or (= " " (first s)) (= " " (last s))))
;; space separated tags
(string/split (string/trim s) #" ")
s)))
flatten
distinct
(map string/lower-case)))))
(defn collect-page-directives
[ast]
@@ -64,18 +67,17 @@
directives (->> (remove (fn [x] (= :macro (first x))) directives)
(into {}))
directives (if (seq directives)
(let [directives (->
(cond-> directives
(:roam_alias directives)
(assoc :alias (:roam_alias directives))
(:roam_tags directives)
(assoc :tags (:roam_tags directives))
(:roam_key directives)
(assoc :key (:roam_key directives)))
(dissoc :roam_alias :roam_tags :roam_key))]
(-> directives
(update :alias sep-by-quote-or-space)
(update :tags sep-by-quote-or-space)))
(cond-> directives
(:roam_alias directives)
(assoc :alias (:roam_alias directives))
(:roam_key directives)
(assoc :key (:roam_key directives))
(:alias directives)
(update :alias sep-by-quote-or-space-or-comma)
(:tags directives)
(update :tags sep-by-quote-or-space-or-comma)
(:roam_tags directives)
(update :roam_tags sep-by-quote-or-space-or-comma))
directives)
directives (assoc directives :macros macros)
other-ast (drop-while directive? ast)]

View File

@@ -1022,6 +1022,8 @@
[old-directives new-directives] (when pre-heading?
[(:page/directives (db/entity (:db/id page)))
(db/parse-directives value format)])
page-tags (when-let [tags (:tags new-directives)]
(util/->tags tags))
page-list (when-let [content (:list new-directives)]
(db/extract-page-list content))
permalink-changed? (when (and pre-heading? (:permalink old-directives))
@@ -1053,13 +1055,28 @@
(block/parse-heading (assoc heading :heading/content value) format))
headings (db/recompute-heading-children repo heading headings)
after-headings (rebuild-after-headings repo file (:end-pos meta) end-pos)
page-id (:db/id page)
modified-time (let [modified-at (tc/to-long (t/now))]
[[:db/add (:db/id page) :page/last-modified-at modified-at]
[[:db/add page-id :page/last-modified-at modified-at]
[:db/add (:db/id file) :file/last-modified-at modified-at]])
page-directives (when pre-heading?
[(assoc page :page/directives new-directives)])
(if (seq new-directives)
[[:db/retract page-id :page/directives]
{:db/id page-id
:page/directives new-directives}]
[[:db/retract page-id :page/directives]]))
page-list (when pre-heading?
[(assoc page :page/list page-list)])]
(if (seq page-list)
[[:db/retract page-id :page/list]
{:db/id page-id
:page/list page-list}]
[[:db/retract page-id :page/list]]))
page-tags (when (and pre-heading? (seq page-tags))
(if (seq page-tags)
[[:db/retract page-id :page/tags]
{:db/id page-id
:page/tags page-tags}]
[[:db/retract page-id :page/tags]]))]
(profile
"Save heading: "
(transact-react-and-alter-file!
@@ -1069,6 +1086,7 @@
headings
page-directives
page-list
page-tags
after-headings
modified-time)
{:key :heading/change

View File

@@ -701,3 +701,21 @@
(defn pp-str [x]
(with-out-str (pprint x)))
(defn ->tags
[tags]
(->> (map (fn [tag]
(let [tag (-> (string/trim tag)
(string/lower-case)
(string/replace #"\s+" "-"))]
(if (tag-valid? tag)
{:db/id tag
:tag/name tag})))
(remove nil? tags))
(remove nil?)
vec))
(defn ->page-tags
[s]
(let [tags (string/split s #",")]
(->tags tags)))