this repo has no description
wip
+344
-38
+2
-1
dune-project
+2
-1
dune-project
+44
-1
example/dune
+44
-1
example/dune
···
7
7
(libraries js_top_worker_client lwt js_of_ocaml))
8
8
9
9
(executable
10
+
(name example2)
11
+
(preprocess
12
+
(pps js_of_ocaml-ppx))
13
+
(modes js)
14
+
(modules example2)
15
+
(libraries js_top_worker_client lwt js_of_ocaml))
16
+
17
+
(executable
10
18
(name worker)
11
19
(modes byte)
12
20
(modules worker)
13
21
(link_flags (-linkall))
14
-
(libraries js_top_worker-web logs.browser))
22
+
(libraries js_top_worker-web logs.browser mime_printer tyxml))
15
23
16
24
(executable
17
25
(name unix_worker)
···
28
36
(libraries js_top_worker_client rpclib.cmdliner))
29
37
30
38
(rule
39
+
(targets
40
+
(dir cmis))
41
+
(action
42
+
(system "mkdir -p cmis; cp %{ocaml_where}/*.cmi cmis")))
43
+
44
+
(rule
31
45
(targets worker.js)
32
46
(deps stubs.js)
33
47
(action
···
42
56
%{dep:worker.bc}
43
57
-o
44
58
%{targets})))
59
+
60
+
(rule
61
+
(targets worker_nocmis.js)
62
+
(deps stubs.js)
63
+
(action
64
+
(run
65
+
%{bin:js_of_ocaml}
66
+
--toplevel
67
+
; --pretty
68
+
--no-cmis
69
+
+toplevel.js
70
+
+dynlink.js
71
+
stubs.js
72
+
%{dep:worker.bc}
73
+
-o
74
+
%{targets})))
75
+
76
+
(alias
77
+
(name default)
78
+
(deps
79
+
worker.js
80
+
worker_nocmis.js
81
+
index.html
82
+
example.bc.js
83
+
example2.bc.js
84
+
index2.html
85
+
cmis
86
+
server.py
87
+
(alias_rec all)))
+51
example/example2.ml
+51
example/example2.ml
···
1
+
(* Simplest example *)
2
+
open Js_of_ocaml
3
+
open Js_top_worker_rpc
4
+
module W = Js_top_worker_client.W
5
+
6
+
let dcs = Js_top_worker_rpc.Toplevel_api_gen.{dcs_url="cmis/";
7
+
dcs_toplevel_modules = ["CamlinternalOO";"Stdlib";"CamlinternalFormat";"Std_exit";"CamlinternalMod";"CamlinternalFormatBasics";"CamlinternalLazy"];
8
+
dcs_file_prefixes = ["stdlib__"];}
9
+
10
+
let log s = Console.console##log (Js.string s)
11
+
12
+
let initialise s callback =
13
+
let ( let* ) = Lwt_result.bind in
14
+
let rpc = Js_top_worker_client.start s 100000 callback in
15
+
let* () =
16
+
W.init rpc
17
+
Toplevel_api_gen.
18
+
{
19
+
path = "/static/cmis";
20
+
cmas = [];
21
+
cmis = { dynamic_cmis = [dcs]; static_cmis = [] };
22
+
}
23
+
in
24
+
Lwt.return (Ok rpc)
25
+
26
+
let log_output (o : Toplevel_api_gen.exec_result) =
27
+
Option.iter (fun s -> log ("stdout: " ^ s)) o.stdout;
28
+
Option.iter (fun s -> log ("stderr: " ^ s)) o.stderr;
29
+
Option.iter (fun s -> log ("sharp_ppf: " ^ s)) o.sharp_ppf;
30
+
Option.iter (fun s -> log ("caml_ppf: " ^ s)) o.caml_ppf;
31
+
let strloc (line, col) =
32
+
"(" ^ string_of_int line ^ "," ^ string_of_int col ^ ")"
33
+
in
34
+
Option.iter
35
+
(fun h ->
36
+
let open Toplevel_api_gen in
37
+
log
38
+
("highlight "
39
+
^ strloc (h.line1, h.col1)
40
+
^ " to "
41
+
^ strloc (h.line2, h.col2)))
42
+
o.highlight
43
+
44
+
let _ =
45
+
let ( let* ) = Lwt_result.bind in
46
+
let* rpc = initialise "worker_nocmis.js" (fun _ -> log "Timeout") in
47
+
let* o = W.setup rpc () in
48
+
log_output o;
49
+
let* o = W.exec rpc "2*2;;" in
50
+
log_output o;
51
+
Lwt.return (Ok ())
+1
-1
example/index2.html
+1
-1
example/index2.html
+17
example/server.py
+17
example/server.py
···
1
+
#!/usr/bin/env python3
2
+
3
+
import http.server
4
+
5
+
class MyHTTPRequestHandler(http.server.SimpleHTTPRequestHandler):
6
+
def end_headers(self):
7
+
self.send_my_headers()
8
+
http.server.SimpleHTTPRequestHandler.end_headers(self)
9
+
10
+
def send_my_headers(self):
11
+
self.send_header("Cache-Control", "no-cache, no-store, must-revalidate")
12
+
self.send_header("Pragma", "no-cache")
13
+
self.send_header("Expires", "0")
14
+
15
+
16
+
if __name__ == '__main__':
17
+
http.server.test(HandlerClass=MyHTTPRequestHandler)
+2
-1
idl/js_top_worker_client_fut.ml
+2
-1
idl/js_top_worker_client_fut.ml
···
80
80
let exec rpc a = Wraw.exec rpc a |> Rpc_fut.T.get
81
81
let compile_js rpc id s = Wraw.compile_js rpc id s |> Rpc_fut.T.get
82
82
let query_errors rpc doc = Wraw.query_errors rpc doc |> Rpc_fut.T.get
83
-
83
+
let exec_toplevel rpc doc = Wraw.exec_toplevel rpc doc |> Rpc_fut.T.get
84
+
84
85
let complete_prefix rpc doc pos =
85
86
Wraw.complete_prefix rpc doc pos |> Rpc_fut.T.get
86
87
+23
idl/toplevel_api.ml
+23
idl/toplevel_api.ml
···
166
166
[@@deriving rpcty]
167
167
(** Represents the result of executing a toplevel phrase *)
168
168
169
+
type exec_toplevel_result = {
170
+
script : string;
171
+
mime_vals : mime_val list;
172
+
}
173
+
[@@deriving rpcty]
174
+
(** Represents the result of executing a toplevel script *)
175
+
169
176
type cma = {
170
177
url : string; (** URL where the cma is available *)
171
178
fn : string; (** Name of the 'wrapping' function *)
···
213
220
let error_list_p = Param.mk error_list
214
221
let typed_enclosings_p = Param.mk typed_enclosings_list
215
222
223
+
let toplevel_script_p = Param.mk ~description:[
224
+
"A toplevel script is a sequence of toplevel phrases interspersed with";
225
+
"The output from the toplevel. Each phase must be preceded by '# ', and";
226
+
"the output from the toplevel is indented by 2 spaces."
227
+
] Types.string
228
+
229
+
let exec_toplevel_result_p = Param.mk exec_toplevel_result
230
+
216
231
let init_libs =
217
232
Param.mk ~name:"init_libs"
218
233
~description:
···
249
264
"Initialised first.";
250
265
]
251
266
(phrase_p @-> returning exec_result_p err)
267
+
268
+
let exec_toplevel =
269
+
declare "exec_toplevel"
270
+
[
271
+
"Execute a toplevel script. The toplevel must have been";
272
+
"Initialised first. Returns the updated toplevel script.";
273
+
]
274
+
(toplevel_script_p @-> returning exec_toplevel_result_p err)
252
275
253
276
let compile_js =
254
277
declare "compile_js"
+78
idl/toplevel_api_gen.ml
+78
idl/toplevel_api_gen.ml
···
1823
1823
and _ = typ_of_exec_result
1824
1824
and _ = exec_result
1825
1825
end[@@ocaml.doc "@inline"][@@merlin.hide ]
1826
+
type exec_toplevel_result = {
1827
+
script: string ;
1828
+
mime_vals: mime_val list }[@@deriving rpcty][@@ocaml.doc
1829
+
" Represents the result of executing a toplevel script "]
1830
+
include
1831
+
struct
1832
+
let _ = fun (_ : exec_toplevel_result) -> ()
1833
+
let rec exec_toplevel_result_script :
1834
+
(_, exec_toplevel_result) Rpc.Types.field =
1835
+
{
1836
+
Rpc.Types.fname = "script";
1837
+
Rpc.Types.field = (let open Rpc.Types in Basic String);
1838
+
Rpc.Types.fdefault = None;
1839
+
Rpc.Types.fdescription = [];
1840
+
Rpc.Types.fversion = None;
1841
+
Rpc.Types.fget = (fun _r -> _r.script);
1842
+
Rpc.Types.fset = (fun v -> fun _s -> { _s with script = v })
1843
+
}
1844
+
and exec_toplevel_result_mime_vals :
1845
+
(_, exec_toplevel_result) Rpc.Types.field =
1846
+
{
1847
+
Rpc.Types.fname = "mime_vals";
1848
+
Rpc.Types.field = (Rpc.Types.List typ_of_mime_val);
1849
+
Rpc.Types.fdefault = None;
1850
+
Rpc.Types.fdescription = [];
1851
+
Rpc.Types.fversion = None;
1852
+
Rpc.Types.fget = (fun _r -> _r.mime_vals);
1853
+
Rpc.Types.fset = (fun v -> fun _s -> { _s with mime_vals = v })
1854
+
}
1855
+
and typ_of_exec_toplevel_result =
1856
+
Rpc.Types.Struct
1857
+
({
1858
+
Rpc.Types.fields =
1859
+
[Rpc.Types.BoxedField exec_toplevel_result_script;
1860
+
Rpc.Types.BoxedField exec_toplevel_result_mime_vals];
1861
+
Rpc.Types.sname = "exec_toplevel_result";
1862
+
Rpc.Types.version = None;
1863
+
Rpc.Types.constructor =
1864
+
(fun getter ->
1865
+
let open Rresult.R in
1866
+
(getter.Rpc.Types.field_get "mime_vals"
1867
+
(Rpc.Types.List typ_of_mime_val))
1868
+
>>=
1869
+
(fun exec_toplevel_result_mime_vals ->
1870
+
(getter.Rpc.Types.field_get "script"
1871
+
(let open Rpc.Types in Basic String))
1872
+
>>=
1873
+
(fun exec_toplevel_result_script ->
1874
+
return
1875
+
{
1876
+
script = exec_toplevel_result_script;
1877
+
mime_vals = exec_toplevel_result_mime_vals
1878
+
})))
1879
+
} : exec_toplevel_result Rpc.Types.structure)
1880
+
and exec_toplevel_result =
1881
+
{
1882
+
Rpc.Types.name = "exec_toplevel_result";
1883
+
Rpc.Types.description =
1884
+
["Represents the result of executing a toplevel script"];
1885
+
Rpc.Types.ty = typ_of_exec_toplevel_result
1886
+
}
1887
+
let _ = exec_toplevel_result_script
1888
+
and _ = exec_toplevel_result_mime_vals
1889
+
and _ = typ_of_exec_toplevel_result
1890
+
and _ = exec_toplevel_result
1891
+
end[@@ocaml.doc "@inline"][@@merlin.hide ]
1826
1892
type cma =
1827
1893
{
1828
1894
url: string [@ocaml.doc " URL where the cma is available "];
···
2051
2117
let completions_p = Param.mk completions
2052
2118
let error_list_p = Param.mk error_list
2053
2119
let typed_enclosings_p = Param.mk typed_enclosings_list
2120
+
let toplevel_script_p =
2121
+
Param.mk
2122
+
~description:["A toplevel script is a sequence of toplevel phrases interspersed with";
2123
+
"The output from the toplevel. Each phase must be preceded by '# ', and";
2124
+
"the output from the toplevel is indented by 2 spaces."]
2125
+
Types.string
2126
+
let exec_toplevel_result_p = Param.mk exec_toplevel_result
2054
2127
let init_libs =
2055
2128
Param.mk ~name:"init_libs"
2056
2129
~description:["Libraries to load during the initialisation of the toplevel. ";
···
2075
2148
declare "exec"
2076
2149
["Execute a phrase using the toplevel. The toplevel must have been";
2077
2150
"Initialised first."] (phrase_p @-> (returning exec_result_p err))
2151
+
let exec_toplevel =
2152
+
declare "exec_toplevel"
2153
+
["Execute a toplevel script. The toplevel must have been";
2154
+
"Initialised first. Returns the updated toplevel script."]
2155
+
(toplevel_script_p @-> (returning exec_toplevel_result_p err))
2078
2156
let compile_js =
2079
2157
declare "compile_js"
2080
2158
["Compile a phrase to javascript. The toplevel must have been";
+3
-1
lib/dune
+3
-1
lib/dune
···
2
2
3
3
(library
4
4
(public_name js_top_worker)
5
-
(modules uTop_complete uTop_lexer uTop_token uTop impl)
5
+
(modules uTop_complete uTop_lexer uTop_token uTop toplexer ocamltop impl)
6
6
(libraries
7
7
logs
8
8
js_top_worker-rpc
···
25
25
(run %{bin:cppo} -V OCAML:%{ocaml_version} %{input-file}))
26
26
uTop_complete
27
27
uTop))))
28
+
29
+
(ocamllex toplexer)
28
30
29
31
(library
30
32
(public_name js_top_worker-web)
+77
-33
lib/impl.ml
+77
-33
lib/impl.ml
···
310
310
311
311
let setup () =
312
312
try
313
-
Logs.info (fun m -> m "setup()");
313
+
Logs.info (fun m -> m "setup() ...");
314
314
315
315
let o =
316
-
match !functions with
317
-
| Some l -> setup l ()
318
-
| None -> failwith "Error: toplevel has not been initialised"
319
-
in
316
+
317
+
(try
318
+
match !functions with
319
+
| Some l -> setup l ()
320
+
| None -> failwith "Error: toplevel has not been initialised"
321
+
with
322
+
| Persistent_env.Error e ->
323
+
Persistent_env.report_error Format.err_formatter e;
324
+
let err = Format.asprintf "%a" Persistent_env.report_error e in
325
+
failwith ("Error: " ^ err)
326
+
| Env.Error e ->
327
+
Env.report_error Format.err_formatter e;
328
+
let err = Format.asprintf "%a" Env.report_error e in
329
+
failwith ("Error: " ^ err))
330
+
in
331
+
332
+
Logs.info (fun m -> m "setup() finished");
333
+
320
334
IdlM.ErrM.return
321
335
Toplevel_api_gen.
322
336
{
···
484
498
| _ -> IdlM.ErrM.return_err (Toplevel_api_gen.InternalError "Parse error")
485
499
with e -> IdlM.ErrM.return ("Exception: %s" ^ Printexc.to_string e)
486
500
501
+
let handle_toplevel stripped =
502
+
if String.length stripped < 2 || stripped.[0] <> '#' || stripped.[1] <> ' ' then begin
503
+
Printf.eprintf "Warning, ignoring toplevel block without a leading '# '.\n";
504
+
IdlM.ErrM.return { Toplevel_api_gen.script=stripped; mime_vals=[] }
505
+
end else begin
506
+
let s = String.sub stripped 2 (String.length stripped - 2) in
507
+
let list = Ocamltop.parse_toplevel s in
508
+
let buf = Buffer.create 1024 in
509
+
let mime_vals = List.fold_left (fun acc (phr, _output) ->
510
+
let new_output = execute phr |> IdlM.T.get |> M.run |> Result.get_ok in
511
+
Printf.bprintf buf "# %s\n" phr;
512
+
let r = (Option.to_list new_output.stdout) @ (Option.to_list new_output.stderr) @ (Option.to_list new_output.caml_ppf) in
513
+
let r = List.concat_map (fun l -> Astring.String.cuts ~sep:"\n" l) r in
514
+
List.iter (fun x -> Printf.bprintf buf " %s\n" x) r;
515
+
let mime_vals = new_output.mime_vals in
516
+
acc @ mime_vals
517
+
) [] list in
518
+
let content_txt = Buffer.contents buf in
519
+
let content_txt = String.sub content_txt 0 (String.length content_txt - 1) in
520
+
let result = { Toplevel_api_gen.script=content_txt; mime_vals } in
521
+
IdlM.ErrM.return result
522
+
end
523
+
524
+
let exec_toplevel (phrase : string) =
525
+
handle_toplevel phrase
526
+
487
527
let config () =
488
528
let path =
489
529
match !path with Some p -> p | None -> failwith "Path not set"
···
629
669
IdlM.ErrM.return { Toplevel_api_gen.from = 0; to_ = 0; entries = [] }
630
670
631
671
let query_errors source =
632
-
let source = Merlin_kernel.Msource.make source in
633
-
let query =
634
-
Query_protocol.Errors { lexing = true; parsing = true; typing = true }
635
-
in
636
-
let errors =
637
-
wdispatch source query
638
-
|> StdLabels.List.map
639
-
~f:(fun
640
-
(Ocaml_parsing.Location.{ kind; main = _; sub; source } as error)
641
-
->
642
-
let of_sub sub =
643
-
Ocaml_parsing.Location.print_sub_msg Format.str_formatter sub;
644
-
String.trim (Format.flush_str_formatter ())
645
-
in
646
-
let loc = Ocaml_parsing.Location.loc_of_report error in
647
-
let main =
648
-
Format.asprintf "@[%a@]" Ocaml_parsing.Location.print_main error
649
-
|> String.trim
650
-
in
651
-
{
652
-
Toplevel_api_gen.kind;
653
-
loc;
654
-
main;
655
-
sub = StdLabels.List.map ~f:of_sub sub;
656
-
source;
657
-
})
658
-
in
659
-
IdlM.ErrM.return errors
672
+
try
673
+
let source = Merlin_kernel.Msource.make source in
674
+
let query =
675
+
Query_protocol.Errors { lexing = true; parsing = true; typing = true }
676
+
in
677
+
let errors =
678
+
wdispatch source query
679
+
|> StdLabels.List.map
680
+
~f:(fun
681
+
(Ocaml_parsing.Location.{ kind; main = _; sub; source } as error)
682
+
->
683
+
let of_sub sub =
684
+
Ocaml_parsing.Location.print_sub_msg Format.str_formatter sub;
685
+
String.trim (Format.flush_str_formatter ())
686
+
in
687
+
let loc = Ocaml_parsing.Location.loc_of_report error in
688
+
let main =
689
+
Format.asprintf "@[%a@]" Ocaml_parsing.Location.print_main error
690
+
|> String.trim
691
+
in
692
+
{
693
+
Toplevel_api_gen.kind;
694
+
loc;
695
+
main;
696
+
sub = StdLabels.List.map ~f:of_sub sub;
697
+
source;
698
+
})
699
+
in
700
+
IdlM.ErrM.return errors
701
+
with e ->
702
+
IdlM.ErrM.return_err
703
+
(Toplevel_api_gen.InternalError (Printexc.to_string e))
660
704
661
705
let type_enclosing source position =
662
706
let position =
+24
lib/ocamltop.ml
+24
lib/ocamltop.ml
···
1
+
let refill_lexbuf s p buffer len =
2
+
if !p = String.length s then 0
3
+
else
4
+
let len' =
5
+
try (String.index_from s !p '\n' - !p + 1)
6
+
with _ -> (String.length s - !p)
7
+
in
8
+
let len'' = min len len' in
9
+
String.blit s !p buffer 0 len'';
10
+
p := !p + len'';
11
+
len''
12
+
13
+
let parse_toplevel s =
14
+
let s = s in
15
+
let lexbuf = Lexing.from_string s in
16
+
let rec loop pos =
17
+
let _phr = !Toploop.parse_toplevel_phrase lexbuf in
18
+
let new_pos = Lexing.lexeme_end lexbuf in
19
+
let phr = String.sub s pos (new_pos - pos) in
20
+
let (cont, output) = Toplexer.entry lexbuf in
21
+
let new_pos = Lexing.lexeme_end lexbuf in
22
+
if cont then (phr, output) :: loop new_pos else [(phr, output)]
23
+
in
24
+
loop 0
+21
lib/toplexer.mll
+21
lib/toplexer.mll
···
1
+
{ }
2
+
3
+
rule entry = parse
4
+
| (_ # '\n')* "\n" {
5
+
output_line [] lexbuf
6
+
}
7
+
| _ | eof { false, [] }
8
+
9
+
and output_line acc = parse
10
+
| " " ((_ # '\n')* as line) "\n" {
11
+
output_line (line :: acc) lexbuf
12
+
}
13
+
| "# " {
14
+
true, List.rev acc
15
+
}
16
+
| eof {
17
+
false, List.rev acc
18
+
}
19
+
| _ {
20
+
false, List.rev acc
21
+
}
+1
lib/worker.ml
+1
lib/worker.ml
···
105
105
Server.query_errors query_errors;
106
106
Server.type_enclosing type_enclosing;
107
107
Server.compile_js compile_js;
108
+
Server.exec_toplevel exec_toplevel;
108
109
let rpc_fn = Impl.IdlM.server Server.implementation in
109
110
Js_of_ocaml.Worker.set_onmessage (fun x -> ignore (server rpc_fn x));
110
111
Console.console##log (Js.string "All finished")