jon.recoil.org
this repo has no description
1(* Unix worker *)
2open Js_top_worker
3open Impl
4
5let capture : (unit -> 'a) -> unit -> Impl.captured * 'a =
6 fun f () ->
7 let stdout_buff = Buffer.create 1024 in
8 let stderr_buff = Buffer.create 1024 in
9 Js_of_ocaml.Sys_js.set_channel_flusher stdout (Buffer.add_string stdout_buff);
10
11 let x = f () in
12 let captured =
13 {
14 Impl.stdout = Buffer.contents stdout_buff;
15 stderr = Buffer.contents stderr_buff;
16 }
17 in
18 (captured, x)
19
20module S : Impl.S = struct
21 type findlib_t = Js_top_worker_web.Findlibish.t
22
23 let capture = capture
24
25 let sync_get f =
26 let f = Fpath.v ("_opam/" ^ f) in
27 Logs.info (fun m -> m "sync_get: %a" Fpath.pp f);
28 try Some (In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all)
29 with e ->
30 Logs.err (fun m ->
31 m "Error reading file %a: %s" Fpath.pp f (Printexc.to_string e));
32 None
33
34 let async_get f =
35 let f = Fpath.v ("_opam/" ^ f) in
36 Logs.info (fun m -> m "async_get: %a" Fpath.pp f);
37 (* For Node.js, we use synchronous file reading wrapped in Lwt *)
38 try
39 let content =
40 In_channel.with_open_bin (Fpath.to_string f) In_channel.input_all
41 in
42 Lwt.return (Ok content)
43 with e ->
44 Logs.err (fun m ->
45 m "Error reading file %a: %s" Fpath.pp f (Printexc.to_string e));
46 Lwt.return (Error (`Msg (Printexc.to_string e)))
47
48 let create_file = Js_of_ocaml.Sys_js.create_file
49
50 let import_scripts urls =
51 let open Js_of_ocaml.Js in
52 let import_scripts_fn = Unsafe.get Unsafe.global (string "importScripts") in
53 List.iter
54 (fun url ->
55 let (_ : 'a) =
56 Unsafe.fun_call import_scripts_fn [| Unsafe.inject (string url) |]
57 in
58 ())
59 urls
60
61 let init_function _ () = failwith "Not implemented"
62 let findlib_init = Js_top_worker_web.Findlibish.init async_get
63
64 let get_stdlib_dcs uri =
65 Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get uri
66 |> Result.to_list
67
68 let find_stdlib_dcs v =
69 let pkg = match Js_top_worker_web.Findlibish.find_dcs_url v "stdlib" with
70 | Some _ as r -> r
71 | None -> Js_top_worker_web.Findlibish.find_dcs_url v "ocaml"
72 in
73 match pkg with
74 | Some url ->
75 Js_top_worker_web.Findlibish.fetch_dynamic_cmis sync_get url
76 |> Result.to_list
77 | None -> []
78
79 let require b v = function
80 | [] -> []
81 | packages -> Js_top_worker_web.Findlibish.require ~import_scripts sync_get b v packages
82
83 let path = "/static/cmis"
84end
85
86module U = Impl.Make (S)
87
88let _ =
89 Logs.set_reporter (Logs_fmt.reporter ());
90 Logs.set_level (Some Logs.Info);
91 Logs.info (fun m -> m "Starting server...");
92 let ( let* ) m f =
93 let open Lwt in
94 m >>= function
95 | Ok x -> f x
96 | Error e -> return (Error e)
97 in
98 let init_config =
99 { stdlib_dcs = None; findlib_requires = [ "base" ]; findlib_index = None; execute = true }
100 in
101 let x =
102 let* _ = U.init init_config in
103 let* o = U.setup "" in
104 Logs.info (fun m ->
105 m "setup output: %s" (Option.value ~default:"" o.stdout));
106 let* _ = U.query_errors "" (Some "c1") [] false "type xxxx = int;;\n" in
107 let* o1 =
108 U.query_errors "" (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
109 in
110 Logs.info (fun m -> m "Number of errors: %d (should be 1)" (List.length o1));
111 let* _ = U.query_errors "" (Some "c1") [] false "type xxx = int;;\n" in
112 let* o2 =
113 U.query_errors "" (Some "c2") [ "c1" ] false "type yyy = xxx;;\n"
114 in
115 Logs.info (fun m ->
116 m "Number of errors1: %d (should be 1)" (List.length o1));
117 Logs.info (fun m ->
118 m "Number of errors2: %d (should be 0)" (List.length o2));
119
120 (* Test completion for List.leng *)
121 let* completions1 =
122 let text = "let _ = List.leng" in
123 U.complete_prefix "" (Some "c_comp1") [] false text
124 (Offset (String.length text))
125 in
126 Logs.info (fun m ->
127 m "Completions for 'List.leng': %d entries"
128 (List.length completions1.entries));
129 List.iter
130 (fun entry ->
131 Logs.info (fun m ->
132 m " - %s (%s): %s" entry.name
133 (match entry.kind with
134 | Constructor -> "Constructor"
135 | Keyword -> "Keyword"
136 | Label -> "Label"
137 | MethodCall -> "MethodCall"
138 | Modtype -> "Modtype"
139 | Module -> "Module"
140 | Type -> "Type"
141 | Value -> "Value"
142 | Variant -> "Variant")
143 entry.desc))
144 completions1.entries;
145
146 (* Test completion for List. (should show all List module functions) *)
147 let* completions2 =
148 let text = "# let _ = List." in
149 U.complete_prefix "" (Some "c_comp2") [] true text
150 (Offset (String.length text))
151 in
152 Logs.info (fun m ->
153 m "Completions for 'List.': %d entries"
154 (List.length completions2.entries));
155 List.iter
156 (fun entry ->
157 Logs.info (fun m ->
158 m " - %s (%s): %s" entry.name
159 (match entry.kind with
160 | Constructor -> "Constructor"
161 | Keyword -> "Keyword"
162 | Label -> "Label"
163 | MethodCall -> "MethodCall"
164 | Modtype -> "Modtype"
165 | Module -> "Module"
166 | Type -> "Type"
167 | Value -> "Value"
168 | Variant -> "Variant")
169 entry.desc))
170 completions2.entries;
171
172 (* Test completion for partial identifier *)
173 let* completions3 =
174 let text = "# let _ = ma" in
175 U.complete_prefix "" (Some "c_comp3") [] true text
176 (Offset (String.length text))
177 in
178 Logs.info (fun m ->
179 m "Completions for 'ma': %d entries" (List.length completions3.entries));
180 List.iter
181 (fun entry ->
182 Logs.info (fun m ->
183 m " - %s (%s): %s" entry.name
184 (match entry.kind with
185 | Constructor -> "Constructor"
186 | Keyword -> "Keyword"
187 | Label -> "Label"
188 | MethodCall -> "MethodCall"
189 | Modtype -> "Modtype"
190 | Module -> "Module"
191 | Type -> "Type"
192 | Value -> "Value"
193 | Variant -> "Variant")
194 entry.desc))
195 completions3.entries;
196
197 (* Test completion in non-toplevel context *)
198 let* completions4 =
199 let text = "let _ = List.leng" in
200 U.complete_prefix "" (Some "c_comp4") [] false text
201 (Offset (String.length text))
202 in
203 Logs.info (fun m ->
204 m "Completions for 'List.leng' (non-toplevel): %d entries"
205 (List.length completions4.entries));
206 List.iter
207 (fun entry ->
208 Logs.info (fun m ->
209 m " - %s (%s): %s" entry.name
210 (match entry.kind with
211 | Constructor -> "Constructor"
212 | Keyword -> "Keyword"
213 | Label -> "Label"
214 | MethodCall -> "MethodCall"
215 | Modtype -> "Modtype"
216 | Module -> "Module"
217 | Type -> "Type"
218 | Value -> "Value"
219 | Variant -> "Variant")
220 entry.desc))
221 completions4.entries;
222
223 (* Test completion using Logical position constructor *)
224 let* completions5 =
225 let text = "# let _ = List.leng\n let foo=1.0;;" in
226 U.complete_prefix "" (Some "c_comp5") [] true text
227 (Logical (1, 16))
228 in
229 Logs.info (fun m ->
230 m "Completions for 'List.leng' (Logical position): %d entries"
231 (List.length completions5.entries));
232 List.iter
233 (fun entry ->
234 Logs.info (fun m ->
235 m " - %s (%s): %s" entry.name
236 (match entry.kind with
237 | Constructor -> "Constructor"
238 | Keyword -> "Keyword"
239 | Label -> "Label"
240 | MethodCall -> "MethodCall"
241 | Modtype -> "Modtype"
242 | Module -> "Module"
243 | Type -> "Type"
244 | Value -> "Value"
245 | Variant -> "Variant")
246 entry.desc))
247 completions5.entries;
248
249 (* Test toplevel completion with variable binding *)
250 let* completions6 =
251 let s = "# let my_var = 42;;\n# let x = 1 + my_v" in
252 U.complete_prefix "" (Some "c_comp6") [] true
253 s
254 (Offset (String.length s))
255 in
256 Logs.info (fun m ->
257 m "Completions for 'my_v' (toplevel variable): %d entries"
258 (List.length completions6.entries));
259 List.iter
260 (fun entry ->
261 Logs.info (fun m ->
262 m " - %s (%s): %s" entry.name
263 (match entry.kind with
264 | Constructor -> "Constructor"
265 | Keyword -> "Keyword"
266 | Label -> "Label"
267 | MethodCall -> "MethodCall"
268 | Modtype -> "Modtype"
269 | Module -> "Module"
270 | Type -> "Type"
271 | Value -> "Value"
272 | Variant -> "Variant")
273 entry.desc))
274 completions6.entries;
275
276 (* Test toplevel completion with function definition *)
277 let* completions7 =
278 U.complete_prefix "" (Some "c_comp7") [] true
279 "# let rec factorial n = if n <= 1 then 1 else n * facto"
280 (Offset 55)
281 in
282 Logs.info (fun m ->
283 m "Completions for 'facto' (recursive function): %d entries"
284 (List.length completions7.entries));
285 List.iter
286 (fun entry ->
287 Logs.info (fun m ->
288 m " - %s (%s): %s" entry.name
289 (match entry.kind with
290 | Constructor -> "Constructor"
291 | Keyword -> "Keyword"
292 | Label -> "Label"
293 | MethodCall -> "MethodCall"
294 | Modtype -> "Modtype"
295 | Module -> "Module"
296 | Type -> "Type"
297 | Value -> "Value"
298 | Variant -> "Variant")
299 entry.desc))
300 completions7.entries;
301
302 (* Test toplevel completion with module paths *)
303 let* completions8 =
304 U.complete_prefix "" (Some "c_comp8") [] true
305 "# String.lengt"
306 (Offset 14)
307 in
308 Logs.info (fun m ->
309 m "Completions for 'String.lengt' (module path): %d entries"
310 (List.length completions8.entries));
311 List.iter
312 (fun entry ->
313 Logs.info (fun m ->
314 m " - %s (%s): %s" entry.name
315 (match entry.kind with
316 | Constructor -> "Constructor"
317 | Keyword -> "Keyword"
318 | Label -> "Label"
319 | MethodCall -> "MethodCall"
320 | Modtype -> "Modtype"
321 | Module -> "Module"
322 | Type -> "Type"
323 | Value -> "Value"
324 | Variant -> "Variant")
325 entry.desc))
326 completions8.entries;
327
328 (* let* o3 =
329 Client.exec_toplevel rpc
330 "# Stringext.of_list ['a';'b';'c'];;\n" in
331 Logs.info (fun m -> m "Exec toplevel output: %s" o3.script); *)
332 Lwt.return (Ok ())
333 in
334 (* The operations are actually synchronous in this test context *)
335 let promise = x in
336 match Lwt.state promise with
337 | Lwt.Return (Ok ()) -> Logs.info (fun m -> m "Success")
338 | Lwt.Return (Error (InternalError s)) -> Logs.err (fun m -> m "Error: %s" s)
339 | Lwt.Fail e ->
340 Logs.err (fun m -> m "Unexpected failure: %s" (Printexc.to_string e))
341 | Lwt.Sleep ->
342 Logs.err (fun m ->
343 m
344 "Error: Promise is still pending (should not happen in sync \
345 context)")