forked from
jonmsterling.com/ocaml-forester
ocaml
preparing for foreign implanatation; making 'host' mandatory
+63
-50
+11
-10
bin/forester/main.ml
+11
-10
bin/forester/main.ml
···
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
-
Forester.plant_forest_from_dirs ~env ~host: config.host ~dev ~tree_dirs ~asset_dirs;
25
+
let foreign_dirs = paths_of_dirs ~env config.foreign in
26
+
Forester.plant_raw_forest_from_dirs ~env ~host: config.host ~dev ~tree_dirs ~asset_dirs ~foreign_dirs;
26
27
Forester.render_forest ~env ~dev ~host: config.host ~home: config.home ~stylesheet: config.stylesheet;
27
28
let dirs_to_copy =
28
29
(if not no_theme then [config.theme] else []) @
···
35
36
let config = Forester_frontend.Config.parse_forest_config_file config_filename in
36
37
let tree_dirs = paths_of_dirs ~env config.trees in
37
38
let asset_dirs = paths_of_dirs ~env config.assets in
38
-
Forester.plant_forest_from_dirs ~env ~host: config.host ~dev: false ~tree_dirs ~asset_dirs;
39
-
let host =
40
-
match config.host with
41
-
| Some host -> host
42
-
| None -> Reporter.fatalf Configuration_error "To export a forest, you must first fill in the `host' field in %s" config_filename
43
-
in
39
+
let foreign_dirs = paths_of_dirs ~env config.foreign in
40
+
Forester.plant_raw_forest_from_dirs ~env ~host: config.host ~dev: false ~tree_dirs ~asset_dirs ~foreign_dirs;
41
+
let host = config.host in
44
42
Forester.export ~env ~host ~asset_dirs
45
43
46
44
let new_tree ~env config_filename dest_dir prefix template random =
···
48
46
let config = Forester_frontend.Config.parse_forest_config_file config_filename in
49
47
let tree_dirs = paths_of_dirs ~env config.trees in
50
48
let asset_dirs = paths_of_dirs ~env config.assets in
51
-
Forester.plant_forest_from_dirs ~env ~host: config.host ~dev: true ~tree_dirs ~asset_dirs;
49
+
let foreign_dirs = paths_of_dirs ~env config.foreign in
50
+
Forester.plant_raw_forest_from_dirs ~env ~host: config.host ~dev: true ~tree_dirs ~asset_dirs ~foreign_dirs;
52
51
let mode = if random then `Random else `Sequential in
53
52
let dest = path_of_dir ~env dest_dir in
54
53
let addr = Forester.create_tree ~env ~dest ~prefix ~template ~mode in
···
59
58
let config = Forester_frontend.Config.parse_forest_config_file config_filename in
60
59
let tree_dirs = paths_of_dirs ~env config.trees in
61
60
let asset_dirs = paths_of_dirs ~env config.assets in
62
-
Forester.plant_forest_from_dirs ~env ~host: config.host ~dev: true ~tree_dirs ~asset_dirs;
61
+
let foreign_dirs = paths_of_dirs ~env config.foreign in
62
+
Forester.plant_raw_forest_from_dirs ~env ~host: config.host ~dev: true ~tree_dirs ~asset_dirs ~foreign_dirs;
63
63
let@ iri, title = Seq.iter @~ Forester.complete ~host: config.host title in
64
64
Format.printf "%a, %s\n" pp_iri iri title
65
65
···
68
68
let config = Forester_frontend.Config.parse_forest_config_file config_filename in
69
69
let tree_dirs = paths_of_dirs ~env config.trees in
70
70
let asset_dirs = paths_of_dirs ~env config.assets in
71
-
Forester.plant_forest_from_dirs ~env ~host: config.host ~dev: true ~tree_dirs ~asset_dirs;
71
+
let foreign_dirs = paths_of_dirs ~env config.foreign in
72
+
Forester.plant_raw_forest_from_dirs ~env ~host: config.host ~dev: true ~tree_dirs ~asset_dirs ~foreign_dirs;
72
73
Forester.json_manifest ~host: config.host ~home: config.home ~dev: true |> Format.printf "%s"
73
74
74
75
let default_config_str =
+1
-1
lib/compiler/Eval.ml
+1
-1
lib/compiler/Eval.ml
···
125
125
module Tape = Tape_effect.Make ()
126
126
module Lex_env = Algaeff.Reader.Make(struct type t = V.t Env.t end)
127
127
module Dyn_env = Algaeff.Reader.Make(struct type t = V.t Env.t end)
128
-
module Host_env = Algaeff.Reader.Make(struct type t = string option end)
128
+
module Host_env = Algaeff.Reader.Make(struct type t = string end)
129
129
module Heap = Algaeff.State.Make(struct type t = V.obj Env.t end)
130
130
module Emitted_trees = Algaeff.State.Make(struct type t = T.content T.article list end)
131
131
module Jobs = Algaeff.State.Make(struct type t = job list end)
+1
-1
lib/compiler/Eval.mli
+1
-1
lib/compiler/Eval.mli
+5
-5
lib/core/Iri_scheme.ml
+5
-5
lib/core/Iri_scheme.ml
···
1
1
let scheme = "forest"
2
2
3
3
let base_iri ~host =
4
-
Iri.iri ~scheme ?host ()
4
+
Iri.iri ~scheme ~host ()
5
5
6
6
let user_iri ~host str =
7
7
Iri.iri
8
-
?host
8
+
~host
9
9
~scheme
10
10
~path: (Absolute [str])
11
11
()
12
12
13
13
let hash_iri ~host hash_str =
14
14
Iri.iri
15
-
?host
15
+
~host
16
16
~scheme
17
17
~path: (Absolute ["hash"; hash_str])
18
18
()
19
19
20
20
let fresh ~host =
21
21
Iri.iri
22
-
?host
22
+
~host
23
23
~scheme
24
24
~path: (Absolute ["unstable"; string_of_int (Oo.id object end)])
25
25
()
···
30
30
| _ -> true
31
31
32
32
let relativise_iri ~host iri =
33
-
if Iri.scheme iri = scheme && Iri.host iri = host then
33
+
if Iri.scheme iri = scheme && Iri.host iri = Some host then
34
34
let (Iri.Absolute components | Iri.Relative components) = Iri.path iri in
35
35
Iri.iri ~path: (Iri.Relative components) ()
36
36
else
+5
-5
lib/core/Iri_scheme.mli
+5
-5
lib/core/Iri_scheme.mli
···
3
3
val scheme : string
4
4
5
5
val base_iri :
6
-
host: string option ->
6
+
host: string ->
7
7
iri
8
8
9
9
val user_iri :
10
-
host: string option ->
10
+
host: string ->
11
11
string ->
12
12
iri
13
13
14
14
val hash_iri :
15
-
host: string option ->
15
+
host: string ->
16
16
string ->
17
17
iri
18
18
19
19
val fresh :
20
-
host: string option ->
20
+
host: string ->
21
21
iri
22
22
23
23
val is_stable_iri : iri -> bool
24
24
25
25
val relativise_iri :
26
-
host: string option ->
26
+
host: string ->
27
27
iri ->
28
28
iri
+1
-1
lib/forest/Json_manifest_client.mli
+1
-1
lib/forest/Json_manifest_client.mli
+8
-13
lib/forest/Legacy_xml_client.ml
+8
-13
lib/forest/Legacy_xml_client.ml
···
14
14
end
15
15
16
16
module type Params = sig
17
-
val host : string option
17
+
val host : string
18
18
val home : string option
19
19
end
20
20
···
48
48
| Iri.Relative xs -> xs
49
49
else
50
50
Iri.to_string ~pctencode: false @@
51
-
Iri.iri ?host ~path ()
51
+
Iri.iri ~host ~path ()
52
52
53
53
let iri_to_string iri =
54
-
if Iri.scheme iri = Iri_scheme.scheme then
55
-
let host = Iri.host iri in
54
+
match Iri.host iri with
55
+
| Some host when Iri.scheme iri = Iri_scheme.scheme ->
56
56
let path = Iri.path iri in
57
57
forester_iri_to_string ~host ~path
58
-
else
58
+
| _ ->
59
59
Iri.to_string ~pctencode: false iri
60
60
61
61
let iri_type iri =
···
77
77
| false -> bare_route ^ ".xml"
78
78
79
79
let route_foreign_forester_iri ~host ~path ~is_asset =
80
-
"foreign-" ^
81
-
match host with
82
-
| None -> route_bare_forester_iri ~path ~is_asset
83
-
| Some host ->
84
-
host ^ "-" ^ route_bare_forester_iri ~path ~is_asset
80
+
"foreign-" ^ host ^ "-" ^ route_bare_forester_iri ~path ~is_asset
85
81
86
82
let route_forester_iri ~host ~path ~is_asset =
87
83
if host = Params.host then
···
109
105
| _ -> false
110
106
111
107
let route iri =
112
-
match Iri.scheme iri with
113
-
| scheme when scheme = Iri_scheme.scheme ->
108
+
match Iri.host iri with
109
+
| Some host when Iri.scheme iri = Iri_scheme.scheme ->
114
110
if iri_is_home iri then "index.xml"
115
111
else
116
-
let host = Iri.host iri in
117
112
let path = Iri.path iri in
118
113
let is_asset = iri_is_asset iri in
119
114
route_forester_iri ~host ~path ~is_asset
+1
-1
lib/forest/Legacy_xml_client.mli
+1
-1
lib/forest/Legacy_xml_client.mli
+14
-4
lib/frontend/Config.ml
+14
-4
lib/frontend/Config.ml
···
3
3
4
4
module Forest_config = struct
5
5
type t = {
6
-
host: string option;
6
+
host: string;
7
7
home: string option;
8
8
trees: string list;
9
9
assets: string list;
10
+
foreign: string list;
10
11
theme: string;
11
12
stylesheet: string
12
13
}
···
15
16
16
17
let default_forest_config : Forest_config.t =
17
18
{
18
-
host = None;
19
+
host = "my-forest";
19
20
trees = ["trees"];
20
21
assets = [];
22
+
foreign = [];
21
23
theme = "theme";
22
24
home = None;
23
25
stylesheet = "default.xsl"
···
35
37
| `Ok tbl ->
36
38
let open Toml.Lenses in
37
39
let forest = key "forest" |-- table in
38
-
let host = get tbl (forest |-- key "host" |-- string) in
40
+
let host =
41
+
match get tbl (forest |-- key "host" |-- string) with
42
+
| Some host -> host
43
+
| None -> Reporter.fatalf Configuration_error "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')"
44
+
in
39
45
let home = get tbl (forest |-- key "home" |-- string) in
40
46
let _ =
41
47
match get tbl (forest |-- key "root" |-- string) with
···
47
53
Option.value ~default: default_forest_config.trees @@
48
54
get tbl (forest |-- key "trees" |-- array |-- strings)
49
55
in
56
+
let foreign =
57
+
Option.value ~default: default_forest_config.trees @@
58
+
get tbl (forest |-- key "foreign" |-- array |-- strings)
59
+
in
50
60
let assets =
51
61
Option.value ~default: default_forest_config.assets @@
52
62
get tbl (forest |-- key "assets" |-- array |-- strings)
···
59
69
Option.value ~default: default_forest_config.stylesheet @@
60
70
get tbl (forest |-- key "stylesheet" |-- string)
61
71
in
62
-
Forest_config.{ host; assets; trees; theme; home; stylesheet }
72
+
Forest_config.{ host; assets; trees; foreign; theme; home; stylesheet }
+3
-2
lib/frontend/Config.mli
+3
-2
lib/frontend/Config.mli
+7
-2
lib/frontend/Forester.ml
+7
-2
lib/frontend/Forester.ml
···
124
124
| exception exn ->
125
125
if ignore_malformed then None else raise exn
126
126
127
-
let plant_forest_from_dirs ~env ~host ~dev ~tree_dirs ~asset_dirs : unit =
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
129
let@ () = Reporter.profile "Expand, evaluate, and analyse forest" in
130
130
begin
···
133
133
end;
134
134
begin
135
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
136
+
let asset_iri = Iri.iri ~scheme: Iri_scheme.scheme ~host ~path: (Absolute asset_path) () in
137
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
+
()
138
143
end
139
144
140
145
let json_manifest ~host ~home ~dev : string =
+6
-5
lib/frontend/Forester.mli
+6
-5
lib/frontend/Forester.mli
···
3
3
type env = Eio_unix.Stdenv.base
4
4
type dir = Eio.Fs.dir_ty Eio.Path.t
5
5
6
-
val plant_forest_from_dirs :
6
+
val plant_raw_forest_from_dirs :
7
7
env: env ->
8
-
host: string option ->
8
+
host: string ->
9
9
dev: bool ->
10
10
tree_dirs: dir list ->
11
11
asset_dirs: dir list ->
12
+
foreign_dirs: dir list ->
12
13
unit
13
14
14
15
val render_forest :
15
16
env: env ->
16
17
dev: bool ->
17
-
host: string option ->
18
+
host: string ->
18
19
home: string option ->
19
20
stylesheet: string ->
20
21
unit
···
39
40
string
40
41
41
42
val json_manifest :
42
-
host: string option ->
43
+
host: string ->
43
44
home: string option ->
44
45
dev: bool ->
45
46
string
46
47
47
48
val complete :
48
-
host: string option ->
49
+
host: string ->
49
50
string ->
50
51
(iri * string) Seq.t