1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
open Forester_prelude
open Forester_core
open Forester_compiler
open struct
module M = URI.Map
module T = Types
module EP = Eio.Path
end
type env = Eio_unix.Stdenv.base
type dir = Eio.Fs.dir_ty EP.t
type target = HTML | JSON | XML | STRING
let output_dir_name = "output"
let create_tree ~env ~dest_dir ~prefix ~template ~mode ~(forest : State.t) =
let next = URI_util.next_uri ~prefix ~mode ~forest in
let fname = next ^ ".tree" in
let now = Human_datetime.now () in
let template_content =
match template with
| None -> ""
| Some name ->
EP.load
EP.(Eio.Stdenv.cwd env / "templates" / (name ^ ".tree"))
in
let body = Format.asprintf "\\date{%a}\n" Human_datetime.pp now in
let create = `Exclusive 0o644 in
let dir =
match dest_dir with
| Some dir -> dir
| None ->
match forest.config.trees with
| dir :: _ -> dir
| [] -> Reporter.fatal Missing_argument ~extra_remarks: [Asai.Diagnostic.loctext "Unable to guess destination director for new tree; please supply one."]
in
let path =
EP.(env#fs / dir / fname)
in
EP.save ~create path @@ body ^ template_content;
EP.native_exn path
let complete ~(forest : State.t) prefix : (string * string) List.t =
let config = forest.config in
let@ article = List.filter_map @~ List.of_seq @@ State.get_all_articles forest in
let@ uri = Option.bind article.frontmatter.uri in
let short_uri = URI.display_path_string ~base: config.url uri in
let@ title = Option.bind article.frontmatter.title in
let title = Plain_text_client.string_of_content ~forest title in
if String.starts_with ~prefix title then
Some (short_uri, title)
else
None
let is_hidden_file fname =
String.starts_with ~prefix: "." fname
let output_path ~cwd ~(forest : State.t) =
let suffix =
String.concat "/" @@
List.filter (fun x -> not (x = "")) @@
URI.path_components forest.config.url
in
Eio.Path.(cwd / output_dir_name / suffix)
let copy_contents_of_dir ~env ~(forest : State.t) dir =
let cwd = Eio.Stdenv.cwd env in
let dest_dir = EP.native_exn @@ output_path ~cwd ~forest in
Logs.debug (fun m -> m "copying contents of directory %s to %s." (Eio.Path.native_exn dir) dest_dir);
let@ fname = List.iter @~ EP.read_dir dir in
if not @@ is_hidden_file fname then
let path = EP.(dir / fname) in
let source = EP.native_exn path in
Eio_util.copy_to_dir ~env ~cwd ~source ~dest_dir
let json_manifest ~dev ~(forest : State.t) : string =
let render = Json_manifest_client.render_tree ~forest in
forest
|> State.get_all_articles
|> List.of_seq
|> List.sort (Forest_util.compare_article ~forest)
|> List.filter_map (fun tree -> render ~dev tree)
|> (fun t -> `List t)
|> Yojson.Safe.to_string
let html_redirect uri_string =
Pure_html.to_xml @@
let open Pure_html in
let open HTML in
html
[]
[
head
[]
[
meta
[
http_equiv `refresh;
content "0;url=%s" uri_string
]
]
]
let outputs_for_article ~(forest : State.t) (article : _ T.article) =
match article.frontmatter.uri with
| None -> []
| Some uri ->
let xml_route = URI.with_path_components (URI.append_path_component (URI.path_components uri) "index.xml") uri in
let html_route = URI.with_path_components (URI.append_path_component (URI.path_components uri) "index.html") uri in
let xml_content = Format.asprintf "%a" (Legacy_xml_client.pp_xml ~forest ~stylesheet: "default.xsl") article in
let html_content =
html_redirect @@ String.concat "/" @@ "" :: Legacy_xml_client.local_path_components forest.config xml_route
in
[xml_route, xml_content; html_route, html_content]
let outputs_for_asset (asset : T.asset) =
let route = asset.uri in
[route, asset.content]
let outputs_for_json_blob_syndication ~(forest : State.t) (syndication : _ T.json_blob_syndication) =
if URI.host syndication.blob_uri = URI.host forest.config.url then
let vertices = Forest.run_datalog_query forest.graphs syndication.query in
let resources =
let@ vertex = List.filter_map @~ Vertex_set.elements vertices in
match vertex with
| Content_vertex _ -> None
| Uri_vertex uri -> State.get_resource forest uri
in
let json_content = Repr.to_json_string ~minify: true (T.forest_t T.content_t) resources in
[syndication.blob_uri, json_content]
else
[]
let outputs_for_atom_feed_syndication ~(forest : State.t) (syndication : T.atom_feed_syndication) =
let atom_nodes = Atom_client.render_feed forest ~source_uri: syndication.source_uri ~feed_uri: syndication.feed_uri in
let atom_content = Format.asprintf "%a" (Pure_html.pp_xml ~header: true) atom_nodes in
[syndication.feed_uri, atom_content]
let outputs_for_syndication ~(forest : State.t) = function
| T.Json_blob syndication -> outputs_for_json_blob_syndication ~forest syndication
| T.Atom_feed syndication -> outputs_for_atom_feed_syndication ~forest syndication
let outputs_for_resource ~(forest : State.t) (evaluated : Tree.evaluated) =
if not evaluated.route_locally then []
else
match evaluated.resource with
| T.Article article -> outputs_for_article ~forest article
| T.Asset asset -> outputs_for_asset asset
| T.Syndication syndication -> outputs_for_syndication ~forest syndication
let uri_to_local_path ~(forest : State.t) uri =
String.concat "/" @@ Legacy_xml_client.local_path_components forest.config uri
let render_forest ~dev ~(forest : State.t) : unit =
let cwd = Eio.Stdenv.cwd forest.env in
let all_resources = forest |> State.get_all_evaluated in
Logs.debug (fun m -> m "Rendering %i resources" (Seq.length all_resources));
begin
let json_string = json_manifest ~dev ~forest in
let json_path = EP.(output_path ~cwd ~forest / "forest.json") in
Eio_util.ensure_context_of_path ~perm: 0o755 json_path;
EP.save ~create: (`Or_truncate 0o644) json_path json_string
end;
let jobs =
let bare_host_uri = URI.with_path_components [] forest.config.url in
let home_route = URI.with_path_components (URI.append_path_component (URI.path_components forest.config.url) "index.html") forest.config.url in
let home_content = html_redirect @@ "/" ^ URI.relative_path_string ~base: bare_host_uri (Config.home_uri forest.config) in
List.cons [home_route, home_content] @@
let@ resource = Eio.Fiber.List.map ~max_fibers: 40 @~ List.of_seq all_resources in
let@ () = Reporter.easy_run in
outputs_for_resource ~forest resource
in
Logs.debug (fun m -> m "Writing %i files to output" (List.length jobs));
begin
let@ items = Eio.Fiber.List.iter ~max_fibers: 20 @~ jobs in
let@ (route : URI.t), content = List.iter @~ items in
let@ () = Reporter.easy_run in
let path = EP.(cwd / output_dir_name / uri_to_local_path ~forest route) in
Eio_util.ensure_context_of_path ~perm: 0o755 path;
EP.save ~create: (`Or_truncate 0o644) path content;
end