forked from
jonmsterling.com/ocaml-forester
ocaml
Rework compiler architecture
I found that Phases.mli was not the right place for a clean interface.
Instead, the module returns data that the compiler driver (still called
"state machine") should deftly weave into the state.
The point of this is that it exposes the places where we can
leverage incremental compilation. Incremental compilation is not an
abstraction that can be layered on top of code. Unless you design with
it in mind from the beginning, you need to bust open the program.
I have also started experimenting with `Marshal` so we can persist
compiler state between runs.
Other changes:
- tweaks to interfaces in core
- add Import_graph.fixup
- test actually verifies that the import graph gets amended
- remove cram tests
- some utility functions to replace cram tests:
- improve error handling in various places
- reimplement some tests
- Import_graph.add_edge_exn to avoid mistakenly adding non-existent
trees to the import graph
authored by
Kento Okura
and committed by
Jon Sterling
aa625021
3573cf3a
+1729
-1631
+2
.gitignore
+2
.gitignore
+12
-13
bin/forester/main.ml
+12
-13
bin/forester/main.ml
···
38
38
| Some v -> Build_info.V1.Version.to_string v
39
39
40
40
let build ~env _ config_filename dev no_theme =
41
+
Reporter.easy_run @@ fun () ->
41
42
let config = Config_parser.parse_forest_config_file config_filename in
42
43
Logs.debug (fun m -> m "Parsed config file %s" config_filename);
43
44
begin
···
45
46
let@ () = Reporter.trace "when copying theme directory" in
46
47
Forester.copy_contents_of_dir ~env @@ Eio_util.path_of_dir ~env config.theme
47
48
end;
48
-
let forest = State_machine.batch_run ~env ~dev ~config in
49
-
forest
50
-
|> State.diagnostics
49
+
let forest = Driver.batch_run ~env ~dev ~config in
50
+
forest.diagnostics
51
51
|> Diagnostic_store.iter (fun _ d -> List.iter Reporter.Tty.display d);
52
-
Forester.render_forest ~dev ~forest
52
+
Forester.render_forest ~dev ~forest;
53
+
Logs.app (fun m -> m "Success!")
53
54
54
55
let export ~env _ config_filename dev =
55
56
let config = Config_parser.parse_forest_config_file config_filename in
56
57
Logs.debug (fun m -> m "Parsed config file %s" config_filename);
57
-
let forest = State_machine.batch_run ~env ~dev ~config in
58
-
forest
59
-
|> State.diagnostics
58
+
let forest = Driver.batch_run ~env ~dev ~config in
59
+
forest.diagnostics
60
60
|> Diagnostic_store.iter (fun _ d -> List.iter Reporter.Tty.display d);
61
61
Forester.export ~forest
62
62
63
63
let new_tree ~env config_filename dest_dir prefix template random =
64
64
let@ () = Reporter.silence in
65
65
let config = Config_parser.parse_forest_config_file config_filename in
66
-
let forest = State_machine.batch_run ~env ~dev: true ~config in
66
+
let forest = Driver.batch_run ~env ~dev: true ~config in
67
67
let mode = if random then `Random else `Sequential in
68
68
let new_tree = Forester.create_tree ~env ~dest_dir ~prefix ~template ~mode ~config ~forest in
69
69
Format.printf "%s" new_tree
···
71
71
let complete ~env config_filename title =
72
72
let@ () = Reporter.silence in
73
73
let config = Config_parser.parse_forest_config_file config_filename in
74
-
let forest = State_machine.batch_run ~env ~dev: true ~config in
74
+
let forest = Driver.batch_run ~env ~dev: true ~config in
75
75
let@ iri, title = Seq.iter @~ Forester.complete ~forest title in
76
76
Format.printf "%a, %s\n" pp_iri iri title
77
77
78
78
let query_all ~env config_filename =
79
79
let@ () = Reporter.silence in
80
80
let config = Config_parser.parse_forest_config_file config_filename in
81
-
let forest = State_machine.batch_run ~env ~config ~dev: true in
82
-
Format.printf "%s" @@
83
-
Forester.json_manifest ~dev: true ~forest
81
+
let forest = Driver.batch_run ~env ~config ~dev: true in
82
+
Format.printf "%s" (Forester.json_manifest ~dev: true ~forest)
84
83
85
84
let default_config_str =
86
85
{|[forest]
···
377
376
378
377
let server ~env _ port config =
379
378
let config = Config_parser.parse_forest_config_file config in
380
-
let forest = State_machine.batch_run ~env ~config ~dev: true in
379
+
let forest = Driver.batch_run ~env ~config ~dev: true in
381
380
Server.run ~env ~port ~forest theme_location
382
381
383
382
let app_cmd ~env =
+1
dune-project
+1
dune-project
+1
forester.opam
+1
forester.opam
+131
-71
lib/compiler/Cache.ml
+131
-71
lib/compiler/Cache.ml
···
5
5
*)
6
6
7
7
open Forester_core
8
-
open Forester_search
9
8
module T = Types
10
9
11
-
type tree = {
12
-
timestamp: float option;
13
-
syn: Syn.t option;
14
-
article: T.content T.article;
15
-
deps: iri list;
16
-
}
10
+
(*Inspired by
11
+
https://rustc-dev-guide.rust-lang.org/queries/incremental-compilation-in-detail.html
12
+
*)
13
+
14
+
module Item = struct
15
+
type color = Red | Green | Unknown
16
+
17
+
type meta = {
18
+
timestamp: float option;
19
+
color: color;
20
+
}
21
+
22
+
type t = (* Key *)
23
+
| Tree of iri
24
+
| Path of Trie.path
25
+
| Asset of string
26
+
27
+
(* TODO: Hand-roll these for performance? *)
28
+
let compare = compare
29
+
let hash = Hashtbl.hash
30
+
let equal = (=)
31
+
32
+
let check_timestamp
33
+
= fun path timestamp ->
34
+
match timestamp with
35
+
| Some timestamp ->
36
+
let last_modified = Eio.Path.(stat ~follow: true @@ path).mtime in
37
+
if last_modified > timestamp then
38
+
Red
39
+
else Green
40
+
| _ -> Red
41
+
end
42
+
43
+
(* The core datastructure here is a {graph; hashtbl}
44
+
We shadow many functions from both datastructures.
45
+
*)
46
+
47
+
module Dependency_tbl = Hashtbl.Make(Item)
17
48
18
-
type forest = tree Iri_tbl.t
49
+
module Dependecy_graph : sig
50
+
type t
51
+
type vertex = Item.t
52
+
val add_vertex : t -> vertex -> t
19
53
20
-
let serialize_graphs
21
-
: (module Forest_graphs.S) -> 'a
22
-
= fun s ->
23
-
let module Graphs = (val s) in
24
-
Graphs.dl_db
54
+
val create : ?size: int -> unit -> t
55
+
val pred : t -> vertex -> vertex list
56
+
val empty : unit -> t
57
+
end
58
+
= struct
59
+
module G = Graph.Imperative.Digraph.ConcreteBidirectional(Item)
60
+
type t = G.t
61
+
type vertex = Item.t
62
+
let create = G.create
63
+
let pred = G.pred
64
+
let add_vertex g v = G.add_vertex g v; g
65
+
let empty = G.create ?size: None
66
+
end
25
67
26
68
type t = {
27
-
search_index: Index.t;
28
-
forest: forest;
29
-
dl_db: Datalog_engine.db;
69
+
tbl: Item.meta Dependency_tbl.t;
70
+
graph: Dependecy_graph.t;
71
+
db: Datalog_engine.db;
30
72
}
31
73
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;}
74
+
let empty = {
75
+
tbl = Dependency_tbl.create 1000;
76
+
graph = Dependecy_graph.create ();
77
+
db = Datalog_engine.db_create ();
78
+
}
79
+
80
+
let find_opt t iri = Dependency_tbl.find_opt t.tbl iri
81
+
82
+
let add_vertex t v color =
83
+
ignore @@ Dependecy_graph.add_vertex t.graph v;
84
+
Dependency_tbl.add t.tbl v color
85
+
86
+
let pred t v = Dependecy_graph.pred t.graph v
87
+
88
+
let get_changed_paths
89
+
: host: string ->
90
+
t ->
91
+
Eio.Fs.dir_ty Eio.Path.t List.t ->
92
+
Eio.Fs.dir_ty Eio.Path.t Seq.t
93
+
= fun ~host cache dirs ->
94
+
Dir_scanner.scan_directories dirs
95
+
|> Seq.filter_map
96
+
(fun path ->
97
+
let path_str = Eio.Path.native_exn path in
98
+
let iri = Iri_scheme.path_to_iri ~host path_str in
99
+
let last_modified = Eio.Path.(stat ~follow: true path).mtime in
100
+
(* "flipped" bind, by default returns the current path. IDK, I am being lazy. *)
101
+
let (let*) o f = match o with None -> Some path | Some v -> f v in
102
+
let* {timestamp; _} = Dependency_tbl.find_opt cache.tbl (Tree iri) in
103
+
let* last_seen = timestamp in
104
+
if last_modified > last_seen then
105
+
Some path
106
+
else
107
+
None
108
+
)
70
109
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
-
()
110
+
let rec try_mark_green t node =
111
+
let exception Done of bool in
112
+
let dependencies =
113
+
List.filter_map
114
+
(fun v ->
115
+
match Dependency_tbl.find_opt t.tbl v with
116
+
| None -> None
117
+
| Some c ->
118
+
Some (v, c)
86
119
)
87
-
forest;
88
-
{init with search_index; graphs; resources = init.resources}
120
+
(pred t node)
121
+
in
122
+
let result =
123
+
try
124
+
List.fold_right
125
+
(fun (dep, Item.{color; _}) acc ->
126
+
match color with
127
+
| Red -> raise (Done false)
128
+
| Green -> true && acc
129
+
| Unknown ->
130
+
if try_mark_green t dep then true && acc
131
+
else raise (Done false)
132
+
)
133
+
dependencies
134
+
true
135
+
with
136
+
| Done b -> b
137
+
in
138
+
if result then
139
+
Dependency_tbl.replace
140
+
t.tbl
141
+
node
142
+
{
143
+
color = Green;
144
+
timestamp = Some (Unix.time ())
145
+
}
146
+
else
147
+
assert false;
148
+
result
89
149
90
150
let marshal filename (v : t) =
91
151
let oc = open_out_bin filename in
+45
-20
lib/compiler/Diagnostic_store.ml
+45
-20
lib/compiler/Diagnostic_store.ml
···
7
7
8
8
open Forester_core
9
9
10
-
type diagnostics = Reporter.Message.t Asai.Diagnostic.t list
11
10
module Table = Hashtbl.Make(Lsp.Uri)
12
11
include Table
13
12
14
-
type t = diagnostics Table.t
13
+
type t = Reporter.diagnostic list Table.t
15
14
16
15
let replace
17
-
: 'a Table.t -> key -> 'a -> unit
18
-
= fun table uri a ->
19
-
assert (not @@ Filename.is_relative (Lsp.Uri.to_path uri));
20
-
Table.replace table uri a
16
+
: 'a list Table.t -> 'a list -> unit
17
+
= fun table fresh_diagnostics ->
18
+
let diags = Hashtbl.create 100 in
19
+
fresh_diagnostics
20
+
|> List.iter
21
+
(fun d ->
22
+
match Reporter.guess_uri d with
23
+
| None ->
24
+
Reporter.fatalf Internal_error "Dropped a diagnostic because its URI could not be guessed"
25
+
| Some uri ->
26
+
Hashtbl.replace diags uri [d]
27
+
);
28
+
diags
29
+
|> Hashtbl.to_seq
30
+
|> Seq.iter
31
+
(fun (uri, ds) ->
32
+
assert (not @@ Filename.is_relative (Lsp.Uri.to_path uri));
33
+
Table.replace table uri ds
34
+
)
21
35
22
36
let add
23
-
: 'a Table.t -> key -> 'a -> unit
24
-
= fun table uri a ->
25
-
assert (not @@ Filename.is_relative (Lsp.Uri.to_path uri));
26
-
Table.add table uri a
27
-
28
-
let append
29
-
: t -> key -> diagnostics -> unit
30
-
= fun table uri diagnostics ->
31
-
assert (not @@ Filename.is_relative (Lsp.Uri.to_path uri));
32
-
match find_opt table uri with
33
-
| None ->
34
-
add table uri diagnostics
35
-
| Some previous ->
36
-
replace table uri (previous @ diagnostics)
37
+
: 'a list Table.t -> 'a list -> unit
38
+
= fun table fresh_diagnostics ->
39
+
let diagnostics = Hashtbl.create 100 in
40
+
fresh_diagnostics
41
+
|> List.iter
42
+
(fun d ->
43
+
match Reporter.guess_uri d with
44
+
| None ->
45
+
Reporter.fatalf Internal_error "Dropped a diagnostic because its URI could not be guessed"
46
+
| Some uri ->
47
+
match Hashtbl.find_opt diagnostics uri with
48
+
| None -> Hashtbl.replace diagnostics uri [d]
49
+
| Some t -> Hashtbl.replace diagnostics uri (d :: t)
50
+
);
51
+
diagnostics
52
+
|> Hashtbl.to_seq
53
+
|> Seq.iter
54
+
(fun (uri, ds) ->
55
+
assert (not @@ Filename.is_relative (Lsp.Uri.to_path uri));
56
+
match Table.find_opt table uri with
57
+
| None ->
58
+
Table.replace table uri ds
59
+
| Some previous ->
60
+
Table.replace table uri (ds @ previous)
61
+
)
+268
lib/compiler/Driver.ml
+268
lib/compiler/Driver.ml
···
1
+
(*
2
+
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
+
*
4
+
* SPDX-License-Identifier: GPL-3.0-or-later
5
+
*)
6
+
7
+
(* TODO:
8
+
- Come up with error hadling/merging strategy
9
+
*)
10
+
11
+
open Forester_core
12
+
open Forester_prelude
13
+
14
+
type target = HTML | JSON | XML | STRING
15
+
16
+
module T = Types
17
+
18
+
type state = State.t
19
+
20
+
module Action = struct
21
+
type exit =
22
+
Fail | Finished
23
+
[@@deriving show]
24
+
25
+
type t =
26
+
| Quit of exit
27
+
| Build_import_graph
28
+
| Build_dependency_graph of iri
29
+
| Plant_assets
30
+
| Plant_foreign
31
+
| Done
32
+
| Load_all_configured_dirs
33
+
| Parse_all
34
+
| Expand_all
35
+
| Eval_all
36
+
| Expand_only of iri
37
+
| Eval_only of iri
38
+
| Parse of iri
39
+
| Query of (string, Vertex.t) Datalog_expr.query
40
+
| Cache_results of (Vertex_set.t [@opaque])
41
+
| Run_jobs of Job.job Range.located list
42
+
[@@deriving show]
43
+
end
44
+
45
+
module Trace = Algaeff.Sequencer.Make(Action)
46
+
47
+
let update
48
+
: Action.t -> State.t -> Action.t * State.t
49
+
= fun action forest ->
50
+
let open Action in
51
+
match action with
52
+
| Quit e ->
53
+
begin
54
+
(* TODO: Graciously exit, i.e. persist cache *)
55
+
match e with
56
+
| Fail -> exit 1
57
+
| Finished -> exit 0
58
+
end
59
+
| Query q ->
60
+
let@ () = Reporter.trace "when running query" in
61
+
let r = Forest.run_datalog_query forest.graphs q in
62
+
Cache_results r, forest
63
+
| Load_all_configured_dirs ->
64
+
let@ () = Reporter.trace "when loading files from disk" in
65
+
let tree_dirs = Eio_util.paths_of_dirs ~env: forest.env forest.config.trees in
66
+
List.iter (fun path -> assert (Eio.Path.is_directory path)) tree_dirs;
67
+
let docs = Phases.load tree_dirs in
68
+
docs
69
+
|> Seq.iter (fun doc ->
70
+
let uri = Lsp.Text_document.documentUri doc in
71
+
let path = Lsp.Uri.to_path uri in
72
+
let iri = Iri_scheme.uri_to_iri ~host: forest.config.host uri in
73
+
Iri_tbl.replace forest.resolver iri path;
74
+
Hashtbl.replace forest.documents uri doc
75
+
);
76
+
Logs.debug (fun m -> m "loaded %d trees" (Seq.length docs));
77
+
(* Logs.debug (fun m -> m "%d documents" (Hashtbl.length forest.documents)); *)
78
+
Parse_all, forest
79
+
| Parse_all ->
80
+
let@ () = Reporter.trace "when parsing trees" in
81
+
let errors, trees =
82
+
Phases.parse forest
83
+
|> Seq.partition_map (fun res ->
84
+
match res with
85
+
| Ok tree -> Right tree
86
+
| Error err -> Left err
87
+
)
88
+
in
89
+
Logs.debug (fun m -> m "parsed %d trees" (Seq.length trees));
90
+
assert (Seq.length trees <= Hashtbl.length forest.documents);
91
+
assert (Seq.length trees <= Iri_tbl.length forest.resolver);
92
+
Seq.iter
93
+
(fun _ ->
94
+
(*TODO: *)
95
+
()
96
+
)
97
+
errors;
98
+
Seq.iter
99
+
(fun tree ->
100
+
(* Every tree that comes from the filesystem has an IRI *)
101
+
let iri = Option.get Code.(tree.iri) in
102
+
Iri_tbl.add
103
+
forest.parsed
104
+
iri
105
+
tree
106
+
)
107
+
trees;
108
+
Build_import_graph, forest
109
+
| Build_import_graph ->
110
+
let@ () = Reporter.trace "when building import graph" in
111
+
let import_graph, diagnostics = Phases.build_import_graph forest in
112
+
assert (Forest_graph.nb_vertex import_graph >= Iri_tbl.length forest.parsed);
113
+
(* Logs.debug (fun m -> m "%d vertices@." (Forest_graph.nb_vertex import_graph)); *)
114
+
Forest_graph.iter_vertex (fun v -> Logs.debug (fun m -> m "vertex %a" T.(pp_vertex pp_content) v)) import_graph;
115
+
Diagnostic_store.iter (fun _ d -> Diagnostic_store.add forest.diagnostics d) diagnostics;
116
+
Expand_all, {forest with import_graph}
117
+
| Build_dependency_graph iri ->
118
+
let@ () = Reporter.tracef "when building dependency graph for %a" pp_iri iri in
119
+
let import_graph = Phases.build_import_graph_for ~iri forest in
120
+
Expand_only iri, {forest with import_graph}
121
+
| Expand_all ->
122
+
let@ () = Reporter.tracef "when expanding trees" in
123
+
let units, expanded_trees = Phases.expand forest in
124
+
Logs.debug (fun m -> m "Expand: got %d trees" (List.length expanded_trees));
125
+
assert (List.length expanded_trees >= Iri_tbl.length forest.parsed);
126
+
begin
127
+
let@ (diagnostics, source_path, (syn : Syn.tree)) = List.iter @~ expanded_trees in
128
+
let@ iri = Option.iter @~ syn.iri in
129
+
Forest.replace forest.expanded iri syn.syn;
130
+
match source_path with
131
+
| None ->
132
+
Logs.warn (fun m -> m "tree at %a has no source path." pp_iri iri);
133
+
(* There is an implicit assumption here that diagnostics are only
134
+
emitted for trees that have a source path. I should think about
135
+
this.*)
136
+
if forest.dev then assert false
137
+
| Some path ->
138
+
assert (not (Filename.is_relative path));
139
+
match diagnostics with
140
+
| [] -> ()
141
+
| diagnostics ->
142
+
(* If we obtained some diagnostics from expanding, we have
143
+
succesfully parsed the tree and can thus overwrite the parsing
144
+
diagnostics *)
145
+
Diagnostic_store.replace forest.diagnostics diagnostics
146
+
end;
147
+
let patched_units =
148
+
let open Expand in
149
+
Unit_map.fold
150
+
(fun iri exports acc ->
151
+
match Unit_map.find_opt iri units with
152
+
| None ->
153
+
Unit_map.add iri exports acc
154
+
| Some _ ->
155
+
Unit_map.add iri exports acc
156
+
)
157
+
units
158
+
units
159
+
in
160
+
Eval_all, {forest with units = patched_units}
161
+
| Expand_only iri ->
162
+
let@ () = Reporter.tracef "when expanding %a" pp_iri iri in
163
+
let result, _err = Phases.expand_only iri forest in
164
+
Eval_only iri, result
165
+
| Eval_all ->
166
+
let@ () = Reporter.tracef "when evaluating" in
167
+
let trees, _errors = Phases.eval forest in
168
+
Logs.debug (fun m -> m "Eval: got %d trees" (Seq.length trees));
169
+
let jobs =
170
+
trees
171
+
|> List.of_seq
172
+
|> List.concat_map
173
+
(fun Eval.{articles; jobs} ->
174
+
begin
175
+
let@ article = List.iter @~ articles in
176
+
Forest.plant_resource (T.Article article) forest.graphs forest.resources
177
+
end;
178
+
jobs
179
+
)
180
+
in
181
+
Run_jobs jobs, forest
182
+
| Eval_only iri ->
183
+
let@ () = Reporter.tracef "when evaluating %a" pp_iri iri in
184
+
let result, _err = Phases.eval_only iri forest in
185
+
Done, result
186
+
| Plant_assets ->
187
+
let@ () = Reporter.tracef "when planting assets" in
188
+
let paths =
189
+
Dir_scanner.scan_asset_directories
190
+
(Eio_util.paths_of_dirs ~env: forest.env forest.config.assets)
191
+
in
192
+
Logs.debug (fun m -> m "planting %i assets" (Seq.length paths));
193
+
let module EP = Eio.Path in
194
+
begin
195
+
let@ path = Eio.Fiber.List.iter ~max_fibers: 20 @~ List.of_seq paths in
196
+
let content = EP.load path in
197
+
let source_path = EP.native_exn path in
198
+
let iri = Asset_router.install ~host: forest.config.host ~source_path ~content in
199
+
Logs.debug (fun m -> m "Installed %s at %a" source_path pp_iri iri);
200
+
Forest.plant_resource (T.Asset {iri; host = forest.config.host; content}) forest.graphs forest.resources;
201
+
end;
202
+
Done, forest
203
+
| Plant_foreign ->
204
+
let@ () = Reporter.tracef "when planting foreign forest" in
205
+
let result, err = Phases.implant_foreign forest in
206
+
let _ = Option.map Reporter.Tty.display err in
207
+
Done, result
208
+
| Run_jobs jobs ->
209
+
Phases.run_jobs forest jobs;
210
+
Done, forest
211
+
| Parse _
212
+
| Cache_results _
213
+
| Done ->
214
+
Done, forest
215
+
216
+
let run_action a s : state =
217
+
let rec go action state =
218
+
match update action state with
219
+
| new_action, new_state ->
220
+
if action = Done then new_state
221
+
else
222
+
begin
223
+
let fatal d = Reporter.Tty.display d; new_state in
224
+
let@ () = Reporter.try_with ~emit: Reporter.Tty.display ~fatal in
225
+
go new_action new_state
226
+
end
227
+
in
228
+
go a s
229
+
230
+
let run_with_history a s =
231
+
let history = ref [] in
232
+
let rec go action state =
233
+
history := action :: !history;
234
+
match update action state with
235
+
| new_action, new_state ->
236
+
if action = Done then new_state
237
+
else
238
+
begin
239
+
let fatal d = Reporter.Tty.display d; new_state in
240
+
let@ () = Reporter.try_with ~emit: Reporter.Tty.display ~fatal in
241
+
go new_action new_state
242
+
end
243
+
in
244
+
let forest = go a s in
245
+
forest, List.rev !history
246
+
247
+
let rec force
248
+
: Action.t list -> state -> unit
249
+
= fun msgs state ->
250
+
match msgs with
251
+
| [] -> ()
252
+
| msg :: remaining ->
253
+
let _discard, new_state = update msg state in
254
+
force remaining new_state
255
+
256
+
let implant_foreign = run_action Plant_foreign
257
+
258
+
let plant_assets = run_action Plant_assets
259
+
260
+
let batch_run ~env ~(config : Config.t) ~dev =
261
+
State.make ~env ~config ~dev ()
262
+
|> plant_assets
263
+
|> implant_foreign
264
+
|> run_action Load_all_configured_dirs
265
+
266
+
let language_server
267
+
: state -> unit
268
+
= fun _ -> ()
+7
-1
lib/compiler/Eio_util.ml
+7
-1
lib/compiler/Eio_util.ml
···
14
14
assert (Path.is_directory path);
15
15
path
16
16
with
17
-
| Unix.Unix_error (e, _, m) -> Reporter.fatalf Configuration_error "%s: %s" (Unix.error_message e) m
17
+
| Unix.Unix_error (e, _, m) ->
18
+
Reporter.fatalf
19
+
Configuration_error
20
+
"%s: %s"
21
+
(Unix.error_message e)
22
+
m
23
+
| Assert_failure (_, _, _) -> Reporter.fatalf Configuration_error "%s is not a directory" dir
18
24
19
25
let path_of_file ~env file =
20
26
try
+27
-27
lib/compiler/Eval.ml
+27
-27
lib/compiler/Eval.ml
···
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.t) : Reporter.Message.t Asai.Diagnostic.t list * result =
751
-
let diagnostics = ref [] in
752
-
let push d = diagnostics := d :: !diagnostics in
750
+
let recover_tree _d = empty_result
751
+
752
+
let eval_tree
753
+
~(host : string)
754
+
~(iri : iri)
755
+
~(source_path : string option)
756
+
(tree : Syn.t)
757
+
: result * (Lsp.Uri.t, Reporter.diagnostic list) Hashtbl.t
758
+
=
759
+
let diagnostics = ref (Hashtbl.create 0) in
753
760
let res =
754
-
let fatal d =
755
-
push d;
756
-
if quit_on_failure then
757
-
begin
758
-
Reporter.Tty.display d ~debug: true;
759
-
exit 1
760
-
end
761
-
else
762
-
empty_result
763
-
in
764
-
Reporter.run ~emit: push ~fatal @@ fun () ->
765
-
let fm = T.default_frontmatter ~iri ?source_path () in
766
-
let@ () = Frontmatter.run ~init: fm in
767
-
let@ () = Emitted_trees.run ~init: [] in
768
-
let@ () = Jobs.run ~init: [] in
769
-
let@ () = Heap.run ~init: Env.empty in
770
-
let@ () = Lex_env.run ~env: Env.empty in
771
-
let@ () = Dyn_env.run ~env: Env.empty in
772
-
let@ () = Host_env.run ~env: host in
773
-
let main = eval_tree_inner ~iri tree in
774
-
let side = Emitted_trees.get () in
775
-
let jobs = Jobs.get () in
776
-
{articles = main :: side; jobs}
761
+
Reporter.lsp_run
762
+
~recover: recover_tree
763
+
(fun ds -> diagnostics := ds;)
764
+
@@ fun () ->
765
+
let fm = T.default_frontmatter ~iri ?source_path () in
766
+
let@ () = Frontmatter.run ~init: fm in
767
+
let@ () = Emitted_trees.run ~init: [] in
768
+
let@ () = Jobs.run ~init: [] in
769
+
let@ () = Heap.run ~init: Env.empty in
770
+
let@ () = Lex_env.run ~env: Env.empty in
771
+
let@ () = Dyn_env.run ~env: Env.empty in
772
+
let@ () = Host_env.run ~env: host in
773
+
let main = eval_tree_inner ~iri tree in
774
+
let side = Emitted_trees.get () in
775
+
let jobs = Jobs.get () in
776
+
{articles = main :: side; jobs}
777
777
in
778
-
!diagnostics, res
778
+
res, !diagnostics
+4
-6
lib/compiler/Eval.mli
+4
-6
lib/compiler/Eval.mli
···
14
14
[@@deriving show]
15
15
16
16
val eval_tree :
17
-
?quit_on_failure: bool ->
18
-
host: string ->
19
-
iri: iri ->
20
-
source_path: string option ->
21
-
Syn.t ->
22
-
Reporter.diagnostic list * result
17
+
host:string ->
18
+
iri:iri ->
19
+
source_path:string option ->
20
+
Syn.t -> result * (Lsp.Uri.t, Reporter.diagnostic list) Hashtbl.t
+4
-11
lib/compiler/Expand.ml
+4
-11
lib/compiler/Expand.ml
···
438
438
]
439
439
440
440
let expand_tree
441
-
: ?quit_on_error: bool ->
442
-
host: string ->
441
+
: host: string ->
443
442
Env.t ->
444
443
Code.tree ->
445
444
Reporter.diagnostic list
446
445
* exports Unit_map.t
447
446
* Syn.tree
448
447
= fun
449
-
?(quit_on_error = true)
450
448
~host
451
449
units
452
450
tree
···
458
456
~emit: push
459
457
~fatal: (fun d ->
460
458
push d;
461
-
if quit_on_error then
462
-
begin
463
-
Reporter.Tty.display d;
464
-
exit 1
465
-
end
466
-
else
467
-
Unit_map.empty,
468
-
Syn.{syn = []; iri = tree.iri}
459
+
(*Return `units` here?*)
460
+
Unit_map.empty,
461
+
Syn.{syn = []; iri = tree.iri}
469
462
)
470
463
@@ fun () ->
471
464
let@ () = U.run ~init: units in
-1
lib/compiler/Expand.mli
-1
lib/compiler/Expand.mli
+1
lib/compiler/Forest.ml
+1
lib/compiler/Forest.ml
···
36
36
(* let () = execute_datalog_script Builtin_relation.axioms *)
37
37
38
38
let run_datalog_query (graphs : env) (q : (string, Vertex.t) Dx.query) : Vertex_set.t =
39
+
let@ () = Reporter.trace "when running query" in
39
40
let () = execute_datalog_script graphs Builtin_relation.axioms in
40
41
let module Graphs = (val graphs) in
41
42
Datalog_eval.run_query Graphs.dl_db q
+3
lib/compiler/Forester_compiler.ml
+3
lib/compiler/Forester_compiler.ml
···
57
57
58
58
module State = State
59
59
module Phases = Phases
60
+
module Driver = Driver
60
61
module Asset_router = Asset_router
61
62
62
63
module Iri_util = Iri_util
···
67
68
68
69
(** {2 LaTeX pipeline}*)
69
70
71
+
module Build_latex = Build_latex
70
72
module LaTeX_pipeline = LaTeX_pipeline
71
73
module LaTeX_template = LaTeX_template
72
74
module Job = Job
···
76
78
module Eio_util = Eio_util
77
79
module Export_for_test = Export_for_test
78
80
module Cache = Cache
81
+
module Dir_scanner = Dir_scanner
79
82
(**/**)
+31
-9
lib/compiler/Imports.ml
+31
-9
lib/compiler/Imports.ml
···
7
7
open Forester_core
8
8
open Forester_prelude
9
9
10
+
(* Think hard about the usage of imperative graphs here. *)
11
+
10
12
module T = Types
11
13
12
14
type analysis_env = {
13
-
graph: Forest_graph.t;
14
15
follow: bool;
15
16
forest: State.t;
16
17
}
···
49
50
in
50
51
analyse_code roots code;
51
52
let@ iri = Option.iter @~ iri_opt in
52
-
Forest_graph.add_vertex env.graph (T.Iri_vertex iri)
53
+
Forest_graph.add_vertex env.forest.import_graph (T.Iri_vertex iri)
53
54
54
55
and analyse_code roots (code : Code.t) =
55
56
List.iter (analyse_node roots) code
···
63
64
let dependency = T.Iri_vertex dep_iri in
64
65
let@ iri = List.iter @~ roots in
65
66
let target = T.Iri_vertex iri in
66
-
Forest_graph.add_edge env.graph dependency target;
67
+
Forest_graph.add_edge_exn env.forest.import_graph dependency target;
67
68
begin
68
69
if env.follow then
69
70
match resolve_iri_to_code dep_iri env.forest with
···
95
96
| Text _ | Hash_ident _ | Xml_ident (_, _) | Verbatim _ | Ident _ | Open _ | Put (_, _) | Default (_, _) | Get _ | Decl_xmlns (_, _) | Call (_, _) | Alloc _ | Dx_var _ | Dx_const_content _ | Dx_const_iri _ | Comment _ | Error _ -> ()
96
97
97
98
let dependencies tree forest =
98
-
let graph = Forest_graph.create () in
99
-
let env = {graph; forest; follow = true} in
99
+
let env = {forest; follow = true} in
100
100
let@ () = Analysis_env.run ~env in
101
101
analyse_tree [] tree;
102
-
env.graph
102
+
env.forest.import_graph
103
+
104
+
let fixup (tree : Code.tree) (forest : State.t) =
105
+
let graph = forest.import_graph in
106
+
let this_iri = Option.get tree.iri in
107
+
let this_vertex = T.Iri_vertex this_iri in
108
+
let old_deps = Vertex_set.of_list @@ Forest_graph.immediate_dependencies graph this_vertex in
109
+
let new_deps =
110
+
let env = {
111
+
forest;
112
+
follow = false;
113
+
}
114
+
in
115
+
let@ () = Analysis_env.run ~env in
116
+
begin
117
+
analyse_tree [] tree;
118
+
Vertex_set.of_list @@ Forest_graph.immediate_dependencies env.forest.import_graph this_vertex
119
+
end;
120
+
in
121
+
let unchanged_deps = Vertex_set.inter new_deps old_deps in
122
+
let added_deps = Vertex_set.diff new_deps unchanged_deps in
123
+
let removed_deps = Vertex_set.diff old_deps unchanged_deps in
124
+
Vertex_set.iter (fun v -> Forest_graph.remove_edge graph v this_vertex) removed_deps;
125
+
Vertex_set.iter (fun v -> Forest_graph.add_edge graph v this_vertex) added_deps
103
126
104
127
let _minimal_dependency_graph
105
128
: addr: iri -> Forest_graph.t
···
135
158
|> Forest.to_seq_values
136
159
|> Seq.iter (analyse_tree [])
137
160
end;
138
-
env.graph
161
+
env.forest.import_graph
139
162
140
163
let build forest =
141
-
let graph = Forest_graph.create () in
142
-
let env = {graph; forest; follow = false} in
164
+
let env = {forest; follow = false} in
143
165
run_builder env
+1
-1
lib/compiler/Imports.mli
+1
-1
lib/compiler/Imports.mli
···
7
7
open Forester_core
8
8
9
9
type analysis_env = {
10
-
graph: Forest_graph.t;
11
10
follow: bool;
12
11
forest: State.t
13
12
}
···
16
15
val run_builder : ?root: iri -> analysis_env -> Forest_graph.t
17
16
val dependencies : Code.tree -> State.t -> Forest_graph.t
18
17
val resolve_iri_to_code : iri -> State.t -> Code.tree option
18
+
val fixup : Code.tree -> State.t -> unit
+176
-266
lib/compiler/Phases.ml
+176
-266
lib/compiler/Phases.ml
···
10
10
11
11
module T = Types
12
12
13
-
type state = State.t
13
+
type diagnostic = Reporter.Message.t Asai.Diagnostic.t
14
14
15
-
type transition = state -> state
15
+
(* I am currently implementing incremental compilation.
16
16
17
-
let init ~(env : Eio_unix.Stdenv.base) ~(config : Config.t) ~(dev : bool) : state =
18
-
Logs.debug (fun m -> m "Initializing with config %a" Config.pp config);
19
-
let graphs = (module Forest_graphs.Make (): Forest_graphs.S) in
20
-
let import_graph = Forest_graph.create ~size: 1000 () in
21
-
let parsed = Forest.create 1000 in
22
-
let documents = Hashtbl.create 1000 in
23
-
let resolver = Iri_tbl.create 1000 in
24
-
let expanded = Forest.create 1000 in
25
-
let resources = Forest.create 1000 in
26
-
let diagnostics = Diagnostic_store.create 100 in
27
-
let units = Expand.Env.empty in
28
-
let search_index = Forester_search.Index.create [] in
29
-
{
30
-
env;
31
-
dev;
32
-
config;
33
-
units;
34
-
documents;
35
-
diagnostics;
36
-
parsed;
37
-
expanded;
38
-
resources;
39
-
resolver;
40
-
import_graph;
41
-
graphs;
42
-
search_index;
43
-
}
17
+
TODO:
44
18
45
-
let load
46
-
: Eio.Fs.dir_ty Eio.Path.t list -> transition
47
-
= fun tree_dirs forest ->
48
-
Logs.debug (fun m -> m "loading trees from file system");
49
-
let paths = Dir_scanner.scan_directories tree_dirs in
50
-
paths
51
-
|> Seq.iter
52
-
begin
53
-
fun path ->
54
-
let content = Eio.Path.load path in
55
-
let path_str = Eio.Path.native_exn path in
56
-
assert (not @@ Filename.is_relative path_str);
57
-
let uri = Lsp.Uri.of_path path_str in
58
-
let iri = Iri_scheme.uri_to_iri ~host: forest.config.host uri in
59
-
let tree =
60
-
Lsp.Text_document.make
61
-
~position_encoding: `UTF8
62
-
{
63
-
textDocument = {
64
-
languageId = "forester";
65
-
text = content;
66
-
uri;
67
-
version = 1
68
-
}
69
-
}
70
-
in
71
-
Iri_tbl.add forest.resolver iri path_str;
72
-
Hashtbl.replace forest.documents uri tree
73
-
end;
74
-
let loaded = forest.documents |> Hashtbl.length in
75
-
Logs.debug (fun m -> m "loaded %i trees" loaded);
76
-
forest
19
+
- functions should leverage the cache by looking up relevant stuff in forest
20
+
21
+
*)
22
+
23
+
let load_tree path =
24
+
let content = Eio.Path.load path in
25
+
let path_str = Eio.Path.native_exn path in
26
+
assert (not @@ Filename.is_relative path_str);
27
+
let uri = Lsp.Uri.of_path path_str in
28
+
Lsp.Text_document.make
29
+
~position_encoding: `UTF8
30
+
{
31
+
textDocument = {
32
+
languageId = "forester";
33
+
text = content;
34
+
uri;
35
+
version = 1
36
+
}
37
+
}
77
38
78
-
let load_configured_dirs
79
-
: transition
80
-
= fun forest ->
81
-
let@ () = Reporter.tracef "when loading trees from disk" in
82
-
let tree_dirs = Eio_util.paths_of_dirs ~env: forest.env forest.config.trees in
83
-
load tree_dirs forest
39
+
let load (tree_dirs : Eio.Fs.dir_ty Eio.Path.t list) =
40
+
Logs.debug (fun m -> m "loading trees from %i directories" (List.length tree_dirs));
41
+
Dir_scanner.scan_directories tree_dirs
42
+
|> Seq.map load_tree
84
43
85
-
let parse
86
-
: quit_on_error: bool -> transition
87
-
= fun ~quit_on_error forest ->
44
+
let parse (forest : State.t) =
88
45
let host = forest.config.host in
89
-
begin
90
-
forest.documents
91
-
|> Hashtbl.iter @@ fun uri doc ->
92
-
let iri = Iri_scheme.uri_to_iri ~host uri in
93
-
let source_path = Lsp.Uri.to_path uri in
94
-
let parse_result =
95
-
let@ () = Reporter.tracef "when parsing %a (%s)" pp_iri iri source_path in
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
101
-
Code.{
102
-
code;
103
-
iri = Some iri;
104
-
timestamp = Some timestamp;
105
-
source_path = Some source_path;
106
-
}
107
-
in
108
-
begin
109
-
match parse_result with
110
-
| Error diagnostic ->
111
-
if quit_on_error then
112
-
begin
113
-
Reporter.Tty.display diagnostic;
114
-
exit 1;
115
-
end
116
-
else
117
-
Diagnostic_store.replace forest.diagnostics uri [diagnostic];
118
-
| Ok tree -> Forest.add forest.parsed iri tree
119
-
end;
120
-
end;
121
-
let parsed = forest.parsed |> Forest.length in
122
-
if not quit_on_error then
123
-
(* If quit_on_error is true and we have encountered an error, we have
124
-
already exited at this point. This means there should be exactly as
125
-
many parsed trees as loaded documents*)
126
-
assert (parsed = Hashtbl.length forest.documents);
127
-
Logs.debug (fun m -> m "parsed %i trees" parsed);
128
-
forest
46
+
let now = Unix.time () in
47
+
forest.documents
48
+
|> Hashtbl.to_seq
49
+
|> Seq.map @@ fun (uri, doc) ->
50
+
let iri = Iri_scheme.uri_to_iri ~host uri in
51
+
let source_path = Lsp.Uri.to_path uri in
52
+
let@ () = Reporter.tracef "when parsing %a (%s)" pp_iri iri source_path in
53
+
let@ code = Result.map @~ Parse.parse_document doc in
54
+
Code.{
55
+
code;
56
+
iri = Some iri;
57
+
timestamp = Some now;
58
+
source_path = Some source_path;
59
+
}
129
60
130
-
(* FIXME: Amend import graph *)
131
-
let reparse (doc : Lsp.Text_document.t) : transition = fun forest ->
61
+
(* Fix signature. Should not mutate the forest*)
62
+
let reparse (doc : Lsp.Text_document.t) : State.t -> State.t * diagnostic option = fun forest ->
132
63
Logs.debug (fun m -> m "reparsing");
133
64
let host = forest.config.host in
134
65
let uri = Lsp.Text_document.documentUri doc in
135
66
let path = Lsp.Uri.to_path uri in
136
-
let timestamp = Eio.Path.(stat ~follow: true @@ forest.env#fs / path).mtime in
67
+
let timestamp =
68
+
try
69
+
Some Eio.Path.(stat ~follow: true @@ forest.env#fs / path).mtime
70
+
with
71
+
| _ ->
72
+
None
73
+
in
137
74
match Parse.parse_document doc with
138
75
| Ok code ->
139
76
let tree =
···
141
78
code;
142
79
iri = Option.some @@ Iri_scheme.uri_to_iri ~host uri;
143
80
source_path = Some path;
144
-
timestamp = Some timestamp;
81
+
timestamp;
145
82
}
146
83
in
147
-
Forest.add forest.parsed (Iri_scheme.uri_to_iri ~host uri) tree;
148
-
Eio.traceln "No parse errors. Clearing previous diagnostics";
84
+
Forest.replace forest.parsed (Iri_scheme.uri_to_iri ~host uri) tree;
85
+
Imports.fixup tree forest;
149
86
Diagnostic_store.remove forest.diagnostics uri;
150
-
forest
87
+
forest, None
151
88
| Error d ->
152
89
(* When we get a parsing diagnostic, we don't need to merge the value
153
90
with the diagnostics from previous passes*)
154
-
Diagnostic_store.replace forest.diagnostics uri [d];
155
-
forest
91
+
Diagnostic_store.replace forest.diagnostics [d];
92
+
forest, None
156
93
157
-
let build_import_graph (forest : state) : state =
158
-
(* I chose not to mention the graph in the trace message since I feel like
159
-
it unnecessarily exposes implementation details.*)
94
+
let build_import_graph (forest : State.t) =
95
+
(* Now that I am adding caching, is this function still correct?*)
160
96
let@ () = Reporter.trace "when resolving imports" in
161
-
{forest with import_graph = Imports.build forest}
97
+
let diagnostics = Diagnostic_store.create 100 in
98
+
let push d = Diagnostic_store.add diagnostics [d] in
99
+
Reporter.run
100
+
~emit: push
101
+
~fatal: (
102
+
(* No fatal diagnostics should arise. *)
103
+
assert false
104
+
)
105
+
@@ fun () ->
106
+
Imports.build forest, diagnostics
162
107
163
-
let build_import_graph_for ~(iri : iri) (forest : state) : state =
108
+
let build_import_graph_for ~(iri : iri) (forest : State.t) =
164
109
match Dir_scanner.find_tree (Eio_util.paths_of_dirs ~env: forest.env forest.config.trees) iri with
165
110
| None -> Reporter.fatalf Resource_not_found "Could not find tree %a in the configured directories." pp_iri iri
166
111
| Some source_path ->
···
170
115
let tree = Code.{code; iri = Some iri; source_path = Some source_path; timestamp = Some timestamp;} in
171
116
let module Graphs = (val forest.graphs) in
172
117
let import_graph = Imports.dependencies tree forest in
173
-
{forest with import_graph}
118
+
import_graph
174
119
| Error _ -> Reporter.fatalf Parse_error ""
175
120
176
-
let expand ~(quit_on_error : bool) (forest : state) : state =
121
+
let expand (forest : State.t) =
122
+
(* This should only return the units for trees that have actually changed.
123
+
Then the driver can just merge the maps without checking anything.*)
177
124
let parsed = forest.parsed in
178
125
let module Graphs = (val forest.graphs) in
179
126
let task (addr : Vertex.t) (units, trees) =
···
189
136
| Some tree ->
190
137
let diagnostics, units, syn =
191
138
Expand.expand_tree
192
-
~quit_on_error
193
139
~host: forest.config.host
194
140
units
195
141
tree
···
203
149
forest.import_graph
204
150
(Expand.Env.empty, [])
205
151
in
206
-
begin
207
-
let@ (diagnostics, source_path, (syn : Syn.tree)) = List.iter @~ expanded_trees in
208
-
let@ iri = Option.iter @~ syn.iri in
209
-
Forest.replace forest.expanded iri syn.syn;
210
-
match source_path with
211
-
| None ->
212
-
Logs.warn (fun m -> m "tree at %a has no source path." pp_iri iri);
213
-
(* There is an implicit assumption here that diagnostics are only
214
-
emitted for trees that have a source path. I should think about
215
-
this.*)
216
-
if forest.dev then assert false
217
-
| Some path ->
218
-
assert (not (Filename.is_relative path));
219
-
match diagnostics with
220
-
| [] -> ()
221
-
| diagnostics ->
222
-
let uri = Lsp.Uri.of_path path in
223
-
224
-
(* If we obtained some diagnostics from expanding, we have
225
-
succesfully parsed the tree and can thus overwrite the parsing
226
-
diagnostics *)
227
-
Diagnostic_store.replace forest.diagnostics uri diagnostics
228
-
end;
229
-
let expanded = forest.expanded |> Forest.length in
230
-
let diagnostics = forest.diagnostics |> Diagnostic_store.length in
231
-
Logs.debug (fun m -> m "expanded %i trees" expanded);
232
-
Logs.debug (fun m -> m "%i trees emitted diagnostics." diagnostics);
233
-
State.with_units units forest
152
+
units, expanded_trees
234
153
235
154
(* There is some duplicated code here. The only significant difference is the
236
155
fact that we are using a different graph builder, one that only traverses
237
156
the dependencies of a specific tree*)
238
-
let expand_only_aux ~(quit_on_error : bool) ~(addr : iri) (forest : state) : Expand.Env.t * Diagnostic_store.t * Syn.t Forest.t =
239
-
let import_graph =
240
-
Imports.run_builder
241
-
~root: addr
242
-
{
243
-
graph = Forest_graph.create ();
244
-
follow = true;
245
-
forest;
246
-
}
247
-
in
157
+
let expand_only_aux ~(addr : iri) (forest : State.t) : Expand.Env.t * Diagnostic_store.t * Syn.t Forest.t =
158
+
let import_graph = Forest_graph.dependencies forest.import_graph (T.Iri_vertex addr) in
248
159
assert (Forest_graph.nb_vertex import_graph >= Forest.length forest.parsed);
249
160
let task (addr : Vertex.t) (units, diagnostics, (trees : (Syn.t Iri_tbl.t))) =
250
161
match addr with
···
258
169
Logs.debug (fun m -> m "failed to resolve %a" pp_iri iri);
259
170
units, diagnostics, trees
260
171
| Some tree ->
261
-
let ds, units, syn = Expand.expand_tree ~quit_on_error ~host: forest.config.host units tree in
262
-
let source_path = tree.source_path in
172
+
let ds, units, syn = Expand.expand_tree ~host: forest.config.host units tree in
263
173
begin
264
174
Forest.add trees iri syn.syn;
265
-
match source_path with
266
-
| None ->
267
-
Logs.warn (fun m -> m "Could not construct URI for tree at %a. There may be missing diagnostics." pp_iri iri)
268
-
| Some path ->
269
-
let uri = Lsp.Uri.of_path path in
270
-
match ds with
271
-
| [] -> ()
272
-
| ds -> Diagnostic_store.add diagnostics uri ds
175
+
match ds with
176
+
| [] -> ()
177
+
| ds -> Diagnostic_store.add diagnostics ds
273
178
end;
274
179
units, diagnostics, trees
275
180
in
···
285
190
286
191
(* The purpose of this function is to update the exported units when a tree has
287
192
been changed when running with the lsp.*)
288
-
let expand_only (iri : iri) : transition = fun forest ->
193
+
let expand_only (iri : iri) : State.t -> State.t * diagnostic option = fun forest ->
289
194
let units, new_diagnostics, trees =
290
195
expand_only_aux
291
-
~quit_on_error: false
292
196
~addr: iri
293
197
forest
294
198
in
···
312
216
match diagnostics with
313
217
| [] -> ()
314
218
| diagnostics ->
315
-
Diagnostic_store.append forest.diagnostics uri diagnostics
219
+
Diagnostic_store.add forest.diagnostics diagnostics
316
220
end;
317
221
(*FIXME: Don't replace all units. Just update the ones that have changed!*)
318
-
{forest with units}
222
+
{forest with units}, None
319
223
320
-
let export_publication ~env ~(forest : state) (publication : Job.publication) : unit =
224
+
let export_publication ~env ~(forest : State.t) (publication : Job.publication) : unit =
321
225
let vertices = Forest.run_datalog_query forest.graphs publication.query in
322
226
let resources =
323
227
let@ vertex = List.filter_map @~ Vertex_set.elements vertices in
324
228
match vertex with
325
229
| Content_vertex _ -> None
326
230
| Iri_vertex iri ->
327
-
match Forest.find_opt forest.resources iri with
328
-
| None ->
329
-
Reporter.emitf Internal_error "Attempted to export publication but tree `%a` has not yet been planted" Iri.pp iri;
330
-
None
331
-
| Some result -> Some result
231
+
match Forest.find_opt forest.resources iri with
232
+
| None ->
233
+
Reporter.emitf Internal_error "Attempted to export publication but tree `%a` has not yet been planted" Iri.pp iri;
234
+
None
235
+
| Some result -> Some result
332
236
in
333
237
match publication.format with
334
238
| Json_blob ->
···
341
245
Eio.Path.save ~create: (`Or_truncate 0o644) path blob;
342
246
assert (Eio.Path.is_file path)
343
247
344
-
let eval_tree (forest : state) iri syn =
248
+
let run_jobs (forest : State.t) jobs =
249
+
Logs.debug (fun m -> m "Running %d jobs" (List.length jobs));
250
+
let@ Range.{value; loc} = Eio.Fiber.List.iter ~max_fibers: 20 @~ jobs in
251
+
let@ () = Reporter.easy_run in
252
+
match value with
253
+
| Job.LaTeX_to_svg {hash; source; content} ->
254
+
let svg = Build_latex.latex_to_svg ~env: forest.env ?loc source in
255
+
let iri = Iri_scheme.hash_iri ~host: forest.config.host hash in
256
+
let frontmatter = T.default_frontmatter ~iri () in
257
+
let mainmatter = content ~svg in
258
+
let backmatter = T.Content [] in
259
+
let article = T.{frontmatter; mainmatter; backmatter} in
260
+
Forest.plant_resource (T.Article article) forest.graphs forest.resources
261
+
| Job.Publish publication ->
262
+
export_publication ~env: forest.env ~forest publication
263
+
264
+
(* in *)
265
+
(* let append_diagnostics () = *)
266
+
(* let@ uri = Option.iter @~ uri in *)
267
+
(* Diagnostic_store.append forest.diagnostics uri diagnostics *)
268
+
(* in *)
269
+
(* let plant_articles () = *)
270
+
(* let@ article = List.iter @~ articles in *)
271
+
(* Forest.plant_resource (T.Article article) forest.graphs forest.resources *)
272
+
(* in *)
273
+
(* append_diagnostics (); *)
274
+
(* plant_articles (); *)
275
+
(* begin *)
276
+
(* let@ Range.{value; loc} = Eio.Fiber.List.iter ~max_fibers: 20 @~ jobs in *)
277
+
(* let@ () = Reporter.easy_run in *)
278
+
(* match value with *)
279
+
(* | Job.LaTeX_to_svg {hash; source; content} -> *)
280
+
(* let svg = Build_latex.latex_to_svg ~env ?loc source in *)
281
+
(* let iri = Iri_scheme.hash_iri ~host hash in *)
282
+
(* let frontmatter = T.default_frontmatter ~iri () in *)
283
+
(* let mainmatter = content ~svg in *)
284
+
(* let backmatter = T.Content [] in *)
285
+
(* let article = T.{frontmatter; mainmatter; backmatter} in *)
286
+
(* Forest.plant_resource (T.Article article) forest.graphs forest.resources *)
287
+
(* | Job.Publish publication -> *)
288
+
(* export_publication ~env ~forest publication *)
289
+
(* end *)
290
+
291
+
let eval (forest : State.t) =
345
292
let host = forest.config.host in
346
-
let env = forest.env in
347
-
let@ () = Reporter.tracef "when evaluating %a" pp_iri iri in
348
-
let source_path = if forest.dev then Iri_tbl.find_opt forest.resolver iri else None in
349
-
let uri = Option.map Lsp.Uri.of_path source_path in
350
-
let diagnostics, Eval.{articles; jobs} =
351
-
Eval.eval_tree
352
-
~quit_on_failure: false
353
-
~host
354
-
~source_path
355
-
~iri
356
-
syn
293
+
let trees, diagnostics =
294
+
Iri_tbl.to_seq forest.expanded
295
+
|> Seq.map (fun (iri, syn) ->
296
+
let source_path = if forest.dev then Iri_tbl.find_opt forest.resolver iri else None in
297
+
Eval.eval_tree
298
+
~host
299
+
~source_path
300
+
~iri
301
+
syn
302
+
)
303
+
|> Seq.split
357
304
in
358
-
let append_diagnostics () =
359
-
let@ uri = Option.iter @~ uri in
360
-
Diagnostic_store.append forest.diagnostics uri diagnostics
305
+
let diags =
306
+
match List.of_seq diagnostics with
307
+
| [] -> None
308
+
| hd :: rest ->
309
+
List.iter
310
+
(fun tbl ->
311
+
Hashtbl.to_seq tbl
312
+
|> Seq.iter (fun (iri, diags) ->
313
+
assert (not @@ Hashtbl.mem hd iri);
314
+
Hashtbl.add hd iri diags
315
+
)
316
+
)
317
+
rest;
318
+
Some hd
361
319
in
362
-
let plant_articles () =
363
-
let@ article = List.iter @~ articles in
364
-
Forest.plant_resource (T.Article article) forest.graphs forest.resources
365
-
in
366
-
append_diagnostics ();
367
-
plant_articles ();
368
-
begin
369
-
let@ Range.{value; loc} = Eio.Fiber.List.iter ~max_fibers: 20 @~ jobs in
370
-
let@ () = Reporter.easy_run in
371
-
match value with
372
-
| Job.LaTeX_to_svg {hash; source; content} ->
373
-
let svg = Build_latex.latex_to_svg ~env ?loc source in
374
-
let iri = Iri_scheme.hash_iri ~host hash in
375
-
let frontmatter = T.default_frontmatter ~iri () in
376
-
let mainmatter = content ~svg in
377
-
let backmatter = T.Content [] in
378
-
let article = T.{frontmatter; mainmatter; backmatter} in
379
-
Forest.plant_resource (T.Article article) forest.graphs forest.resources
380
-
| Job.Publish publication ->
381
-
export_publication ~env ~forest publication
382
-
(* TODO: This MUST be deferred until after all the trees have been evaluated. *)
383
-
end
384
-
385
-
let eval : transition = fun forest ->
386
-
let expanded = forest.expanded in
387
-
expanded |> Forest.iter (eval_tree forest);
388
-
Logs.debug (fun m -> m "evaluated %i resources" (Forest.length forest.resources));
389
-
forest
320
+
trees, diags
390
321
391
322
let eval_only
392
323
(iri : iri)
393
-
: transition
324
+
: State.t -> State.t * diagnostic option
394
325
= fun forest ->
395
326
match Forest.find_opt forest.expanded iri with
396
327
| None -> assert false
397
328
| Some syn ->
398
329
(* NOTE: Not running jobs. *)
399
-
let diagnostics, Eval.{articles; jobs = _} =
330
+
let Eval.{articles; jobs = _}, _diagnostics =
400
331
Eval.eval_tree
401
-
~quit_on_failure: false
402
332
~host: forest.config.host
403
333
~source_path: None
404
334
~iri
···
408
338
let@ article = List.iter @~ articles in
409
339
Forest.plant_resource (Article article) forest.graphs forest.resources
410
340
end;
411
-
begin
412
-
let@ uri =
413
-
Option.iter @~
414
-
Option.map Lsp.Uri.of_path @@
415
-
Iri_tbl.find_opt forest.resolver iri
416
-
in
417
-
Diagnostic_store.append
418
-
forest.diagnostics
419
-
uri
420
-
diagnostics;
421
-
end;
422
-
forest
341
+
(* Diagnostic_store.add forest.diagnostics diagnostics; *)
342
+
forest, None
343
+
344
+
let check_status
345
+
_iri
346
+
: State.t -> State.t * diagnostic option
347
+
= fun state ->
348
+
match state with
349
+
| {dependency_cache = _;
350
+
_;
351
+
} ->
352
+
state, None
423
353
424
354
let implant_foreign
425
-
: transition
355
+
: State.t -> State.t * diagnostic option
426
356
= fun state ->
427
357
begin
428
358
let foreign_paths = Eio_util.paths_of_files ~env: state.env state.config.foreign in
359
+
Logs.debug (fun m -> m "implanting %i foreign paths" (List.length foreign_paths));
429
360
let module EP = Eio.Path in
430
361
let@ path = List.iter @~ foreign_paths in
431
362
let path_str = EP.native_exn path in
···
441
372
| exception exn ->
442
373
Reporter.fatalf Parse_error "Encountered unknown error while decoding foreign forest blob: %s" (Printexc.to_string exn)
443
374
end;
444
-
state
445
-
446
-
let plant_assets
447
-
: transition
448
-
= fun state ->
449
-
let@ () = Reporter.tracef "when planting assets" in
450
-
let paths =
451
-
Dir_scanner.scan_asset_directories
452
-
(Eio_util.paths_of_dirs ~env: state.env state.config.assets)
453
-
in
454
-
Logs.debug (fun m -> m "got %i asset paths" (Seq.length paths));
455
-
Logs.debug (fun m -> m "planting %i assets" (Seq.length paths));
456
-
let module EP = Eio.Path in
457
-
begin
458
-
let@ path = Eio.Fiber.List.iter ~max_fibers: 20 @~ List.of_seq paths in
459
-
let content = EP.load path in
460
-
let source_path = EP.native_exn path in
461
-
let iri = Asset_router.install ~host: state.config.host ~source_path ~content in
462
-
Logs.debug (fun m -> m "Installed %s at %a" source_path pp_iri iri);
463
-
Forest.plant_resource (T.Asset {iri; host = state.config.host; content}) state.graphs state.resources;
464
-
end;
465
-
state
375
+
state, None
-22
lib/compiler/Phases.mli
-22
lib/compiler/Phases.mli
···
1
-
(*
2
-
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
-
*
4
-
* SPDX-License-Identifier: GPL-3.0-or-later
5
-
*
6
-
*)
7
-
8
-
type transition = State.t -> State.t
9
-
10
-
val init : env: Eio_unix.Stdenv.base -> config: Config.t -> dev: bool -> State.t
11
-
val load : Eio.Fs.dir_ty Eio.Path.t list -> transition
12
-
val load_configured_dirs : transition
13
-
val parse : quit_on_error: bool -> transition
14
-
val reparse : Lsp.Text_document.t -> transition
15
-
val build_import_graph : transition
16
-
val build_import_graph_for : iri: Forester_core.iri -> transition
17
-
val expand : quit_on_error: bool -> transition
18
-
val expand_only : Forester_core.iri -> transition
19
-
val eval : transition
20
-
val eval_only : Forester_core.iri -> transition
21
-
val implant_foreign : transition
22
-
val plant_assets : transition
+67
-18
lib/compiler/State.ml
+67
-18
lib/compiler/State.ml
···
21
21
resources: resource Forest.t;
22
22
graphs: (module Forest_graphs.S);
23
23
import_graph: Forest_graph.t;
24
+
dependency_cache: Cache.t;
24
25
resolver: string Iri_tbl.t;
25
26
search_index: Forester_search.Index.t;
26
27
}
27
28
28
-
let documents (t : t) = t.documents
29
-
let parsed (t : t) = t.parsed
30
-
let resources (t : t) = t.resources
31
-
let expanded (t : t) = t.expanded
32
-
let graphs (t : t) = t.graphs
33
-
let import_graph (t : t) = t.import_graph
34
-
let config (t : t) = t.config
35
-
let env (t : t) = t.env
36
-
let diagnostics (t : t) = t.diagnostics
37
-
let units (t : t) = t.units
29
+
let make
30
+
~(env : Eio_unix.Stdenv.base)
31
+
~(config : Config.t)
32
+
~(dev : bool)
33
+
?(graphs = (module Forest_graphs.Make (): Forest_graphs.S))
34
+
?(import_graph = Forest_graph.create ~size: 1000 ())
35
+
?(parsed = Forest.create 1000)
36
+
?(documents = Hashtbl.create 1000)
37
+
?(resolver = Iri_tbl.create 1000)
38
+
?(expanded = Forest.create 1000)
39
+
?(resources = Forest.create 1000)
40
+
?(diagnostics = Diagnostic_store.create 100)
41
+
?(units = Expand.Env.empty)
42
+
?(search_index = Forester_search.Index.create [])
43
+
?(dependency_cache = Cache.empty)
44
+
()
45
+
= {env; dev; config; units; documents; diagnostics; parsed; expanded; resources; resolver; import_graph; graphs; search_index; dependency_cache;}
46
+
47
+
let serialize_graphs
48
+
: (module Forest_graphs.S) -> 'a
49
+
= fun s ->
50
+
let module Graphs = (val s) in
51
+
Graphs.dl_db
52
+
53
+
(* This function is a temporary solution. Here is the plan:
38
54
39
-
let with_config
40
-
: Config.t -> t -> t
41
-
= fun config forest ->
42
-
{forest with config}
55
+
Write this function, then go to Phases.ml and make sure that the computations
56
+
we are doing in bulk here are carried out with each step.
57
+
*)
58
+
let batch_write : t -> _ = function
59
+
| {import_graph;
60
+
_
61
+
} ->
62
+
(* let dl_db = serialize_graphs graphs in *)
63
+
let open Cache in
64
+
let module Gmap = Forest_graph.Map(Cache.Dependecy_graph) in
65
+
let tbl = Dependency_tbl.create 100 in
66
+
let now = Unix.time () in
67
+
let g =
68
+
Gmap.map
69
+
(function
70
+
| T.Content_vertex _ ->
71
+
(*Import graph has no content vertices*)
72
+
assert false
73
+
| T.Iri_vertex iri ->
74
+
let item = Item.Tree iri in
75
+
Dependency_tbl.add tbl item Item.{timestamp = Some now; color = Green};
76
+
item
77
+
)
78
+
import_graph
79
+
in
80
+
{Cache.empty with graph = g; tbl;}
43
81
44
-
let with_units
45
-
: Expand.Env.t -> t -> t
46
-
= fun units forest ->
47
-
{forest with units}
82
+
let reconstruct = fun ~env: _ ~(_config : Config.t) paths cache ->
83
+
match cache with
84
+
| {search_index = _; _} ->
85
+
(* let init = Phases.init ~env ~config ~dev: true in *)
86
+
(* let graphs = Forest_graphs.init dl_db in *)
87
+
paths
88
+
|> Seq.iter (fun _path ->
89
+
(* let iri = Iri_scheme.path_to_iri ~host: config.host (Eio.Path.native_exn path) in *)
90
+
(* match Iri_tbl.find_opt forest iri with *)
91
+
(* | None -> () *)
92
+
(* | Some tree -> *)
93
+
(* match check_timestamp path tree.timestamp with *)
94
+
(* | _ -> () *)
95
+
()
96
+
)
+136
lib/compiler/test/Test_compiler.ml
+136
lib/compiler/test/Test_compiler.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_prelude
9
+
open Forester_compiler
10
+
11
+
module T = Types
12
+
13
+
module Mock_forest = struct
14
+
let languageId = "forester"
15
+
let mk_doc ?(version = 1) path content =
16
+
Lsp.Text_document.make
17
+
~position_encoding: `UTF8
18
+
{
19
+
textDocument = {
20
+
languageId;
21
+
text = content;
22
+
uri = Lsp.Uri.of_path path;
23
+
version;
24
+
}
25
+
}
26
+
let t1 = mk_doc "/test/t1.tree" {||}
27
+
let t2 = mk_doc "/test/t2.tree" {||}
28
+
let t3 = mk_doc "/test/t3.tree" {||}
29
+
let t4 = mk_doc "/test/t4.tree" {||}
30
+
let t5 = mk_doc "/test/t5.tree" {||}
31
+
let t6 = mk_doc "/test/t6.tree" {||}
32
+
let t7 = mk_doc "/test/t7.tree" {||}
33
+
let t8 = mk_doc "/test/reparse.tree" {||}
34
+
35
+
let add_trees trees (forest : State.t) =
36
+
trees
37
+
|> List.iter (fun doc ->
38
+
let uri = Lsp.Text_document.documentUri doc in
39
+
Hashtbl.add forest.documents uri doc;
40
+
let path = Lsp.Uri.to_path uri in
41
+
let iri = Iri_scheme.uri_to_iri ~host: forest.config.host uri in
42
+
Iri_tbl.replace forest.resolver iri path;
43
+
);
44
+
forest
45
+
46
+
let init ~env ~config () =
47
+
State.make ~env ~config ~dev: true ()
48
+
|> add_trees [t1; t2; t3; t4; t5; t6; t7; t8]
49
+
50
+
let build ~env ~config () =
51
+
init ~env ~config ()
52
+
|> Driver.run_action Parse_all
53
+
end
54
+
55
+
let () =
56
+
(* Logs.set_level (Some Debug); *)
57
+
let@ env = Eio_main.run in
58
+
let@ () = Reporter.easy_run in
59
+
let config = {Config.default with trees = []} in
60
+
61
+
(* When a tree changes, we need to recompute its dependencies and update the
62
+
import graph*)
63
+
let test_reparsing () =
64
+
let@ () = Reporter.test_run in
65
+
(*First, perform a regular batch compilation run.*)
66
+
let forest =
67
+
Mock_forest.init ~env ~config ()
68
+
|> Driver.run_action Parse_all
69
+
in
70
+
let path = "/test/reparse.tree" in
71
+
let vtx = T.Iri_vertex (Iri_scheme.path_to_iri ~host: config.host path) in
72
+
Format.printf "%a@." T.(pp_vertex pp_content) vtx;
73
+
let old_import_graph = forest.import_graph in
74
+
Alcotest.(check int) "old vertex has no import" 0 (Forest_graph.in_degree old_import_graph vtx);
75
+
let reparsed_forest, _ =
76
+
let open Phases in
77
+
let document =
78
+
(* Create a Text_document.t with new content.*)
79
+
Mock_forest.mk_doc
80
+
~version: 2
81
+
path
82
+
{| \import{t1}|}
83
+
in
84
+
reparse document forest
85
+
in
86
+
let import_graph = reparsed_forest.import_graph in
87
+
Forest_graph.iter_vertex
88
+
(fun v -> Format.printf "%a@." T.(pp_vertex pp_content) v)
89
+
import_graph;
90
+
Alcotest.(check bool) "vertex has an import" true (Forest_graph.in_degree import_graph vtx > 0);
91
+
in
92
+
let test_batch_run () =
93
+
let forest =
94
+
let@ () = Reporter.easy_run in
95
+
Mock_forest.build ~env ~config ()
96
+
(* Driver.batch_run ~env ~config ~dev: false *)
97
+
in
98
+
Alcotest.(check int) "" 8 @@ List.length @@ Forest.get_all_articles forest.resources
99
+
in
100
+
let test_includes_paths () =
101
+
let@ () = Reporter.easy_run in
102
+
let forest = Mock_forest.init ~env ~config () |> Driver.run_action Parse_all in
103
+
let path =
104
+
let@ {frontmatter = {source_path; _}; _} =
105
+
Option.bind @@ Forest.get_article (Iri.of_string "forest://my-forest/reparse") forest.resources
106
+
in
107
+
source_path
108
+
in
109
+
Alcotest.(check bool) "" true @@ Option.is_some path
110
+
in
111
+
let test_omits_paths () =
112
+
let@ () = Reporter.easy_run in
113
+
let forest = Driver.batch_run ~env ~config ~dev: false in
114
+
let path =
115
+
let@ {frontmatter = {source_path; _}; _} =
116
+
Option.bind @@ Forest.get_article (Iri.of_string "forest://my-forest/index") forest.resources
117
+
in
118
+
source_path
119
+
in
120
+
Alcotest.(check bool) "" true @@ Option.is_none path
121
+
in
122
+
let open Alcotest in
123
+
run
124
+
"check compiler internals"
125
+
[
126
+
"pipeline",
127
+
[
128
+
test_case "basic batch run" `Quick test_batch_run;
129
+
test_case "reparsing" `Quick test_reparsing
130
+
];
131
+
"dev mode",
132
+
[
133
+
test_case "includes paths in dev mode" `Quick test_includes_paths;
134
+
test_case "omits paths outside dev mode" `Quick test_omits_paths;
135
+
]
136
+
]
+55
lib/compiler/test/Test_driver.ml
+55
lib/compiler/test/Test_driver.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_test
11
+
open Testables
12
+
13
+
let config = Config.default
14
+
15
+
let check_actions ~env () =
16
+
let forest, history =
17
+
setup_forest
18
+
~raw_trees: [{path = "foo.tree"; content = {|\title{hello}|}}]
19
+
~env
20
+
~config
21
+
(fun path ->
22
+
Sys.chdir (Eio.Path.native_exn path);
23
+
let@ () = Reporter.easy_run in
24
+
let forest = State.make ~env ~config ~dev: false () in
25
+
Driver.run_with_history Load_all_configured_dirs forest
26
+
)
27
+
in
28
+
Alcotest.(check @@ list action)
29
+
""
30
+
[
31
+
Load_all_configured_dirs;
32
+
Parse_all;
33
+
Build_import_graph;
34
+
Expand_all;
35
+
Eval_all;
36
+
Run_jobs [];
37
+
Done;
38
+
]
39
+
history;
40
+
Alcotest.(check @@ int) "" 1 (Iri_tbl.length forest.resources)
41
+
42
+
let () =
43
+
let@ env = Eio_main.run in
44
+
Logs.set_level (Some Debug);
45
+
(* Logs.set_reporter (Logs.format_reporter ()); *)
46
+
(* let () = assert false in *)
47
+
let open Alcotest in
48
+
run
49
+
"Test_driver"
50
+
[
51
+
"Steps",
52
+
[
53
+
test_case "Batch compilation steps" `Quick (check_actions ~env)
54
+
]
55
+
]
+83
lib/compiler/test/Test_errors.ml
+83
lib/compiler/test/Test_errors.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_prelude
9
+
open Forester_compiler
10
+
open Forester_test
11
+
open Testables
12
+
13
+
let parse_string str =
14
+
let lexbuf = Lexing.from_string str in
15
+
let res = Parse.parse ~source: (`String {title = None; content = str}) lexbuf in
16
+
Result.map strip_loc res
17
+
18
+
let _test_parse_error_explanation src expect =
19
+
Alcotest.(check @@ result code string)
20
+
""
21
+
(Result.Error expect)
22
+
(
23
+
parse_string src
24
+
|> Result.map_error
25
+
(fun d -> Asai.Diagnostic.string_of_text d.explanation.value)
26
+
)
27
+
28
+
let raw_trees = [
29
+
{
30
+
path = "parse_error.tree";
31
+
content = "\\})--aa]jv"
32
+
};
33
+
{
34
+
path = "import_error.tree";
35
+
content = {|\import{nonexistent}|}
36
+
}
37
+
]
38
+
39
+
let () =
40
+
let@ env = Eio_main.run in
41
+
let@ () = Reporter.easy_run in
42
+
let config = Config.default in
43
+
let test () =
44
+
let@ tmp_dir = setup_forest ~env ~raw_trees ~config in
45
+
Sys.chdir (Eio.Path.native_exn tmp_dir);
46
+
let forest, history =
47
+
State.make ~env ~config ~dev: false ()
48
+
|> Driver.run_with_history Load_all_configured_dirs
49
+
in
50
+
Alcotest.(check @@ list action)
51
+
""
52
+
[
53
+
Load_all_configured_dirs;
54
+
Parse_all;
55
+
Build_import_graph;
56
+
Expand_all;
57
+
Eval_all;
58
+
(Run_jobs []);
59
+
Done
60
+
]
61
+
history;
62
+
Alcotest.(check int) "" 1 (Diagnostic_store.length forest.diagnostics);
63
+
Alcotest.(check bool) "" true (Iri_tbl.length forest.parsed = (Hashtbl.length forest.documents - 1));
64
+
in
65
+
let test_expansion () = Alcotest.(check string) "" "" "" in
66
+
let open Alcotest in
67
+
run
68
+
"verify error reporting"
69
+
[
70
+
"parsing",
71
+
[
72
+
test_case "diagnostic" `Quick test;
73
+
];
74
+
"expanding",
75
+
[
76
+
test_case "expansion" `Quick test_expansion;
77
+
];
78
+
"evaluating",
79
+
[
80
+
];
81
+
"driver",
82
+
[];
83
+
]
+150
lib/compiler/test/Test_import_graph.ml
+150
lib/compiler/test/Test_import_graph.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_compiler
9
+
open Forester_prelude
10
+
open Forester_test
11
+
12
+
module T = Types
13
+
14
+
let config = {Config.default with trees = ["imports"]}
15
+
16
+
let mk_vertex v = T.Iri_vertex (Iri_scheme.user_iri ~host: config.host v)
17
+
18
+
let has_edge g v w =
19
+
Forest_graph.mem_edge g (mk_vertex v) (mk_vertex w)
20
+
21
+
(*
22
+
┌─1
23
+
│ ┌─4
24
+
│ ├─5
25
+
├─2─┬─3─┼─6
26
+
index─┤ │ └─7
27
+
│ └─8
28
+
├─9
29
+
└─10
30
+
*)
31
+
32
+
let raw_trees = [
33
+
{
34
+
path = "index.tree";
35
+
content = {|
36
+
\import{1}
37
+
\import{2}
38
+
\import{9}
39
+
\import{10}
40
+
|}
41
+
};
42
+
{
43
+
path = "1.tree";
44
+
content = {||}
45
+
};
46
+
{
47
+
path = "2.tree";
48
+
content = {|
49
+
\import{3}
50
+
\import{8}
51
+
|}
52
+
};
53
+
{
54
+
path = "3.tree";
55
+
content = {|
56
+
\import{4}
57
+
\import{5}
58
+
\import{6}
59
+
\import{7}
60
+
|}
61
+
};
62
+
{path = "4.tree"; content = {||}};
63
+
{path = "5.tree"; content = {||}};
64
+
{path = "6.tree"; content = {||}};
65
+
{path = "7.tree"; content = {||}};
66
+
{path = "8.tree"; content = {||}};
67
+
{path = "9.tree"; content = {||}};
68
+
{path = "10.tree"; content = {||}};
69
+
{path = "11.tree"; content = {||}};
70
+
{path = "12.tree"; content = {||}};
71
+
]
72
+
73
+
let () =
74
+
let@ env = Eio_main.run in
75
+
Logs.set_level (Some Debug);
76
+
Logs.set_reporter (Logs_fmt.reporter ());
77
+
let open Alcotest in
78
+
let forest =
79
+
let@ () = Reporter.easy_run in
80
+
let@ tmp_dir = setup_forest ~env ~config ~raw_trees in
81
+
Sys.chdir (Eio.Path.native_exn tmp_dir);
82
+
State.make ~env ~config ~dev: false ()
83
+
|> Driver.run_action Load_all_configured_dirs
84
+
in
85
+
let test_parsing_and_creating () =
86
+
Alcotest.(check int)
87
+
"graph has as many vertices as loaded documents"
88
+
(Hashtbl.length forest.documents)
89
+
(Forest.length forest.parsed)
90
+
in
91
+
let test_graph () =
92
+
Alcotest.(check bool)
93
+
"has some edges"
94
+
true
95
+
(
96
+
List.for_all
97
+
Fun.id
98
+
[
99
+
List.for_all
100
+
(fun v -> has_edge forest.import_graph v "3")
101
+
[
102
+
"4";
103
+
"5";
104
+
"6";
105
+
"7";
106
+
];
107
+
has_edge forest.import_graph "2" "index";
108
+
]
109
+
)
110
+
in
111
+
let test_unloaded_forest () =
112
+
(**)
113
+
let@ () = Reporter.easy_run in
114
+
let empty_state = State.make ~env ~dev: false ~config () in
115
+
let minimal_graph =
116
+
Imports.run_builder
117
+
~root: (Iri_scheme.user_iri ~host: config.host "3")
118
+
{
119
+
forest = empty_state;
120
+
follow = true
121
+
}
122
+
in
123
+
(* Although the imports directory contains more trees, the graph only has 5
124
+
vertices.*)
125
+
Alcotest.(check int)
126
+
"minmal graph has correct number vertices"
127
+
5
128
+
(Forest_graph.nb_vertex minimal_graph)
129
+
in
130
+
let test_dependencies () =
131
+
let dependency_graph = Forest_graph.dependencies forest.import_graph (mk_vertex "2") in
132
+
Alcotest.(check int)
133
+
""
134
+
7
135
+
(Forest_graph.nb_vertex dependency_graph)
136
+
in
137
+
run
138
+
"Import_graph"
139
+
[
140
+
"creating import graph",
141
+
[
142
+
test_case "parsing and creating the import graph" `Quick test_parsing_and_creating;
143
+
test_case "the graph has some correct edges" `Quick test_graph;
144
+
test_case "dependency graph of a single tree" `Quick test_dependencies;
145
+
];
146
+
"creating minimal import graph",
147
+
[
148
+
test_case "can create portion of graph without loading entire forest" `Quick test_unloaded_forest;
149
+
]
150
+
]
+24
lib/compiler/test/Test_incremental_compilation.ml
+24
lib/compiler/test/Test_incremental_compilation.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_compiler
9
+
open Forester_prelude
10
+
open Forester_frontend
11
+
open Current_incr
12
+
13
+
module T = Types
14
+
15
+
let () =
16
+
let@ env = Eio_main.run in
17
+
let open Alcotest in
18
+
run
19
+
"Test_incremental_compilation"
20
+
[
21
+
"",
22
+
[]
23
+
(* [test_case "separate" `Quick test_separate] *)
24
+
]
+5
lib/compiler/test/Test_timestamp.ml
+5
lib/compiler/test/Test_timestamp.ml
+45
lib/compiler/test/dune
+45
lib/compiler/test/dune
···
1
+
;;; SPDX-FileCopyrightText: 2024 The Forester Project Contributors
2
+
;;;
3
+
;;; SPDX-License-Identifier: GPL-3.0-or-later
4
+
5
+
(tests
6
+
(names
7
+
Test_LaTeX_pipeline
8
+
Test_compiler
9
+
Test_diagnostic_store
10
+
Test_driver
11
+
Test_errors
12
+
Test_eval
13
+
Test_expansion
14
+
Test_graph_database
15
+
Test_import_graph
16
+
Test_iri_util)
17
+
(preprocess
18
+
(pps ppx_deriving.show))
19
+
(libraries
20
+
asai
21
+
eio
22
+
eio_main
23
+
eio.core
24
+
eio.unix
25
+
alcotest
26
+
unix
27
+
fmt
28
+
iri
29
+
lsp
30
+
logs
31
+
yuujinchou
32
+
ocamlgraph
33
+
forester.test
34
+
forester.prelude
35
+
forester.parser
36
+
forester.compiler
37
+
forester.core
38
+
forester.frontend))
39
+
40
+
;;;
41
+
42
+
(executable
43
+
(name Test_timestamp)
44
+
(public_name test-timestamp)
45
+
(libraries))
+1
lib/core/Base.ml
+1
lib/core/Base.ml
···
55
55
let length = Tbl.length
56
56
let create = Tbl.create
57
57
let iter f = Tbl.iter (fun x y -> f (x : S.t :> iri) y)
58
+
let to_seq tbl = Tbl.to_seq tbl |> Seq.map (fun (x, y) -> (x : S.t :> iri), y)
58
59
let to_seq_values = Tbl.to_seq_values
59
60
let to_seq_keys tbl = Tbl.to_seq_keys tbl |> Seq.map (fun x -> (x : S.t :> iri))
60
61
end
+1
lib/core/Base.mli
+1
lib/core/Base.mli
+52
lib/core/Forest_graph.ml
+52
lib/core/Forest_graph.ml
···
7
7
module G = Graph.Imperative.Digraph.ConcreteBidirectional(Vertex)
8
8
include G
9
9
include Graph.Oper.I(G)
10
+
module Map = Graph.Gmap.Vertex(G)
10
11
11
12
module Reachability = Graph.Fixpoint.Make(G)(struct
12
13
type vertex = G.E.vertex
···
25
26
let safe_succ g x =
26
27
if mem_vertex g x then succ g x else []
27
28
29
+
let safe_dependents = safe_succ
30
+
28
31
let safe_pred g x =
29
32
if mem_vertex g x then pred g x else []
33
+
34
+
let immediate_dependencies = safe_pred
35
+
36
+
let add_edge_safe g v w = if mem_vertex g v && mem_vertex g w then add_edge g v w
37
+
let add_edge_exn g v w =
38
+
if mem_vertex g v then
39
+
if mem_vertex g w then add_edge g v w
40
+
else
41
+
(* We should only be adding iri vertices anyway *)
42
+
let iri = Option.get @@ Vertex.iri_of_vertex w in
43
+
Reporter.fatalf Internal_error "%a is not in the graph" Base.pp_iri iri
44
+
else
45
+
let iri = Option.get @@ Vertex.iri_of_vertex v in
46
+
Reporter.fatalf Internal_error "%a is not in the import graph" Base.pp_iri iri
47
+
48
+
let dependencies graph vertex : t =
49
+
let dep_graph = create () in
50
+
let rec go v =
51
+
iter_pred
52
+
(fun dep ->
53
+
if mem_vertex dep_graph dep then ()
54
+
else
55
+
begin
56
+
add_edge dep_graph dep v;
57
+
go dep
58
+
end
59
+
)
60
+
graph
61
+
v
62
+
in
63
+
go vertex;
64
+
dep_graph
65
+
66
+
module Graphviz = Graph.Graphviz.Dot(struct
67
+
include G
68
+
module V = Vertex
69
+
70
+
let vertex_name v =
71
+
match Vertex.iri_of_vertex v with
72
+
| Some iri -> "\"" ^ Iri.to_string iri ^ "\""
73
+
| None -> ""
74
+
75
+
let graph_attributes _ = []
76
+
let default_vertex_attributes _ = []
77
+
let vertex_attributes _ = []
78
+
let default_edge_attributes _ = []
79
+
let edge_attributes e = [`Label ""]
80
+
let get_subgraph _ = None
81
+
end)
+21
lib/core/Forest_graph.mli
+21
lib/core/Forest_graph.mli
···
6
6
7
7
type t
8
8
9
+
module Map : (G_Dst : Graph.Gmap.V_DST) ->
10
+
sig
11
+
val map : (Vertex.t -> G_Dst.vertex) -> t -> G_Dst.t
12
+
val filter_map : (Vertex.t -> G_Dst.vertex option) -> t -> G_Dst.t
13
+
end
14
+
9
15
val create : ?size: int -> unit -> t
10
16
val add_vertex : t -> Vertex.t -> unit
11
17
val add_edge : t -> Vertex.t -> Vertex.t -> unit
18
+
19
+
(* Only adds the edge if both vertices are in g*)
20
+
val add_edge_safe : t -> Vertex.t -> Vertex.t -> unit
21
+
val add_edge_exn : t -> Vertex.t -> Vertex.t -> unit
12
22
val safe_pred : t -> Vertex.t -> Vertex.t list
13
23
val safe_succ : t -> Vertex.t -> Vertex.t list
24
+
val immediate_dependencies : t -> Vertex.t -> Vertex.t list
25
+
val safe_dependents : t -> Vertex.t -> Vertex.t list
14
26
val mem_edge : t -> Vertex.t -> Vertex.t -> bool
15
27
val transitive_closure : ?reflexive: bool -> t -> t
16
28
17
29
val out_degree : t -> Vertex.t -> int
30
+
val in_degree : t -> Vertex.t -> int
18
31
19
32
val remove_vertex : t -> Vertex.t -> unit
33
+
val remove_edge : t -> Vertex.t -> Vertex.t -> unit
20
34
val transitive_reduction : ?reflexive: bool -> t -> t
21
35
val nb_vertex : t -> int
22
36
val iter_edges : (Vertex.t -> Vertex.t -> unit) -> t -> unit
···
25
39
val topo_fold : (Vertex.t -> 'a -> 'a) -> t -> 'a -> 'a
26
40
27
41
val iter_succ : (Vertex.t -> unit) -> t -> Vertex.t -> unit
42
+
43
+
val dependencies : t -> Vertex.t -> t
44
+
45
+
module Graphviz : sig
46
+
val fprint_graph : Format.formatter -> t -> unit
47
+
val output_graph : out_channel -> t -> unit
48
+
end
+4
lib/core/Iri_scheme.ml
+4
lib/core/Iri_scheme.ml
···
79
79
|> last_segment
80
80
|> user_iri ~host
81
81
82
+
(* Badly named. This is not a general conversion but the forester-specific way
83
+
we convert a path into an iri, namely keeping only the filename and chopping
84
+
the extension*)
82
85
let uri_to_iri
83
86
: host: string -> Lsp.Uri.t -> Iri.t
84
87
= fun ~host uri ->
···
95
98
let path_to_iri ~host str =
96
99
str
97
100
|> last_segment
101
+
|> Filename.chop_extension
98
102
|> user_iri ~host
99
103
100
104
let source_path_to_addr p = Filename.(chop_extension @@ basename p)
+39
-5
lib/core/Reporter.ml
+39
-5
lib/core/Reporter.ml
···
99
99
let emit _diagnostics = () in
100
100
run ~emit ~fatal k
101
101
102
-
let lsp_run ?init_loc ?init_backtrace publish path k =
103
-
let diagnostics = ref [] in
102
+
(* Reporting diagnostics requires a document URI to publish *)
103
+
let guess_uri (d : diagnostic) =
104
+
match d with
105
+
| {explanation; _} ->
106
+
match explanation.loc with
107
+
| None -> None
108
+
| Some loc ->
109
+
match Range.view loc with
110
+
| `End_of_file {source; _}
111
+
| `Range ({source; _}, _) ->
112
+
match source with
113
+
| `String _ -> None
114
+
| `File path ->
115
+
if path <> "" then
116
+
Some (Lsp.Uri.of_path path)
117
+
else None
118
+
119
+
let lsp_run ?init_loc ?init_backtrace ~recover publish k =
120
+
let diagnostics = Hashtbl.create 100 in
104
121
let push_diagnostic d =
105
-
diagnostics := d :: !diagnostics
122
+
match guess_uri d with
123
+
| None -> fatal Internal_error "dropped a diagnostic because URI could not be guessed."
124
+
| Some uri ->
125
+
match Hashtbl.find_opt diagnostics uri with
126
+
| None ->
127
+
Hashtbl.add diagnostics uri [d];
128
+
recover d
129
+
| Some previous ->
130
+
Hashtbl.add diagnostics uri (d :: previous);
131
+
recover d
106
132
in
107
133
run
108
-
~emit: push_diagnostic
134
+
~emit: (fun d -> ignore @@ push_diagnostic d)
109
135
~fatal: push_diagnostic
110
136
?init_loc
111
137
?init_backtrace
112
138
@@ fun () ->
113
139
let result = k () in
114
-
publish path !diagnostics;
140
+
publish diagnostics;
115
141
result
116
142
117
143
let ignore = run ~emit: (fun _ -> ()) ~fatal: (fun _ -> fatalf Message.Internal_error "ignoring error")
144
+
145
+
let () =
146
+
register_printer (function
147
+
| `Emit _
148
+
| `Trace
149
+
| `Fatal _ ->
150
+
Some "unhandled effect!"
151
+
)
+9
-6
lib/core/Reporter.mli
+9
-6
lib/core/Reporter.mli
···
47
47
val easy_run : (unit -> 'a) -> 'a
48
48
val silence : (unit -> 'a) -> 'a
49
49
val test_run : (unit -> 'a) -> 'a
50
+
51
+
val guess_uri : diagnostic -> Lsp.Uri.t option
52
+
50
53
val lsp_run :
51
-
?init_loc: Asai.Range.t ->
52
-
?init_backtrace: Asai.Diagnostic.backtrace ->
53
-
('a -> Message.t Asai.Diagnostic.t list -> unit) ->
54
-
'a ->
55
-
(unit -> unit) ->
56
-
unit
54
+
?init_loc:Range.t ->
55
+
?init_backtrace:Asai.Diagnostic.backtrace ->
56
+
recover: (diagnostic -> 'a) ->
57
+
((Lsp.Uri.t, diagnostic list) Hashtbl.t -> unit) ->
58
+
(unit -> 'a) -> 'a
59
+
57
60
val ignore :
58
61
?init_loc: Asai.Range.t ->
59
62
?init_backtrace: Asai.Diagnostic.backtrace ->
+6
lib/core/Vertex_set.mli
+6
lib/core/Vertex_set.mli
+33
-7
lib/frontend/Forester.ml
+33
-7
lib/frontend/Forester.ml
···
15
15
type env = Eio_unix.Stdenv.base
16
16
type dir = Eio.Fs.dir_ty EP.t
17
17
18
-
type target = State_machine.target = HTML | JSON | XML | STRING
18
+
type target = HTML | JSON | XML | STRING
19
19
20
20
let (let*) = Option.bind
21
21
···
55
55
EP.save ~create path @@ body ^ template_content;
56
56
EP.native_exn path
57
57
58
-
let complete ~forest prefix =
59
-
let config = State.config forest in
58
+
let complete ~(forest : State.t) prefix =
59
+
let config = forest.config in
60
60
let@ article = Seq.filter_map @~ List.to_seq @@ Forest.get_all_articles forest.resources in
61
61
let@ iri = Option.bind article.frontmatter.iri in
62
62
let@ iri = Option.bind @@ Option_util.guard Iri_scheme.is_named_iri iri in
···
94
94
= fun ~env ~config ~target addr ->
95
95
let dev = true in
96
96
let iri = Iri_scheme.user_iri ~host: config.host addr in
97
-
let result = State_machine.render_tree ~env ~config ~dev target iri in
98
-
Format.printf "%s" result
97
+
let forest =
98
+
State.make ~env ~config ~dev ()
99
+
|> Driver.run_action (Build_dependency_graph iri)
100
+
in
101
+
let output =
102
+
match Forest.get_article iri forest.resources with
103
+
| None -> assert false
104
+
| Some article ->
105
+
match target with
106
+
| HTML -> Pure_html.to_string @@ Htmx_client.render_article forest article
107
+
| XML ->
108
+
Format.asprintf "%a" Legacy_xml_client.(pp_xml ~forest ?stylesheet: None) article
109
+
| JSON -> Yojson.Safe.to_string @@ snd @@ Option.get @@ Json_manifest_client.render_tree ~dev ~forest article
110
+
| STRING -> "TODO"
111
+
in
112
+
Format.printf "%s" output
113
+
114
+
(* let result = *)
115
+
(* render_tree *)
116
+
(* ~env *)
117
+
(* ~config *)
118
+
(* ~dev *)
119
+
(* target *)
120
+
(* iri *)
121
+
(* in *)
122
+
(* Format.printf *)
123
+
(* "%s" *)
124
+
(* result *)
99
125
100
126
let json_manifest ~dev ~(forest : State.t) : string =
101
127
let render = Json_manifest_client.render_tree ~forest in
···
106
132
|> Yojson.Safe.to_string
107
133
108
134
let render_forest ~dev ~(forest : State.t) : unit =
109
-
let cwd = Eio.Stdenv.cwd (State.env forest) in
135
+
let cwd = Eio.Stdenv.cwd forest.env in
110
136
let all_resources = forest.resources |> Forest.get_all_resources in
111
137
List.iter (fun t -> Forest.plant_resource t forest.graphs forest.resources) all_resources;
112
138
Logs.debug (fun m -> m "Rendering %i resources" (List.length all_resources));
···
116
142
Eio_util.ensure_context_of_path ~perm: 0o755 json_path;
117
143
EP.save ~create: (`Or_truncate 0o644) json_path json_string
118
144
end;
119
-
let module Graphs = (val State.graphs forest) in
145
+
let module Graphs = (val forest.graphs) in
120
146
let jobs =
121
147
(* TODO: this takes a long time, but it does not seem to be the case that parallising helps at all. *)
122
148
let@ resource = List.filter_map @~ all_resources in
+1
-1
lib/frontend/Forester.mli
+1
-1
lib/frontend/Forester.mli
-2
lib/frontend/Forester_frontend.ml
-2
lib/frontend/Forester_frontend.ml
+2
-2
lib/frontend/Htmx_client.ml
+2
-2
lib/frontend/Htmx_client.ml
···
50
50
Iri.equal ~normalize: false home_iri iri
51
51
| None -> false
52
52
53
-
let route forest addr =
54
-
let config = State.config forest in
53
+
let route (forest : State.t) addr =
54
+
let config = forest.config in
55
55
if Some addr = Option.map (Iri_scheme.user_iri ~host: config.host) config.home then
56
56
"index.html"
57
57
else
+2
-2
lib/frontend/Json_manifest_client.ml
+2
-2
lib/frontend/Json_manifest_client.ml
···
12
12
13
13
module PT = Plain_text_client
14
14
15
-
let render_tree ~dev ~forest (doc : T.content T.article) : (string * Yojson.Safe.t) option =
16
-
let host = (State.config forest).host in
15
+
let render_tree ~dev ~(forest : State.t) (doc : T.content T.article) : (string * Yojson.Safe.t) option =
16
+
let host = forest.config.host in
17
17
let@ iri = Option.bind doc.frontmatter.iri in
18
18
(* TODO : Check routing *)
19
19
let route = Legacy_xml_client.route forest iri in
+14
-14
lib/frontend/Legacy_xml_client.ml
+14
-14
lib/frontend/Legacy_xml_client.ml
···
68
68
Iri.equal ~normalize: false home_iri iri
69
69
| None -> false
70
70
71
-
let route_resource_iri ~suffix forest iri =
72
-
let config = State.config forest in
71
+
let route_resource_iri ~suffix (forest : State.t) iri =
72
+
let config = forest.config in
73
73
let host = Option.value ~default: "" @@ Iri.host iri in
74
74
let bare_route =
75
75
String.concat "-" @@
···
86
86
"foreign-" ^ host ^ "-" ^ bare_route ^ suffix
87
87
end
88
88
89
-
let route forest iri =
90
-
match Forest.find_opt (State.resources forest) iri with
89
+
let route (forest : State.t) iri =
90
+
match Forest.find_opt forest.resources iri with
91
91
| Some resource ->
92
92
let suffix =
93
93
match resource with
···
183
183
render_content forest section.mainmatter
184
184
]
185
185
186
-
and render_frontmatter forest (frontmatter : T.content T.frontmatter) : P.node =
186
+
and render_frontmatter (forest : State.t) (frontmatter : T.content T.frontmatter) : P.node =
187
187
(* match Hashtbl.find_opt frontmatter_cache frontmatter with *)
188
188
(* | Some cached -> cached *)
189
189
(* | None -> *)
190
-
let config = State.config forest in
190
+
let config = forest.config in
191
191
let result =
192
192
X.frontmatter
193
193
[]
···
231
231
and render_content_node
232
232
: State.t -> 'a T.content_node -> P.node list
233
233
= fun forest node ->
234
-
let config = State.config forest in
234
+
let config = forest.config in
235
235
match node with
236
236
| Text str ->
237
237
[P.txt "%s" str]
···
284
284
metadata_shown = Some true
285
285
}
286
286
in
287
-
let module Legacy_query_engine = (val (Forest.legacy_query_engine (State.graphs forest))) in
287
+
let module Legacy_query_engine = (val (Forest.legacy_query_engine forest.graphs)) in
288
288
Legacy_query_engine.run_query q
289
289
|> get_sorted_articles forest
290
290
|> List.map article_to_section
···
299
299
metadata_shown = Some true
300
300
}
301
301
in
302
-
Forest.run_datalog_query (State.graphs forest) q
302
+
Forest.run_datalog_query forest.graphs q
303
303
|> get_sorted_articles forest
304
304
|> List.map article_to_section
305
305
|> List.map (render_section forest)
···
350
350
nodes
351
351
352
352
and render_link (forest : State.t) (link : T.content T.link) : P.node list =
353
-
let config = State.config forest in
353
+
let config = forest.config in
354
354
let article_opt = Forest.get_article link.href forest.resources in
355
355
let attrs =
356
356
match article_opt with
···
388
388
let positives = [Builtin_relation.has_indirect_contributor @* [const (T.Iri_vertex scope); var "X"]] in
389
389
let negatives = [] in
390
390
Datalog_expr.{var = "X"; positives; negatives}
391
-
|> Forest.run_datalog_query (State.graphs forest)
391
+
|> Forest.run_datalog_query forest.graphs
392
392
|> get_sorted_articles forest
393
393
in
394
394
let@ biotree = List.filter_map @~ articles in
···
427
427
X.null @@ List.map (render_date forest) dates
428
428
429
429
and render_date forest (date : Human_datetime.t) =
430
-
let config = State.config forest in
430
+
let config = forest.config in
431
431
let href_attr =
432
432
let str = Format.asprintf "%a" Human_datetime.pp (Human_datetime.drop_time date) in
433
433
let base = Iri_scheme.base_iri ~host: config.host in
···
444
444
Human_datetime.day date |> X.optional @@ X.day [] "%i"
445
445
]
446
446
447
-
let render_article forest (article : T.content T.article) : P.node =
447
+
let render_article (forest : State.t) (article : T.content T.article) : P.node =
448
448
let@ () = Reporter.tracef "when rendering article %a" Format.(pp_print_option Iri.pp) article.frontmatter.iri in
449
-
let config = State.config forest in
449
+
let config = forest.config in
450
450
let xmlns_prefix = Xmlns.{prefix = X.reserved_prefix; xmlns = X.forester_xmlns} in
451
451
let@ () = Loop_detection.run ~env: Iri_set.empty in
452
452
let@ () = Scope.run ~env: article.frontmatter.iri in
-177
lib/frontend/State_machine.ml
-177
lib/frontend/State_machine.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_compiler
9
-
10
-
type target = HTML | JSON | XML | STRING
11
-
12
-
module T = Types
13
-
14
-
type state = State.t
15
-
16
-
type 'a action =
17
-
| Quit
18
-
| Build_import_graph
19
-
| Build_dependency_graph of iri
20
-
| Plant_assets
21
-
| Plant_foreign
22
-
| Done
23
-
| Load_all_configured_dirs
24
-
| Parse_all
25
-
| Expand_all
26
-
| Eval_all
27
-
| Expand_only of iri
28
-
| Eval_only of iri
29
-
| Parse of iri
30
-
| Get of iri
31
-
| Query of (string, Vertex.t) Datalog_expr.query
32
-
| Cache_results of (Vertex_set.t [@opaque])
33
-
[@@deriving show]
34
-
35
-
type ('r, 'e) result =
36
-
| Nothing
37
-
| Vertex_set of Vertex_set.t
38
-
| Got of T.content T.article
39
-
| Error of 'e
40
-
41
-
let update
42
-
: type a. a action -> state -> (a action * state * (a, _) result)
43
-
= fun msg state ->
44
-
Logs.debug
45
-
(fun m ->
46
-
m
47
-
"Running action %a"
48
-
(pp_action (fun fmt _ -> Format.pp_print_nothing fmt ()))
49
-
msg
50
-
);
51
-
match msg with
52
-
| Query q ->
53
-
let r = Forest.run_datalog_query state.graphs q in
54
-
(Cache_results r, state, Vertex_set r)
55
-
| Get iri ->
56
-
begin
57
-
match Forest.get_article iri state.resources with
58
-
| Some article ->
59
-
Done, state, Got article
60
-
| None -> Done, state, Error (`Not_found iri)
61
-
end
62
-
| Quit -> exit 0
63
-
| Load_all_configured_dirs ->
64
-
(
65
-
Parse_all,
66
-
Phases.load_configured_dirs state,
67
-
Nothing
68
-
)
69
-
| Parse_all ->
70
-
Reporter.log Format.pp_print_string "Parse trees";
71
-
(
72
-
Build_import_graph,
73
-
Phases.parse ~quit_on_error: false state,
74
-
Nothing
75
-
)
76
-
| Build_import_graph ->
77
-
(
78
-
Expand_all,
79
-
Phases.build_import_graph state,
80
-
Nothing
81
-
)
82
-
| Build_dependency_graph iri ->
83
-
(
84
-
Expand_only iri,
85
-
Phases.build_import_graph_for ~iri state,
86
-
Nothing
87
-
)
88
-
| Expand_all ->
89
-
Reporter.log Format.pp_print_string "Expand, evaluate and analyse forest";
90
-
(
91
-
Eval_all,
92
-
Phases.expand ~quit_on_error: false state,
93
-
Nothing
94
-
)
95
-
| Expand_only iri ->
96
-
(
97
-
Eval_only iri,
98
-
Phases.expand_only iri state,
99
-
Nothing
100
-
)
101
-
| Eval_all ->
102
-
(
103
-
Done,
104
-
Phases.eval state,
105
-
Nothing
106
-
)
107
-
| Eval_only iri ->
108
-
(
109
-
Done,
110
-
Phases.eval_only iri state,
111
-
Nothing
112
-
)
113
-
| Plant_assets ->
114
-
(
115
-
Done,
116
-
Phases.plant_assets state,
117
-
Nothing
118
-
)
119
-
| Plant_foreign ->
120
-
(
121
-
Done,
122
-
Phases.implant_foreign state,
123
-
Nothing
124
-
)
125
-
| Parse _
126
-
| Cache_results _
127
-
| Done ->
128
-
(Done, state, Nothing)
129
-
130
-
let run_action action state : state =
131
-
let rec go action state =
132
-
match update action state with
133
-
| (new_action, new_state, result) ->
134
-
if action = Done then (new_state, result)
135
-
else
136
-
go new_action new_state
137
-
in
138
-
go action state
139
-
|> fst
140
-
141
-
let rec force
142
-
: 'a action list -> state -> ('r, 'e) result
143
-
= fun msgs state ->
144
-
match msgs with
145
-
| [] -> Nothing
146
-
| msg :: remaining ->
147
-
let _discard, new_state, _ = update msg state in
148
-
force remaining new_state
149
-
150
-
let implant_foreign = run_action Plant_foreign
151
-
152
-
let plant_assets = run_action Plant_assets
153
-
154
-
let batch_run ~env ~(config : Config.t) ~dev =
155
-
Phases.init ~env ~config ~dev
156
-
|> plant_assets
157
-
|> implant_foreign
158
-
|> run_action Load_all_configured_dirs
159
-
160
-
let language_server
161
-
: state -> unit
162
-
= fun _ -> ()
163
-
164
-
let render_tree ~env ~config ~dev target iri =
165
-
let forest =
166
-
Phases.init ~env ~config ~dev
167
-
|> run_action (Build_dependency_graph iri)
168
-
in
169
-
match Forest.get_article iri forest.resources with
170
-
| None -> assert false
171
-
| Some article ->
172
-
match target with
173
-
| HTML -> Pure_html.to_string @@ Htmx_client.render_article forest article
174
-
| XML ->
175
-
Format.asprintf "%a" Legacy_xml_client.(pp_xml ~forest ?stylesheet: None) article
176
-
| JSON -> Yojson.Safe.to_string @@ snd @@ Option.get @@ Json_manifest_client.render_tree ~dev ~forest article
177
-
| STRING -> "TODO"
+1
lib/frontend/dune
+1
lib/frontend/dune
+37
lib/frontend/test/dune
+37
lib/frontend/test/dune
···
1
+
(tests
2
+
(names
3
+
Test_DSL
4
+
Test_config
5
+
Test_implanting
6
+
Test_json_manifest_client
7
+
Test_legacy_xml_client)
8
+
(preprocess
9
+
(pps ppx_deriving.show ppx_yojson_conv))
10
+
(libraries
11
+
alcotest
12
+
asai
13
+
fmt
14
+
eio_main
15
+
eio
16
+
eio.unix
17
+
logs
18
+
iri
19
+
pure-html
20
+
forester.prelude
21
+
forester.core
22
+
forester.compiler
23
+
forester.frontend
24
+
forester.test))
25
+
26
+
(executable
27
+
(name Test_transclusion)
28
+
(public_name transclude)
29
+
(libraries
30
+
forester.core
31
+
forester.prelude
32
+
forester.compiler
33
+
forester.frontend
34
+
pure-html
35
+
eio_main
36
+
logs
37
+
iri))
+6
-6
lib/language_server/Call_hierarchy.ml
+6
-6
lib/language_server/Call_hierarchy.ml
···
13
13
14
14
let incoming (params : L.CallHierarchyIncomingCallsParams.t) =
15
15
let Lsp_state.{forest; _} = Lsp_state.get () in
16
-
let config = State.config forest in
17
-
let module G = (val State.graphs forest) in
16
+
let config = forest.config in
17
+
let module G = (val forest.graphs) in
18
18
match params with
19
19
| {item; _} ->
20
20
let vertex_to_item (v : _ T.vertex) =
···
28
28
| {uri; _} ->
29
29
let iri = Iri_scheme.path_to_iri ~host: config.host (Lsp.Uri.to_path uri) in
30
30
let vertex = T.Iri_vertex iri in
31
-
let run_query = Forest.run_datalog_query (State.graphs forest) in
31
+
let run_query = Forest.run_datalog_query forest.graphs in
32
32
let fwdlinks = run_query @@ Builtin_queries.fwdlinks_datalog vertex in
33
33
Eio.traceln "got %i link items" (Vertex_set.cardinal fwdlinks);
34
34
let children = run_query @@ Builtin_queries.children_datalog vertex in
···
38
38
39
39
let outgoing (params : L.CallHierarchyOutgoingCallsParams.t) =
40
40
let Lsp_state.{forest; _} = Lsp_state.get () in
41
-
let config = State.config forest in
42
-
let module G = (val State.graphs forest) in
41
+
let config = forest.config in
42
+
let module G = (val forest.graphs) in
43
43
Eio.traceln "computing outgoing calls";
44
44
match params with
45
45
| {item; _} ->
···
54
54
| {uri; _} ->
55
55
let iri = Iri_scheme.path_to_iri ~host: config.host (Lsp.Uri.to_path uri) in
56
56
let vertex = T.Iri_vertex iri in
57
-
let run_query = Forest.run_datalog_query (State.graphs forest) in
57
+
let run_query = Forest.run_datalog_query forest.graphs in
58
58
let backlinks = run_query @@ Builtin_queries.backlinks_datalog vertex in
59
59
Eio.traceln "got %i link items" (Vertex_set.cardinal backlinks);
60
60
let parents = run_query @@ Builtin_queries.context_datalog vertex in
+5
-2
lib/language_server/Change_configuration.ml
+5
-2
lib/language_server/Change_configuration.ml
···
5
5
*
6
6
*)
7
7
8
-
open Forester_compiler
9
8
open Forester_frontend
10
9
11
10
module L = Lsp.Types
···
22
21
match List.assoc_opt "configuration_file" xs with
23
22
| Some (`String f) ->
24
23
let config = Config_parser.parse_forest_config_file f in
25
-
Lsp_state.modify (fun state -> {state with forest = State.with_config config state.forest})
24
+
Lsp_state.modify (fun state ->
25
+
{state with
26
+
forest = {state.forest with config = config}
27
+
}
28
+
)
26
29
| _ ->
27
30
Eio.traceln "invalid value for configuration_file"
28
31
(* RPC.Response.Error.raise *)
+3
-4
lib/language_server/Code_action.ml
+3
-4
lib/language_server/Code_action.ml
···
6
6
*)
7
7
8
8
open Lsp_error
9
-
open Forester_compiler
10
9
11
10
module L = Lsp.Types
12
11
13
12
(* This function is mainly decodes the arguments to the command*)
14
13
let execute (params : L.ExecuteCommandParams.t) =
15
14
let Lsp_state.{forest; _} = Lsp_state.get () in
16
-
let config = State.config forest in
15
+
let config = forest.config in
17
16
match params with
18
17
| {arguments; command; _} ->
19
18
match command with
···
44
43
x
45
44
)
46
45
in
47
-
let env = State.env forest in
46
+
let env = forest.env in
48
47
let template = None in
49
48
let res = Forester_frontend.Forester.create_tree ~env ~prefix ~template ~mode ~config ~forest ~dest_dir: None in
50
49
`String res
···
68
67
69
68
let compute (_params : L.CodeActionParams.t) : L.CodeActionResult.t =
70
69
let Lsp_state.{forest; _} = Lsp_state.get () in
71
-
let config = State.config forest in
70
+
let config = forest.config in
72
71
let prefixes = config.prefixes in
73
72
Eio.traceln "got %i prefixes" (List.length prefixes);
74
73
let actions =
+2
-4
lib/language_server/Completion.ml
+2
-4
lib/language_server/Completion.ml
···
107
107
in
108
108
let Lsp_state.{forest; _} = Lsp_state.get () in
109
109
let addr_items () =
110
-
forest
111
-
|> State.parsed
110
+
forest.parsed
112
111
|> Forest.to_seq_values
113
112
|> Seq.filter_map
114
113
begin
···
148
147
(* TODO: If the selected item is not in scope in the current tree, auto-import it.
149
148
reference: https://github.com/rust-lang/rust-analyzer/blob/fc98e0657abf3ce07eed513e38274c89bbb2f8ad/crates/ide-assists/src/handlers/auto_import.rs#L15
150
149
*)
151
-
let units = State.units forest in
152
-
units
150
+
forest.units
153
151
|> Expand.Unit_map.to_list
154
152
|> List.map snd
155
153
|> List.concat_map
+18
-30
lib/language_server/Diagnostics.ml
+18
-30
lib/language_server/Diagnostics.ml
···
10
10
*)
11
11
12
12
open Forester_compiler
13
-
open Forester_core
14
13
15
14
module L = Lsp.Types
16
15
17
16
let compute (document : Lsp.Text_document.t) =
18
17
let Lsp_state.{forest; _} = Lsp_state.get () in
19
-
let config = State.config forest in
20
18
let uri = Lsp.Text_document.documentUri document in
21
-
let iri = Iri_scheme.uri_to_iri ~host: config.host uri in
22
-
Phases.(
23
-
forest
24
-
|> reparse document
25
-
|> expand_only iri
26
-
|> eval
27
-
|> State.diagnostics
28
-
|> Diagnostic_store.iter
29
-
(fun uri diagnostics ->
30
-
match diagnostics with
31
-
| [] ->
32
-
Eio.traceln "Clearing diagnostics for %s" (Lsp.Uri.to_path uri);
33
-
Publish.publish uri []
34
-
| diagnostics ->
35
-
Eio.traceln "publishing %i diagnostics to %s" (List.length diagnostics) (Lsp.Uri.to_path uri);
36
-
List.iter
37
-
(fun d ->
38
-
Eio.traceln
39
-
"%s"
40
-
(
41
-
Asai.Diagnostic.(d.explanation.value)
42
-
|> Asai.Diagnostic.string_of_text
43
-
)
44
-
)
45
-
diagnostics;
46
-
Publish.publish uri diagnostics
47
-
)
48
-
)
19
+
match Diagnostic_store.find_opt forest.diagnostics uri with
20
+
| None -> ()
21
+
| Some [] ->
22
+
Eio.traceln "Clearing diagnostics for %s" (Lsp.Uri.to_path uri);
23
+
Publish.publish uri []
24
+
| Some diagnostics ->
25
+
Eio.traceln "publishing %i diagnostics to %s" (List.length diagnostics) (Lsp.Uri.to_path uri);
26
+
List.iter
27
+
(fun d ->
28
+
Eio.traceln
29
+
"%s"
30
+
(
31
+
Asai.Diagnostic.(d.explanation.value)
32
+
|> Asai.Diagnostic.string_of_text
33
+
)
34
+
)
35
+
diagnostics;
36
+
Publish.publish uri diagnostics
+2
-4
lib/language_server/Did_change.ml
+2
-4
lib/language_server/Did_change.ml
···
5
5
*
6
6
*)
7
7
8
-
open Forester_compiler
9
8
module L = Lsp.Types
10
9
11
10
let compute
···
14
13
let Lsp_state.{forest; _} = Lsp_state.get () in
15
14
match params with
16
15
| {textDocument = {uri; _}; contentChanges} ->
17
-
let docs = State.documents forest in
18
-
match Hashtbl.find_opt docs uri with
16
+
match Hashtbl.find_opt forest.documents uri with
19
17
| None -> assert false
20
18
| Some doc ->
21
19
let new_doc = Lsp.Text_document.apply_content_changes doc contentChanges in
22
20
Eio.traceln "After change, doc has content %s" (Lsp.Text_document.text new_doc);
23
-
Hashtbl.replace docs uri new_doc;
21
+
Hashtbl.replace forest.documents uri new_doc;
24
22
Diagnostics.compute new_doc
+1
-4
lib/language_server/Did_open.ml
+1
-4
lib/language_server/Did_open.ml
···
5
5
*
6
6
*)
7
7
8
-
open Forester_compiler
9
-
10
8
module L = Lsp.Types
11
9
12
10
let compute
13
11
({textDocument = {uri; _}} as params: L.DidOpenTextDocumentParams.t)
14
12
=
15
13
let Lsp_state.{forest; _} = Lsp_state.get () in
16
-
let docs = State.documents forest in
17
14
let document =
18
15
Lsp.Text_document.make
19
16
~position_encoding: `UTF16
20
17
params
21
18
in
22
-
Hashtbl.replace docs uri document;
19
+
Hashtbl.replace forest.documents uri document;
23
20
Diagnostics.compute document
+2
-2
lib/language_server/Document_link.ml
+2
-2
lib/language_server/Document_link.ml
···
21
21
~forest: forest.resources
22
22
~router: (Legacy_xml_client.route forest)
23
23
in
24
-
let config = State.config forest in
24
+
let config = forest.config in
25
25
match params with
26
26
| {textDocument; _} ->
27
27
let Lsp_state.{forest; _} = Lsp_state.get () in
28
28
let links =
29
-
let iri = Iri_scheme.uri_to_iri ~host: forest.config.host textDocument.uri in
29
+
let iri = Iri_scheme.uri_to_iri ~host: config.host textDocument.uri in
30
30
match Imports.resolve_iri_to_code iri forest with
31
31
| None -> []
32
32
| Some tree ->
+1
-2
lib/language_server/Forester_lsp.ml
+1
-2
lib/language_server/Forester_lsp.ml
···
13
13
module LspEio = LspEio
14
14
15
15
open Forester_compiler
16
-
open Forester_frontend
17
16
18
17
open Server
19
18
open Lsp_error
···
183
182
184
183
let start ~env ~(config : Config.t) =
185
184
let lsp_io = LspEio.init env in
186
-
let forest = State_machine.batch_run ~env ~config ~dev: true in
185
+
let forest = Driver.batch_run ~env ~config ~dev: true in
187
186
Server.run
188
187
~init: {forest; lsp_io; should_shutdown = false;}
189
188
@@ fun () ->
+1
-1
lib/language_server/Hover.ml
+1
-1
lib/language_server/Hover.ml
+2
-2
lib/language_server/Inlay_hint.ml
+2
-2
lib/language_server/Inlay_hint.ml
···
19
19
_;
20
20
} ->
21
21
let Lsp_state.{forest; _} = Lsp_state.get () in
22
-
let config = State.config forest in
22
+
let config = forest.config in
23
23
let host = config.host in
24
-
match Forest.find_opt (State.parsed forest) (Iri_scheme.uri_to_iri ~host textDocument.uri) with
24
+
match Forest.find_opt forest.parsed (Iri_scheme.uri_to_iri ~host textDocument.uri) with
25
25
| None ->
26
26
None
27
27
| Some {code; _} ->
+1
-2
lib/language_server/Publish.ml
+1
-2
lib/language_server/Publish.ml
···
7
7
8
8
open Forester_prelude
9
9
open Forester_core
10
-
open Forester_compiler
11
10
12
11
module L = Lsp.Types
13
12
module Lsp_Diagnostic = Lsp.Types.Diagnostic
···
34
33
let code = `String (Reporter.Message.short_code diag.message) in
35
34
let source =
36
35
let Lsp_state.{forest; _} = Lsp_state.get () in
37
-
match Hashtbl.find_opt (State.documents forest) uri with
36
+
match Hashtbl.find_opt forest.documents uri with
38
37
| None -> None
39
38
| Some doc ->
40
39
Some (Lsp.Text_document.text doc)
-18
lib/language_server/Util.ml
-18
lib/language_server/Util.ml
···
4
4
* SPDX-License-Identifier: GPL-3.0-or-later
5
5
*)
6
6
7
-
open Forester_core
8
7
module L = Lsp.Types
9
-
10
-
(* Reporting diagnostics requires a document URI to publish *)
11
-
let guess_uri (d : Reporter.diagnostic) =
12
-
match d with
13
-
| {explanation; _} ->
14
-
match explanation.loc with
15
-
| None -> None
16
-
| Some loc ->
17
-
match Range.view loc with
18
-
| `End_of_file {source; _}
19
-
| `Range ({source; _}, _) ->
20
-
match source with
21
-
| `String _ -> None
22
-
| `File path ->
23
-
if path <> "" then
24
-
Some (Lsp.Uri.of_path path)
25
-
else None
26
8
27
9
let start_of_file =
28
10
let beginning = L.Position.create ~character: 0 ~line: 0 in
+4
-6
lib/language_server/Workspace_symbols.ml
+4
-6
lib/language_server/Workspace_symbols.ml
···
24
24
in
25
25
let trees
26
26
=
27
-
forest
28
-
|> State.parsed
27
+
forest.parsed
29
28
|> Forest.to_seq_keys
30
29
|> Seq.filter_map
31
30
(fun iri ->
···
41
40
in
42
41
let uri =
43
42
let (let*) = Option.bind in
44
-
let* tree = Forest.find_opt (State.parsed forest) iri in
43
+
let* tree = Forest.find_opt forest.parsed iri in
45
44
let* source_path = tree.source_path in
46
45
Some (Lsp.Uri.of_path source_path)
47
46
in
···
63
62
in
64
63
let symbols =
65
64
let open Forester_compiler in
66
-
forest
67
-
|> State.units
65
+
forest.units
68
66
|> Unit_map.to_seq
69
67
|> Seq.concat_map
70
68
(fun ((iri, exports): iri * _) ->
···
79
77
in
80
78
let uri =
81
79
let (let*) = Option.bind in
82
-
let* tree = Forest.find_opt (State.parsed forest) iri in
80
+
let* tree = Forest.find_opt forest.parsed iri in
83
81
let* source_path = tree.source_path in
84
82
Some (Lsp.Uri.of_path source_path)
85
83
in
+10
lib/parser/test/dune
+10
lib/parser/test/dune
+13
-29
lib/search/Search_engine.ml
+13
-29
lib/search/Search_engine.ml
···
21
21
forest.resources
22
22
"hyprtext format"
23
23
in
24
-
Format.printf "got %i results.@." (List.length ranked_results);
24
+
Format.printf "got %i ranked results.@." (List.length ranked_results);
25
25
List.iter
26
26
(fun (iri, score) ->
27
27
match Forest.get_article iri forest.resources with
···
31
31
)
32
32
ranked_results
33
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
-
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
+
(* Index.search ~fuzz: 1 index "forester" |> fun results -> Format.printf "got %d results for \"forester\" from marshalled index" (List.length results) *)
40
+
(**)
56
41
let test_search (forest : State.t) =
57
42
let s = read_line () in
58
43
let results =
···
90
75
let main ~env () =
91
76
let config = Config_parser.parse_forest_config_file "forest.toml" in
92
77
let dev = true in
93
-
let forest = State_machine.batch_run ~env ~dev ~config in
78
+
let forest = Driver.batch_run ~env ~dev ~config in
94
79
let articles = Forest.get_all_articles forest.resources in
95
80
let index =
96
-
Reporter.profile "Building index" @@ fun () ->
81
+
(* Reporter.profile "Building index" @@ fun () -> *)
97
82
Index.create articles
98
83
in
99
84
let size = Obj.reachable_words @@ Obj.repr index in
100
85
Format.printf "index size: %i@." size;
101
86
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 *)
87
+
test_search forest
88
+
(* test_search_cache forest.search_index *)
89
+
(* test_ranked forest; *)
106
90
107
91
let () =
108
92
let@ env = Eio_main.run in
+36
lib/search/search.t
+36
lib/search/search.t
···
1
+
$ git clone https://git.sr.ht/~jonsterling/forester-notes.org
2
+
Cloning into 'forester-notes.org'...
3
+
$ cd forester-notes.org
4
+
$ echo "hyprtext" | forester-search
5
+
index size: 294728
6
+
￫ info[Reporter.Message.Profiling]
7
+
￮ [0.000216s] Searching
8
+
9
+
average doc length: 11.211111 words
10
+
got 13 results
11
+
forest://forester/index
12
+
1; 0; 24; 0 = hypertexts
13
+
forest://forester/jms-0052
14
+
1; 0; 12; 0 = hypertext
15
+
forest://forester/jms-0053
16
+
1; 0; 36; 0 = hypertext
17
+
forest://forester/sterling-2024-cl-forester
18
+
0; 1; 9; 0 = hypertext
19
+
forest://forester/tfmt-0006
20
+
1; 1; 50; 0 = hypertext
21
+
forest://forester/tfmt-0007
22
+
1; 3; 8; 0 = hypertext
23
+
forest://forester/tfmt-0009
24
+
1; 0; 173; 1 = hypertext
25
+
forest://forester/tfmt-000E
26
+
1; 0; 4; 0 = hypertext
27
+
forest://forester/tfmt-000G
28
+
1; 2; 6; 0; 0 = hypertext
29
+
forest://forester/tfmt-000I
30
+
1; 6; 56; 0 = hypertext
31
+
forest://forester/tfmt-000L
32
+
1; 0; 26; 0 = hypertext
33
+
forest://forester/tfmt-000M
34
+
0; 1; 12; 0 = hypertext
35
+
forest://forester/tfmt-000O
36
+
1; 6; 206; 0 = hypertext
+4
lib/server/README.md
+4
lib/server/README.md
+7
-9
lib/server/Server.ml
+7
-9
lib/server/Server.ml
···
197
197
|> Iri_types.pct_decode
198
198
|> Repr.of_json_string
199
199
Datalog_expr.(query_t Repr.string (T.vertex_t T.content_t)) |> function
200
-
| Ok q ->
200
+
| Ok _q ->
201
201
Logs.app (fun m -> m "parsed successfully");
202
-
let (_, _, result) = State_machine.update (Query q) forest in
202
+
(* let _, _, result = Driver.update (Query q) forest in *)
203
203
begin
204
-
match result with
205
-
| Vertex_set vs -> Htmx_client.render_query_result forest vs
206
-
| Got _
207
-
| Error _
208
-
| Nothing ->
209
-
None
210
-
(* Pure_html.txt "failed to run" *)
204
+
match None with
205
+
(* FIXME :*)
206
+
(* | `Vertex_set(vs : Vertex_set.t) -> Htmx_client.render_query_result forest vs *)
207
+
| Some (`Vertex_set vs) -> Htmx_client.render_query_result forest vs
208
+
| _ -> None
211
209
end
212
210
| Error (`Msg str) ->
213
211
Logs.app (fun m -> m "failed to parse: %s" str);
-108
test/Build.t
-108
test/Build.t
···
1
-
Run build:
2
-
3
-
$ cd forest
4
-
$ forester export export.toml
5
-
$ forester build forest.toml
6
-
￫ info[Reporter.Message.Log]
7
-
￮ Building ./build/resources/4f2455dfdf10f6ad466d28c223f6bc39.svg
8
-
9
-
10
-
11
-
$ cat output/forest.json
12
-
{"person":{"title":"Author Testington","taxon":"Person","tags":[],"route":"person.xml","metas":{}},"sub":{"title":"Hello › I am a subtree","taxon":null,"tags":[],"route":"sub.xml","metas":{}},"hash/4f2455dfdf10f6ad466d28c223f6bc39":{"title":"Forest://lsp-test/hash/4f2455dfdf10f6ad466d28c223f6bc39","taxon":null,"tags":[],"route":"hash-4f2455dfdf10f6ad466d28c223f6bc39.xml","metas":{}},"index/0":{"title":"Hello › I am an anonymous subtree","taxon":null,"tags":[],"route":"index-0.xml","metas":{}},"figure":{"title":"Forest://lsp-test/figure","taxon":null,"tags":[],"route":"figure.xml","metas":{}},"lorem":{"title":"Forest://lsp-test/lorem","taxon":null,"tags":[],"route":"lorem.xml","metas":{}},"nested":{"title":"I am nested","taxon":null,"tags":[],"route":"nested.xml","metas":{}},"forest://foreign/index":{"title":"I am exported","taxon":null,"tags":[],"route":"foreign-foreign-index.xml","metas":{}},"asset":{"title":"Forest://lsp-test/asset","taxon":null,"tags":[],"route":"asset.xml","metas":{}},"index":{"title":"Hello","taxon":null,"tags":[],"route":"index.xml","metas":{}},"hello":{"title":"Hello","taxon":null,"tags":[],"route":"hello.xml","metas":{}}}
13
-
14
-
$ ls output
15
-
asset.xml
16
-
figure.xml
17
-
foreign-foreign-index.xml
18
-
forest.json
19
-
hash-4f2455dfdf10f6ad466d28c223f6bc39.xml
20
-
hash-bafkrmicdssbzi7prmhx4kqzm6cq5saqjawd5kxye7c4nep3a2ew7sx7aou.md
21
-
hello.xml
22
-
index-0.xml
23
-
index.xml
24
-
lorem.xml
25
-
nested.xml
26
-
person.xml
27
-
sub.xml
28
-
$ cat output/index.xml
29
-
<?xml version="1.0" encoding="UTF-8"?>
30
-
<?xml-stylesheet type="text/xsl" href="default.xsl"?>
31
-
<fr:tree xmlns:fr="http://www.jonmsterling.com/jms-005P.xml" root="true">
32
-
<fr:frontmatter>
33
-
<fr:authors />
34
-
<fr:addr>index</fr:addr>
35
-
<fr:route>index.xml</fr:route>
36
-
<fr:title text="Hello">Hello</fr:title>
37
-
</fr:frontmatter>
38
-
<fr:mainmatter>
39
-
<fr:tree show-metadata="false">
40
-
<fr:frontmatter>
41
-
<fr:authors />
42
-
<fr:addr>sub</fr:addr>
43
-
<fr:route>sub.xml</fr:route>
44
-
<fr:title text="I am a subtree">I am a subtree</fr:title>
45
-
</fr:frontmatter>
46
-
<fr:mainmatter />
47
-
</fr:tree>
48
-
<fr:tree show-metadata="false">
49
-
<fr:frontmatter>
50
-
<fr:authors />
51
-
<fr:addr>index/0</fr:addr>
52
-
<fr:route>index-0.xml</fr:route>
53
-
<fr:title text="I am an anonymous subtree">I am an anonymous subtree</fr:title>
54
-
</fr:frontmatter>
55
-
<fr:mainmatter />
56
-
</fr:tree>
57
-
</fr:mainmatter>
58
-
<fr:backmatter>
59
-
<fr:tree show-metadata="false" hidden-when-empty="true">
60
-
<fr:frontmatter>
61
-
<fr:title text="References">References</fr:title>
62
-
</fr:frontmatter>
63
-
<fr:mainmatter />
64
-
</fr:tree>
65
-
<fr:tree show-metadata="false" hidden-when-empty="true">
66
-
<fr:frontmatter>
67
-
<fr:title text="Context">Context</fr:title>
68
-
</fr:frontmatter>
69
-
<fr:mainmatter />
70
-
</fr:tree>
71
-
<fr:tree show-metadata="false" hidden-when-empty="true">
72
-
<fr:frontmatter>
73
-
<fr:title text="Backlinks">Backlinks</fr:title>
74
-
</fr:frontmatter>
75
-
<fr:mainmatter />
76
-
</fr:tree>
77
-
<fr:tree show-metadata="false" hidden-when-empty="true">
78
-
<fr:frontmatter>
79
-
<fr:title text="Related">Related</fr:title>
80
-
</fr:frontmatter>
81
-
<fr:mainmatter />
82
-
</fr:tree>
83
-
<fr:tree show-metadata="false" hidden-when-empty="true">
84
-
<fr:frontmatter>
85
-
<fr:title text="Contributions">Contributions</fr:title>
86
-
</fr:frontmatter>
87
-
<fr:mainmatter />
88
-
</fr:tree>
89
-
</fr:backmatter>
90
-
</fr:tree>
91
-
<<<<<<< HEAD
92
-
=======
93
-
>>>>>>> 81943b1 (Delete Iri_resolver)
94
-
<<<<<<< HEAD
95
-
=======
96
-
>>>>>>> 81943b1 (Delete Iri_resolver)
97
-
<<<<<<< HEAD
98
-
=======
99
-
>>>>>>> 81943b1 (Delete Iri_resolver)
100
-
<<<<<<< HEAD
101
-
=======
102
-
>>>>>>> 81943b1 (Delete Iri_resolver)
103
-
<<<<<<< HEAD
104
-
=======
105
-
>>>>>>> 81943b1 (Delete Iri_resolver)
106
-
<<<<<<< HEAD
107
-
=======
108
-
>>>>>>> 81943b1 (Delete Iri_resolver)
-19
test/Errors.t
-19
test/Errors.t
···
1
-
$ cd forest
2
-
$ forester build error-no-theme.toml
3
-
￫ error[Reporter.Message.Configuration_error]
4
-
ꭍ ￮ when copying theme directory
5
-
￮ No such file or directory: nonexistent
6
-
7
-
[1]
8
-
$ forester build error-no-assets.toml
9
-
￫ error[Reporter.Message.Configuration_error]
10
-
ꭍ ￮ when planting assets
11
-
￮ No such file or directory: nonexistent
12
-
13
-
[1]
14
-
$ forester build error-no-trees.toml
15
-
￫ error[Reporter.Message.Configuration_error]
16
-
ꭍ ￮ when loading trees from disk
17
-
￮ No such file or directory: nonexistent
18
-
19
-
[1]
-23
test/Export.t
-23
test/Export.t
···
1
-
$ cd forest
2
-
3
-
Export the forest defined by `export.toml`
4
-
5
-
$ forester export -v export.toml
6
-
forester: [INFO] Parse trees...
7
-
8
-
forester: [INFO] Expand, evaluate and analyse forest...
9
-
10
-
forester: [INFO] Exporting forest...
11
-
12
-
Verify that the foreign blob can be implanted.
13
-
14
-
$ forester build -v forest.toml
15
-
forester: [INFO] Implant foreign forest from `$TESTCASE_ROOT/forest/export/foreign.json'...
16
-
17
-
forester: [INFO] Parse trees...
18
-
19
-
forester: [INFO] Expand, evaluate and analyse forest...
20
-
21
-
￫ info[Reporter.Message.Log]
22
-
￮ Building ./build/resources/4f2455dfdf10f6ad466d28c223f6bc39.svg
23
-
-37
test/Init.t
-37
test/Init.t
···
1
-
$ mkdir new-forest
2
-
$ cd new-forest
3
-
$ forester init
4
-
Cloning into '$TESTCASE_ROOT/new-forest/theme'...
5
-
Note: switching to '4.3.0'.
6
-
7
-
You are in 'detached HEAD' state. You can look around, make experimental
8
-
changes and commit them, and you can discard any commits you make in this
9
-
state without impacting any branches by switching back to a branch.
10
-
11
-
If you want to create a new branch to retain commits you create, you may
12
-
do so (now or later) by using -c with the switch command. Example:
13
-
14
-
git switch -c <new-branch-name>
15
-
16
-
Or undo this operation with:
17
-
18
-
git switch -
19
-
20
-
Turn off this advice by setting config variable advice.detachedHead to false
21
-
22
-
HEAD is now at 7dc5c6d don't render backmatter on designated root (TODO: replace by customisation)
23
-
￫ info[Reporter.Message.Log]
24
-
￮ Initialized forest, try editing `trees/index.tree` and running `forester build`. Afterwards, you can open `output/index.xml` in your browser to view your forest.
25
-
26
-
$ forester build -v
27
-
forester: [INFO] Parse trees...
28
-
29
-
forester: [INFO] Expand, evaluate and analyse forest...
30
-
31
-
$ ls
32
-
assets
33
-
forest.toml
34
-
output
35
-
theme
36
-
trees
37
-
+33
test/Prelude.ml
+33
test/Prelude.ml
···
7
7
open Forester_prelude
8
8
open Forester_core
9
9
open Forester_compiler
10
+
open Forester_parser
10
11
11
12
let rec strip_loc : Code.t -> Code.t = fun nodes ->
12
13
List.map
···
50
51
| Error _ ->
51
52
node
52
53
54
+
type raw_tree = {path: string; content: string}
55
+
53
56
let parse_string str =
54
57
let lexbuf = Lexing.from_string str in
55
58
let res = Parse.parse ~source: (`String {title = None; content = str}) lexbuf in
56
59
Result.map strip_loc res
60
+
61
+
let with_open_tmp_dir ~env kont =
62
+
let open Eio in
63
+
let dir_name = string_of_int @@ Oo.id (object end) in
64
+
let cwd = Eio.Stdenv.cwd env in
65
+
let tmp = "_tmp" in
66
+
let tmp_path = Eio.Path.(cwd / tmp / dir_name) in
67
+
Path.rmtree ~missing_ok: true tmp_path;
68
+
Path.mkdirs ~exists_ok: true ~perm: 0o755 tmp_path;
69
+
(* let@ p = Eio.Path.with_open_dir tmp_path in *)
70
+
let result = kont tmp_path in
71
+
Path.rmtree ~missing_ok: true tmp_path;
72
+
result
73
+
74
+
let setup_forest ~env ~raw_trees ~(config : Config.t) kont =
75
+
let@ tmp = with_open_tmp_dir ~env in
76
+
let module EP = Eio.Path in
77
+
(* let tree_dir = EP.(tmp / "trees") in *)
78
+
let tree_dirs =
79
+
List.map
80
+
(fun dir_name ->
81
+
let dir = EP.(tmp / dir_name) in
82
+
EP.(mkdir ~perm: 0o755 dir);
83
+
dir
84
+
)
85
+
config.trees
86
+
in
87
+
let create = `Exclusive 0o644 in
88
+
List.iter (fun tree -> EP.(save ~create (List.hd tree_dirs / tree.path) tree.content)) raw_trees;
89
+
kont tmp
test/README.md
lib/frontend/test/transclusion.t
test/README.md
lib/frontend/test/transclusion.t
-64
test/Render.t
-64
test/Render.t
···
1
-
$ cd forest
2
-
$ forester render --addr=index --format=xml
3
-
<?xml version="1.0" encoding="UTF-8"?>
4
-
5
-
<fr:tree xmlns:fr="http://www.jonmsterling.com/jms-005P.xml" root="true">
6
-
<fr:frontmatter>
7
-
<fr:authors />
8
-
<fr:addr>index</fr:addr>
9
-
<fr:route>index.xml</fr:route>
10
-
<fr:title text="Hello">Hello</fr:title>
11
-
</fr:frontmatter>
12
-
<fr:mainmatter>
13
-
<fr:tree show-metadata="false">
14
-
<fr:frontmatter>
15
-
<fr:authors />
16
-
<fr:addr>sub</fr:addr>
17
-
<fr:route>sub.xml</fr:route>
18
-
<fr:title text="I am a subtree">I am a subtree</fr:title>
19
-
</fr:frontmatter>
20
-
<fr:mainmatter />
21
-
</fr:tree>
22
-
<fr:tree show-metadata="false">
23
-
<fr:frontmatter>
24
-
<fr:authors />
25
-
<fr:addr>index/0</fr:addr>
26
-
<fr:route>index-0.xml</fr:route>
27
-
<fr:title text="I am an anonymous subtree">I am an anonymous subtree</fr:title>
28
-
</fr:frontmatter>
29
-
<fr:mainmatter />
30
-
</fr:tree>
31
-
</fr:mainmatter>
32
-
<fr:backmatter>
33
-
<fr:tree show-metadata="false" hidden-when-empty="true">
34
-
<fr:frontmatter>
35
-
<fr:title text="References">References</fr:title>
36
-
</fr:frontmatter>
37
-
<fr:mainmatter />
38
-
</fr:tree>
39
-
<fr:tree show-metadata="false" hidden-when-empty="true">
40
-
<fr:frontmatter>
41
-
<fr:title text="Context">Context</fr:title>
42
-
</fr:frontmatter>
43
-
<fr:mainmatter />
44
-
</fr:tree>
45
-
<fr:tree show-metadata="false" hidden-when-empty="true">
46
-
<fr:frontmatter>
47
-
<fr:title text="Backlinks">Backlinks</fr:title>
48
-
</fr:frontmatter>
49
-
<fr:mainmatter />
50
-
</fr:tree>
51
-
<fr:tree show-metadata="false" hidden-when-empty="true">
52
-
<fr:frontmatter>
53
-
<fr:title text="Related">Related</fr:title>
54
-
</fr:frontmatter>
55
-
<fr:mainmatter />
56
-
</fr:tree>
57
-
<fr:tree show-metadata="false" hidden-when-empty="true">
58
-
<fr:frontmatter>
59
-
<fr:title text="Contributions">Contributions</fr:title>
60
-
</fr:frontmatter>
61
-
<fr:mainmatter />
62
-
</fr:tree>
63
-
</fr:backmatter>
64
-
</fr:tree>
test/Test_DSL.ml
lib/frontend/test/Test_DSL.ml
test/Test_DSL.ml
lib/frontend/test/Test_DSL.ml
test/Test_LaTeX_pipeline.ml
lib/compiler/test/Test_LaTeX_pipeline.ml
test/Test_LaTeX_pipeline.ml
lib/compiler/test/Test_LaTeX_pipeline.ml
-108
test/Test_compiler.ml
-108
test/Test_compiler.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_prelude
9
-
open Forester_compiler
10
-
open Forester_frontend
11
-
12
-
module T = Types
13
-
14
-
let () =
15
-
Logs.set_level (Some Debug);
16
-
let@ env = Eio_main.run in
17
-
let config = Config.default in
18
-
let tree_dirs = Eio_util.paths_of_dirs ~env config.trees in
19
-
20
-
(* This test verifies that the `reparse` function works correctly.*)
21
-
let test_reparsing () =
22
-
let@ () = Reporter.test_run in
23
-
(*First, perform a regular batch compilation run.*)
24
-
let before_forest = State_machine.batch_run ~env ~config ~dev: false in
25
-
(* Get the URI of "reparse.tree". In order to make the test reproducible,
26
-
we can't use hardcoded paths, as those may be different in CI and on
27
-
different hosts.*)
28
-
let uri =
29
-
Option.get @@
30
-
let@ uri = Seq.find_map @~ Hashtbl.to_seq_keys before_forest.documents in
31
-
if String.ends_with ~suffix: "reparse.tree" (Lsp.Uri.to_string uri) then
32
-
Some uri
33
-
else None
34
-
in
35
-
let vtx = T.Iri_vertex (Iri_scheme.uri_to_iri ~host: config.host uri) in
36
-
let reparsed_forest =
37
-
let open Phases in
38
-
let document =
39
-
(* Create a Text_document.t with new content.*)
40
-
let textDocument =
41
-
Lsp.Types.TextDocumentItem.create
42
-
~languageId: "forester"
43
-
~uri
44
-
~version: 2
45
-
~text: {| \title{I am now importing something and the import graphs should be updated accordingly} \import{a}|}
46
-
in
47
-
Lsp.Text_document.make ~position_encoding: `UTF16 @@ Lsp.Types.DidOpenTextDocumentParams.create ~textDocument
48
-
in
49
-
reparse document before_forest
50
-
in
51
-
let module Graphs = (val reparsed_forest.graphs) in
52
-
let import_graph = Graphs.get_rel Query.Edges "imports" in
53
-
(* FIXME: *)
54
-
Alcotest.(check string) "" "" ""
55
-
(* Alcotest.(check bool) *)
56
-
(* "" *)
57
-
(* true *)
58
-
(* (Forest_graph.out_degree import_graph vtx > 0) *)
59
-
in
60
-
let test_batch_run () =
61
-
let forest =
62
-
let@ () = Reporter.easy_run in
63
-
State_machine.batch_run ~env ~config ~dev: false
64
-
in
65
-
Alcotest.(check int) "" 8 @@ List.length @@ Forest.get_all_articles forest.resources
66
-
in
67
-
let test_includes_paths () =
68
-
let@ () = Reporter.easy_run in
69
-
let forest =
70
-
State_machine.batch_run
71
-
~env
72
-
~config
73
-
~dev: true
74
-
in
75
-
let path =
76
-
let@ {frontmatter = {source_path; _}; _} =
77
-
Option.bind @@ Forest.get_article (Iri.of_string "forest://my-forest/index") forest.resources
78
-
in
79
-
source_path
80
-
in
81
-
Alcotest.(check bool) "" true @@ Option.is_some path
82
-
in
83
-
let test_omits_paths () =
84
-
let@ () = Reporter.easy_run in
85
-
let forest = State_machine.batch_run ~env ~config ~dev: false in
86
-
let path =
87
-
let@ {frontmatter = {source_path; _}; _} =
88
-
Option.bind @@ Forest.get_article (Iri.of_string "forest://my-forest/index") forest.resources
89
-
in
90
-
source_path
91
-
in
92
-
Alcotest.(check bool) "" true @@ Option.is_none path
93
-
in
94
-
let open Alcotest in
95
-
run
96
-
"check compiler internals"
97
-
[
98
-
"pipeline",
99
-
[
100
-
test_case "basic batch run" `Quick test_batch_run;
101
-
test_case "reparsing" `Quick test_reparsing
102
-
];
103
-
"dev mode",
104
-
[
105
-
test_case "includes paths in dev mode" `Quick test_includes_paths;
106
-
test_case "omits paths outside dev mode" `Quick test_omits_paths;
107
-
]
108
-
]
+2
-2
test/Test_config.ml
lib/frontend/test/Test_config.ml
+2
-2
test/Test_config.ml
lib/frontend/test/Test_config.ml
···
4
4
* SPDX-License-Identifier: GPL-3.0-or-later
5
5
*)
6
6
7
+
open Forester_test
7
8
open Testables
8
-
open Forester_core
9
9
open Forester_compiler
10
10
open Forester_frontend
11
11
···
71
71
"You need to set the `host' key in your configuration file; this is a global identifier that will be used to distinguish your forest from other forests (you can use your name, e.g. `johnqpublic')";
72
72
in
73
73
let emit = function
74
-
| {message; explanation; _} ->
74
+
| {message; _} ->
75
75
Alcotest.(check Testables.message) "" Configuration_error message
76
76
in
77
77
Forester_core.Reporter.run ~fatal ~emit @@ fun () ->
+8
-7
test/Test_e2e.ml
+8
-7
test/Test_e2e.ml
···
78
78
(Lsp.Header.to_string header)
79
79
content
80
80
in
81
-
let stdin =
81
+
let _stdin =
82
82
Eio.Flow.string_source
83
83
initialize_request
84
84
in
85
85
let paths = parse_paths env#fs @@ Sys.getenv "PATH" in
86
-
let forester = Option.get @@ which "forester" paths in
87
-
(* let _o = *)
88
-
(* pipe_into ~env stdin [forester; "lsp"] *)
89
-
(* in *)
86
+
let _forester = Option.get @@ which "forester" paths in
90
87
Alcotest.(check string)
91
88
""
92
89
""
93
90
""
94
91
in
95
92
let open Alcotest in
96
-
(* Format.printf "%s@." o *)
97
-
run "Language server" ["initialization", [test_case "" `Quick test_initialization]]
93
+
run
94
+
"Language server"
95
+
[
96
+
"initialization",
97
+
[test_case "" `Quick test_initialization]
98
+
]
+9
-12
test/Test_errors.ml
+9
-12
test/Test_errors.ml
···
7
7
open Forester_core
8
8
open Forester_prelude
9
9
open Forester_compiler
10
-
open Forester_compiler
11
-
open Forester_frontend
12
10
open Testables
13
11
open Prelude
14
12
···
20
18
let test_parse_error_explanation src expect =
21
19
Alcotest.(check @@ result code string)
22
20
""
21
+
(Result.Error expect)
23
22
(
24
-
parse_string {||}
23
+
parse_string src
25
24
|> Result.map_error
26
25
(fun d -> Asai.Diagnostic.string_of_text d.explanation.value)
27
26
)
28
-
(Result.Error "")
29
27
30
28
let () =
31
29
let@ env = Eio_main.run in
32
30
let@ () = Reporter.easy_run in
33
31
let config = {Config.default with trees = ["errors"]} in
34
-
let tree_dirs = Eio_util.paths_of_dirs ~env config.trees in
35
-
let mk_iri addr = Iri_scheme.user_iri ~host: config.host addr in
36
-
let _, forest, _ =
37
-
Phases.init ~env ~config ~dev: false
38
-
|> State_machine.(update Load_all_configured_dirs)
32
+
let _tree_dirs = Eio_util.paths_of_dirs ~env config.trees in
33
+
let _mk_iri addr = Iri_scheme.user_iri ~host: config.host addr in
34
+
let _, forest =
35
+
State.make ~env ~config ~dev: false ()
36
+
|> Driver.(update Load_all_configured_dirs)
39
37
in
40
-
let documents = State.documents forest in
41
38
let parse_error_uri =
42
-
documents
39
+
forest.documents
43
40
|> Hashtbl.to_seq_keys
44
41
|> Seq.find_map
45
42
(fun uri ->
···
55
52
""
56
53
{|syntax error, unexpected "<"|}
57
54
(
58
-
Hashtbl.find documents parse_error_uri
55
+
Hashtbl.find forest.documents parse_error_uri
59
56
|> Parse.parse_document
60
57
|> Result.get_error |> fun d ->
61
58
Asai.Diagnostic.string_of_text d.explanation.value
+11
-14
test/Test_eval.ml
lib/compiler/test/Test_eval.ml
+11
-14
test/Test_eval.ml
lib/compiler/test/Test_eval.ml
···
5
5
*)
6
6
7
7
open Forester_core
8
-
open Forester_prelude
8
+
open Forester_test
9
9
open Forester_compiler
10
-
open Forester_frontend
11
10
12
11
module T = Types
13
12
14
13
let eval_string ~iri ~host str =
15
14
str
16
-
|> Prelude.parse_string
15
+
|> parse_string
17
16
|> Result.get_ok
18
17
|> (fun code -> Code.{code; source_path = None; iri = None; timestamp = None;})
19
-
|> Expand.expand_tree ~quit_on_error: false ~host Expand.Env.empty
20
-
|> (fun (_, _, syn) ->
21
-
Eval.eval_tree ~host ~iri ~source_path: None syn.syn
18
+
|> Expand.expand_tree ~host Expand.Env.empty
19
+
|> (fun (_, _, tree) ->
20
+
Eval.eval_tree ~host ~iri ~source_path: None tree.syn
22
21
)
23
-
|> (fun (ds, {articles; _}) -> (ds, (List.hd articles).mainmatter))
22
+
|> (fun (Eval.{articles; _}, _) -> ((List.hd articles).mainmatter))
24
23
25
24
let () =
26
25
Logs.set_level (Some Debug);
···
28
27
let host = config.host in
29
28
let iri = Iri_scheme.user_iri ~host "test" in
30
29
let open Forester_frontend.DSL in
31
-
let open Forester_frontend.DSL.Datalog in
32
30
let test_eval str res =
33
-
Alcotest.(check (pair (list Testables.diagnostic) Testables.content))
31
+
Alcotest.(check Testables.content)
34
32
""
35
33
(eval_string ~iri ~host str)
36
34
res
37
35
in
38
-
let test_verbatim () = test_eval {|\verb<<|asdf<<|} ([], T.Content [cdata "asdf"]) in
36
+
let test_verbatim () = test_eval {|\verb<<|asdf<<|} (T.Content [cdata "asdf"]) in
39
37
let test_datalog () =
40
38
test_eval
41
39
{|\execute\datalog{
42
40
\rel/accepted-or-refereed ?X -: {\rel/has-tag ?X '{refereed}}
43
41
}|}
44
-
([], T.Content [])
42
+
(T.Content [])
45
43
in
46
44
let test_let () =
47
45
test_eval
48
46
{|\let\foo[x]{\x}
49
47
\foo{bar}
50
48
|}
51
-
([], T.Content [txt "bar"])
49
+
(Content [txt "bar"])
52
50
in
53
51
let test_def () =
54
52
test_eval
55
53
{|\def\foo[x]{\x}
56
54
\foo{bar}
57
55
|}
58
-
([], T.Content [txt "bar"])
56
+
(T.Content [txt "bar"])
59
57
in
60
58
let test_object () =
61
59
test_eval
···
72
70
\my-object#method1
73
71
|}
74
72
(
75
-
[],
76
73
T.Content
77
74
[
78
75
txt "the";
+2
-1
test/Test_expansion.ml
lib/compiler/test/Test_expansion.ml
+2
-1
test/Test_expansion.ml
lib/compiler/test/Test_expansion.ml
···
7
7
open Forester_core
8
8
open Forester_compiler
9
9
open Forester_frontend
10
+
open Forester_test
10
11
open Testables
11
12
12
13
let () =
···
14
15
let host = "test" in
15
16
let _, env, result = (
16
17
Expand.expand_tree
17
-
~quit_on_error: true
18
+
(* ~quit_on_error: true *)
18
19
~host
19
20
Expand.Env.empty
20
21
{
test/Test_graph_database.ml
lib/compiler/test/Test_graph_database.ml
test/Test_graph_database.ml
lib/compiler/test/Test_graph_database.ml
test/Test_implanting.ml
lib/frontend/test/Test_implanting.ml
test/Test_implanting.ml
lib/frontend/test/Test_implanting.ml
-119
test/Test_import_graph.ml
-119
test/Test_import_graph.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_compiler
9
-
open Forester_prelude
10
-
open Forester_frontend
11
-
12
-
module T = Types
13
-
14
-
let config = {Config.default with trees = ["imports"]}
15
-
16
-
let () =
17
-
let@ env = Eio_main.run in
18
-
(* Logs.set_level (Some Debug); *)
19
-
Logs.set_reporter (Logs_fmt.reporter ());
20
-
let open Alcotest in
21
-
let forest =
22
-
let@ () = Reporter.easy_run in
23
-
State_machine.(
24
-
Phases.init ~env ~config ~dev: false
25
-
|> run_action Load_all_configured_dirs
26
-
)
27
-
in
28
-
let batch_graph =
29
-
Imports.run_builder
30
-
{
31
-
forest;
32
-
graph = Forest_graph.create ();
33
-
follow = false
34
-
}
35
-
in
36
-
let mk_vtx addr = T.Iri_vertex (Iri_scheme.user_iri ~host: config.host addr) in
37
-
let vtx_a = mk_vtx "a" in
38
-
let vtx_b = mk_vtx "b" in
39
-
let vtx_c = mk_vtx "c" in
40
-
let vtx_d = mk_vtx "d" in
41
-
let vtx_e = mk_vtx "e" in
42
-
let has_edge g v w = Forest_graph.mem_edge g v w in
43
-
let test_parsed_trees () =
44
-
Alcotest.(check bool)
45
-
"number of trees"
46
-
true
47
-
((Hashtbl.length forest.documents) = (Forest.length forest.parsed))
48
-
in
49
-
let test_graph () =
50
-
Alcotest.(check bool)
51
-
"number of vertices"
52
-
true
53
-
(Forest.length forest.parsed >= (Forest_graph.nb_vertex batch_graph));
54
-
Alcotest.(check bool)
55
-
"has edges"
56
-
true
57
-
(
58
-
List.for_all
59
-
Fun.id
60
-
[
61
-
(has_edge batch_graph vtx_b vtx_a);
62
-
(has_edge batch_graph vtx_c vtx_b);
63
-
(has_edge batch_graph vtx_d vtx_c);
64
-
(has_edge batch_graph vtx_e vtx_c);
65
-
]
66
-
)
67
-
in
68
-
let test_minimal_graph () =
69
-
let@ () = Reporter.easy_run in
70
-
let minimal_graph =
71
-
Imports.run_builder
72
-
~root: (Iri_scheme.user_iri ~host: config.host "a")
73
-
{
74
-
forest = Phases.init ~env ~dev: false ~config;
75
-
graph = Forest_graph.create ();
76
-
follow = true
77
-
}
78
-
in
79
-
(* Although the imports directory contains more trees, the graph only has 5
80
-
vertices.*)
81
-
Alcotest.(check int)
82
-
"minmal graph has correct number vertices"
83
-
5
84
-
(Forest_graph.nb_vertex minimal_graph)
85
-
in
86
-
let test_phase () =
87
-
let iri = Iri_scheme.user_iri ~host: config.host "a" in
88
-
Alcotest.(check bool)
89
-
""
90
-
true
91
-
(
92
-
try
93
-
let _ = (
94
-
let@ () = Reporter.easy_run in
95
-
State_machine.render_tree ~env ~config ~dev: false HTML iri
96
-
)
97
-
in
98
-
true
99
-
with
100
-
| exn ->
101
-
Eio.traceln "%a" Eio.Exn.pp exn;
102
-
assert false
103
-
)
104
-
in
105
-
run
106
-
"Import graph"
107
-
[
108
-
"creating import graph",
109
-
[
110
-
test_case "check parsed trees" `Quick test_parsed_trees;
111
-
test_case "check number of vertices" `Quick test_graph;
112
-
];
113
-
"creating minimal import graph",
114
-
[
115
-
test_case "running builder" `Quick test_minimal_graph;
116
-
test_case "run compilation phase" `Quick test_phase;
117
-
(* test_case "check dependencies" `Quick test_dependencies; *)
118
-
]
119
-
]
-3
test/Test_iri_util.ml
lib/compiler/test/Test_iri_util.ml
-3
test/Test_iri_util.ml
lib/compiler/test/Test_iri_util.ml
test/Test_json_manifest_client.ml
lib/frontend/test/Test_json_manifest_client.ml
test/Test_json_manifest_client.ml
lib/frontend/test/Test_json_manifest_client.ml
test/Test_legacy_xml_client.ml
lib/frontend/test/Test_legacy_xml_client.ml
test/Test_legacy_xml_client.ml
lib/frontend/test/Test_legacy_xml_client.ml
+1
-14
test/Test_parser.ml
lib/parser/test/Test_parser.ml
+1
-14
test/Test_parser.ml
lib/parser/test/Test_parser.ml
···
4
4
* SPDX-License-Identifier: GPL-3.0-or-later
5
5
*)
6
6
7
-
open Forester_prelude
7
+
open Forester_test
8
8
open Forester_core
9
-
open Forester_compiler
10
9
open Testables
11
-
open Prelude
12
10
open Forester_frontend.DSL.Code
13
11
14
12
let test_prim () =
···
136
134
}|}
137
135
)
138
136
139
-
let test_file_parsing () =
140
-
Alcotest.(check @@ result code diagnostic)
141
-
"same nodes"
142
-
(Ok [ident ["foo"]])
143
-
(
144
-
let@ () = Reporter.easy_run in
145
-
Result.map strip_loc @@
146
-
Parse.parse_file "trees/index.tree"
147
-
)
148
-
149
137
let () =
150
138
let open Alcotest in
151
139
run
···
157
145
"verbatim", [test_case "verbatim" `Quick test_verbatim];
158
146
"math", [test_case "math" `Quick test_math];
159
147
"object", [test_case "object" `Quick test_object];
160
-
"file", [test_case "parse file" `Quick test_file_parsing];
161
148
]
+22
-12
test/Test_transclusion.ml
lib/frontend/test/Test_transclusion.ml
+22
-12
test/Test_transclusion.ml
lib/frontend/test/Test_transclusion.ml
···
11
11
open Forester_compiler
12
12
open Forester_frontend
13
13
14
-
module EP = Eio.Path
15
-
16
14
module T = Types
17
15
module HTML = Pure_html.HTML
18
16
19
-
let config = {Config.default with trees = ["transclude"]}
17
+
let config = {Config.default with trees = ["transclude"]; host = "test"}
20
18
let host = config.host
21
19
22
20
let href = Iri_scheme.user_iri ~host "transcludee"
···
38
36
39
37
let () =
40
38
let@ env = Eio_main.run in
39
+
Logs.set_level (Some Debug);
41
40
let@ () = Reporter.easy_run in
42
-
(* Needs to be false to make tests reproducible. The source path depends on the host *)
43
-
let tree_dirs = Eio_util.paths_of_dirs ~env config.trees in
44
-
let forest =
45
-
Phases.init ~env ~config ~dev: false
46
-
|> State_machine.(run_action Load_all_configured_dirs)
47
-
in
48
41
let iri = Iri_scheme.user_iri ~host "transcludee" in
49
-
let print_transclusion
50
-
: T.transclusion -> unit
51
-
= fun t ->
42
+
let resources = Iri_tbl.create 10 in
43
+
Iri_tbl.add
44
+
resources
45
+
iri
46
+
(
47
+
T.(
48
+
Article
49
+
{
50
+
frontmatter =
51
+
default_frontmatter
52
+
~iri: (Iri.of_string "forest://test/transcludee")
53
+
~title: (Content [Text "I am being transcluded"])
54
+
();
55
+
mainmatter = Content [Text "Hello"];
56
+
backmatter = Content []
57
+
}
58
+
)
59
+
);
60
+
let forest = {(State.make ~env ~config ~dev: false ()) with resources} in
61
+
let print_transclusion : T.transclusion -> unit = fun t ->
52
62
let content = Option.get @@ Forest.get_content_of_transclusion t forest.resources in
53
63
Format.printf
54
64
"%a"
+3
-2
test/Testables.ml
+3
-2
test/Testables.ml
···
39
39
40
40
let message = testable Reporter.Message.pp (=)
41
41
42
-
let code = testable Code.pp (=)
42
+
let code = testable Forester_parser.Code.pp (=)
43
43
let syn = testable Syn.pp (=)
44
44
let path = testable Trie.pp_path (=)
45
45
let data = testable Resolver.P.pp_data (=)
···
55
55
let pp fmt t = Format.pp_print_string fmt (Lsp.Text_document.text t) in
56
56
testable pp (=)
57
57
58
-
let code = testable Code.pp (=)
59
58
let tree = testable Code.pp_tree (=)
60
59
61
60
let result = testable Eval.pp_result (=)
62
61
let content = testable Types.pp_content (=)
62
+
63
+
let action = testable Driver.Action.pp (=)
-61
test/Transclude.t
-61
test/Transclude.t
···
1
-
$ transclude
2
-
<?xml version="1.0" encoding="UTF-8"?>
3
-
4
-
<fr:tree xmlns:fr="http://www.jonmsterling.com/jms-005P.xml" root="false">
5
-
<fr:frontmatter>
6
-
<fr:authors />
7
-
<fr:addr>transcludee</fr:addr>
8
-
<fr:route>transcludee.xml</fr:route>
9
-
<fr:title text="" />
10
-
</fr:frontmatter>
11
-
<fr:mainmatter>
12
-
<fr:tree show-metadata="false">
13
-
<fr:frontmatter>
14
-
<fr:authors />
15
-
<fr:addr>transcludee</fr:addr>
16
-
<fr:route>transcludee.xml</fr:route>
17
-
<fr:title text="I am being transcluded">I am being transcluded</fr:title>
18
-
</fr:frontmatter>
19
-
<fr:mainmatter>
20
-
<fr:info>Transclusion loop detected, rendering stopped.</fr:info>
21
-
</fr:mainmatter>
22
-
</fr:tree>
23
-
</fr:mainmatter>
24
-
<fr:backmatter />
25
-
</fr:tree>
26
-
<?xml version="1.0" encoding="UTF-8"?>
27
-
28
-
<fr:tree xmlns:fr="http://www.jonmsterling.com/jms-005P.xml" root="false">
29
-
<fr:frontmatter>
30
-
<fr:authors />
31
-
<fr:addr>transcludee</fr:addr>
32
-
<fr:route>transcludee.xml</fr:route>
33
-
<fr:title text="" />
34
-
</fr:frontmatter>
35
-
<fr:mainmatter>I am being transcluded</fr:mainmatter>
36
-
<fr:backmatter />
37
-
</fr:tree>
38
-
<?xml version="1.0" encoding="UTF-8"?>
39
-
40
-
<fr:tree xmlns:fr="http://www.jonmsterling.com/jms-005P.xml" root="false">
41
-
<fr:frontmatter>
42
-
<fr:authors />
43
-
<fr:addr>transcludee</fr:addr>
44
-
<fr:route>transcludee.xml</fr:route>
45
-
<fr:title text="" />
46
-
</fr:frontmatter>
47
-
<fr:mainmatter>
48
-
<fr:tree show-metadata="true">
49
-
<fr:frontmatter>
50
-
<fr:authors />
51
-
<fr:addr>transcludee</fr:addr>
52
-
<fr:route>transcludee.xml</fr:route>
53
-
<fr:title text="I am being transcluded">I am being transcluded</fr:title>
54
-
</fr:frontmatter>
55
-
<fr:mainmatter>
56
-
<fr:info>Transclusion loop detected, rendering stopped.</fr:info>
57
-
</fr:mainmatter>
58
-
</fr:tree>
59
-
</fr:mainmatter>
60
-
<fr:backmatter />
61
-
</fr:tree>
+13
-83
test/dune
+13
-83
test/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-26-27-33)))
9
-
(_
10
-
(env-vars
11
-
(FORESTERLSP_TEST true))))
12
-
13
-
(cram
14
-
(applies_to Lsp)
15
-
(deps %{bin:forester} %{bin:nvim}))
16
-
17
-
(cram
18
-
(applies_to Transclude)
19
-
(deps
20
-
%{bin:transclude}
21
-
(glob_files_rec ./transclude/*)))
22
-
23
-
(cram
24
-
(applies_to :whole_subtree)
25
-
(deps
26
-
%{bin:forester}
27
-
(glob_files_rec ./forest/*)))
28
-
29
-
(executables
30
-
(names Test_transclusion)
31
-
(public_names transclude)
32
-
(libraries
33
-
logs
34
-
logs.fmt
35
-
pure-html
36
-
eio
37
-
eio.core
38
-
eio.unix
39
-
eio_main
40
-
lsp
41
-
yojson
42
-
forester.language_server
43
-
forester.frontend
44
-
forester.prelude
45
-
forester.compiler
46
-
forester.core))
47
-
48
-
(alias
49
-
(name dev))
50
-
51
-
(tests
52
-
(names
53
-
Test_LaTeX_pipeline
54
-
Test_DSL
55
-
Test_compiler
56
-
Test_config
57
-
Test_errors
58
-
Test_expansion
59
-
Test_graph_database
60
-
Test_import_graph
61
-
Test_implanting
62
-
Test_iri_util
63
-
Test_json_manifest_client
64
-
Test_legacy_xml_client
65
-
Test_parser
66
-
Test_eval)
5
+
(library
6
+
(name Forester_test)
7
+
(public_name forester.test)
67
8
(preprocess
68
9
(pps ppx_deriving.show ppx_yojson_conv))
69
-
(deps
70
-
(glob_files_rec ./errors/*)
71
-
(glob_files_rec ./trees/*)
72
-
(glob_files_rec ./imports/*))
73
10
(libraries
74
11
alcotest
75
-
asai
76
-
bwd
12
+
forester.prelude
13
+
forester.core
14
+
forester.compiler
15
+
forester.parser
16
+
forester.frontend
77
17
eio
78
-
eio.core
79
-
eio.unix
80
18
eio_main
19
+
eio.unix
20
+
asai
21
+
bwd
81
22
fmt
82
-
forester.compiler
83
-
forester.core
84
-
forester.frontend
85
-
forester.language_server
86
-
forester.parser
87
-
forester.prelude
88
23
iri
89
-
jsonrpc
90
-
logs
91
-
logs.fmt
92
24
lsp
93
-
pure-html
94
-
unix
95
-
yojson
96
-
yuujinchou))
25
+
jsonrpc
26
+
yojson))
-1
test/errors/expansion_error.tree
-1
test/errors/expansion_error.tree
···
1
-
\foo/bar
-1
test/errors/parse_error.tree
-1
test/errors/parse_error.tree
···
1
-
\<xml{
-1
test/forest/assets/asset.md
-1
test/forest/assets/asset.md
···
1
-
# I am an asset
-7
test/forest/error-no-assets.toml
-7
test/forest/error-no-assets.toml
-6
test/forest/error-no-theme.toml
-6
test/forest/error-no-theme.toml
-6
test/forest/error-no-trees.toml
-6
test/forest/error-no-trees.toml
-7
test/forest/export.toml
-7
test/forest/export.toml
-1
test/forest/for_export/index.tree
-1
test/forest/for_export/index.tree
···
1
-
\title{I am exported}
-8
test/forest/forest.toml
-8
test/forest/forest.toml
-7
test/forest/no-export.toml
-7
test/forest/no-export.toml
test/forest/theme/.gitkeep
test/forest/theme/.gitkeep
This is a binary file and will not be displayed.
-1
test/forest/trees/asset.tree
-1
test/forest/trees/asset.tree
···
1
-
\route-asset{assets/asset.md}
-28
test/forest/trees/figure.tree
-28
test/forest/trees/figure.tree
···
1
-
\xmlns:html{http://www.w3.org/1999/xhtml}
2
-
3
-
\def\NFA/ep{NFA\<html:sup>{#{\varepsilon}}}
4
-
5
-
\def\automata/tex-preamble{
6
-
\usepackage{tikz}
7
-
\usepackage{amssymb}
8
-
%\usepackage[tt=false]{libertine}
9
-
\usetikzlibrary{automata,positioning}
10
-
}
11
-
12
-
\figure{
13
-
\tex{\automata/tex-preamble}{
14
-
\begin{tikzpicture}[node distance=1.5cm,on grid]
15
-
\node[state,initial] (q0) {$q_0$};
16
-
\node[state,above=of q0] (q1) {$q_1$};
17
-
\node[state,accepting,below=of q0] (q2) {$q_2$};
18
-
\path[->]
19
-
(q0) edge[loop right] node {$a$} ()
20
-
(q1) edge[loop above] node {$a$} ()
21
-
(q2) edge[loop below] node {$b$} ()
22
-
(q0) edge node[left] {$\varepsilon$} (q1)
23
-
(q0) edge node[left] {$\varepsilon$} (q2)
24
-
;
25
-
\end{tikzpicture}
26
-
}
27
-
\figcaption{A sample \NFA/ep #{M} over #{\Sigma=\brc{a,b}}, where #{\lang{M}=\brc{a^mb^n}=\lang{a{*}b{*}}}.}
28
-
}
-7
test/forest/trees/index.tree
-7
test/forest/trees/index.tree
-3
test/forest/trees/lorem.tree
-3
test/forest/trees/lorem.tree
···
1
-
\p{
2
-
Lorem ipsum dolor sit amet, consectetur adipiscing elit. Nulla imperdiet tempus mauris vel suscipit. Vestibulum tincidunt turpis et risus vulputate volutpat. Interdum et malesuada fames ac ante ipsum primis in faucibus. Quisque sit amet nisl et diam eleifend facilisis. Aliquam porta, turpis in volutpat congue, mi ligula dictum nunc, ac mollis erat ex eget nunc. Vestibulum at posuere quam. Proin facilisis porta erat, et feugiat libero egestas at. Morbi rhoncus fringilla dolor, sit amet egestas lectus dictum vel. Curabitur arcu lectus, feugiat a nibh nec, scelerisque porta augue. Mauris interdum magna odio, sed efficitur turpis fermentum at. Nunc imperdiet metus sit amet nulla ornare condimentum. Cras id auctor sem.
3
-
}
-1
test/forest/trees/nested/nested.tree
-1
test/forest/trees/nested/nested.tree
···
1
-
\title{I am nested}
-7
test/imports/a.tree
-7
test/imports/a.tree
-7
test/imports/b.tree
-7
test/imports/b.tree
-8
test/imports/c.tree
-8
test/imports/c.tree
-5
test/imports/d.tree
-5
test/imports/d.tree
-5
test/imports/e.tree
-5
test/imports/e.tree
test/imports/f.tree
test/imports/f.tree
This is a binary file and will not be displayed.
test/imports/g.tree
lib/compiler/test/Test_diagnostic_store.ml
test/imports/g.tree
lib/compiler/test/Test_diagnostic_store.ml
-1
test/transclude/transcludee.tree
-1
test/transclude/transcludee.tree
···
1
-
\title{I am being transcluded}
-1
test/trees/importee.tree
-1
test/trees/importee.tree
···
1
-
\def\foo{\p{bar}}
-1
test/trees/importer.tree
-1
test/trees/importer.tree
···
1
-
\import{importee}
-1
test/trees/index.tree
-1
test/trees/index.tree
···
1
-
\foo
-1
test/trees/linked.tree
-1
test/trees/linked.tree
···
1
-
\title{link to me}
-1
test/trees/linker.tree
-1
test/trees/linker.tree
···
1
-
\p{[link](transcluder)}
-1
test/trees/reparse.tree
-1
test/trees/reparse.tree
···
1
-
\title{I am not importing anything}
-1
test/trees/transcludee.tree
-1
test/trees/transcludee.tree
···
1
-
\p{I am being transcluded}