forked from
jonmsterling.com/ocaml-forester
ocaml
working on content-addressing assets; removing obsolete features
+127
-87
+3
-13
bin/forester/main.ml
+3
-13
bin/forester/main.ml
···
18
18
| None -> "n/a"
19
19
| Some v -> Build_info.V1.Version.to_string v
20
20
21
-
let build ~env config_filename dev render_only no_assets no_theme =
21
+
let build ~env config_filename dev no_theme =
22
22
let config = Forester_frontend.Config.parse_forest_config_file config_filename in
23
23
let tree_dirs = paths_of_dirs ~env config.trees in
24
24
let asset_dirs = paths_of_dirs ~env config.assets in
25
25
let foreign_dirs = paths_of_dirs ~env config.foreign in
26
26
Forester.plant_raw_forest_from_dirs ~env ~host: config.host ~dev ~tree_dirs ~asset_dirs ~foreign_dirs;
27
-
Forester.render_forest ~env ~dev ~host: config.host ~home: config.home ~stylesheet: config.stylesheet;
27
+
Forester.render_forest ~env ~dev ~host: config.host ~home: config.home;
28
28
let dirs_to_copy =
29
29
(if not no_theme then [config.theme] else []) @
30
-
(if not no_assets then config.assets else [])
30
+
[]
31
31
in
32
32
let@ dir_to_copy = List.iter @~ dirs_to_copy in
33
33
Forester.copy_contents_of_dir ~env @@ path_of_dir ~env dir_to_copy
···
151
151
let doc = "Run forester in development mode; this will attach source file locations to the generated json." in
152
152
Arg.value @@ Arg.flag @@ Arg.info ["dev"] ~doc
153
153
in
154
-
let arg_no_assets =
155
-
let doc = "Build without copying the asset directory" in
156
-
Arg.value @@ Arg.flag @@ Arg.info ["no-assets"] ~doc
157
-
in
158
154
let arg_no_theme =
159
155
let doc = "Build without copying the theme directory" in
160
156
Arg.value @@ Arg.flag @@ Arg.info ["no-theme"] ~doc
161
-
in
162
-
let arg_render_only =
163
-
let doc = "Builds the entire forest but renders only the specified comma-separated list of trees" in
164
-
Arg.value @@ Arg.opt (Arg.some' (Arg.list Arg.string)) None @@ Arg.info ["render-only"] ~docv: "TREES" ~doc
165
157
in
166
158
let doc = "Build the forest" in
167
159
let man =
···
177
169
const (build ~env)
178
170
$ arg_config
179
171
$ arg_dev
180
-
$ arg_render_only
181
-
$ arg_no_assets
182
172
$ arg_no_theme
183
173
)
184
174
+3
-1
dune-project
+3
-1
dune-project
+1
forester.opam
+1
forester.opam
+22
lib/compiler/Asset_content_addresser.ml
+22
lib/compiler/Asset_content_addresser.ml
···
1
+
open Forester_core
2
+
3
+
let router : (string, string * iri) Hashtbl.t = Hashtbl.create 100
4
+
5
+
let install ~source_path ~content =
6
+
match Hashtbl.find_opt router source_path with
7
+
| Some (filename, iri) -> (filename, iri)
8
+
| None ->
9
+
let hash = Result.get_ok @@ Multihash_digestif.of_cstruct `Sha3_256 (Cstruct.of_string content) in
10
+
let cid = Cid.v ~version: `Cidv1 ~codec: `Raw ~base: `Base32 ~hash in
11
+
let cid_str = Cid.to_string cid in
12
+
let ext = Filename.extension source_path in
13
+
let filename = cid_str ^ ext in
14
+
let iri = Iri.iri ~path: (Relative ["content"; filename]) () in
15
+
Hashtbl.add router source_path (filename, iri);
16
+
filename, iri
17
+
18
+
let iri_of_asset ~source_path =
19
+
match Hashtbl.find_opt router source_path with
20
+
| Some (_, iri) -> iri
21
+
| None ->
22
+
Reporter.fatalf Resource_not_found "Asset located at `%s' does not have a content address" source_path
+4
lib/compiler/Eval.ml
+4
lib/compiler/Eval.ml
···
402
402
T.{ href; target; modifier = Identity }
403
403
in
404
404
emit_content_node ~loc @@ T.Transclude transclusion
405
+
| Route_asset ->
406
+
let source_path = pop_text_arg ~loc in
407
+
let iri = Asset_content_addresser.iri_of_asset ~source_path in
408
+
emit_content_node ~loc @@ T.Text (Iri.to_string ~pctencode: false iri)
405
409
| Object { self; methods } ->
406
410
let table =
407
411
let env = Lex_env.read () in
+3
-2
lib/compiler/Expand.ml
+3
-2
lib/compiler/Expand.ml
···
152
152
begin
153
153
match import with
154
154
| None ->
155
-
Reporter.emitf ?loc: loc Tree_not_found "Could not find tree named `%s'" dep
155
+
Reporter.emitf ?loc: loc Resource_not_found "Could not import tree named `%s'" dep
156
156
| Some tree ->
157
157
begin
158
158
match vis with
···
338
338
["rel"; "links-to"], Syn.Text Builtin_relation.links_to;
339
339
["rel"; "is-reference"], Syn.Text Builtin_relation.is_reference;
340
340
["rel"; "is-person"], Syn.Text Builtin_relation.is_person;
341
-
["execute"], Syn.Dx_execute
341
+
["execute"], Syn.Dx_execute;
342
+
["route-asset"], Syn.Route_asset;
342
343
];
343
344
Builtins.Transclude.alloc_expanded ();
344
345
Builtins.Transclude.alloc_show_heading ();
+2
lib/compiler/Forester_compiler.ml
+2
lib/compiler/Forester_compiler.ml
+1
lib/compiler/Syn.ml
+1
lib/compiler/Syn.ml
+7
-1
lib/compiler/dune
+7
-1
lib/compiler/dune
+2
-2
lib/core/Reporter.ml
+2
-2
lib/core/Reporter.ml
···
1
1
module Message = struct
2
2
type t =
3
-
| Tree_not_found
4
3
| Duplicate_tree
5
4
| Parse_error
6
5
| Type_error
···
18
17
| Routing_error
19
18
| Profiling
20
19
| External_error
20
+
| Resource_not_found
21
21
| Log
22
22
[@@deriving show]
23
23
24
24
let default_severity : t -> Asai.Diagnostic.severity = function
25
25
| Duplicate_tree -> Error
26
-
| Tree_not_found -> Error
27
26
| Parse_error -> Error
28
27
| Type_error -> Error
29
28
| Type_warning -> Warning
···
41
40
| Profiling -> Info
42
41
| External_error -> Error
43
42
| Log -> Info
43
+
| Resource_not_found -> Error
44
44
45
45
let short_code : t -> string =
46
46
show
+8
-4
lib/forest/Forest.ml
+8
-4
lib/forest/Forest.ml
···
7
7
module type S = sig
8
8
type resource =
9
9
| Article of T.content T.article
10
-
| Asset of iri
10
+
| Asset of { iri: iri; contents: string; filename: string }
11
11
12
12
val plant_resource : resource -> unit
13
13
14
14
val get_resource : Iri.t -> resource option
15
15
val get_article : Iri.t -> T.content T.article option
16
+
val get_all_resources : unit -> resource Seq.t
16
17
17
18
val get_expanded_title : ?scope: iri -> ?flags: T.title_flags -> T.content T.frontmatter -> T.content
18
19
val get_content_of_transclusion : T.content T.transclusion -> T.content
···
39
40
40
41
type resource =
41
42
| Article of article
42
-
| Asset of iri
43
+
| Asset of { iri: iri; contents: string; filename: string }
43
44
44
45
let resources : (Iri.t, resource) Hashtbl.t =
45
46
Hashtbl.create 1000
···
149
150
150
151
let iri_for_resource = function
151
152
| Article article -> article.frontmatter.iri
152
-
| Asset iri -> Some iri
153
+
| Asset asset -> Some asset.iri
153
154
154
155
let plant_resource resource =
155
156
analyse_resource resource;
···
163
164
let get_resource iri =
164
165
Hashtbl.find_opt resources iri
165
166
167
+
let get_all_resources () =
168
+
Hashtbl.to_seq_values resources
169
+
166
170
let get_article iri =
167
171
let@ resource = Option.bind @@ get_resource iri in
168
172
match resource with
···
173
177
match get_article addr with
174
178
| Some article -> article
175
179
| None ->
176
-
Reporter.fatalf Tree_not_found "Could not find tree %a" pp_iri addr
180
+
Reporter.fatalf Resource_not_found "Could not find tree %a" pp_iri addr
177
181
178
182
module Legacy_query_engine = Legacy_query_engine.Make(Graphs)
179
183
include Legacy_query_engine
+3
-1
lib/forest/Forest.mli
+3
-1
lib/forest/Forest.mli
···
5
5
module type S = sig
6
6
type resource =
7
7
| Article of T.content T.article
8
-
| Asset of iri
8
+
| Asset of { iri: iri; contents: string; filename: string }
9
9
10
10
val plant_resource : resource -> unit
11
11
val get_resource : iri -> resource option
12
12
val get_article : iri -> T.content T.article option
13
+
val get_all_resources : unit -> resource Seq.t
14
+
13
15
val get_expanded_title : ?scope: iri -> ?flags: T.title_flags -> T.content T.frontmatter -> T.content
14
16
val get_content_of_transclusion : T.content T.transclusion -> T.content
15
17
val get_title_or_content_of_vertex : ?not_found: (iri -> T.content option) -> modifier: T.modifier -> T.content T.vertex -> T.content option
+21
-33
lib/forest/Legacy_xml_client.ml
+21
-33
lib/forest/Legacy_xml_client.ml
···
65
65
| Absolute [_] -> "user"
66
66
| _ -> failwith "addr_type"
67
67
68
-
let route_bare_forester_iri ~path ~is_asset =
69
-
let bare_route =
70
-
String.concat (if is_asset then "/" else "-") @@
71
-
match path with
72
-
| Iri.Absolute xs -> xs
73
-
| Iri.Relative xs -> xs (* impossible? *)
74
-
in
75
-
match is_asset with
76
-
| true -> bare_route
77
-
| false -> bare_route ^ ".xml"
78
-
79
-
let route_foreign_forester_iri ~host ~path ~is_asset =
80
-
"foreign-" ^ host ^ "-" ^ route_bare_forester_iri ~path ~is_asset
81
-
82
-
let route_forester_iri ~host ~path ~is_asset =
83
-
if host = Params.host then
84
-
route_bare_forester_iri ~path ~is_asset
85
-
else
86
-
route_foreign_forester_iri ~host ~path ~is_asset
87
-
88
68
let home_iri =
89
69
let@ root = Option.bind Params.home in
90
70
let base = Iri_scheme.base_iri ~host: Params.host in
···
99
79
Iri.equal ~normalize: true home_iri iri
100
80
| None -> false
101
81
102
-
let iri_is_asset iri =
103
-
match F.get_resource iri with
104
-
| Some (F.Asset _) -> true
105
-
| _ -> false
106
-
107
82
let route iri =
108
-
match Iri.host iri with
109
-
| Some host when Iri.scheme iri = Iri_scheme.scheme ->
110
-
if iri_is_home iri then "index.xml"
111
-
else
112
-
let path = Iri.path iri in
113
-
let is_asset = iri_is_asset iri in
114
-
route_forester_iri ~host ~path ~is_asset
115
-
| _ -> Iri.to_uri iri
83
+
match F.get_resource iri with
84
+
| Some (F.Article _) ->
85
+
let host = Option.value ~default: "" @@ Iri.host iri in
86
+
let bare_route =
87
+
String.concat "-" @@
88
+
match Iri.path iri with
89
+
| Iri.Absolute xs -> xs
90
+
| Iri.Relative xs -> xs (* impossible? *)
91
+
in
92
+
begin
93
+
if host = Params.host then
94
+
if iri_is_home iri then "index.xml"
95
+
else
96
+
bare_route ^ ".xml"
97
+
else
98
+
"foreign-" ^ host ^ bare_route ^ ".xml"
99
+
end
100
+
| Some (F.Asset asset) ->
101
+
"content/" ^ asset.filename
102
+
| None ->
103
+
Iri.to_uri iri
116
104
117
105
let get_expanded_title frontmatter =
118
106
let scope = Scope.read () in
+7
-7
lib/frontend/Config.ml
+7
-7
lib/frontend/Config.ml
···
9
9
assets: string list;
10
10
foreign: string list;
11
11
theme: string;
12
-
stylesheet: string
13
12
}
14
13
[@@deriving show, repr]
15
14
end
···
22
21
foreign = [];
23
22
theme = "theme";
24
23
home = None;
25
-
stylesheet = "default.xsl"
26
24
}
27
25
28
26
let parse_forest_config_file filename =
···
49
47
| Some _ ->
50
48
Reporter.emitf Configuration_error "In your configuration file, change `root' key to `home' in the [forest] group."
51
49
in
50
+
let _ =
51
+
match get tbl (forest |-- key "stylesheet" |-- string) with
52
+
| None -> ()
53
+
| Some _ ->
54
+
Reporter.emitf Configuration_error "Custom XSL stylesheet injection is no longer supported; please remove the `stylesheet' key from the [forest] group."
55
+
in
52
56
let trees =
53
57
Option.value ~default: default_forest_config.trees @@
54
58
get tbl (forest |-- key "trees" |-- array |-- strings)
···
65
69
Option.value ~default: default_forest_config.theme @@
66
70
get tbl (forest |-- key "theme" |-- string)
67
71
in
68
-
let stylesheet =
69
-
Option.value ~default: default_forest_config.stylesheet @@
70
-
get tbl (forest |-- key "stylesheet" |-- string)
71
-
in
72
-
Forest_config.{ host; assets; trees; foreign; theme; home; stylesheet }
72
+
Forest_config.{ host; assets; trees; foreign; theme; home }
-1
lib/frontend/Config.mli
-1
lib/frontend/Config.mli
+2
-1
lib/frontend/Dir_scanner.ml
+2
-1
lib/frontend/Dir_scanner.ml
+38
-20
lib/frontend/Forester.ml
+38
-20
lib/frontend/Forester.ml
···
126
126
127
127
let plant_raw_forest_from_dirs ~env ~host ~dev ~tree_dirs ~asset_dirs ~foreign_dirs : unit =
128
128
let parsed_trees = parse_trees_in_dirs ~dev tree_dirs in
129
-
let@ () = Reporter.profile "Expand, evaluate, and analyse forest" in
130
129
begin
131
-
let@ _, article = Seq.iter @~ Iri_map.to_seq @@ Forest_reader.read_trees ~host ~env parsed_trees in
132
-
F.plant_resource @@ F.Article article
130
+
let@ () = Reporter.profile "Read assets" in
131
+
let@ source_path = Seq.iter @~ Dir_scanner.scan_directories asset_dirs in
132
+
let source_path = String.concat "/" source_path in
133
+
let cwd = Eio.Stdenv.cwd env in
134
+
let content = EP.load EP.(cwd / source_path) in
135
+
let filename, iri = Forester_compiler.Asset_content_addresser.install ~source_path ~content in
136
+
F.plant_resource @@ F.Asset { iri; contents = content; filename }
133
137
end;
134
138
begin
135
-
let@ asset_path = Seq.iter @~ Dir_scanner.scan_directories asset_dirs in
136
-
let asset_iri = Iri.iri ~scheme: Iri_scheme.scheme ~host ~path: (Absolute asset_path) () in
137
-
F.plant_resource @@ F.Asset asset_iri
138
-
end;
139
-
begin
140
-
let@ _foreign_dir = List.iter @~ foreign_dirs in
141
-
(* TODO: plant the trees & assets from the foreign directory *)
142
-
()
139
+
let@ () = Reporter.profile "Expand, evaluate, and analyse forest" in
140
+
begin
141
+
let@ _, article = Seq.iter @~ Iri_map.to_seq @@ Forest_reader.read_trees ~host ~env parsed_trees in
142
+
F.plant_resource @@ F.Article article
143
+
end;
144
+
begin
145
+
let@ _foreign_dir = List.iter @~ foreign_dirs in
146
+
(* TODO: plant the trees & assets from the foreign directory *)
147
+
()
148
+
end
143
149
end
144
150
145
151
let json_manifest ~host ~home ~dev : string =
···
149
155
let module R = Json_manifest_client.Make(Client)(F) in
150
156
Yojson.Basic.to_string @@ R.render_trees ~dev ~host all_articles
151
157
152
-
let render_forest ~env ~dev ~host ~home ~stylesheet : unit =
158
+
let render_forest ~env ~dev ~host ~home : unit =
153
159
let module P = struct let host = host let home = home end in
154
160
let module Client = Legacy_xml_client.Make(P)(F)() in
155
161
let module R = Json_manifest_client.Make(Client)(F) in
156
162
let@ () = Reporter.profile "Render forest" in
157
163
let cwd = Eio.Stdenv.cwd env in
158
-
let all_articles = FU.get_all_articles () in
164
+
let all_resources = List.of_seq @@ F.get_all_resources () in
159
165
begin
166
+
let all_articles = List.filter_map (function F.Article article -> Some article | _ -> None) all_resources in
160
167
let json_string = Yojson.Basic.to_string @@ R.render_trees ~dev ~host all_articles in
161
168
let json_path = EP.(cwd / output_dir_name / "forest.json") in
162
169
Eio_util.ensure_context_of_path ~perm: 0o755 json_path;
163
170
EP.save ~create: (`Or_truncate 0o644) json_path json_string
164
171
end;
165
172
begin
166
-
let@ article = Eio.Fiber.List.iter ~max_fibers: 20 @~ all_articles in
173
+
let@ resource = Eio.Fiber.List.iter ~max_fibers: 20 @~ all_resources in
167
174
let@ () = Reporter.easy_run in
168
-
let@ route = Option.iter @~ Option.map Client.route article.frontmatter.iri in
169
-
let path = EP.(cwd / output_dir_name / route) in
170
-
Eio_util.ensure_context_of_path ~perm: 0o755 path;
171
-
let@ flow = EP.with_open_out ~create: (`Or_truncate 0o644) path in
172
-
let@ writer = Eio.Buf_write.with_flow flow in
173
-
Client.pp_xml ~stylesheet (Eio.Buf_write.make_formatter writer) article
175
+
match resource with
176
+
| F.Article article ->
177
+
let@ route = Option.iter @~ Option.map Client.route article.frontmatter.iri in
178
+
let path = EP.(cwd / output_dir_name / route) in
179
+
Eio_util.ensure_context_of_path ~perm: 0o755 path;
180
+
let@ flow = EP.with_open_out ~create: (`Or_truncate 0o644) path in
181
+
let@ writer = Eio.Buf_write.with_flow flow in
182
+
Client.pp_xml ~stylesheet:"default.xsl" (Eio.Buf_write.make_formatter writer) article
183
+
| F.Asset asset ->
184
+
let route = Client.route asset.iri in
185
+
let dest = EP.(cwd / output_dir_name / route) in
186
+
if Eio_util.file_exists dest then ()
187
+
else
188
+
begin
189
+
Eio_util.ensure_context_of_path ~perm: 0o755 dest;
190
+
EP.save ~create: (`Or_truncate 0o644) dest asset.contents
191
+
end
174
192
end
175
193
176
194
let export ~env ~host ~asset_dirs : unit =