forked from
jonmsterling.com/ocaml-forester
ocaml
remove duplicated code
+1
-125
-92
lib/compiler/Forest.ml
-92
lib/compiler/Forest.ml
···
150
150
| T.Article article -> analyse_article graphs article
151
151
| T.Asset asset -> analyse_asset graphs asset
152
152
| _ -> ()
153
-
154
-
let get_article
155
-
: URI.t -> _ t -> T.content T.article option
156
-
= fun uri forest ->
157
-
match find_opt forest uri with
158
-
| None -> None
159
-
| Some (T.Asset _) ->
160
-
Logs.debug (fun m -> m "%a is an asset, not an article" URI.pp uri);
161
-
None
162
-
| Some (T.Syndication _) ->
163
-
Logs.debug (fun m -> m "%a is a syndication, not an article" URI.pp uri);
164
-
None
165
-
| Some (T.Article article) -> Some article
166
-
167
-
let rec get_expanded_title ?scope ?(flags = T.{empty_when_untitled = false}) (frontmatter : _ T.frontmatter) forest =
168
-
let short_title =
169
-
match frontmatter.title with
170
-
| Some content -> content
171
-
| None when not flags.empty_when_untitled ->
172
-
begin
173
-
match frontmatter.uri with
174
-
| Some uri -> T.Content [T.Uri uri]
175
-
| _ -> T.Content [T.Text "Untitled"]
176
-
end
177
-
| _ -> T.Content []
178
-
in
179
-
Option.value ~default: short_title @@
180
-
match frontmatter.designated_parent with
181
-
| Some parent_uri when not (Option.equal URI.equal scope frontmatter.designated_parent) ->
182
-
let@ parent = Option.map @~ get_article parent_uri forest in
183
-
let parent_title = get_expanded_title parent.frontmatter forest in
184
-
let parent_link = T.Link {href = parent_uri; content = parent_title} in
185
-
let chevron = T.Text " › " in
186
-
T.map_content (fun xs -> parent_link :: chevron :: xs) short_title
187
-
| _ -> None
188
-
189
-
let section_symbol = "§"
190
-
191
-
let get_content_of_transclusion (transclusion : T.transclusion) forest =
192
-
match transclusion.target with
193
-
| Full flags ->
194
-
let@ article = Option.map @~ get_article transclusion.href forest in
195
-
T.Content [T.Section (T.article_to_section article ~flags)]
196
-
| Mainmatter ->
197
-
let@ article = Option.map @~ get_article transclusion.href forest in
198
-
article.mainmatter
199
-
| Title flags ->
200
-
Option.some @@
201
-
begin
202
-
match get_article transclusion.href forest with
203
-
| None -> T.Content [T.Uri transclusion.href]
204
-
| Some article -> get_expanded_title ~flags article.frontmatter forest
205
-
end
206
-
| Taxon ->
207
-
let@ article = Option.map @~ get_article transclusion.href forest in
208
-
let default = T.Content [T.Text section_symbol] in
209
-
Option.value ~default article.frontmatter.taxon
210
-
211
-
let get_title_or_content_of_vertex ?(not_found = fun _ -> None) vertex forest =
212
-
match vertex with
213
-
| T.Content_vertex content -> Some content
214
-
| T.Uri_vertex uri ->
215
-
begin
216
-
match get_article uri forest with
217
-
| Some article -> article.frontmatter.title
218
-
| None -> not_found uri
219
-
end
220
-
221
-
let get_all_articles resources =
222
-
let extract_article = function
223
-
| T.Article a -> Some a
224
-
| _ -> None
225
-
in
226
-
resources
227
-
|> to_seq_values
228
-
|> Seq.filter_map extract_article
229
-
|> List.of_seq
230
-
231
-
let get_all_assets resources =
232
-
let extract_asset = function
233
-
| T.Asset a -> Some a
234
-
| _ -> None
235
-
in
236
-
resources
237
-
|> to_seq_values
238
-
|> Seq.filter_map extract_asset
239
-
|> List.of_seq
240
-
241
-
let get_all_resources resources =
242
-
resources
243
-
|> to_seq_values
244
-
|> List.of_seq
-32
lib/compiler/Forest.mli
-32
lib/compiler/Forest.mli
···
25
25
- When encountering a {{!Forester_core.Types.Datalog_script}[Datalog_script script]}, it runs the script and records the results in {{!Forester_core.Forest_graphs.S}[graphs]}.
26
26
*)
27
27
28
-
val get_article :
29
-
key ->
30
-
T.content T.resource t ->
31
-
T.content T.article option
32
-
33
28
val run_datalog_query :
34
29
(module Forest_graphs.S) ->
35
30
(string, Forester_core.Vertex.t) Dx.query ->
36
31
Forester_core.Vertex_set.t
37
-
38
-
val get_expanded_title :
39
-
?scope: key ->
40
-
?flags: T.title_flags ->
41
-
T.content T.frontmatter ->
42
-
T.content T.resource t ->
43
-
T.content
44
-
45
-
val get_content_of_transclusion :
46
-
T.transclusion ->
47
-
T.content T.resource t ->
48
-
T.content option
49
-
50
-
val get_title_or_content_of_vertex :
51
-
?not_found: (key -> T.content option) ->
52
-
T.content T.vertex ->
53
-
T.content T.resource t ->
54
-
T.content option
55
-
56
-
val get_all_articles :
57
-
'a T.resource t -> 'a T.article list
58
-
59
-
val get_all_assets :
60
-
'a T.resource t -> T.asset list
61
-
62
-
val get_all_resources :
63
-
'a t -> 'a list
+1
-1
lib/frontend/Html_client.ml
+1
-1
lib/frontend/Html_client.ml
···
31
31
32
32
let get_expanded_title frontmatter forest =
33
33
let scope = Scope.read () in
34
-
Forest.get_expanded_title ?scope ~flags: T.{empty_when_untitled = true} frontmatter forest
34
+
State.get_expanded_title ?scope ~flags: T.{empty_when_untitled = true} frontmatter forest
35
35
36
36
let render_xml_qname qname =
37
37
let qname = Xmlns.normalise_qname qname in