forked from
jonmsterling.com/ocaml-forester
ocaml
refactor: remove awful render module
authored by
Kento Okura
and committed by
Jon Sterling
90bed77a
befdefbf
+146
-300
+11
-11
bin/forester/main.ml
+11
-11
bin/forester/main.ml
···
45
45
let@ () = Reporter.trace "when copying theme directory" in
46
46
Forester.copy_contents_of_dir ~env @@ Eio_util.path_of_dir ~env config.theme
47
47
end;
48
-
let forest = Forester.compile ~env ~dev ~config in
48
+
let forest = State_machine.batch_run ~env ~dev ~config in
49
49
forest
50
50
|> State.diagnostics
51
51
|> Diagnostic_store.iter (fun _ d -> List.iter Reporter.Tty.display d);
···
54
54
let export ~env _ config_filename dev =
55
55
let config = Config_parser.parse_forest_config_file config_filename in
56
56
Logs.debug (fun m -> m "Parsed config file %s" config_filename);
57
-
let forest = Forester.compile ~env ~dev ~config in
57
+
let forest = State_machine.batch_run ~env ~dev ~config in
58
58
forest
59
59
|> State.diagnostics
60
60
|> Diagnostic_store.iter (fun _ d -> List.iter Reporter.Tty.display d);
···
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 = Forester.compile ~env ~dev: true ~config in
66
+
let forest = State_machine.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 = Forester.compile ~env ~dev: true ~config in
74
+
let forest = State_machine.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 = Forester.compile ~env ~config ~dev: true in
81
+
let forest = State_machine.batch_run ~env ~config ~dev: true in
82
82
Format.printf "%s" @@
83
83
Forester.json_manifest ~dev: true ~forest
84
84
···
349
349
(
350
350
Arg.enum
351
351
[
352
-
"html", Forester.Target HTML;
353
-
"json", Forester.Target JSON;
354
-
"xml", Forester.Target XML;
355
-
"string", Forester.Target STRING
352
+
"html", Forester.HTML;
353
+
"json", JSON;
354
+
"xml", XML;
355
+
"string", STRING
356
356
]
357
357
)
358
-
~vopt: (Forester.Target HTML)
359
-
(Target HTML)
358
+
~vopt: Forester.HTML
359
+
HTML
360
360
& info ["format"]
361
361
)
362
362
in
+11
-16
lib/frontend/Forester.ml
+11
-16
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 = Target : 'a Render.target -> target
18
+
type target = State_machine.target = HTML | JSON | XML | STRING
19
19
20
20
let (let*) = Option.bind
21
21
···
62
62
let@ iri = Option.bind @@ Option_util.guard Iri_scheme.is_named_iri iri in
63
63
let iri = Iri_scheme.relativise_iri ~host: config.host iri in
64
64
let@ title = Option.bind article.frontmatter.title in
65
-
let title = Format.asprintf "%a" Render.(pp ~dev: true forest STRING) (Content title) in
65
+
let title =
66
+
Plain_text_client.string_of_content
67
+
~forest: forest.resources
68
+
~router: (Legacy_xml_client.route forest)
69
+
title
70
+
in
66
71
if String.starts_with ~prefix title then
67
72
Some (iri, title)
68
73
else
···
89
94
= fun ~env ~config ~target addr ->
90
95
let dev = true in
91
96
let iri = Iri_scheme.user_iri ~host: config.host addr in
92
-
let Target tgt = target in
93
-
let result = State_machine.render_tree ~env ~config ~dev tgt iri in
97
+
let result = State_machine.render_tree ~env ~config ~dev target iri in
94
98
Format.printf "%s" result
95
99
96
-
(* FIXME: deprecate this*)
97
-
let compile ~env ~dev ~(config : Config.t) : State.t =
98
-
State_machine.batch_run ~env ~config ~dev
99
-
100
100
let json_manifest ~dev ~(forest : State.t) : string =
101
-
let render = Render.render ~dev forest JSON in
101
+
let render = Json_manifest_client.render_tree ~forest in
102
102
forest.resources
103
103
|> Forest.get_all_articles
104
-
|> List.map (fun tree -> render (Article tree))
105
-
|> List.map
106
-
(function
107
-
| `Assoc [r, t] -> r, t
108
-
| _ -> assert false
109
-
)
104
+
|> List.filter_map (fun tree -> render ~dev tree)
110
105
|> (fun t -> `Assoc t)
111
106
|> Yojson.Safe.to_string
112
107
···
129
124
| T.Article article ->
130
125
let@ iri = Option.map @~ article.frontmatter.iri in
131
126
let route = Legacy_xml_client.route forest iri in
132
-
let content = Format.asprintf "%a" (Render.pp_xml ~dev ~stylesheet: "default.xsl" ~forest) article in
127
+
let content = Format.asprintf "%a" Legacy_xml_client.(pp_xml ~forest ~stylesheet: "default.xsl") article in
133
128
route, content
134
129
| T.Asset asset ->
135
130
Option.some @@
+1
-7
lib/frontend/Forester.mli
+1
-7
lib/frontend/Forester.mli
···
10
10
type env = Eio_unix.Stdenv.base
11
11
type dir = Eio.Fs.dir_ty Eio.Path.t
12
12
13
-
type target = Target : 'a Render.target -> target
14
-
15
-
val compile :
16
-
env: env ->
17
-
dev: bool ->
18
-
config: Config.t ->
19
-
State.t
13
+
type target = State_machine.target = HTML | JSON | XML | STRING
20
14
21
15
val render_forest :
22
16
dev: bool ->
+2
-1
lib/frontend/Forester_frontend.ml
+2
-1
lib/frontend/Forester_frontend.ml
···
8
8
9
9
module Config_parser = Config_parser
10
10
module Forester = Forester
11
-
module Render = Render
12
11
13
12
module DSL = DSL
14
13
15
14
module State_machine = State_machine
16
15
17
16
module Htmx_client = Htmx_client
17
+
module Plain_text_client = Plain_text_client
18
+
module Legacy_xml_client = Legacy_xml_client
+4
-52
lib/frontend/Htmx_client.ml
+4
-52
lib/frontend/Htmx_client.ml
···
79
79
let rec render_article (forest : State.t) (article : T.content T.article) : P.node =
80
80
(* FIXME: What should reserved be here? *)
81
81
let@ () = Xmlns.run ~reserved: [] in
82
-
H.html
82
+
H.article
83
83
[]
84
84
[
85
-
H.head
86
-
[]
87
-
[
88
-
H.meta [H.charset "utf-8"];
89
-
(* H.link [H.rel "stylesheet"; H.href "style.css"]; *)
90
-
H.link
91
-
[
92
-
H.rel "stylesheet";
93
-
H.href "https://cdn.jsdelivr.net/npm/katex@0.16.20/dist/katex.min.css";
94
-
H.integrity "sha384-sMefv1J1YJCHsg0mTa9YG+n/9KnJb9lGrJUUY5arg6bAL1qps/oZjmUwaHlX5Ugg";
95
-
H.crossorigin `anonymous
96
-
];
97
-
H.script
98
-
[
99
-
H.defer;
100
-
H.src "https://cdn.jsdelivr.net/npm/katex@0.16.20/dist/katex.min.js";
101
-
H.integrity "sha384-i9p+YmlwbK0lT9RcfgdAo/Cikui1KeFMeV/0Fwsu+rzgsCvas6oUptNOmo29C33p";
102
-
H.crossorigin `anonymous
103
-
]
104
-
"";
105
-
H.script
106
-
[
107
-
H.defer;
108
-
H.src "https://cdn.jsdelivr.net/npm/katex@0.16.20/dist/contrib/auto-render.min.js";
109
-
H.integrity "sha384-hCXGrW6PitJEwbkoStFjeJxv+fSOOQKOPbJxSfM6G5sWZjAyWhXiTIIAmQqnlLlh";
110
-
H.crossorigin `anonymous;
111
-
P.string_attr "onload" "renderMathInElement(document.body);"
112
-
]
113
-
"";
114
-
H.script [H.src "https://unpkg.com/htmx.org@2.0.4/dist/htmx.js"] "";
115
-
H.script [H.src "https://unpkg.com/htmx.org/dist/ext/json-enc.js"] "";
116
-
H.script
117
-
[
118
-
]
119
-
{js|
120
-
document.body.addEventListener('htmx:load', function(evt) {
121
-
myJavascriptLib.init(evt.detail.elt);
122
-
});
123
-
|js};
124
-
];
125
-
H.body
126
-
[]
127
-
[
128
-
H.article
129
-
[]
130
-
[
131
-
render_frontmatter forest article.frontmatter;
132
-
H.null @@ render_content forest article.mainmatter;
133
-
H.section [H.class_ "backmatter"] @@ render_content forest article.backmatter
134
-
]
135
-
]
85
+
render_frontmatter forest article.frontmatter;
86
+
H.null @@ render_content forest article.mainmatter;
87
+
H.section [H.class_ "backmatter"] @@ render_content forest article.backmatter
136
88
]
137
89
138
90
and render_section (forest : State.t) (section : T.content T.section) : P.node =
+9
-9
lib/frontend/Legacy_xml_client.ml
+9
-9
lib/frontend/Legacy_xml_client.ml
···
466
466
X.backmatter [] @@ render_content forest article.backmatter
467
467
]
468
468
469
-
(* let pp_xml ?stylesheet fmt article = *)
470
-
(* Format.fprintf fmt {|<?xml version="1.0" encoding="UTF-8"?>|}; *)
471
-
(* Format.pp_print_newline fmt (); *)
472
-
(* begin *)
473
-
(* let@ uri = Option.iter @~ stylesheet in *)
474
-
(* Format.fprintf fmt "<?xml-stylesheet type=\"text/xsl\" href=\"%s\"?>" uri *)
475
-
(* end; *)
476
-
(* Format.pp_print_newline fmt (); *)
477
-
(* P.pp_xml fmt @@ render_article article *)
469
+
let pp_xml ~forest ?stylesheet fmt article =
470
+
Format.fprintf fmt {|<?xml version="1.0" encoding="UTF-8"?>|};
471
+
Format.pp_print_newline fmt ();
472
+
begin
473
+
let@ uri = Option.iter @~ stylesheet in
474
+
Format.fprintf fmt "<?xml-stylesheet type=\"text/xsl\" href=\"%s\"?>" uri
475
+
end;
476
+
Format.pp_print_newline fmt ();
477
+
P.pp_xml fmt @@ render_article forest article
+1
lib/frontend/Legacy_xml_client.mli
+1
lib/frontend/Legacy_xml_client.mli
-114
lib/frontend/Render.ml
-114
lib/frontend/Render.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_compiler
9
-
open Forester_core
10
-
11
-
exception Todo of string
12
-
13
-
module T = Types
14
-
module P = Pure_html
15
-
16
-
type _ renderable =
17
-
| Content : T.content -> T.content renderable
18
-
| Article : T.content T.article -> T.content T.article renderable
19
-
| Frontmatter : T.content T.frontmatter -> T.content T.frontmatter renderable
20
-
21
-
type xml = P.node
22
-
type json = Yojson.Safe.t
23
-
type html = P.node
24
-
25
-
type _ target =
26
-
| XML : xml target
27
-
| JSON : json target
28
-
| HTML : html target
29
-
| STRING : string target
30
-
[@@deriving show]
31
-
32
-
let render
33
-
: type a b. dev: bool -> State.t -> a target -> b renderable -> a
34
-
= fun
35
-
~dev
36
-
forest
37
-
tgt
38
-
renderable
39
-
->
40
-
let renderable =
41
-
match renderable with
42
-
| Content _ -> renderable
43
-
| Article a ->
44
-
if dev then
45
-
renderable
46
-
else
47
-
Article {a with frontmatter = {a.frontmatter with source_path = None}}
48
-
| Frontmatter fm ->
49
-
if dev then
50
-
renderable
51
-
else
52
-
Frontmatter {fm with source_path = None}
53
-
in
54
-
match tgt with
55
-
| JSON ->
56
-
begin
57
-
match renderable with
58
-
| Content content ->
59
-
`String
60
-
(Plain_text_client.string_of_content ~forest: forest.resources ~router: Iri.to_uri content)
61
-
| Article article ->
62
-
begin
63
-
match (Json_manifest_client.render_tree ~dev ~forest article) with
64
-
| Some (r, t) -> `Assoc [r, t]
65
-
| None -> `Null
66
-
end
67
-
| Frontmatter _ -> raise (Todo "")
68
-
end
69
-
| HTML ->
70
-
begin
71
-
match renderable with
72
-
| Content content -> P.HTML.div [] @@ Htmx_client.render_content forest content
73
-
| Article article -> Htmx_client.render_article forest article
74
-
| Frontmatter _ -> P.HTML.null []
75
-
end
76
-
| XML ->
77
-
begin
78
-
match renderable with
79
-
| Content content ->
80
-
P.HTML.null @@ Legacy_xml_client.render_content forest content
81
-
| Article article ->
82
-
Legacy_xml_client.render_article forest article
83
-
| Frontmatter _ ->
84
-
raise (Todo "render frontmatter to xml")
85
-
end
86
-
| STRING ->
87
-
begin
88
-
match renderable with
89
-
| Content content -> Plain_text_client.string_of_content ~forest: forest.resources ~router: Iri.to_uri content
90
-
| Article _ -> raise (Todo "render article to string")
91
-
| Frontmatter _ -> raise (Todo "render frontmatter to string")
92
-
end
93
-
94
-
let pp
95
-
: type a b. dev: bool -> State.t -> a target -> Format.formatter -> b renderable -> unit
96
-
= fun ~dev forest target fmt renderable ->
97
-
let stuff =
98
-
render ~dev forest target renderable
99
-
in
100
-
match target with
101
-
| XML -> P.pp_xml fmt stuff
102
-
| HTML -> P.pp fmt stuff
103
-
| JSON -> Yojson.Safe.pp fmt stuff
104
-
| STRING -> Format.pp_print_string fmt stuff
105
-
106
-
let pp_xml ?stylesheet ~forest ~dev fmt article =
107
-
Format.fprintf fmt {|<?xml version="1.0" encoding="UTF-8"?>|};
108
-
Format.pp_print_newline fmt ();
109
-
begin
110
-
let@ uri = Option.iter @~ stylesheet in
111
-
Format.fprintf fmt "<?xml-stylesheet type=\"text/xsl\" href=\"%s\"?>" uri
112
-
end;
113
-
Format.pp_print_newline fmt ();
114
-
P.pp_xml fmt @@ render ~dev forest XML (Article article)
+13
-16
lib/frontend/State_machine.ml
+13
-16
lib/frontend/State_machine.ml
···
8
8
open Forester_compiler
9
9
open Forester_search
10
10
11
+
type target = HTML | JSON | XML | STRING
12
+
11
13
module T = Types
12
14
13
15
type state = State.t
···
26
28
| Expand_only of iri
27
29
| Eval_only of iri
28
30
| Parse of iri
29
-
| Get of (('a Render.target [@opaque]) * iri)
31
+
| Get of iri
30
32
| Query of (string, Vertex.t) Datalog_expr.query
31
33
| Cache_results of (Vertex_set.t [@opaque])
32
34
| Index
···
35
37
type ('r, 'e) result =
36
38
| Nothing
37
39
| Vertex_set of Vertex_set.t
38
-
| Render_result of 'r
40
+
| Got of T.content T.article
39
41
| Error of 'e
40
42
41
43
let update
···
52
54
| Query q ->
53
55
let r = Forest.run_datalog_query state.graphs q in
54
56
(Cache_results r, state, Vertex_set r)
55
-
| Get (target, iri) ->
57
+
| Get iri ->
56
58
begin
57
59
match Forest.get_article iri state.resources with
58
60
| Some article ->
59
-
let result =
60
-
Render_result
61
-
(
62
-
Render.render
63
-
~dev: true
64
-
state
65
-
target
66
-
(Article article)
67
-
)
68
-
in
69
-
(Done, state, result)
70
-
| None -> (Done, state, Error (`Not_found iri))
61
+
Done, state, Got article
62
+
| None -> Done, state, Error (`Not_found iri)
71
63
end
72
64
| Quit -> exit 0
73
65
| Load_all_configured_dirs ->
···
186
178
match Forest.get_article iri forest.resources with
187
179
| None -> assert false
188
180
| Some article ->
189
-
Format.asprintf "%a" Render.(pp ~dev forest target) (Article article)
181
+
match target with
182
+
| HTML -> Pure_html.to_string @@ Htmx_client.render_article forest article
183
+
| XML ->
184
+
Format.asprintf "%a" Legacy_xml_client.(pp_xml ~forest ?stylesheet: None) article
185
+
| JSON -> Yojson.Safe.to_string @@ snd @@ Option.get @@ Json_manifest_client.render_tree ~dev ~forest article
186
+
| STRING -> "TODO"
+8
-4
lib/language_server/Completion.ml
+8
-4
lib/language_server/Completion.ml
···
116
116
let* iri = tree.iri in
117
117
let* {frontmatter; mainmatter; _} = Forest.get_article iri forest.resources in
118
118
let documentation =
119
-
let render = Render.render ~dev: true forest STRING in
119
+
let render =
120
+
Plain_text_client.string_of_content
121
+
~forest: forest.resources
122
+
~router: (Legacy_xml_client.route forest)
123
+
in
120
124
let title = frontmatter.title in
121
125
let taxon = frontmatter.taxon in
122
126
let content =
123
127
Format.asprintf
124
128
{|%s\n %s\n %s\n |}
125
-
(Option.fold ~none: "" ~some: (fun s -> Format.asprintf "# %s" (render (Content s))) title)
126
-
(Option.fold ~none: "" ~some: (fun s -> Format.asprintf "taxon: %s" (render (Content s))) taxon)
127
-
(render (Content mainmatter))
129
+
(Option.fold ~none: "" ~some: (fun s -> Format.asprintf "# %s" (render s)) title)
130
+
(Option.fold ~none: "" ~some: (fun s -> Format.asprintf "taxon: %s" (render s)) taxon)
131
+
(render mainmatter)
128
132
in
129
133
Some (`String content)
130
134
in
+6
-2
lib/language_server/Document_link.ml
+6
-2
lib/language_server/Document_link.ml
···
16
16
(* TODO: handle external links as well? *)
17
17
let compute (params : L.DocumentLinkParams.t) =
18
18
let Lsp_state.{forest; _} = Lsp_state.get () in
19
-
let render = Render.render ~dev: true forest STRING in
19
+
let render =
20
+
Plain_text_client.string_of_content
21
+
~forest: forest.resources
22
+
~router: (Legacy_xml_client.route forest)
23
+
in
20
24
let config = State.config forest in
21
25
match params with
22
26
| {textDocument; _} ->
···
39
43
let iri = (Iri_scheme.user_iri ~host: config.host addr) in
40
44
let* target = Option.map Lsp.Uri.of_path @@ Iri_tbl.find_opt forest.resolver iri in
41
45
let* {frontmatter; _} = Forest.get_article iri forest.resources in
42
-
let* tooltip = Option.map (fun c -> render (Content c)) frontmatter.title in
46
+
let* tooltip = Option.map (fun c -> render c) frontmatter.title in
43
47
let link =
44
48
L.DocumentLink.create
45
49
~range
+2
lib/language_server/Forester_lsp.ml
+2
lib/language_server/Forester_lsp.ml
+5
lib/language_server/Forester_lsp.mli
+5
lib/language_server/Forester_lsp.mli
···
7
7
8
8
open Forester_compiler
9
9
10
+
(**/**)
11
+
module State = Lsp_state
12
+
module LspEio = LspEio
13
+
(**/**)
14
+
10
15
(** An implementation of the {{: https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/} Microsoft Language Server Protocol } for forester. *)
11
16
12
17
(** Analysis of the {{!type:Forester_compiler.Code.t}concrete syntax}*)
+6
-2
lib/language_server/Hover.ml
+6
-2
lib/language_server/Hover.ml
···
24
24
: L.Hover.t option
25
25
=
26
26
let Lsp_state.{forest; _} = Lsp_state.get () in
27
-
let render = Render.render ~dev: true forest STRING in
27
+
let render =
28
+
Plain_text_client.string_of_content
29
+
~forest: forest.resources
30
+
~router: (Legacy_xml_client.route forest)
31
+
in
28
32
let config = State.config forest in
29
33
let host = config.host in
30
34
let content =
···
42
46
| None ->
43
47
Format.asprintf "Could not get article %a." pp_iri iri_under_cursor
44
48
| Some {mainmatter; frontmatter; _} ->
45
-
let main = render (Content mainmatter) in
49
+
let main = render mainmatter in
46
50
if main = "" then (Format.asprintf "%a" T.(pp_frontmatter pp_content) frontmatter)
47
51
else main
48
52
in
+8
-7
lib/language_server/Inlay_hint.ml
+8
-7
lib/language_server/Inlay_hint.ml
···
19
19
_;
20
20
} ->
21
21
let Lsp_state.{forest; _} = Lsp_state.get () in
22
-
let render = Render.render forest STRING in
22
+
(* let render = Render.render forest STRING in *)
23
23
let config = State.config forest in
24
24
let host = config.host in
25
25
match Forest.find_opt (State.parsed forest) (Iri_scheme.uri_to_iri ~host textDocument.uri) with
···
48
48
match Analysis.extract_addr node with
49
49
| None -> None
50
50
| Some str ->
51
-
(* Eio.traceln "got addr"; *)
52
51
let iri = Iri_scheme.user_iri ~host str in
53
52
match Forest.get_article iri forest.resources with
54
53
| None ->
55
-
(* Eio.traceln "article %a not found" pp_iri iri; *)
56
54
None
57
55
| Some {frontmatter; _} ->
58
-
(* Eio.traceln "got article"; *)
59
56
match frontmatter.title with
60
57
| None -> None
61
58
| Some title ->
62
-
(* Eio.traceln "got title"; *)
63
-
let content = " " ^ render ~dev: true (Content title) in
64
-
(* Eio.traceln "made content title"; *)
59
+
let content =
60
+
" " ^
61
+
Plain_text_client.string_of_content
62
+
~forest: forest.resources
63
+
~router: (Legacy_xml_client.route forest)
64
+
title
65
+
in
65
66
Some
66
67
(
67
68
L.InlayHint.create
+8
-3
lib/language_server/Workspace_symbols.ml
+8
-3
lib/language_server/Workspace_symbols.ml
···
17
17
({query = _; _}: L.WorkspaceSymbolParams.t)
18
18
=
19
19
let Lsp_state.{forest; _} = Lsp_state.get () in
20
-
let render = Render.render ~dev: true forest STRING in
21
-
let trees =
20
+
let render =
21
+
Plain_text_client.string_of_content
22
+
~forest: forest.resources
23
+
~router: (Legacy_xml_client.route forest)
24
+
in
25
+
let trees
26
+
=
22
27
forest
23
28
|> State.parsed
24
29
|> Forest.to_seq_keys
···
31
36
begin
32
37
match frontmatter.title with
33
38
| None -> "untitled"
34
-
| Some content -> render (Content content)
39
+
| Some content -> render content
35
40
end
36
41
in
37
42
let uri =
+25
-24
lib/language_server/dune
+25
-24
lib/language_server/dune
···
4
4
5
5
(library
6
6
(name Forester_lsp)
7
+
(public_name forester.language_server)
7
8
(libraries
8
-
algaeff
9
-
repr
10
-
unix
11
-
ocamlgraph
12
-
forester.prelude
13
-
forester.core
14
-
forester.compiler
15
-
forester.frontend
16
-
forester.human_datetime
17
-
lsp
18
-
asai
19
-
eio
20
-
eio.core
21
-
eio.unix
22
-
jsonrpc
23
-
yojson
24
-
bwd
25
-
iri
26
-
yuujinchou
27
-
fmt
28
-
str
29
-
logs
30
-
)
9
+
algaeff
10
+
repr
11
+
unix
12
+
ocamlgraph
13
+
forester.prelude
14
+
forester.core
15
+
forester.compiler
16
+
forester.frontend
17
+
forester.human_datetime
18
+
lsp
19
+
asai
20
+
eio
21
+
eio.core
22
+
eio.unix
23
+
jsonrpc
24
+
yojson
25
+
bwd
26
+
iri
27
+
yuujinchou
28
+
fmt
29
+
str
30
+
logs)
31
31
(preprocess
32
32
(pps ppx_deriving.show ppx_repr ppx_yojson_conv))
33
-
(public_name forester.language_server))
33
+
(instrumentation
34
+
(backend bisect_ppx)))
+15
-21
lib/server/Server.ml
+15
-21
lib/server/Server.ml
···
89
89
match Forest.get_article iri forest.resources with
90
90
| None -> Cohttp_eio.Server.respond_string ~status: `Not_found ~body: "" ()
91
91
| Some article ->
92
-
let content =
93
-
Render.(
94
-
Format.asprintf
95
-
"%a"
96
-
(pp ~dev: forest.dev forest HTML)
97
-
(Article article)
98
-
)
99
-
in
92
+
let content = Pure_html.to_string @@ Htmx_client.render_article forest article in
100
93
Cohttp_eio.Server.respond_string ~status: `OK ~body: content ()
101
94
end
102
95
| Search ->
···
111
104
)
112
105
(Uri.query_of_encoded body)
113
106
in
114
-
Cohttp_eio.Server.respond_string ~status: `OK ~body: (Format.asprintf "%s" search_term) ()
107
+
let search_results = Forester_search.Index.search forest.search_index search_term in
108
+
let response =
109
+
List.concat_map
110
+
(fun iris ->
111
+
let open Pure_html in
112
+
let open HTML in
113
+
[ul [] (List.map (fun iri -> li [] [txt "%s" (Format.asprintf "%a" pp_iri iri)]) iris)]
114
+
)
115
+
search_results
116
+
in
117
+
Cohttp_eio.Server.respond_string ~status: `OK ~body: (Pure_html.to_string @@ Pure_html.HTML.ul [] response) ()
115
118
else
116
119
Cohttp_eio.Server.respond_string ~status: `Method_not_allowed ~body: "" ()
117
120
| Searchmenu ->
···
129
132
| None ->
130
133
Cohttp_eio.Server.respond_string ~status: `OK ~body: "" ()
131
134
| Some home_tree ->
132
-
begin
133
-
let content =
134
-
Render.(
135
-
Format.asprintf
136
-
"%a"
137
-
(pp ~dev: forest.dev forest HTML)
138
-
(Article home_tree)
139
-
)
140
-
in
141
-
Cohttp_eio.Server.respond_string ~status: `OK ~body: content ()
142
-
end
135
+
let content = Pure_html.to_string @@ Htmx_client.render_article forest home_tree in
136
+
Cohttp_eio.Server.respond_string ~status: `OK ~body: content ()
143
137
end
144
138
| Query ->
145
139
let q = Uri.get_query_param resource "query" in
···
156
150
match result with
157
151
| Vertex_set vs ->
158
152
Htmx_client.render_query_result forest vs
159
-
| Render_result _
153
+
| Got _
160
154
| Error _
161
155
| Nothing ->
162
156
[Pure_html.txt "failed to run"]
+1
-1
lib/server/dune
+1
-1
lib/server/dune
+2
test/Render.t
+2
test/Render.t
+8
-6
test/Test_transclusion.ml
+8
-6
test/Test_transclusion.ml
···
52
52
let content = Option.get @@ Forest.get_content_of_transclusion t forest.resources in
53
53
Format.printf
54
54
"%a"
55
-
Render.(pp_xml ~forest ~dev: false ?stylesheet: None)
56
-
T.{
57
-
frontmatter = default_frontmatter ~iri: href ();
58
-
mainmatter = content;
59
-
backmatter = Content []
60
-
}
55
+
Legacy_xml_client.(pp_xml ~forest ?stylesheet: None)
56
+
(
57
+
T.{
58
+
frontmatter = default_frontmatter ~iri: href ();
59
+
mainmatter = content;
60
+
backmatter = Content []
61
+
}
62
+
)
61
63
in
62
64
let test_full_default () =
63
65
print_transclusion