forked from
jonmsterling.com/ocaml-forester
ocaml
Misc: Start tracking timestamps, progress on HTMX client
- add spelll library
- WIP: Serialize and read forests from disks
- tweak Forest_graphs interface for increased flexibility
- add last_changed field to frontmatter
- progress on server and HTMX rendering
- Progress on search engine
authored by
Kento Okura
and committed by
Jon Sterling
3573cf3a
92a817df
+1374
-306
+17
-2
bin/forester/theme/style.css
+17
-2
bin/forester/theme/style.css
···
1
1
/* SPDX-License-Identifier: CC0-1.0 */
2
2
3
+
.search-result-item {
4
+
padding: 0.75em 1em;
5
+
display: flex;
6
+
border-left: 2px solid transparent;
7
+
align-items: center;
8
+
justify-content: start;
9
+
outline: none;
10
+
transition: color;
11
+
width: 100%;
12
+
}
13
+
14
+
#search-results {
15
+
list-style: none;
16
+
}
17
+
3
18
#search-results:empty {
4
19
display: none;
5
20
}
···
8
23
display: none;
9
24
}
10
25
11
-
.search-wrapper {
12
-
display: flex;
26
+
.search-form {
27
+
display: grid;
13
28
}
14
29
15
30
.search {
+1
dune-project
+1
dune-project
+1
forester.opam
+1
forester.opam
+100
lib/compiler/Cache.ml
+100
lib/compiler/Cache.ml
···
1
+
(*
2
+
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
+
*
4
+
* SPDX-License-Identifier: GPL-3.0-or-later
5
+
*)
6
+
7
+
open Forester_core
8
+
open Forester_search
9
+
module T = Types
10
+
11
+
type tree = {
12
+
timestamp: float option;
13
+
syn: Syn.t option;
14
+
article: T.content T.article;
15
+
deps: iri list;
16
+
}
17
+
18
+
type forest = tree Iri_tbl.t
19
+
20
+
let serialize_graphs
21
+
: (module Forest_graphs.S) -> 'a
22
+
= fun s ->
23
+
let module Graphs = (val s) in
24
+
Graphs.dl_db
25
+
26
+
type t = {
27
+
search_index: Index.t;
28
+
forest: forest;
29
+
dl_db: Datalog_engine.db;
30
+
}
31
+
32
+
let serialize_state : State.t -> t = function
33
+
| {graphs; resources; search_index; parsed; import_graph; expanded; _} ->
34
+
let dl_db = serialize_graphs graphs in
35
+
let forest : tree Iri_tbl.t = Iri_tbl.create 1000 in
36
+
Forest.get_all_articles resources
37
+
|> List.iter
38
+
(function
39
+
| (T.{frontmatter = {iri = Some iri; _}; _} as article) ->
40
+
begin
41
+
(* match Iri_tbl.find_opt expanded iri with *)
42
+
match Iri_tbl.find_opt parsed iri with
43
+
| Some {timestamp; _} ->
44
+
let deps =
45
+
List.filter_map
46
+
(function
47
+
| T.Iri_vertex iri -> Some iri
48
+
| _ -> None
49
+
) @@
50
+
Forest_graph.safe_pred import_graph (T.Iri_vertex iri)
51
+
in
52
+
let syn = Iri_tbl.find_opt expanded iri in
53
+
Iri_tbl.add
54
+
forest
55
+
iri
56
+
{
57
+
article;
58
+
syn;
59
+
timestamp;
60
+
deps;
61
+
}
62
+
| None ->
63
+
()
64
+
end
65
+
| _ ->
66
+
(* This does not appear to happen?*)
67
+
assert false
68
+
);
69
+
{search_index; forest; dl_db;}
70
+
71
+
let reconstruct : env: Eio_unix.Stdenv.base -> config: Config.t -> t -> State.t = fun ~env ~config forest ->
72
+
match forest with
73
+
| {search_index; forest; dl_db} ->
74
+
let init =
75
+
Phases.init
76
+
~env
77
+
~config
78
+
~dev: true
79
+
in
80
+
let graphs = Forest_graphs.init dl_db in
81
+
Iri_tbl.iter
82
+
(fun iri v ->
83
+
Iri_tbl.add init.resources iri (T.Article v.article);
84
+
let _ = Option.get @@ Option.map (Iri_tbl.add init.expanded iri) v.syn in
85
+
()
86
+
)
87
+
forest;
88
+
{init with search_index; graphs; resources = init.resources}
89
+
90
+
let marshal filename (v : t) =
91
+
let oc = open_out_bin filename in
92
+
Fun.protect
93
+
~finally: (fun () -> close_out oc)
94
+
(fun () -> Marshal.to_channel oc v [])
95
+
96
+
let unmarshal filename : t =
97
+
let ic = open_in_bin filename in
98
+
Fun.protect
99
+
~finally: (fun () -> close_in ic)
100
+
(fun () -> Marshal.from_channel ic)
+4
-4
lib/compiler/Eval.ml
+4
-4
lib/compiler/Eval.ml
···
383
383
| Some current_iri ->
384
384
anon_iri current_iri
385
385
in
386
-
let subtree = eval_tree_inner ~iri nodes in
386
+
let subtree = eval_tree_inner ~iri nodes.syn in
387
387
let frontmatter = Frontmatter.get () in
388
388
let subtree = {subtree with frontmatter = {subtree.frontmatter with iri = Some iri; designated_parent = frontmatter.iri}} in
389
389
Emitted_trees.modify @@ List.cons subtree;
···
719
719
and emit_content_node ~loc content =
720
720
emit_content_nodes ~loc [content]
721
721
722
-
and eval_tree_inner ~(iri : iri) (tree : Syn.tree) : T.content T.article =
722
+
and eval_tree_inner ~(iri : iri) (syn : Syn.t) : T.content T.article =
723
723
let attribution_is_author attr =
724
724
match T.(attr.role) with
725
725
| T.Author -> true
···
737
737
in
738
738
let@ () = Anon_subtree_ix.run ~init: 0 in
739
739
let@ () = Frontmatter.run ~init: frontmatter in
740
-
let mainmatter = {value = eval_tape tree.syn; loc = None} |> V.extract_content in
740
+
let mainmatter = {value = eval_tape syn; loc = None} |> V.extract_content in
741
741
let frontmatter = Frontmatter.get () in
742
742
let backmatter = default_backmatter ~iri in
743
743
T.{frontmatter; mainmatter; backmatter}
···
747
747
jobs = []
748
748
}
749
749
750
-
let eval_tree ?(quit_on_failure = true) ~(host : string) ~(iri : iri) ~(source_path : string option) (tree : Syn.tree) : Reporter.Message.t Asai.Diagnostic.t list * result =
750
+
let eval_tree ?(quit_on_failure = true) ~(host : string) ~(iri : iri) ~(source_path : string option) (tree : Syn.t) : Reporter.Message.t Asai.Diagnostic.t list * result =
751
751
let diagnostics = ref [] in
752
752
let push d = diagnostics := d :: !diagnostics in
753
753
let res =
+1
-1
lib/compiler/Eval.mli
+1
-1
lib/compiler/Eval.mli
+1
-1
lib/compiler/Expand.ml
+1
-1
lib/compiler/Expand.ml
···
161
161
{value = Syn.Group (d, expand xs); loc} :: expand rest
162
162
| {value = Subtree (addr, nodes); loc} :: rest ->
163
163
let host = H.read () in
164
-
let subtree = expand_tree_inner @@ Code.{source_path = None; iri = Option.map (Iri_scheme.user_iri ~host) addr; code = nodes} in
164
+
let subtree = expand_tree_inner @@ Code.{source_path = None; timestamp = None; iri = Option.map (Iri_scheme.user_iri ~host) addr; code = nodes} in
165
165
{value = Syn.Subtree (addr, subtree); loc} :: expand rest
166
166
| {value = Math (m, xs); loc} :: rest ->
167
167
{value = Syn.Math (m, expand xs); loc} :: expand rest
+1
lib/compiler/Forester_compiler.ml
+1
lib/compiler/Forester_compiler.ml
+4
-2
lib/compiler/Imports.ml
+4
-2
lib/compiler/Imports.ml
···
28
28
begin
29
29
match Parse.parse_file path with
30
30
| Ok code ->
31
-
Some Code.{code; iri = Some iri; source_path = Some path}
31
+
let timestamp = Eio.Path.(stat ~follow: true @@ forest.env#fs / path).mtime in
32
+
Some Code.{code; iri = Some iri; source_path = Some path; timestamp = Some timestamp}
32
33
| Error _ -> None
33
34
end
34
35
| None -> None
···
75
76
analyse_tree
76
77
roots
77
78
(* Consider using the env to keep track of the current source path *)
78
-
{iri; code; source_path = None}
79
+
(* FIXME: not passing timestamp of parent tree. Need to modify Analysis_env for that *)
80
+
{iri; code; source_path = None; timestamp = None;}
79
81
| Scope code | Namespace (_, code) | Group (_, code) | Math (_, code) | Let (_, _, code) | Fun (_, code) | Def (_, _, code) ->
80
82
analyse_code roots code
81
83
| Object {methods; _} | Patch {methods; _} ->
+15
-7
lib/compiler/Phases.ml
+15
-7
lib/compiler/Phases.ml
···
25
25
let resources = Forest.create 1000 in
26
26
let diagnostics = Diagnostic_store.create 100 in
27
27
let units = Expand.Env.empty in
28
-
let search_index = State.Search_index.empty in
28
+
let search_index = Forester_search.Index.create [] in
29
29
{
30
30
env;
31
31
dev;
···
94
94
let parse_result =
95
95
let@ () = Reporter.tracef "when parsing %a (%s)" pp_iri iri source_path in
96
96
let@ code = Result.map @~ Parse.parse_document doc in
97
+
(* I am doing some more IO here. I am not stat-ing when
98
+
the file is first loaded because things pass through
99
+
L.Text_document.t, which I did not want to change.*)
100
+
let timestamp = Eio.Path.(stat ~follow: true @@ forest.env#fs / source_path).mtime in
97
101
Code.{
98
102
code;
99
103
iri = Some iri;
104
+
timestamp = Some timestamp;
100
105
source_path = Some source_path;
101
106
}
102
107
in
···
128
133
let host = forest.config.host in
129
134
let uri = Lsp.Text_document.documentUri doc in
130
135
let path = Lsp.Uri.to_path uri in
136
+
let timestamp = Eio.Path.(stat ~follow: true @@ forest.env#fs / path).mtime in
131
137
match Parse.parse_document doc with
132
138
| Ok code ->
133
139
let tree =
134
140
Code.{
135
141
code;
136
142
iri = Option.some @@ Iri_scheme.uri_to_iri ~host uri;
137
-
source_path = Some path
143
+
source_path = Some path;
144
+
timestamp = Some timestamp;
138
145
}
139
146
in
140
147
Forest.add forest.parsed (Iri_scheme.uri_to_iri ~host uri) tree;
···
159
166
| Some source_path ->
160
167
match Parse.parse_file source_path with
161
168
| Ok code ->
162
-
let tree = Code.{code; iri = Some iri; source_path = Some source_path} in
169
+
let timestamp = Eio.Path.(stat ~follow: true @@ forest.env#fs / source_path).mtime in
170
+
let tree = Code.{code; iri = Some iri; source_path = Some source_path; timestamp = Some timestamp;} in
163
171
let module Graphs = (val forest.graphs) in
164
172
let import_graph = Imports.dependencies tree forest in
165
173
{forest with import_graph}
···
198
206
begin
199
207
let@ (diagnostics, source_path, (syn : Syn.tree)) = List.iter @~ expanded_trees in
200
208
let@ iri = Option.iter @~ syn.iri in
201
-
Forest.replace forest.expanded iri syn;
209
+
Forest.replace forest.expanded iri syn.syn;
202
210
match source_path with
203
211
| None ->
204
212
Logs.warn (fun m -> m "tree at %a has no source path." pp_iri iri);
···
227
235
(* There is some duplicated code here. The only significant difference is the
228
236
fact that we are using a different graph builder, one that only traverses
229
237
the dependencies of a specific tree*)
230
-
let expand_only_aux ~(quit_on_error : bool) ~(addr : iri) (forest : state) : Expand.Env.t * Diagnostic_store.t * Syn.tree Forest.t =
238
+
let expand_only_aux ~(quit_on_error : bool) ~(addr : iri) (forest : state) : Expand.Env.t * Diagnostic_store.t * Syn.t Forest.t =
231
239
let import_graph =
232
240
Imports.run_builder
233
241
~root: addr
···
238
246
}
239
247
in
240
248
assert (Forest_graph.nb_vertex import_graph >= Forest.length forest.parsed);
241
-
let task (addr : Vertex.t) (units, diagnostics, trees) =
249
+
let task (addr : Vertex.t) (units, diagnostics, (trees : (Syn.t Iri_tbl.t))) =
242
250
match addr with
243
251
| T.Content_vertex _ ->
244
252
(* when creating the import graph we are only adding iri vertices *)
···
253
261
let ds, units, syn = Expand.expand_tree ~quit_on_error ~host: forest.config.host units tree in
254
262
let source_path = tree.source_path in
255
263
begin
256
-
Forest.add trees iri syn;
264
+
Forest.add trees iri syn.syn;
257
265
match source_path with
258
266
| None ->
259
267
Logs.warn (fun m -> m "Could not construct URI for tree at %a. There may be missing diagnostics." pp_iri iri)
+2
-4
lib/compiler/State.ml
+2
-4
lib/compiler/State.ml
···
9
9
module T = Types
10
10
type resource = T.content T.resource
11
11
12
-
module Search_index = Map.Make(String)
13
-
14
12
type t = {
15
13
env: Eio_unix.Stdenv.base;
16
14
dev: bool;
···
18
16
units: Expand.Env.t;
19
17
documents: (Lsp.Uri.t, Lsp.Text_document.t) Hashtbl.t;
20
18
parsed: Code.tree Forest.t;
21
-
expanded: Syn.tree Forest.t;
19
+
expanded: Syn.t Forest.t;
22
20
diagnostics: Diagnostic_store.t;
23
21
resources: resource Forest.t;
24
22
graphs: (module Forest_graphs.S);
25
23
import_graph: Forest_graph.t;
26
24
resolver: string Iri_tbl.t;
27
-
search_index: iri list Search_index.t;
25
+
search_index: Forester_search.Index.t;
28
26
}
29
27
30
28
let documents (t : t) = t.documents
+1
lib/compiler/dune
+1
lib/compiler/dune
+59
-52
lib/core/Forest_graphs.ml
+59
-52
lib/core/Forest_graphs.ml
···
20
20
val add_graph : Query.rel -> Forest_graph.t -> unit
21
21
end
22
22
23
-
module Make () : S = struct
23
+
let init : Dl.db -> (module S) = fun db ->
24
+
(module struct
24
25
25
-
let dl_db = Dl.db_create ()
26
+
let dl_db = Dl.db_create ()
26
27
27
-
let all_vertices_ref : Vertex_set.t ref =
28
-
ref Vertex_set.empty
28
+
let all_vertices_ref : Vertex_set.t ref =
29
+
ref Vertex_set.empty
29
30
30
-
let get_all_vertices () = !all_vertices_ref
31
+
let get_all_vertices () = !all_vertices_ref
31
32
32
-
let rel_graph_table : (Query.rel, Forest_graph.t) Hashtbl.t =
33
-
Hashtbl.create 20
33
+
let rel_graph_table : (Query.rel, Forest_graph.t) Hashtbl.t =
34
+
Hashtbl.create 20
34
35
35
-
let rel_preorder_table : (Query.rel, Forest_graph.t) Hashtbl.t =
36
-
Hashtbl.create 20
36
+
let rel_preorder_table : (Query.rel, Forest_graph.t) Hashtbl.t =
37
+
Hashtbl.create 20
37
38
38
-
let add_graph rel gph = Hashtbl.add rel_graph_table rel gph
39
+
let add_graph rel gph = Hashtbl.add rel_graph_table rel gph
39
40
40
-
let get_graph rel =
41
-
match Hashtbl.find_opt rel_graph_table rel with
42
-
| None ->
43
-
let gph = Forest_graph.create () in
44
-
Hashtbl.add rel_graph_table rel gph;
45
-
gph
46
-
| Some gph -> gph
41
+
let get_graph rel =
42
+
match Hashtbl.find_opt rel_graph_table rel with
43
+
| None ->
44
+
let gph = Forest_graph.create () in
45
+
Hashtbl.add rel_graph_table rel gph;
46
+
gph
47
+
| Some gph -> gph
47
48
48
-
let get_preorder rel =
49
-
match Hashtbl.find_opt rel_preorder_table rel with
50
-
| None ->
51
-
let message = Format.asprintf "Compute reflexive-transitive closure of %s" rel in
52
-
let@ () = Reporter.profile message in
53
-
let gph = Forest_graph.transitive_closure ~reflexive: true @@ get_graph rel in
54
-
Hashtbl.add rel_preorder_table rel gph;
55
-
gph
56
-
| Some gph -> gph
49
+
let get_preorder rel =
50
+
match Hashtbl.find_opt rel_preorder_table rel with
51
+
| None ->
52
+
let message = Format.asprintf "Compute reflexive-transitive closure of %s" rel in
53
+
let@ () = Reporter.profile message in
54
+
let gph = Forest_graph.transitive_closure ~reflexive: true @@ get_graph rel in
55
+
Hashtbl.add rel_preorder_table rel gph;
56
+
gph
57
+
| Some gph -> gph
58
+
59
+
let get_rel = function
60
+
| Query.Edges -> get_graph
61
+
| Query.Paths -> get_preorder
62
+
63
+
let register_iri iri =
64
+
let vtx : Vertex.t = T.Iri_vertex iri in
65
+
Dl.db_add_fact dl_db @@ Dl.mk_literal Builtin_relation.is_node [Dl.mk_const vtx];
66
+
begin
67
+
let@ host = Option.iter @~ Iri.host iri in
68
+
let host_vtx = T.Content_vertex (T.Content [T.Text host]) in
69
+
Dl.db_add_fact dl_db @@ Dl.mk_literal Builtin_relation.in_host [Dl.mk_const vtx; Dl.mk_const host_vtx];
70
+
end;
71
+
Hashtbl.clear rel_preorder_table;
72
+
all_vertices_ref := Vertex_set.add vtx !all_vertices_ref;
73
+
let@ gph = Seq.iter @~ Hashtbl.to_seq_values rel_graph_table in
74
+
Forest_graph.add_vertex gph vtx
57
75
58
-
let get_rel = function
59
-
| Query.Edges -> get_graph
60
-
| Query.Paths -> get_preorder
76
+
let add_edge rel ~source ~target =
77
+
Hashtbl.remove rel_preorder_table rel;
78
+
let gph = get_graph rel in
79
+
Forest_graph.add_edge gph source target;
80
+
Dl.db_add_fact dl_db @@
81
+
Dl.mk_literal
82
+
rel
83
+
[
84
+
Dl.mk_const source;
85
+
Dl.mk_const target
86
+
]
87
+
end)
61
88
62
-
let register_iri iri =
63
-
let vtx : Vertex.t = T.Iri_vertex iri in
64
-
Dl.db_add_fact dl_db @@ Dl.mk_literal Builtin_relation.is_node [Dl.mk_const vtx];
65
-
begin
66
-
let@ host = Option.iter @~ Iri.host iri in
67
-
let host_vtx = T.Content_vertex (T.Content [T.Text host]) in
68
-
Dl.db_add_fact dl_db @@ Dl.mk_literal Builtin_relation.in_host [Dl.mk_const vtx; Dl.mk_const host_vtx];
69
-
end;
70
-
Hashtbl.clear rel_preorder_table;
71
-
all_vertices_ref := Vertex_set.add vtx !all_vertices_ref;
72
-
let@ gph = Seq.iter @~ Hashtbl.to_seq_values rel_graph_table in
73
-
Forest_graph.add_vertex gph vtx
89
+
module Make () : S = struct
90
+
module S = (val (init @@ Dl.db_create ()))
74
91
75
-
let add_edge rel ~source ~target =
76
-
Hashtbl.remove rel_preorder_table rel;
77
-
let gph = get_graph rel in
78
-
Forest_graph.add_edge gph source target;
79
-
Dl.db_add_fact dl_db @@
80
-
Dl.mk_literal
81
-
rel
82
-
[
83
-
Dl.mk_const source;
84
-
Dl.mk_const target
85
-
]
92
+
include S
86
93
end
+2
lib/core/Forest_graphs.mli
+2
lib/core/Forest_graphs.mli
+2
-1
lib/core/Types.ml
+2
-1
lib/core/Types.ml
···
71
71
source_path: string option;
72
72
tags: 'content vertex list;
73
73
metas: (string * 'content) list;
74
+
last_changed: float option;
74
75
}
75
76
[@@deriving show, repr]
76
77
···
196
197
in
197
198
trim_back @@ trim_front xs
198
199
199
-
let default_frontmatter ?iri ?source_path ?designated_parent ?(dates = []) ?(attributions = []) ?taxon ?number ?(metas = []) ?(tags = []) ?title () = {iri; source_path; designated_parent; dates; attributions; taxon; number; metas; tags; title}
200
+
let default_frontmatter ?iri ?source_path ?designated_parent ?(dates = []) ?(attributions = []) ?taxon ?number ?(metas = []) ?(tags = []) ?title ?last_changed () = {iri; source_path; designated_parent; dates; attributions; taxon; number; metas; tags; title; last_changed}
200
201
201
202
let article_to_section ?(flags = default_section_flags) (article : 'a article) =
202
203
let mainmatter =
+1
-1
lib/frontend/DSL.ml
+1
-1
lib/frontend/DSL.ml
···
26
26
let cdata content = T.CDATA content
27
27
let contextual_number href = T.Contextual_number (Iri.of_string href)
28
28
let results_of_query query = T.Results_of_query query
29
-
let katex m content = T.KaTeX (m, content)
29
+
let katex m content = T.KaTeX (m, T.Content content)
30
30
let tex content = T.TeX_cs (Word content)
31
31
let img href = T.(Img (Remote href))
32
32
let route_of_iri iri = T.Route_of_iri iri
+162
-20
lib/frontend/Htmx_client.ml
+162
-20
lib/frontend/Htmx_client.ml
···
175
175
]
176
176
]
177
177
178
+
(*This type is just temporary until I figure out the logic *)
179
+
type toc_config = {
180
+
suffix: string;
181
+
taxon: string;
182
+
number: string;
183
+
fallback_number: string;
184
+
185
+
(* In XSL, hese require querying the ancestors. We can't do this here, so we
186
+
explicitly pass these parameters down*)
187
+
in_backmatter: bool;
188
+
is_root: bool;
189
+
implicitly_unnumbered: bool;
190
+
}
191
+
192
+
let default_toc_config
193
+
?(suffix = "")
194
+
?(taxon = "")
195
+
?(number = "")
196
+
?(fallback_number = "")
197
+
?(in_backmatter = false)
198
+
()
199
+
= {
200
+
suffix;
201
+
taxon;
202
+
number;
203
+
fallback_number;
204
+
in_backmatter;
205
+
is_root = false;
206
+
implicitly_unnumbered = false;
207
+
}
208
+
178
209
let rec render_article (forest : State.t) (article : T.content T.article) : node =
179
210
(* FIXME: What should reserved be here? *)
180
211
let@ () = Xmlns.run ~reserved: [] in
···
314
345
render_content forest @@
315
346
T.apply_modifier_to_content T.Sentence_case c
316
347
) @
317
-
[txt "."]
348
+
[txt ". "]
318
349
)
319
350
frontmatter.taxon
320
351
in
···
518
549
| Transclude transclusion ->
519
550
render_transclusion transclusion
520
551
| Contextual_number addr ->
521
-
let custom_number =
522
-
let@ article = Option.bind @@ Forest.get_article addr forest.resources in
523
-
article.frontmatter.number
524
-
in
525
-
let num =
526
-
match custom_number with
527
-
| None -> Format.asprintf "[%a]" Iri.pp addr
528
-
| Some num -> num
529
-
in
530
-
[txt "%s" num]
552
+
begin
553
+
match (Forest.get_article addr) forest.resources with
554
+
| Some a ->
555
+
[
556
+
contextual_number
557
+
(T.article_to_section a)
558
+
(default_toc_config ())
559
+
]
560
+
| None -> []
561
+
end
562
+
563
+
(* let custom_number = *)
564
+
(* article.frontmatter.number *)
565
+
(* in *)
566
+
(* let num = *)
567
+
(* match custom_number with *)
568
+
(* | None -> Format.asprintf "[%a]" Iri.pp addr *)
569
+
(* | Some num -> num *)
570
+
(* in *)
571
+
(* [txt "%s" num] *)
531
572
| Link link ->
532
573
render_link forest link
533
574
| Results_of_query q ->
···
614
655
[a attrs (render_content forest link.content)]
615
656
]
616
657
658
+
and contextual_number (_tree : T.content T.section) (cfg : toc_config) =
659
+
let should_number =
660
+
cfg.number <> ""
661
+
|| (
662
+
(not cfg.in_backmatter && not cfg.is_root)
663
+
&& not cfg.implicitly_unnumbered
664
+
)
665
+
in
666
+
let taxon =
667
+
if cfg.taxon <> "" then
668
+
cfg.taxon ^
669
+
(
670
+
if should_number || cfg.fallback_number <> "" then " "
671
+
else ""
672
+
)
673
+
else ""
674
+
in
675
+
let number =
676
+
if should_number then
677
+
if cfg.number <> String.empty then cfg.number
678
+
else
679
+
(* TODO: Implement this:
680
+
<xsl:number format="1.1" count="f:tree[ancestor::f:tree and (not(@toc='false' or @numbered='false'))]" level="multiple" />
681
+
*)
682
+
assert false
683
+
else if cfg.fallback_number <> String.empty then
684
+
cfg.fallback_number
685
+
else ""
686
+
in
687
+
let suffix =
688
+
if cfg.taxon <> String.empty
689
+
|| cfg.fallback_number <> String.empty
690
+
|| should_number then cfg.suffix
691
+
else ""
692
+
in
693
+
null [txt "%s %s %s" taxon suffix number]
694
+
695
+
and _tree_taxon_with_number (_tree : T.content T.section) cfg =
696
+
(*TODO: Implement.*)
697
+
contextual_number _tree cfg
698
+
699
+
and _render_toc_item (forest : State.t) (item : T.content T.section) =
700
+
let to_str = Plain_text_client.string_of_content ~forest: forest.resources ~router: (Legacy_xml_client.route forest) in
701
+
null
702
+
[
703
+
a
704
+
[
705
+
class_ "bullet";
706
+
href "";
707
+
title_
708
+
"%s%s"
709
+
(Option.value ~default: "" @@ Option.map to_str item.frontmatter.title)
710
+
(
711
+
Option.value ~default: "" @@
712
+
Option.map
713
+
(
714
+
Format.asprintf
715
+
"[%a]"
716
+
pp_iri
717
+
)
718
+
item.frontmatter.iri
719
+
)
720
+
]
721
+
[txt "■"];
722
+
span
723
+
[class_ "link local"]
724
+
[
725
+
span
726
+
[class_ "taxon"]
727
+
[_tree_taxon_with_number item (default_toc_config ())];
728
+
(* null @@ render_content forest item.mainmatter; *)
729
+
];
730
+
ul [] (render_content forest item.mainmatter)
731
+
]
732
+
733
+
and render_toc_mainmatter content =
734
+
let T.Content nodes = content in
735
+
ul
736
+
[class_ "block"]
737
+
(
738
+
List.filter_map
739
+
(fun node ->
740
+
match node with
741
+
| T.Section section ->
742
+
Some (render_toc section)
743
+
| _ -> None
744
+
)
745
+
nodes
746
+
)
747
+
748
+
and render_toc (section : T.content T.section) =
749
+
if Some false
750
+
= List.find_map
751
+
(fun (k, v) ->
752
+
if k = "toc" && v = T.Content [T.Text "true"] then Some true
753
+
else None
754
+
)
755
+
section.frontmatter.metas then null []
756
+
else
757
+
nav
758
+
[id "toc"; Hx.swap_oob "true"]
759
+
[
760
+
div
761
+
[class_ "block"]
762
+
[
763
+
h1 [] [txt "Table of contents"];
764
+
(render_toc_mainmatter section.mainmatter);
765
+
]
766
+
]
767
+
617
768
let render_query_result (forest : State.t) (vs : Vertex_set.t) =
618
769
let module C = Types.Comparators(struct
619
770
let string_of_content =
···
640
791
|> List.map (render_section forest) |> fun nodes ->
641
792
if List.length nodes = 0 then None
642
793
else Some (div [class_ "tree-content"] nodes)
643
-
644
-
let render_toc _article =
645
-
nav
646
-
[id "toc"; Hx.swap_oob "true"]
647
-
[
648
-
div
649
-
[class_ "block"]
650
-
[h1 [] [txt "Table of contents"]]
651
-
]
+1
-1
lib/frontend/Htmx_client.mli
+1
-1
lib/frontend/Htmx_client.mli
-9
lib/frontend/State_machine.ml
-9
lib/frontend/State_machine.ml
···
6
6
7
7
open Forester_core
8
8
open Forester_compiler
9
-
open Forester_search
10
9
11
10
type target = HTML | JSON | XML | STRING
12
11
···
31
30
| Get of iri
32
31
| Query of (string, Vertex.t) Datalog_expr.query
33
32
| Cache_results of (Vertex_set.t [@opaque])
34
-
| Index
35
33
[@@deriving show]
36
34
37
35
type ('r, 'e) result =
···
128
126
| Cache_results _
129
127
| Done ->
130
128
(Done, state, Nothing)
131
-
| Index ->
132
-
(
133
-
Done,
134
-
{state with search_index = Index.index state.resources},
135
-
Nothing
136
-
)
137
129
138
130
let run_action action state : state =
139
131
let rec go action state =
···
164
156
|> plant_assets
165
157
|> implant_foreign
166
158
|> run_action Load_all_configured_dirs
167
-
|> run_action Index
168
159
169
160
let language_server
170
161
: state -> unit
+1
lib/parser/Code.ml
+1
lib/parser/Code.ml
+1
lib/parser/Code.mli
+1
lib/parser/Code.mli
+185
lib/search/Context.ml
+185
lib/search/Context.ml
···
1
+
(*
2
+
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
+
*
4
+
* SPDX-License-Identifier: GPL-3.0-or-later
5
+
*)
6
+
7
+
open Forester_core
8
+
module T = Types
9
+
10
+
(* The idea is to render a search result with surrounding context, say 5 words
11
+
on each side. *)
12
+
13
+
type path = int list
14
+
15
+
let show_leaf_node
16
+
: T.content T.content_node -> string
17
+
= fun node ->
18
+
match node with
19
+
| T.Text s -> s
20
+
| T.CDATA s -> s
21
+
| T.TeX_cs cs ->
22
+
begin
23
+
match cs with
24
+
| TeX_cs.Word s -> "\\" ^ s
25
+
| TeX_cs.Symbol c -> "\\" ^ String.init 0 (Fun.const c)
26
+
end
27
+
| T.Iri i
28
+
| T.Route_of_iri i ->
29
+
Format.asprintf "%a" pp_iri i
30
+
| T.Xml_elt _
31
+
| T.Transclude _
32
+
| T.Contextual_number _
33
+
| T.Results_of_query _
34
+
| T.Section _
35
+
| T.Prim (_, _)
36
+
| T.KaTeX (_, _)
37
+
| T.Link _
38
+
| T.Img _
39
+
| T.Artefact _
40
+
| T.Datalog_script _
41
+
| T.Results_of_datalog_query _ ->
42
+
raise @@
43
+
Invalid_argument (Format.asprintf "%a is not a leaf node" T.(pp_content_node pp_content) node)
44
+
45
+
let get_nth_word i string =
46
+
Str.(split @@ regexp "[^a-zA-Z0-9]+") string
47
+
|> List.filter_map
48
+
(fun s ->
49
+
let lower = String.lowercase_ascii s in
50
+
if not @@ Tokenizer.(Set.mem lower common_words) then
51
+
Some lower
52
+
else
53
+
None
54
+
)
55
+
|> (fun l -> List.nth l i)
56
+
57
+
let render_context_list
58
+
: (path -> 'a -> string) -> path -> 'a list -> string
59
+
= fun f path l ->
60
+
match path with
61
+
| [] -> String.concat "" @@ List.map (f []) l
62
+
| i :: path' ->
63
+
let n = List.nth l i in
64
+
f path' n
65
+
66
+
let rec render_context_frontmatter
67
+
: path -> T.content T.frontmatter -> string
68
+
= fun path frontmatter ->
69
+
match path with
70
+
| [] -> raise (Invalid_argument "stopped on non-leaf node")
71
+
| 0 :: path ->
72
+
Format.(asprintf "%a" (pp_print_option pp_iri) frontmatter.iri)
73
+
| 1 :: path' ->
74
+
begin
75
+
match path' with
76
+
| [] ->
77
+
Option.value ~default: "" @@
78
+
Option.map T.show_content frontmatter.title
79
+
| path ->
80
+
Option.value ~default: "" @@
81
+
Option.map (render_context_content path) frontmatter.title
82
+
end
83
+
| 2 :: path' ->
84
+
begin
85
+
match path' with
86
+
| [] -> assert false
87
+
| path -> assert false
88
+
end (*frontmatter.dates*)
89
+
| 3 :: path' ->
90
+
begin
91
+
match path' with
92
+
| [] -> assert false
93
+
| path -> assert false
94
+
end (*frontmatter.attributions*)
95
+
| 4 :: path' ->
96
+
begin
97
+
match path' with
98
+
| [] -> assert false
99
+
| path ->
100
+
Option.value ~default: "" @@
101
+
Option.map (render_context_content path) frontmatter.taxon
102
+
end (*frontmatter.taxon*)
103
+
| 5 :: path' ->
104
+
begin
105
+
match path' with
106
+
| [] -> assert false
107
+
| path -> assert false
108
+
end (*frontmatter.number*)
109
+
| 6 :: path' ->
110
+
begin
111
+
match path' with
112
+
| [] -> assert false
113
+
| path -> assert false
114
+
end (*frontmatter.designated_parent*)
115
+
| 7 :: path' ->
116
+
begin
117
+
match path' with
118
+
| [] -> assert false
119
+
| path -> assert false
120
+
end (*frontmatter.source_path*)
121
+
| 8 :: path' ->
122
+
begin
123
+
match path' with
124
+
| [] -> assert false
125
+
| path -> assert false
126
+
end (*frontmatter.tags*)
127
+
| 9 :: path' ->
128
+
begin
129
+
match path' with
130
+
| [] -> assert false
131
+
| path -> assert false
132
+
end (*frontmatter.metas*)
133
+
| _ -> raise (Invalid_argument "out of bound index")
134
+
135
+
and render_context_node
136
+
: path -> T.content T.content_node -> string
137
+
= fun path node ->
138
+
match path with
139
+
| [] -> show_leaf_node node
140
+
| i :: path' ->
141
+
match node with
142
+
| T.Text s -> get_nth_word i s
143
+
| T.CDATA _ -> raise @@ Invalid_argument "can't descend into CDATA node"
144
+
| T.Xml_elt _ -> assert false
145
+
| T.Transclude _ -> assert false
146
+
| T.Contextual_number _ -> assert false
147
+
| T.Results_of_query _ -> assert false
148
+
| T.Section _ -> assert false
149
+
| T.Prim (_, content) ->
150
+
render_context_content path content
151
+
| T.KaTeX (_, _) -> assert false
152
+
| T.TeX_cs _ -> assert false
153
+
| T.Link {href; content} -> render_context_content path' content
154
+
| T.Img _ -> assert false
155
+
| T.Artefact _ -> assert false
156
+
| T.Iri _ -> assert false
157
+
| T.Route_of_iri _ -> assert false
158
+
| T.Datalog_script _ -> assert false
159
+
| T.Results_of_datalog_query _ -> assert false
160
+
161
+
and render_context_content
162
+
: path -> T.content -> string
163
+
= fun path content ->
164
+
let T.Content c = content in
165
+
match path with
166
+
| [] -> T.show_content content
167
+
| i :: path' ->
168
+
let node = List.nth c i in
169
+
(* render_context_node in *)
170
+
render_context_node path' node
171
+
172
+
and render_context_article
173
+
: path -> T.content T.article -> string
174
+
= fun path article ->
175
+
match path with
176
+
| [] -> ""
177
+
| 0 :: path' -> render_context_frontmatter path' article.frontmatter
178
+
| 1 :: path' -> render_context_content path' article.mainmatter
179
+
| _ -> raise (Invalid_argument "out of bound index")
180
+
181
+
and debug_context_article : path -> string = function
182
+
| [] -> "empty path"
183
+
| 0 :: path' -> "frontmatter ->"
184
+
| 1 :: path' -> "mainmatter ->"
185
+
| _ -> raise (Invalid_argument "out of bound index")
+3
lib/search/Forester_search.ml
+3
lib/search/Forester_search.ml
+140
-129
lib/search/Index.ml
+140
-129
lib/search/Index.ml
···
5
5
*)
6
6
7
7
open Forester_core
8
-
open Forester_compiler
8
+
open Forester_prelude
9
+
open Spelll
10
+
9
11
module T = Forester_core.Types
10
-
module Search_index = State.Search_index
11
12
12
-
module Set = Set.Make(String)
13
-
(* module Index = Map.Make(String) *)
13
+
module Ocurrences = Set.Make(struct
14
+
type t = int list list * iri
15
+
(* FIXME: *)
16
+
let compare (_i, x) (_j, y) = Iri.compare ?normalize: None x y
17
+
end)
14
18
15
-
let common_words =
16
-
Set.of_list
17
-
[
18
-
"a";
19
-
"and";
20
-
"be";
21
-
"have";
22
-
"i";
23
-
"in";
24
-
"of";
25
-
"that";
26
-
"the";
27
-
"to";
28
-
]
19
+
type t = {
20
+
index: Ocurrences.t Index.t;
21
+
number_of_tokens: int;
22
+
number_of_docs: int;
23
+
}
24
+
25
+
let average_doc_length
26
+
: t -> float
27
+
= fun {number_of_tokens; number_of_docs; _} ->
28
+
Float.of_int number_of_tokens /. Float.of_int number_of_docs
29
+
30
+
let add_one
31
+
: T.content T.article -> t -> t
32
+
= fun article ({index; number_of_tokens; number_of_docs;} as t) ->
33
+
if Option.is_none T.(article.frontmatter.iri) then t
34
+
else
35
+
let tokens_in_article = Tokenizer.tokenize_article article in
36
+
let iri = Option.get T.(article.frontmatter.iri) in
37
+
let new_tokens = ref 0 in
38
+
let new_index =
39
+
List.fold_left
40
+
(fun index (ocurrences, token) ->
41
+
match Index.retrieve_l ~limit: 0 index token with
42
+
| [] ->
43
+
(* Unseen token*)
44
+
(* TODO: add to list of ocurrences*)
45
+
let ocurrence = Ocurrences.singleton ([ocurrences], iri) in
46
+
new_tokens := !new_tokens + 1;
47
+
Index.add index token ocurrence
48
+
| ids :: [] ->
49
+
Index.add index token (Ocurrences.add ([ocurrences], iri) ids)
50
+
| _ ->
51
+
(* We are using limit=0, so this shouldn't happen*)
52
+
assert false
53
+
)
54
+
index
55
+
tokens_in_article
56
+
in
57
+
{
58
+
index = new_index;
59
+
number_of_docs = number_of_docs + 1;
60
+
number_of_tokens = number_of_tokens + !new_tokens
61
+
}
29
62
30
-
let tokenize string =
31
-
Str.(split @@ regexp "[^a-zA-Z0-9]+") string
32
-
|> List.filter_map
33
-
(fun s ->
34
-
let lower = String.lowercase_ascii s in
35
-
if not @@ Set.mem lower common_words then
36
-
Some (Stemming.stem lower)
37
-
else
38
-
None
39
-
)
63
+
let add
64
+
: T.content T.article list -> t -> t
65
+
=
66
+
List.fold_right add_one
40
67
41
-
let rec tokenize_content : T.content -> _ = function
42
-
| Content nodes ->
43
-
List.concat_map
44
-
(function
45
-
| T.Text s
46
-
| T.CDATA s ->
47
-
tokenize s
48
-
| T.Xml_elt {content; _} ->
49
-
(* TODO: Consider tokenizing xml_qname *)
50
-
tokenize_content content
51
-
| T.Section {frontmatter; mainmatter; _} -> tokenize_frontmatter frontmatter @ tokenize_content mainmatter
52
-
| T.Prim (_, content) -> tokenize_content content
53
-
| T.Link {content; _} -> tokenize_content content
54
-
| T.KaTeX (_, _) ->
55
-
(* NOTE:
56
-
In order to properly search math, we need to revamp the
57
-
architecture and add more features...*)
58
-
[]
59
-
| T.Transclude _
60
-
| T.Contextual_number _
61
-
| T.Results_of_query _
62
-
| T.TeX_cs _
63
-
| T.Img _
64
-
| T.Artefact _
65
-
| T.Iri _
66
-
| T.Route_of_iri _
67
-
| T.Datalog_script _
68
-
| T.Results_of_datalog_query _ ->
69
-
[]
68
+
let search
69
+
: ?fuzz: int -> t -> string -> (int list list * iri) list
70
+
= fun ?(fuzz = 0) index term ->
71
+
Tokenizer.tokenize term
72
+
|> List.concat_map
73
+
(fun str ->
74
+
List.concat_map Ocurrences.to_list @@
75
+
Index.retrieve_l ~limit: fuzz index.index str
70
76
)
71
-
nodes
72
77
73
-
and tokenize_vertex = function
74
-
| T.Iri_vertex _ -> []
75
-
| T.Content_vertex c ->
76
-
tokenize_content c
78
+
module BM_25 = struct
79
+
let sum = List.fold_left (+.) 0.
77
80
78
-
and tokenize_attribution
79
-
: T.content T.attribution -> _
80
-
= function
81
-
| {vertex; _} ->
82
-
tokenize_vertex vertex
81
+
(* Inverse document frequency *)
82
+
let idf q (index : t) =
83
+
let n = Float.of_int @@ List.length @@ search ~fuzz: 0 index q in
84
+
log (((Float.of_int index.number_of_docs -. n +. 0.5) /. n +. 0.5) +. 1.)
83
85
84
-
and tokenize_frontmatter
85
-
: T.content T.frontmatter -> _
86
-
= function
87
-
| {title;
88
-
attributions;
89
-
taxon;
90
-
tags;
91
-
metas;
92
-
_;
93
-
} ->
94
-
List.concat
95
-
[
96
-
Option.value ~default: [] (Option.map tokenize_content title);
97
-
Option.value ~default: [] (Option.map tokenize_content taxon);
98
-
List.concat_map tokenize_attribution attributions;
99
-
List.concat_map tokenize_vertex tags;
100
-
List.concat_map (fun (s, c) -> tokenize s @ tokenize_content c) metas;
101
-
]
86
+
let doc_length d =
87
+
Float.of_int @@
88
+
List.length @@
89
+
Tokenizer.tokenize_article d
102
90
103
-
let tokenize_article : T.content T.article -> _ = function
104
-
| {frontmatter; mainmatter; _} ->
105
-
tokenize_frontmatter frontmatter @ tokenize_content mainmatter
91
+
let score
92
+
: T.content T.article -> string -> t -> float
93
+
= fun d q index ->
94
+
let tokens = Tokenizer.tokenize q in
95
+
assert (List.length tokens > 0);
96
+
let avg_len = average_doc_length index in
97
+
let k_1 = 1.5 in
98
+
let b = 0.75 in
99
+
sum @@
100
+
List.map
101
+
(fun q_i ->
102
+
let num_occurrences =
103
+
Float.of_int @@
104
+
List.length @@ search index q_i
105
+
in
106
+
(* Format.printf "num_occurrences: %f" num_occurrences; *)
107
+
idf q index *.
108
+
begin
109
+
(num_occurrences *. k_1 +. 1.) /.
110
+
(num_occurrences +. k_1 *. (1. -. b +. (b *. doc_length d /. avg_len))) +.
111
+
1.
112
+
end
113
+
)
114
+
tokens
115
+
end
106
116
107
-
let add
108
-
: T.content T.article list ->
109
-
iri list Search_index.t ->
110
-
iri list Search_index.t
111
-
= fun articles index ->
112
-
List.fold_left
113
-
(fun acc article ->
114
-
if Option.is_none T.(article.frontmatter.iri) then acc
115
-
else
116
-
let tokens = tokenize_article article in
117
-
let iri = Option.get T.(article.frontmatter.iri) in
118
-
List.fold_left
119
-
(fun acc token ->
120
-
match Search_index.find_opt token acc with
121
-
| Some ids ->
122
-
if List.nth ids (List.length ids - 1) = iri then acc
123
-
else
124
-
Search_index.add token (ids @ [iri]) acc
125
-
| None -> Search_index.add token [iri] acc
117
+
let ranked_search
118
+
: ?fuzz: int -> t -> T.content T.resource Iri_tbl.t -> string -> (iri * float) list
119
+
= fun ?fuzz index forest terms ->
120
+
Tokenizer.tokenize terms |> function
121
+
| tokens ->
122
+
(* In order to rank documents, I search for the first token and then
123
+
rank the returned documents according to all tokens. This duplicates the
124
+
search for the first token, so this should be changed.*)
125
+
let first_token = List.hd tokens in
126
+
let matches = search ~fuzz: 1 index first_token in
127
+
let iris =
128
+
List.filter_map
129
+
(fun (_, iri) ->
130
+
match Iri_tbl.find_opt forest iri with
131
+
| Some (T.Article a) ->
132
+
Some (iri, BM_25.score a terms index)
133
+
| None -> assert false
134
+
| _ -> None
126
135
)
127
-
acc
128
-
tokens
129
-
)
130
-
index
131
-
articles
136
+
matches
137
+
in
138
+
List.sort
139
+
(fun (_, score_a) (_, score_b) -> Float.compare score_a score_b)
140
+
iris
141
+
142
+
let create articles =
143
+
let index = {
144
+
index = Index.empty;
145
+
number_of_docs = 0;
146
+
number_of_tokens = 0
147
+
}
148
+
in
149
+
add articles index
132
150
133
-
let search
134
-
: iri list Search_index.t -> string -> iri list list
135
-
= fun index term ->
136
-
tokenize term
137
-
|> List.concat_map
138
-
(fun str ->
139
-
match Search_index.find_opt str index with
140
-
| Some ids ->
141
-
[ids]
142
-
| None -> []
143
-
)
151
+
let marshal (v : t) filename =
152
+
let oc = open_out_bin filename in
153
+
Fun.protect
154
+
~finally: (fun () -> close_out oc)
155
+
(fun () -> Marshal.to_channel oc v [])
144
156
145
-
let index
146
-
: T.content T.resource Forest.t -> iri list Search_index.t
147
-
= function
148
-
| resources ->
149
-
Forest.get_all_articles resources
150
-
|> (fun articles -> add articles Search_index.empty)
157
+
let unmarshal filename : t =
158
+
let ic = open_in_bin filename in
159
+
Fun.protect
160
+
~finally: (fun () -> close_in ic)
161
+
(fun () -> Marshal.from_channel ic)
+110
lib/search/Search_engine.ml
+110
lib/search/Search_engine.ml
···
1
+
(*
2
+
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
+
*
4
+
* SPDX-License-Identifier: GPL-3.0-or-later
5
+
*)
6
+
7
+
open Forester_prelude
8
+
open Forester_core
9
+
open Forester_compiler
10
+
open Forester_search
11
+
open Forester_frontend
12
+
open Cmdliner
13
+
open Cmdliner.Term.Syntax
14
+
15
+
let test_ranked (forest : State.t) =
16
+
let ranked_results =
17
+
Reporter.profile "Ranked search" @@ fun () ->
18
+
Index.ranked_search
19
+
~fuzz: 2
20
+
forest.search_index
21
+
forest.resources
22
+
"hyprtext format"
23
+
in
24
+
Format.printf "got %i results.@." (List.length ranked_results);
25
+
List.iter
26
+
(fun (iri, score) ->
27
+
match Forest.get_article iri forest.resources with
28
+
| Some article ->
29
+
Format.printf "%a, %f@." pp_iri iri score;
30
+
| None -> assert false
31
+
)
32
+
ranked_results
33
+
34
+
let test_search_cache index =
35
+
Reporter.profile "marshalling" @@ fun () ->
36
+
Index.marshal index ".forester.index";
37
+
Reporter.profile "unmarshal" @@ fun () ->
38
+
let index = Index.unmarshal ".forester.index" in
39
+
begin
40
+
Index.search ~fuzz: 1 index "forester" |> function results -> Format.printf "got %d results from marshalled index" (List.length results);
41
+
end
42
+
43
+
let test_cache (forest : State.t) =
44
+
Logs.set_reporter (Logs_fmt.reporter ());
45
+
Logs.set_level (Some Debug);
46
+
Format.printf "Original forest has %d articles " @@ List.length @@ Forest.get_all_articles @@ forest.resources;
47
+
Cache.(marshal "forest.cache" @@ serialize_state forest);
48
+
let cached_forest =
49
+
Cache.(
50
+
reconstruct ~env: forest.env ~config: forest.config @@
51
+
unmarshal "forest.cache"
52
+
)
53
+
in
54
+
Format.printf "Reconstructed forest has %d articles " @@ List.length @@ Forest.get_all_articles @@ cached_forest.resources
55
+
56
+
let test_search (forest : State.t) =
57
+
let s = read_line () in
58
+
let results =
59
+
Reporter.profile "Searching" @@ fun () ->
60
+
Index.search ~fuzz: 1 forest.search_index s
61
+
in
62
+
Format.printf "average doc length: %f words@." (Index.average_doc_length forest.search_index);
63
+
Format.printf "got %i results@." (List.length results);
64
+
List.iter
65
+
(fun (locations, iri) ->
66
+
match Forest.get_article iri forest.resources with
67
+
| Some article ->
68
+
Format.printf "%a@." pp_iri iri;
69
+
List.iter
70
+
(fun path ->
71
+
Format.(
72
+
printf
73
+
"@[<1>%a@ = %s@]@."
74
+
(
75
+
pp_print_list
76
+
~pp_sep: (fun out () -> fprintf out "; ")
77
+
pp_print_int
78
+
)
79
+
path
80
+
(
81
+
Context.render_context_article path article
82
+
)
83
+
)
84
+
)
85
+
locations
86
+
| None -> assert false
87
+
)
88
+
results
89
+
90
+
let main ~env () =
91
+
let config = Config_parser.parse_forest_config_file "forest.toml" in
92
+
let dev = true in
93
+
let forest = State_machine.batch_run ~env ~dev ~config in
94
+
let articles = Forest.get_all_articles forest.resources in
95
+
let index =
96
+
Reporter.profile "Building index" @@ fun () ->
97
+
Index.create articles
98
+
in
99
+
let size = Obj.reachable_words @@ Obj.repr index in
100
+
Format.printf "index size: %i@." size;
101
+
let forest = {forest with search_index = index} in
102
+
test_search forest;
103
+
test_search_cache forest.search_index
104
+
(* test_ranked forest; *)
105
+
(* test_cache forest *)
106
+
107
+
let () =
108
+
let@ env = Eio_main.run in
109
+
let@ () = Forester_core.Reporter.easy_run in
110
+
main ~env ()
+208
lib/search/Test_forester_search.ml
+208
lib/search/Test_forester_search.ml
···
1
+
(*
2
+
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
+
*
4
+
* SPDX-License-Identifier: GPL-3.0-or-later
5
+
*)
6
+
7
+
open Forester_core
8
+
open Forester_search
9
+
module T = Forester_core.Types
10
+
module Trie = Yuujinchou.Trie
11
+
12
+
let doc1 =
13
+
T.{
14
+
frontmatter =
15
+
default_frontmatter
16
+
~iri: (Iri.of_string "forest://doc1")
17
+
~title: (T.Content [T.Text "Title of tremendous importance"])
18
+
();
19
+
mainmatter =
20
+
T.Content [T.Text "A donut on a glass plate. Only the donuts."];
21
+
backmatter = T.Content [];
22
+
}
23
+
24
+
let doc2 =
25
+
T.{
26
+
frontmatter = default_frontmatter ~iri: (Iri.of_string "forest://doc2") ();
27
+
mainmatter =
28
+
T.Content [T.Text "donut is a donut"];
29
+
backmatter = T.Content [];
30
+
}
31
+
32
+
let pp_pair pp_fst pp_snd out (x, y) =
33
+
Format.fprintf out "(%a, %a)" pp_fst x pp_snd y
34
+
35
+
let test_context path doc =
36
+
Format.(
37
+
printf
38
+
"word at path %a: %s@."
39
+
(pp_print_list pp_print_int)
40
+
path
41
+
(Context.render_context_article path doc)
42
+
)
43
+
44
+
let test_nth_word () =
45
+
let corpus =
46
+
"Far far away, behind the word mountains, far from the countries Vokalia and Consonantia, there live the blind texts. Separated they live in Bookmarksgrove right at the coast of the Semantics, a large language ocean. A small river named Duden flows by their place and supplies it with the necessary regelialia. It is a paradisematic country, in which roasted parts of sentences fly into your mouth. Even the all-powerful Pointing has no control about the blind texts it is an almost unorthographic life One day however a small line of blind text by the name of Lorem Ipsum decided to leave for the far World of Grammar. The Big Oxmox advised her not to do so, because there were thousands of bad Commas, wild Question Marks and devious Semikoli, but the Little Blind Text didn’t listen. She packed her seven versalia, put her initial into the belt and made herself on the way. When she reached the first hills of the Italic Mountains, she had a last view back on the skyline of her hometown Bookmarksgrove, the headline of Alphabet Village and the subline of her own road, the Line Lane. Pityful a rethoric question ran over her cheek, then"
47
+
in
48
+
let tokens = Tokenizer.tokenize corpus in
49
+
List.iteri
50
+
(fun i token ->
51
+
Alcotest.(check string)
52
+
"Using get_nth_word and stemming the word should be the same as the nth
53
+
element of tokens. Will be used to render the context of a token."
54
+
(
55
+
Context.get_nth_word i corpus
56
+
|> String.lowercase_ascii
57
+
|> Stemming.stem
58
+
)
59
+
token
60
+
)
61
+
tokens
62
+
63
+
let test_tokenize_content () =
64
+
let content =
65
+
let open Forester_frontend.DSL in
66
+
T.Content
67
+
[
68
+
p
69
+
[
70
+
ol
71
+
[
72
+
li [txt "First item"];
73
+
li [txt "Second item"]
74
+
];
75
+
ul
76
+
[
77
+
li [txt "First item in second list"];
78
+
li [txt "Second item in second list"]
79
+
];
80
+
]
81
+
]
82
+
in
83
+
let tokens = Tokenizer.tokenize_content [] In_mainmatter content in
84
+
let locations = List.map (fun (x, y) -> List.rev x) tokens in
85
+
let render path = Context.render_context_content path content in
86
+
Alcotest.(check @@ list string)
87
+
""
88
+
[
89
+
"first";
90
+
"item";
91
+
"second";
92
+
"item";
93
+
"first";
94
+
"item";
95
+
"second";
96
+
"list";
97
+
"second";
98
+
"item";
99
+
"second";
100
+
"list"
101
+
]
102
+
(List.map render locations)
103
+
104
+
let test_render_context_frontmatter () =
105
+
let open Forester_frontend.DSL in
106
+
let frontmatter =
107
+
T.default_frontmatter
108
+
~iri: (Iri.of_string "forest://test/asdf")
109
+
~source_path: "/foo/bar"
110
+
~taxon: (T.Content [T.Text "Hello"])
111
+
~title: (T.Content [txt "title"; katex Display [txt "a=b"]])
112
+
~attributions: [
113
+
{
114
+
role = T.Author;
115
+
vertex = Iri_vertex (Iri.of_string "forest://test/kentookura");
116
+
};
117
+
{
118
+
role = T.Contributor;
119
+
vertex = Iri_vertex (Iri.of_string "forest://test/jonmsterling")
120
+
}
121
+
]
122
+
()
123
+
in
124
+
let tokens = Tokenizer.tokenize_frontmatter [] frontmatter in
125
+
let locations = List.map (fun (x, y) -> List.rev x) tokens in
126
+
let render path = Context.render_context_frontmatter path frontmatter in
127
+
Alcotest.(check @@ list string)
128
+
""
129
+
["title"; "hello"]
130
+
(List.map render locations)
131
+
132
+
let test_ranking () =
133
+
Alcotest.(check string)
134
+
""
135
+
""
136
+
""
137
+
138
+
let () =
139
+
let open Alcotest in
140
+
run
141
+
"Test_forester_search"
142
+
[
143
+
"tokenizer",
144
+
[
145
+
test_case "get_nth_word" `Quick test_nth_word;
146
+
test_case "tokenize_content" `Quick test_tokenize_content;
147
+
];
148
+
"context",
149
+
[
150
+
test_case "render_context_frontmatter" `Quick test_render_context_frontmatter;
151
+
];
152
+
]
153
+
154
+
(* let () = *)
155
+
(* let forest = [doc1; doc2] in *)
156
+
(* print_endline "Tokens:"; *)
157
+
(* forest *)
158
+
(* |> List.iter *)
159
+
(* (fun doc -> *)
160
+
(* print_endline @@ *)
161
+
(* Format.( *)
162
+
(* asprintf *)
163
+
(* "%a %a@." *)
164
+
(* pp_iri *)
165
+
(* T.(Option.get doc.frontmatter.iri) *)
166
+
(* ( *)
167
+
(* pp_print_list *)
168
+
(* ~pp_sep: (fun out () -> fprintf out ", ") *)
169
+
(* ( *)
170
+
(* pp_pair *)
171
+
(* (pp_print_list pp_print_int) *)
172
+
(* pp_print_string *)
173
+
(* ) *)
174
+
(* ) *)
175
+
(* (Tokenizer.tokenize_article doc) *)
176
+
(* ) *)
177
+
(* ); *)
178
+
(* let index = Index.of_list forest in *)
179
+
(* index *)
180
+
(* |> Spelll.Index.iter *)
181
+
(* (fun term iris -> *)
182
+
(* let ocurrences = *)
183
+
(* List.map *)
184
+
(* (fun (x, y) -> y, x) *)
185
+
(* (Index.Ocurrences.to_list iris) *)
186
+
(* in *)
187
+
(* Format.( *)
188
+
(* printf *)
189
+
(* "%s: %a@." *)
190
+
(* term *)
191
+
(* ( *)
192
+
(* pp_print_list *)
193
+
(* ~pp_sep: (fun out () -> fprintf out ", ") *)
194
+
(* ( *)
195
+
(* pp_pair *)
196
+
(* pp_iri *)
197
+
(* (pp_print_list @@ pp_print_list ~pp_sep: (fun out () -> fprintf out "->") pp_print_int) *)
198
+
(* ) *)
199
+
(* ) *)
200
+
(* ocurrences *)
201
+
(* ) *)
202
+
(* ); *)
203
+
(* (* Format.printf "\nSearch for donus:@."; *) *)
204
+
(* (* List.concat_map Index.Ocurrences.to_list @@ *) *)
205
+
(* (* Spelll.Index.retrieve_l ~limit: 1 index "donus" *) *)
206
+
(* (* |> List.iter (fun (_, iri) -> Format.printf "%a@." pp_iri iri); *) *)
207
+
(* test_context [0; 1; 0; 2;] doc1; *)
208
+
(* test_context [1; 0; 0;] doc2; *)
+185
lib/search/Tokenizer.ml
+185
lib/search/Tokenizer.ml
···
1
+
(*
2
+
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
+
*
4
+
* SPDX-License-Identifier: GPL-3.0-or-later
5
+
*)
6
+
7
+
module T = Forester_core.Types
8
+
9
+
module Set = Set.Make(String)
10
+
11
+
type loc =
12
+
| In_frontmatter
13
+
| In_mainmatter
14
+
15
+
let int_of_field_frontmatter
16
+
= function
17
+
| `iri -> 0
18
+
| `title -> 1
19
+
| `dates -> 2
20
+
| `attributions -> 3
21
+
| `taxon -> 4
22
+
| `number -> 5
23
+
| `designated_parent -> 6
24
+
| `source_path -> 7
25
+
| `tags -> 8
26
+
| `metas -> 9
27
+
28
+
let int_of_field_article
29
+
= function
30
+
| `frontmatter -> 0
31
+
| `mainmatter -> 1
32
+
| `backmatter -> 2
33
+
34
+
type token = {v: string; loc: loc}
35
+
36
+
let common_words =
37
+
Set.of_list
38
+
[
39
+
"a";
40
+
"and";
41
+
"be";
42
+
"have";
43
+
"i";
44
+
"in";
45
+
"of";
46
+
"that";
47
+
"the";
48
+
"to";
49
+
]
50
+
51
+
let tokenize string =
52
+
Str.(split @@ regexp "[^a-zA-Z0-9]+") string
53
+
|> List.filter_map
54
+
(fun s ->
55
+
let lower = String.lowercase_ascii s in
56
+
if not @@ Set.mem lower common_words then
57
+
Some (Stemming.stem lower)
58
+
else
59
+
None
60
+
)
61
+
62
+
let rec tokenize_content
63
+
: int list -> loc -> T.content -> (int list * string) list
64
+
= fun path loc node ->
65
+
match node with
66
+
| T.Content nodes ->
67
+
List.concat @@
68
+
List.mapi
69
+
(fun i node ->
70
+
match node with
71
+
| T.Text s ->
72
+
List.mapi
73
+
(fun j token -> j :: i :: path, token)
74
+
(tokenize s)
75
+
(* i :: path, token *)
76
+
| T.CDATA s ->
77
+
List.mapi
78
+
(fun j token -> j :: i :: path, token)
79
+
(tokenize s)
80
+
| T.Xml_elt {content; _} ->
81
+
(* TODO: Consider tokenizing xml_qname *)
82
+
tokenize_content
83
+
(i :: path)
84
+
loc
85
+
content
86
+
| T.Section {frontmatter; mainmatter; _} ->
87
+
tokenize_frontmatter
88
+
(int_of_field_article `frontmatter :: path)
89
+
frontmatter @
90
+
tokenize_content path loc mainmatter
91
+
| T.Prim (_, content) -> tokenize_content (i :: path) loc content
92
+
| T.Link {content; _} -> tokenize_content (i :: path) loc content
93
+
| T.KaTeX (_, _) ->
94
+
(* NOTE:
95
+
In order to properly search math, we need to revamp the
96
+
architecture and add more features...*)
97
+
[]
98
+
| T.Transclude _
99
+
| T.Contextual_number _
100
+
| T.Results_of_query _
101
+
| T.TeX_cs _
102
+
| T.Img _
103
+
| T.Artefact _
104
+
| T.Iri _
105
+
| T.Route_of_iri _
106
+
| T.Datalog_script _
107
+
| T.Results_of_datalog_query _ ->
108
+
[]
109
+
)
110
+
nodes
111
+
112
+
and tokenize_vertex
113
+
: int list ->
114
+
loc ->
115
+
T.content T.vertex ->
116
+
(int list * string) list
117
+
= fun path loc v ->
118
+
match v with
119
+
| T.Iri_vertex _ -> []
120
+
| T.Content_vertex c ->
121
+
tokenize_content path loc c
122
+
123
+
and tokenize_attribution
124
+
: int list ->
125
+
loc ->
126
+
T.content T.attribution ->
127
+
(int list * string) list
128
+
= fun path loc v ->
129
+
match v with
130
+
| T.{vertex; _} ->
131
+
tokenize_vertex path loc vertex
132
+
133
+
and tokenize_frontmatter
134
+
: int list ->
135
+
T.content T.frontmatter ->
136
+
(int list * string) list
137
+
= fun path fm ->
138
+
match fm with
139
+
| {title;
140
+
attributions;
141
+
taxon;
142
+
tags;
143
+
metas;
144
+
_;
145
+
} ->
146
+
List.concat
147
+
[
148
+
Option.value
149
+
~default: []
150
+
(
151
+
Option.map
152
+
(
153
+
tokenize_content
154
+
(int_of_field_frontmatter `title :: path)
155
+
In_frontmatter
156
+
)
157
+
title
158
+
);
159
+
Option.value
160
+
~default: []
161
+
(
162
+
Option.map
163
+
(
164
+
tokenize_content
165
+
(int_of_field_frontmatter `taxon :: path)
166
+
In_frontmatter
167
+
)
168
+
taxon
169
+
);
170
+
List.concat_map (tokenize_attribution path In_frontmatter) attributions;
171
+
List.concat_map (tokenize_vertex path In_frontmatter) tags;
172
+
List.concat @@
173
+
List.mapi
174
+
(fun i (s, c) ->
175
+
(List.mapi (fun i t -> i :: path, t) @@ tokenize s) @
176
+
tokenize_content path In_frontmatter c
177
+
)
178
+
metas;
179
+
]
180
+
181
+
let tokenize_article : T.content T.article -> (int list * string) list = function
182
+
| {frontmatter; mainmatter; _} ->
183
+
tokenize_frontmatter [0] frontmatter @
184
+
tokenize_content [1] In_mainmatter mainmatter
185
+
|> List.map (fun (x, y) -> List.rev x, y)
+53
-1
lib/search/dune
+53
-1
lib/search/dune
···
2
2
;;;
3
3
;;; SPDX-License-Identifier: GPL-3.0-or-later
4
4
5
+
(env
6
+
(dev
7
+
(flags
8
+
(:standard -w -66-32-33-27-26-69))))
9
+
5
10
(library
6
11
(name Forester_search)
12
+
(preprocess
13
+
(pps ppx_deriving.show))
14
+
(modules Forester_search Index Stemming Tokenizer Context)
7
15
(public_name forester.search)
8
-
(libraries forester.core forester.compiler str eio.core eio))
16
+
(libraries
17
+
yuujinchou
18
+
forester.human_datetime
19
+
forester.prelude
20
+
forester.core
21
+
str
22
+
iri
23
+
eio.core
24
+
eio
25
+
eio.unix
26
+
spelll))
27
+
28
+
(executable
29
+
(name Search_engine)
30
+
(public_name forester-search)
31
+
(modules Search_engine)
32
+
(libraries
33
+
forester.prelude
34
+
forester.compiler
35
+
forester.frontend
36
+
forester.core
37
+
logs.fmt
38
+
asai
39
+
iri
40
+
logs
41
+
eio
42
+
eio_main
43
+
eio.unix
44
+
forester.search
45
+
cmdliner))
46
+
47
+
(test
48
+
(name Test_forester_search)
49
+
(modules Test_forester_search)
50
+
(preprocess
51
+
(pps ppx_deriving.show))
52
+
(libraries
53
+
alcotest
54
+
spelll
55
+
yuujinchou
56
+
iri
57
+
forester.search
58
+
forester.core
59
+
forester.frontend
60
+
forester.compiler))
+1
-15
lib/server/Index.ml
+1
-15
lib/server/Index.ml
···
17
17
meta [name "viewport"; content "width=device-width";];
18
18
link [rel "stylesheet"; href "/style.css";];
19
19
link [rel "icon"; type_ "image/x-icon"; href "/favicon.ico";];
20
-
(* script [type_ "module"; src "min.js";] ""; *)
20
+
script [type_ "module"; src "/min.js";] "";
21
21
script [src "/htmx.js"] "";
22
22
link [rel "stylesheet"; href "https://cdn.jsdelivr.net/npm/katex@0.16.21/dist/katex.min.css"; integrity "sha384-zh0CIslj+VczCZtlzBcjt5ppRcsAmDnRem7ESsYwWwg3m/OaJ2l4x7YBZl9Kxxib"; crossorigin `anonymous;];
23
23
script [src "https://cdn.jsdelivr.net/npm/katex@0.16.21/dist/katex.js"; integrity "sha384-CAltQiu9myJj3FAllEacN6FT+rOyXo+hFZKGuR2p4HB8JvJlyUHm31eLfL4eEiJL"; crossorigin `anonymous;] "";
···
42
42
Hx.swap "outerHTML";
43
43
]
44
44
[];
45
-
(* nav *)
46
-
(* [id "toc";] *)
47
-
(* [ *)
48
-
(* div *)
49
-
(* [class_ "block";] *)
50
-
(* [ *)
51
-
(* h1 *)
52
-
(* [] *)
53
-
(* [ *)
54
-
(* txt "Table of contents"; *)
55
-
(* ]; *)
56
-
(* ul [id "toc-list";] []; *)
57
-
(* ]; *)
58
-
(* ]; *)
59
45
];
60
46
div [id "modal-container";] [];
61
47
];
+55
-44
lib/server/Server.ml
+55
-44
lib/server/Server.ml
···
25
25
assert (List.length theme_location = 1);
26
26
let base_dir = List.hd theme_location in
27
27
let theme_dir = EP.(env#fs / base_dir / "theme") in
28
-
let stylesheet = EP.(load (theme_dir / "style.css")) in
29
-
let htmx = EP.(load (theme_dir / "htmx.js")) in
28
+
let load_file f = EP.(load (theme_dir / f)) in
29
+
let stylesheet = load_file "style.css" in
30
+
let htmx = load_file "htmx.js" in
31
+
let favicon = load_file "favicon.ico" in
30
32
let js_bundle = EP.(load (env#fs / base_dir / "min.js")) in
31
-
let favicon = EP.(load (theme_dir / "favicon.ico")) in
32
33
let font_dir = EP.(native_exn @@ theme_dir / "fonts") in
33
34
{stylesheet; htmx; js_bundle; font_dir; favicon;}
34
35
···
79
80
let headers = Http.Header.of_list ["Content-Type", "application/javascript"] in
80
81
Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: theme.js_bundle ()
81
82
| Index ->
82
-
Cohttp_eio.Server.respond_string ~status: `OK ~body: (Pure_html.to_string (Index.v ())) ()
83
+
let headers = Http.Header.of_list ["Content-Type", "text/html"] in
84
+
Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: (Pure_html.to_string (Index.v ())) ()
83
85
| Favicon ->
84
86
let headers = Http.Header.of_list ["Content-Type", "image/x-icon"] in
85
87
Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: theme.favicon ()
86
88
| Tree s ->
87
89
let href = Iri_scheme.user_iri ~host: State.(forest.config.host) s in
88
90
let request_headers = Http.Request.headers request in
89
-
let is_htmx = Option.is_some @@ Http.Header.get request_headers "Hx-Request" in
91
+
let is_htmx =
92
+
(*If it is an HTMX request, we just send a fragment.
93
+
If it is not an HTMX request, we need to send the whole page. This
94
+
happens for example when the user opens a link via the URL bar of
95
+
the browser.
96
+
*)
97
+
Option.is_some @@ Http.Header.get request_headers "Hx-Request"
98
+
in
90
99
begin
91
100
if is_htmx then
92
-
(* If it is an HTMX request, we just send a fragment. *)
93
101
begin
102
+
(* We use custom headers to configure the transclusion. *)
94
103
match Headers.parse_content_target request_headers with
104
+
(* If we fail to parse a target, just render the article.*)
95
105
| None ->
96
106
begin
97
107
match Forest.get_article href forest.resources with
98
-
| None -> Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()
108
+
| None ->
109
+
(* TODO: Some sort of 404 template *)
110
+
Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()
99
111
| Some content ->
100
-
let response =
101
-
Pure_html.(
102
-
to_string @@
103
-
(Htmx_client.render_article forest content)
104
-
)
105
-
in
112
+
let response = Pure_html.to_string @@ Htmx_client.render_article forest content in
106
113
Cohttp_eio.Server.respond_string ~status: `OK ~body: response ()
107
114
end
108
115
| Some target ->
109
116
let modifier = Option.value ~default: T.Identity (Headers.parse_modifier request_headers) in
110
-
match Forest.get_content_of_transclusion
111
-
{target; href; modifier;}
112
-
forest.resources with
117
+
match Forest.get_content_of_transclusion {target; href; modifier;} forest.resources with
113
118
| None -> Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()
114
119
| Some content ->
115
-
let response =
116
-
Pure_html.(
117
-
to_string @@
118
-
HTML.span [] (Htmx_client.render_content forest content)
119
-
)
120
-
in
120
+
(* TODO: Remove any sort of HTML generation from the handler. *)
121
+
let response = Pure_html.(to_string @@ HTML.span [] (Htmx_client.render_content forest content)) in
121
122
Cohttp_eio.Server.respond_string ~status: `OK ~body: response ()
122
123
end
123
124
else
124
-
(* If it is not an HTMX request, we need to send the whole page. *)
125
125
match Forest.get_article href forest.resources with
126
126
| Some article ->
127
-
let content =
128
-
Pure_html.to_string @@
129
-
Index.v
130
-
~c: (Htmx_client.render_article forest article)
131
-
()
132
-
in
127
+
let content = Pure_html.to_string @@ Index.v ~c: (Htmx_client.render_article forest article) () in
133
128
let headers = Http.Header.of_list ["Content-Type", "text/html"] in
134
129
Cohttp_eio.Server.respond_string ~headers ~status: `OK ~body: content ()
135
130
| None -> Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()
···
137
132
| Search ->
138
133
if request.meth = `POST then
139
134
let body = Eio.Flow.read_all body in
140
-
let search_term =
141
-
String.concat "" @@
142
-
snd @@
143
-
List.find
135
+
let get_param key =
136
+
Option.map (String.concat "") @@
137
+
Option.map snd @@
138
+
List.find_opt
144
139
(fun (s, _) ->
145
-
s = "search"
140
+
s = key
146
141
)
147
142
(Uri.query_of_encoded body)
148
143
in
149
-
let search_results = Forester_search.Index.search forest.search_index search_term in
150
-
let response =
151
-
List.concat_map
152
-
(fun iris ->
153
-
let open Pure_html in
154
-
let open HTML in
155
-
[ul [] (List.map (fun iri -> li [] [txt "%s" (Format.asprintf "%a" pp_iri iri)]) iris)]
156
-
)
157
-
search_results
144
+
let _search_term = Option.value ~default: "" @@ get_param "search" in
145
+
let search_for = get_param "search-for" in
146
+
let search_results =
147
+
match search_for with
148
+
| None -> []
149
+
| Some "title-text" ->
150
+
(* Forester_search.Index.search *)
151
+
(* forest.search_index *)
152
+
(* search_term *)
153
+
[]
154
+
| Some "full-text" ->
155
+
(* Forester_search.Index.search *)
156
+
(* forest.search_index *)
157
+
(* search_term *)
158
+
[]
159
+
| Some _ -> assert false
158
160
in
159
-
Cohttp_eio.Server.respond_string ~status: `OK ~body: (Pure_html.to_string @@ Pure_html.HTML.ul [] response) ()
161
+
let response
162
+
=
163
+
Search_menu.results
164
+
forest
165
+
(List.map snd search_results)
166
+
in
167
+
Cohttp_eio.Server.respond_string
168
+
~status: `OK
169
+
~body: response
170
+
()
160
171
else
161
172
Cohttp_eio.Server.respond_string ~status: `Method_not_allowed ~body: "" ()
162
173
| Searchmenu ->
+2
-2
test/Test_DSL.ml
+2
-2
test/Test_DSL.ml
···
42
42
transclude "foo-001";
43
43
contextual_number "chapter-3";
44
44
results_of_query (union []);
45
-
katex Inline (T.Content [txt "a = b"]);
45
+
katex Inline [txt "a = b"];
46
46
tex "\\begin{}";
47
47
link "https://git.sr.ht/~jonsterling/ocaml-forester" [txt "Forester"];
48
48
img "img.png";
···
91
91
(
92
92
Section
93
93
{
94
-
frontmatter = {iri = None; title = None; dates = []; attributions = []; taxon = None; number = None; designated_parent = None; source_path = None; tags = []; metas = []};
94
+
frontmatter = {iri = None; title = None; dates = []; attributions = []; taxon = None; number = None; designated_parent = None; source_path = None; tags = []; metas = []; last_changed = None;};
95
95
mainmatter = (Content [(Prim (`P, (Content [(Text "section")])))]);
96
96
flags = {hidden_when_empty = None; included_in_toc = None; header_shown = None; metadata_shown = (Some false); numbered = None; expanded = None}
97
97
}
+2
-2
test/Test_eval.ml
+2
-2
test/Test_eval.ml
···
15
15
str
16
16
|> Prelude.parse_string
17
17
|> Result.get_ok
18
-
|> (fun code -> Code.{code; source_path = None; iri = None;})
18
+
|> (fun code -> Code.{code; source_path = None; iri = None; timestamp = None;})
19
19
|> Expand.expand_tree ~quit_on_error: false ~host Expand.Env.empty
20
20
|> (fun (_, _, syn) ->
21
-
Eval.eval_tree ~host ~iri ~source_path: None syn
21
+
Eval.eval_tree ~host ~iri ~source_path: None syn.syn
22
22
)
23
23
|> (fun (ds, {articles; _}) -> (ds, (List.hd articles).mainmatter))
24
24