jon.recoil.org
this repo has no description
1open Brr
2
3type t = {
4 backend : Backend.t;
5 extra_style : Jstr.t option;
6 inline_style : Jstr.t option;
7 default_run_on : string;
8 mutable cells : Cell.t list;
9 (* test_links: maps exercise cell id -> list of test cells linked to it *)
10 mutable test_links : (int * Cell.t list) list;
11 (* Messages to replay after a backend reset *)
12 init_messages : X_protocol.request list ref;
13}
14
15let find_by_id t id = List.find (fun c -> Cell.id c = id) t.cells
16
17let find_by_cell_id t name =
18 List.find_opt (fun c -> Cell.cell_id c = Some name) t.cells
19
20let cells t = List.rev t.cells
21
22(* Find the nearest preceding exercise cell in document order.
23 t.cells is stored in reverse document order (most recent first). *)
24let find_preceding_exercise t =
25 List.find_opt (fun c -> Cell.mode c = Cell.Exercise) t.cells
26
27(* Register a test cell as linked to an exercise cell.
28 When the exercise completes, all linked tests will be triggered. *)
29let link_test t ~exercise ~test =
30 let ex_id = Cell.id exercise in
31 let existing =
32 match List.assoc_opt ex_id t.test_links with
33 | Some tests -> tests
34 | None -> []
35 in
36 t.test_links <- (ex_id, test :: existing)
37 :: List.filter (fun (id, _) -> id <> ex_id) t.test_links
38
39(* Set up the on_completed callback for an exercise cell.
40 When it completes, run all linked test cells. *)
41let setup_exercise_callback t exercise =
42 Cell.set_on_completed exercise (fun _ex ->
43 let ex_id = Cell.id exercise in
44 match List.assoc_opt ex_id t.test_links with
45 | None -> ()
46 | Some tests -> List.iter Cell.run tests)
47
48let read_meta_content name =
49 let doc = Document.to_jv G.document in
50 let selector = Jstr.of_string ("meta[name=\"" ^ name ^ "\"]") in
51 let result = Jv.call doc "querySelector" [| Jv.of_jstr selector |] in
52 if Jv.is_none result then None
53 else
54 let content = Jv.call result "getAttribute" [| Jv.of_string "content" |] in
55 if Jv.is_none content then None
56 else Some (Jv.to_string content)
57
58let reset_all t =
59 Backend.reset t.backend;
60 (* Re-register the message handler on the fresh worker *)
61 Backend.on_message t.backend (function
62 | X_protocol.Formatted_source (id, code_fmt) ->
63 Cell.set_source (find_by_id t id) code_fmt
64 | Top_response_at (id, loc, msg) ->
65 Cell.add_message (find_by_id t id) loc msg
66 | Top_response (id, msg) ->
67 Cell.completed_run (find_by_id t id) msg
68 | Merlin_response (id, msg) ->
69 Cell.receive_merlin (find_by_id t id) msg);
70 (* Replay init messages *)
71 List.iter (Backend.post t.backend) !(t.init_messages);
72 (* Reset all cells to Not_run *)
73 List.iter Cell.reset_status t.cells
74
75let create ~backend ?extra_style ?inline_style ?(default_run_on = "load")
76 ?format_config () =
77 let init_messages = ref [] in
78 let t =
79 { backend; extra_style; inline_style; default_run_on;
80 cells = []; test_links = []; init_messages }
81 in
82 (* Route backend responses to the appropriate cell *)
83 Backend.on_message backend (function
84 | X_protocol.Formatted_source (id, code_fmt) ->
85 Cell.set_source (find_by_id t id) code_fmt
86 | Top_response_at (id, loc, msg) ->
87 Cell.add_message (find_by_id t id) loc msg
88 | Top_response (id, msg) ->
89 Cell.completed_run (find_by_id t id) msg
90 | Merlin_response (id, msg) ->
91 Cell.receive_merlin (find_by_id t id) msg);
92 (* Initialise backend and record messages for replay after reset *)
93 let send msg =
94 init_messages := !(init_messages) @ [msg];
95 Backend.post backend msg
96 in
97 send Setup;
98 (match format_config with
99 | Some conf -> send (Format_config conf)
100 | None -> ());
101 (* Universe discovery: register external package CMIs with merlin.
102 <meta name="x-ocaml-packages" content="pkg1,pkg2,...">
103 <meta name="x-ocaml-cmis-url" content="./cmis/"> (optional, default ./cmis/)
104 For each package, we send Add_cmis with dynamic_cmis pointing to
105 {base_url}/{pkg}/ with toplevel module {Pkg} and prefix {pkg}__. *)
106 (match read_meta_content "x-ocaml-packages" with
107 | None -> ()
108 | Some packages_str ->
109 let base_url =
110 match read_meta_content "x-ocaml-cmis-url" with
111 | Some url -> url
112 | None -> "./cmis/"
113 in
114 let packages =
115 List.filter (fun s -> s <> "")
116 (List.map String.trim (String.split_on_char ',' packages_str))
117 in
118 List.iter (fun pkg ->
119 let capitalised = String.capitalize_ascii pkg in
120 let dcs = Protocol.{
121 dcs_url = base_url ^ pkg ^ "/";
122 dcs_toplevel_modules = [ capitalised ];
123 dcs_file_prefixes = [ pkg ^ "__" ];
124 } in
125 send
126 (Add_cmis { Protocol.static_cmis = []; dynamic_cmis = Some dcs }))
127 packages);
128 t
129
130let run_on_of_string = function "click" -> `Click | "load" | _ -> `Load
131
132let register t this =
133 let id = List.length t.cells in
134 let prev = match t.cells with [] -> None | c :: _ -> Some c in
135 let mode =
136 Cell.mode_of_string
137 (Option.value ~default:"interactive"
138 (Webcomponent.get_attribute this "mode"))
139 in
140 let run_on =
141 run_on_of_string
142 (Option.value ~default:t.default_run_on
143 (Webcomponent.get_attribute this "run-on"))
144 in
145 let cell_id = Webcomponent.get_attribute this "data-id" in
146 let cell_for = Webcomponent.get_attribute this "data-for" in
147 let cell_env = Webcomponent.get_attribute this "data-env" in
148 let filename = Webcomponent.get_attribute this "data-filename" in
149 let merlin =
150 match Webcomponent.get_attribute this "data-merlin" with
151 | Some "false" -> false
152 | _ -> true
153 in
154 let eval_fn ~id ~line_number code =
155 Backend.eval ~id ~line_number t.backend code
156 in
157 let fmt_fn ~id code = Backend.fmt ~id t.backend code in
158 let post_fn msg = Backend.post t.backend msg in
159 let cell =
160 Cell.init ~id ~mode ~run_on ?cell_id ?cell_for ?cell_env ?filename ~merlin
161 ?extra_style:t.extra_style ?inline_style:t.inline_style ~eval_fn ~fmt_fn
162 ~post_fn this
163 in
164 t.cells <- cell :: t.cells;
165 Cell.set_prev ~prev cell;
166 Cell.set_stop_fn cell (fun () -> reset_all t);
167 (* Test linking: connect Test cells to their target Exercise cell *)
168 (match mode with
169 | Cell.Test ->
170 let target =
171 match cell_for with
172 | Some target_id -> find_by_cell_id t target_id
173 | None -> find_preceding_exercise t
174 in
175 (match target with
176 | Some exercise ->
177 link_test t ~exercise ~test:cell;
178 setup_exercise_callback t exercise;
179 (* Late registration: if exercise already completed, trigger now *)
180 if Cell.has_completed exercise then Cell.run cell
181 | None -> ())
182 | Cell.Exercise ->
183 (* Set up the callback so tests linked later will be triggered *)
184 setup_exercise_callback t cell
185 | _ -> ());
186 Cell.start cell this;
187 if List.for_all Cell.loadable t.cells then Cell.run cell;
188 cell