this repo has no description
various
+121
-113
+121
-113
src/x_ocaml.ml
+121
-113
src/x_ocaml.ml
···
3
3
4
4
let current_attribute attr = Brr.El.at (Jstr.of_string attr) current_script
5
5
6
-
let extra_load =
7
-
match current_attribute "src-load" with
8
-
| None -> None
9
-
| Some url -> Some (Jstr.to_string url)
10
-
11
6
let read_meta name =
12
7
let doc = Brr.Document.to_jv Brr.G.document in
13
8
let selector = Jstr.of_string ("meta[name=\"" ^ name ^ "\"]") in
···
18
13
if Jv.is_none content then None
19
14
else Some (Jv.to_string content)
20
15
21
-
let backend_name =
22
-
match current_attribute "backend" with
23
-
| Some name -> Jstr.to_string name
24
-
| None ->
25
-
match read_meta "x-ocaml-backend" with
26
-
| Some name -> name
27
-
| None -> "builtin"
16
+
let () =
17
+
let extra_load =
18
+
match current_attribute "src-load" with
19
+
| None -> None
20
+
| Some url -> Some (Jstr.to_string url)
21
+
in
28
22
29
-
let findlib_requires =
30
-
match read_meta "x-ocaml-packages" with
31
-
| None -> None
32
-
| Some s ->
33
-
let pkgs = List.filter (fun s -> s <> "")
34
-
(List.map String.trim (String.split_on_char ',' s)) in
35
-
if pkgs = [] then None else Some pkgs
23
+
let backend_name =
24
+
match current_attribute "backend" with
25
+
| Some name -> Jstr.to_string name
26
+
| None ->
27
+
match read_meta "x-ocaml-backend" with
28
+
| Some name -> name
29
+
| None -> "builtin"
30
+
in
31
+
32
+
let findlib_requires =
33
+
match read_meta "x-ocaml-packages" with
34
+
| None -> None
35
+
| Some s ->
36
+
let pkgs = List.filter (fun s -> s <> "")
37
+
(List.map String.trim (String.split_on_char ',' s)) in
38
+
if pkgs = [] then None else Some pkgs
39
+
in
36
40
37
-
let resolve_url relative =
38
-
let url_ctor = Jv.get Jv.global "URL" in
39
-
let loc = Jv.get (Jv.get Jv.global "window") "location" in
40
-
let href = Jv.to_string (Jv.get loc "href") in
41
-
let url_obj = Jv.new' url_ctor [| Jv.of_string relative; Jv.of_string href |] in
42
-
Jv.to_string (Jv.get url_obj "href")
41
+
let resolve_url relative =
42
+
let url_ctor = Jv.get Jv.global "URL" in
43
+
let loc = Jv.get (Jv.get Jv.global "window") "location" in
44
+
let href = Jv.to_string (Jv.get loc "href") in
45
+
let url_obj = Jv.new' url_ctor [| Jv.of_string relative; Jv.of_string href |] in
46
+
Jv.to_string (Jv.get url_obj "href")
47
+
in
43
48
44
-
let findlib_index_url =
45
-
match read_meta "x-ocaml-universe" with
46
-
| None -> None
47
-
| Some base ->
48
-
let base = if String.length base > 0 && base.[String.length base - 1] = '/'
49
-
then base else base ^ "/" in
50
-
Some (resolve_url (base ^ "findlib_index.json"))
49
+
let findlib_index_url =
50
+
match read_meta "x-ocaml-universe" with
51
+
| None -> None
52
+
| Some base ->
53
+
let base = if String.length base > 0 && base.[String.length base - 1] = '/'
54
+
then base else base ^ "/" in
55
+
Some (resolve_url (base ^ "findlib_index.json"))
56
+
in
51
57
52
-
(** Synchronous XHR fetch of a small text resource.
53
-
Used only for the findlib_index.json pre-fetch (~200 bytes)
54
-
to extract compiler info before creating the worker. *)
55
-
let sync_fetch_text url =
56
-
let xhr = Jv.new' (Jv.get Jv.global "XMLHttpRequest") [||] in
57
-
Jv.call xhr "open" [| Jv.of_string "GET"; Jv.of_string url; Jv.of_bool false |] |> ignore;
58
-
(try Jv.call xhr "send" [||] |> ignore with _ -> ());
59
-
let status = Jv.to_int (Jv.get xhr "status") in
60
-
if status = 200 then Some (Jv.to_string (Jv.get xhr "responseText"))
61
-
else None
58
+
let sync_fetch_text url =
59
+
let xhr = Jv.new' (Jv.get Jv.global "XMLHttpRequest") [||] in
60
+
Jv.call xhr "open" [| Jv.of_string "GET"; Jv.of_string url; Jv.of_bool false |] |> ignore;
61
+
(try Jv.call xhr "send" [||] |> ignore with _ -> ());
62
+
let status = Jv.to_int (Jv.get xhr "status") in
63
+
if status = 200 then Some (Jv.to_string (Jv.get xhr "responseText"))
64
+
else None
65
+
in
62
66
63
-
(** Parse the compiler object from findlib_index.json.
64
-
Uses browser JSON.parse — no OCaml JSON library needed. *)
65
-
let findlib_index_json =
66
-
match findlib_index_url with
67
-
| None -> None
68
-
| Some url ->
69
-
match sync_fetch_text url with
67
+
let findlib_index_json =
68
+
match findlib_index_url with
70
69
| None -> None
71
-
| Some text ->
72
-
(try
73
-
Some (Jv.call (Jv.get Jv.global "JSON") "parse" [| Jv.of_string text |])
74
-
with _ -> None)
70
+
| Some url ->
71
+
match sync_fetch_text url with
72
+
| None -> None
73
+
| Some text ->
74
+
(try
75
+
Some (Jv.call (Jv.get Jv.global "JSON") "parse" [| Jv.of_string text |])
76
+
with _ -> None)
77
+
in
75
78
76
-
let findlib_index_base_dir =
77
-
match findlib_index_url with
78
-
| None -> ""
79
-
| Some fi_url ->
80
-
match String.rindex_opt fi_url '/' with
81
-
| Some i -> String.sub fi_url 0 (i + 1)
82
-
| None -> fi_url
79
+
let findlib_index_base_dir =
80
+
match findlib_index_url with
81
+
| None -> ""
82
+
| Some fi_url ->
83
+
match String.rindex_opt fi_url '/' with
84
+
| Some i -> String.sub fi_url 0 (i + 1)
85
+
| None -> fi_url
86
+
in
83
87
84
-
(** Derive the worker URL from findlib_index.json's compiler field.
85
-
Supports two modes:
86
-
- Direct: compiler.worker_url (relative to findlib_index.json)
87
-
- Day10-style: compiler.version + compiler.content_hash constructs
88
-
../../../compiler/{version}/{content_hash}/worker.js *)
89
-
let worker_url_from_findlib_index =
90
-
match findlib_index_json with
91
-
| None -> None
92
-
| Some json ->
93
-
let compiler = Jv.get json "compiler" in
94
-
if Jv.is_none compiler || Jv.is_undefined compiler then None
95
-
else
96
-
let worker_url = Jv.get compiler "worker_url" in
97
-
if not (Jv.is_none worker_url || Jv.is_undefined worker_url) then
98
-
Some (findlib_index_base_dir ^ Jv.to_string worker_url)
88
+
let worker_url_from_findlib_index =
89
+
match findlib_index_json with
90
+
| None -> None
91
+
| Some json ->
92
+
let compiler = Jv.get json "compiler" in
93
+
if Jv.is_none compiler || Jv.is_undefined compiler then None
99
94
else
100
-
try
101
-
let version = Jv.to_string (Jv.get compiler "version") in
102
-
let content_hash = Jv.to_string (Jv.get compiler "content_hash") in
103
-
Some (findlib_index_base_dir ^ "../../../compiler/" ^ version ^ "/" ^ content_hash ^ "/worker.js")
104
-
with _ -> None
95
+
let worker_url = Jv.get compiler "worker_url" in
96
+
if not (Jv.is_none worker_url || Jv.is_undefined worker_url) then
97
+
Some (findlib_index_base_dir ^ Jv.to_string worker_url)
98
+
else
99
+
try
100
+
let version = Jv.to_string (Jv.get compiler "version") in
101
+
let content_hash = Jv.to_string (Jv.get compiler "content_hash") in
102
+
Some (findlib_index_base_dir ^ "../../../compiler/" ^ version ^ "/" ^ content_hash ^ "/worker.js")
103
+
with _ -> None
104
+
in
105
105
106
-
let worker_url =
107
-
(* Priority: 1) explicit x-ocaml-worker meta tag,
108
-
2) compiler field from findlib_index.json,
109
-
3) src-worker script attribute *)
110
-
match read_meta "x-ocaml-worker" with
111
-
| Some url -> url
112
-
| None ->
113
-
match worker_url_from_findlib_index with
114
-
| Some url -> url
106
+
let worker_url =
107
+
match read_meta "x-ocaml-worker" with
108
+
| Some url -> Some url
115
109
| None ->
116
-
match current_attribute "src-worker" with
110
+
match worker_url_from_findlib_index with
111
+
| Some url -> Some url
117
112
| None ->
118
-
if backend_name = "builtin" then
119
-
failwith "x-ocaml script missing src-worker attribute"
120
-
else ""
121
-
| Some url -> Jstr.to_string url
113
+
match current_attribute "src-worker" with
114
+
| None ->
115
+
if backend_name = "builtin" then None
116
+
else Some ""
117
+
| Some url -> Some (Jstr.to_string url)
118
+
in
122
119
123
-
let backend = Backend.make ~backend:backend_name ?extra_load ?findlib_requires
124
-
?findlib_index:findlib_index_url worker_url
120
+
match worker_url with
121
+
| None ->
122
+
(* No worker URL available — x-ocaml elements on this page are inert
123
+
(e.g. code blocks on non-interactive pages due to resource leak). *)
124
+
()
125
+
| Some worker_url ->
125
126
126
-
let format_config =
127
-
match current_attribute "x-ocamlformat" with
128
-
| None -> None
129
-
| Some conf -> Some (Jstr.to_string conf)
127
+
let backend = Backend.make ~backend:backend_name ?extra_load ?findlib_requires
128
+
?findlib_index:findlib_index_url worker_url
129
+
in
130
130
131
-
let extra_style = current_attribute "src-style"
132
-
let inline_style = current_attribute "inline-style"
131
+
let format_config =
132
+
match current_attribute "x-ocamlformat" with
133
+
| None -> None
134
+
| Some conf -> Some (Jstr.to_string conf)
135
+
in
133
136
134
-
let default_run_on =
135
-
current_attribute "run-on" |> Option.map Jstr.to_string
137
+
let extra_style = current_attribute "src-style" in
138
+
let inline_style = current_attribute "inline-style" in
139
+
140
+
let default_run_on =
141
+
current_attribute "run-on" |> Option.map Jstr.to_string
142
+
in
136
143
137
-
let page =
138
-
Page.create ~backend ?extra_style ?inline_style ?default_run_on
139
-
?format_config ()
144
+
let page =
145
+
Page.create ~backend ?extra_style ?inline_style ?default_run_on
146
+
?format_config ()
147
+
in
140
148
141
-
let elt_name =
142
-
match current_attribute "elt-name" with
143
-
| None -> Jstr.of_string "x-ocaml"
144
-
| Some name -> name
149
+
let elt_name =
150
+
match current_attribute "elt-name" with
151
+
| None -> Jstr.of_string "x-ocaml"
152
+
| Some name -> name
153
+
in
145
154
146
-
let _ =
147
-
Webcomponent.define elt_name @@ fun this ->
155
+
ignore @@ Webcomponent.define elt_name @@ fun this ->
148
156
let _cell = Page.register page this in
149
157
()