-
-
Notifications
You must be signed in to change notification settings - Fork 1.8k
/
graph.cljs
252 lines (239 loc) · 10.7 KB
/
graph.cljs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
(ns frontend.handler.graph
"Provides util handler fns for graph view"
(:require [clojure.set :as set]
[clojure.string :as string]
[frontend.db :as db]
[logseq.db.default :as default-db]
[frontend.state :as state]
[frontend.util :as util]))
(defn- build-links
[links]
(map (fn [[from to]]
{:source from
:target to})
links))
(defn- build-nodes
[dark? current-page page-links tags nodes namespaces]
(let [parents (set (map last namespaces))
current-page (or current-page "")
pages (set (flatten nodes))]
(->>
pages
(remove nil?)
(mapv (fn [p]
(let [p (str p)
current-page? (= p current-page)
color (case [dark? current-page?] ; FIXME: Put it into CSS
[false false] "#999"
[false true] "#045591"
[true false] "#93a1a1"
[true true] "#ffffff")
color (if (contains? tags p)
(if dark? "orange" "green")
color)
n (get page-links p 1)
size (int (* 8 (max 1.0 (js/Math.cbrt n))))]
(cond->
{:id p
:label p
:size size
:color color}
(contains? parents p)
(assoc :parent true))))))))
;; slow
(defn- uuid-or-asset?
[id]
(or (util/uuid-string? id)
(string/starts-with? id "../assets/")
(= id "..")
(string/starts-with? id "assets/")
(string/ends-with? id ".gif")
(string/ends-with? id ".jpg")
(string/ends-with? id ".png")))
(defn- remove-uuids-and-files!
[nodes]
(remove
(fn [node] (uuid-or-asset? (:id node)))
nodes))
(defn- normalize-page-name
[{:keys [nodes links page-name->original-name]}]
(let [links (->>
(map
(fn [{:keys [source target]}]
(let [source (get page-name->original-name source)
target (get page-name->original-name target)]
(when (and source target)
{:source source :target target})))
links)
(remove nil?))
nodes (->> (remove-uuids-and-files! nodes)
(util/distinct-by (fn [node] (:id node)))
(map (fn [node]
(if-let [original-name (get page-name->original-name (:id node))]
(assoc node :id original-name :label original-name)
nil)))
(remove nil?))]
{:nodes nodes
:links links}))
(defn exclude-from-graph
[pages, excluded-pages?]
(let [aliases (cond->> pages
(not excluded-pages?)
(mapcat (fn [page]
(when (= true (:exclude-from-graph-view (:block/properties page)))
(:block/alias page))))
(remove nil?)
(map :db/id))]
(cond->> pages
(not excluded-pages?)
(remove (fn [page]
(or
(not (nil? (some #{(:db/id page)} aliases)))
(= true (:exclude-from-graph-view (:block/properties page)))))))))
(defn build-global-graph
[theme {:keys [journal? orphan-pages? builtin-pages? excluded-pages?]}]
(let [dark? (= "dark" theme)
current-page (or (:block/name (db/get-current-page)) "")]
(when-let [repo (state/get-current-repo)]
(let [relation (db/get-pages-relation repo journal?)
tagged-pages (db/get-all-tagged-pages repo)
namespaces (db/get-all-namespace-relation repo)
tags (set (map second tagged-pages))
full-pages (db/get-all-pages repo)
all-pages (map db/get-original-name full-pages)
page-name->original-name (zipmap (map :block/name full-pages) all-pages)
pages-after-journal-filter (if-not journal?
(remove :block/journal? full-pages)
full-pages)
pages-after-exclude-filter (exclude-from-graph pages-after-journal-filter excluded-pages?)
links (concat (seq relation)
(seq tagged-pages)
(seq namespaces))
linked (set (flatten links))
build-in-pages (set (map string/lower-case default-db/built-in-pages-names))
nodes (cond->> (map :block/name pages-after-exclude-filter)
(not builtin-pages?)
(remove (fn [p] (contains? build-in-pages (string/lower-case p))))
(not orphan-pages?)
(filter #(contains? linked (string/lower-case %))))
page-links (reduce (fn [m [k v]] (-> (update m k inc)
(update v inc))) {} links)
links (build-links (remove (fn [[_ to]] (nil? to)) links))
nodes (build-nodes dark? (string/lower-case current-page) page-links tags nodes namespaces)]
(normalize-page-name
{:nodes nodes
:links links
:page-name->original-name page-name->original-name})))))
(defn build-page-graph
[page theme show-journal]
(let [dark? (= "dark" theme)]
(when-let [repo (state/get-current-repo)]
(let [page (util/page-name-sanity-lc page)
page-entity (db/entity [:block/name page])
tags (:tags (:block/properties page-entity))
tags (remove #(= page %) tags)
ref-pages (db/get-page-referenced-pages repo page)
mentioned-pages (db/get-pages-that-mentioned-page repo page show-journal)
namespaces (db/get-all-namespace-relation repo)
links (concat
namespaces
(map (fn [[p _aliases]]
[page p]) ref-pages)
(map (fn [[p _aliases]]
[p page]) mentioned-pages)
(map (fn [tag]
[page tag])
tags))
other-pages (->> (concat (map first ref-pages)
(map first mentioned-pages))
(remove nil?)
(set))
other-pages-links (mapcat
(fn [page]
(let [ref-pages (-> (map first (db/get-page-referenced-pages repo page))
(set)
(set/intersection other-pages))
mentioned-pages (-> (map first (db/get-pages-that-mentioned-page repo page show-journal))
(set)
(set/intersection other-pages))]
(concat
(map (fn [p] [page p]) ref-pages)
(map (fn [p] [p page]) mentioned-pages))))
other-pages)
links (->> (concat links other-pages-links)
(remove nil?)
(distinct)
(build-links))
nodes (->> (concat
[page]
(map first ref-pages)
(map first mentioned-pages)
tags)
(remove nil?)
(distinct))
nodes (build-nodes dark? page links (set tags) nodes namespaces)
full-pages (exclude-from-graph (db/get-all-pages repo) false) ;; TODO Figue out how to toggel
all-pages (map db/get-original-name full-pages)
page-name->original-name (zipmap (map :block/name full-pages) all-pages)]
(normalize-page-name
{:nodes nodes
:links links
:page-name->original-name page-name->original-name})))))
(defn build-block-graph
"Builds a citation/reference graph for a given block uuid."
[block theme]
(let [dark? (= "dark" theme)]
(when-let [repo (state/get-current-repo)]
(let [ref-blocks (db/get-block-referenced-blocks block)
namespaces (db/get-all-namespace-relation repo)
links (concat
(map (fn [[p _aliases]]
[block p]) ref-blocks)
namespaces)
other-blocks (->> (concat (map first ref-blocks))
(remove nil?)
(set))
other-blocks-links (mapcat
(fn [block]
(let [ref-blocks (-> (map first (db/get-block-referenced-blocks block))
(set)
(set/intersection other-blocks))]
(concat
(map (fn [p] [block p]) ref-blocks))))
other-blocks)
links (->> (concat links other-blocks-links)
(remove nil?)
(distinct)
(build-links))
nodes (->> (concat
[block]
(map first ref-blocks))
(remove nil?)
(distinct)
;; FIXME: get block tags
)
nodes (build-nodes dark? block links #{} nodes namespaces)]
(normalize-page-name
{:nodes nodes
:links links})))))
(defn n-hops
"Get all nodes that are n hops from nodes (a collection of node ids)"
[{:keys [links] :as graph} nodes level]
(let [search-nodes (fn [forward?]
(let [links (group-by (if forward? :source :target) links)]
(loop [nodes nodes
level level]
(if (zero? level)
nodes
(recur (distinct (apply concat nodes
(map
(fn [id]
(->> (get links id) (map (if forward? :target :source))))
nodes)))
(dec level))))))
nodes (concat (search-nodes true) (search-nodes false))
nodes (set nodes)]
(update graph :nodes
(fn [full-nodes]
(filter (fn [node] (contains? nodes (:id node)))
full-nodes)))))