this repo has no description
Merge pull request #7 from art-w/extend
Allow protocol extensions
+235
-193
+81
-67
src/client/merlin_client.ml
+81
-67
src/client/merlin_client.ml
···
1
-
open Brr
2
-
module Worker = Brr_webworkers.Worker
1
+
module type WORKER = sig
2
+
type t
3
+
val post : t -> Protocol.action -> unit
4
+
end
3
5
4
-
(* When a query is sent to the Worker we keep the Future result in an indexed
5
-
table so that the on_message function will be able to determine the Future when
6
-
the answer is posted by the Worker.
7
-
The Worker works synchronously so we expect answer to arrive in order. *)
8
-
type worker = {
9
-
worker: Worker.t;
10
-
queue: (Protocol.answer -> unit) Queue.t
11
-
}
6
+
module Make (Worker : WORKER) = struct
7
+
(* When a query is sent to the Worker we keep the Future result in an indexed
8
+
table so that the on_message function will be able to determine the Future when
9
+
the answer is posted by the Worker.
10
+
The Worker works synchronously so we expect answer to arrive in order. *)
11
+
type worker = {
12
+
worker: Worker.t;
13
+
queue: (Protocol.answer -> unit) Queue.t
14
+
}
12
15
13
-
let add_fut worker res = Queue.add res worker.queue
14
-
let res_fut worker v = (Queue.take worker.queue) v
16
+
let add_fut worker res = Queue.add res worker.queue
17
+
let res_fut worker v = (Queue.take worker.queue) v
15
18
16
-
let make_worker url =
17
-
let worker = Worker.create @@ Jstr.of_string url in
18
-
let queue = Queue.create () in
19
-
let worker = { worker; queue } in
20
-
let on_message m =
21
-
let m = Ev.as_type m in
22
-
let data_marshaled : bytes = Brr_io.Message.Ev.data m in
23
-
let data : Protocol.answer = Marshal.from_bytes data_marshaled 0 in
24
-
res_fut worker data
25
-
in
26
-
let _listener =
27
-
Ev.listen Brr_io.Message.Ev.message on_message @@
28
-
Worker.as_target worker.worker
29
-
in
30
-
worker
19
+
let on_message worker data = res_fut worker data
31
20
32
-
(* todo share that with worker *)
33
-
type action = Completion | Type_enclosing | Errors
21
+
let make_worker worker =
22
+
let queue = Queue.create () in
23
+
{ worker; queue }
34
24
35
-
type errors = Protocol.error list
25
+
(* todo share that with worker *)
26
+
type action = Completion | Type_enclosing | Errors
36
27
37
-
let query ~action worker (*todo: other queries*) =
38
-
let fut, set = Fut.create () in
39
-
add_fut worker set;
40
-
Worker.post worker.worker (Marshal.to_bytes action []);
41
-
fut
28
+
type errors = Protocol.error list
42
29
43
-
let query_errors worker (source : string) =
44
-
let open Fut.Syntax in
45
-
let action = Protocol.All_errors source in
46
-
let+ data : Protocol.answer = query ~action worker in
47
-
Console.(log ["Received errors:"; data]);
48
-
match data with
49
-
| Protocol.Errors errors -> errors
50
-
| _ -> assert false
30
+
let query ~action worker (*todo: other queries*) =
31
+
let fut, set = Fut.create () in
32
+
add_fut worker set;
33
+
Worker.post worker.worker action;
34
+
fut
51
35
52
-
let query_completions worker (source : string) position =
53
-
let open Fut.Syntax in
54
-
let action = Protocol.Complete_prefix (source, position) in
55
-
let+ data : Protocol.answer = query ~action worker in
56
-
Console.(log ["Received completions:"; data]);
57
-
match data with
58
-
| Protocol.Completions compl -> compl
59
-
| _ -> assert false
36
+
let query_errors worker (source : string) =
37
+
let open Fut.Syntax in
38
+
let action = Protocol.All_errors source in
39
+
let+ data : Protocol.answer = query ~action worker in
40
+
match data with
41
+
| Protocol.Errors errors -> errors
42
+
| _ -> assert false
60
43
61
-
let query_type worker (source : string) position =
62
-
let open Fut.Syntax in
63
-
let action = Protocol.Type_enclosing (source, position) in
64
-
let+ data : Protocol.answer = query ~action worker in
65
-
Console.(log ["Received typed enclosings:"; data]);
66
-
match data with
67
-
| Protocol.Typed_enclosings l -> l
68
-
| _ -> assert false
44
+
let query_completions worker (source : string) position =
45
+
let open Fut.Syntax in
46
+
let action = Protocol.Complete_prefix (source, position) in
47
+
let+ data : Protocol.answer = query ~action worker in
48
+
match data with
49
+
| Protocol.Completions compl -> compl
50
+
| _ -> assert false
69
51
70
-
let add_cmis worker cmis =
71
-
let open Fut.Syntax in
72
-
let action = Protocol.Add_cmis cmis in
73
-
let+ data : Protocol.answer = query ~action worker in
74
-
Console.(log ["Received response from adding cmis:"; data]);
75
-
match data with
76
-
| Protocol.Added_cmis -> ()
77
-
| _ -> assert false
52
+
let query_type worker (source : string) position =
53
+
let open Fut.Syntax in
54
+
let action = Protocol.Type_enclosing (source, position) in
55
+
let+ data : Protocol.answer = query ~action worker in
56
+
match data with
57
+
| Protocol.Typed_enclosings l -> l
58
+
| _ -> assert false
59
+
60
+
let add_cmis worker cmis =
61
+
let open Fut.Syntax in
62
+
let action = Protocol.Add_cmis cmis in
63
+
let+ data : Protocol.answer = query ~action worker in
64
+
match data with
65
+
| Protocol.Added_cmis -> ()
66
+
| _ -> assert false
67
+
end
68
+
69
+
module Webworker = struct
70
+
include Brr_webworkers.Worker
71
+
72
+
let post t action =
73
+
let bytes = Marshal.to_bytes action [] in
74
+
post t bytes
75
+
end
76
+
77
+
include Make (Webworker)
78
+
79
+
let make_worker url =
80
+
let worker = make_worker @@ Webworker.create @@ Jstr.of_string url in
81
+
let on_message m =
82
+
let m = Brr.Ev.as_type m in
83
+
let data_marshaled : bytes = Brr_io.Message.Ev.data m in
84
+
let data : Protocol.answer = Marshal.from_bytes data_marshaled 0 in
85
+
on_message worker data
86
+
in
87
+
let _listen =
88
+
Brr.Ev.listen Brr_io.Message.Ev.message on_message
89
+
@@ Webworker.as_target worker.worker
90
+
in
91
+
worker
+86
-75
src/extension/merlin_codemirror.ml
+86
-75
src/extension/merlin_codemirror.ml
···
3
3
4
4
module Utils = Utils
5
5
6
-
let linter worker = fun view ->
7
-
let open Fut.Syntax in
8
-
let doc = Utils.get_full_doc @@ Editor.View.state view in
9
-
let+ result = Merlin_client.query_errors worker doc in
10
-
List.map (fun Protocol.{ kind; loc; main; sub = _; source } ->
11
-
let from = loc.loc_start.pos_cnum in
12
-
let to_ = loc.loc_end.pos_cnum in
13
-
let source = Protocol.report_source_to_string source in
14
-
let severity = match kind with
15
-
| Report_error
16
-
| Report_warning_as_error _
17
-
| Report_alert_as_error _ -> Lint.Diagnostic.Error
18
-
| Report_warning _ -> Lint.Diagnostic.Warning
19
-
| Report_alert _ -> Lint.Diagnostic.Info
20
-
in
21
-
Lint.Diagnostic.create ~source ~from ~to_ ~severity ~message:main ()
22
-
) result
23
-
|> Array.of_list
6
+
let ocaml = Jv.get Jv.global "__CM__mllike" |> Stream.Language.of_jv
7
+
let ocaml = Stream.Language.define ocaml
24
8
25
-
let keywords = List.map
26
-
(fun label ->
27
-
Autocomplete.Completion.create ~label ~type_:"keyword" ())
28
-
[
29
-
"as"; "do"; "else"; "end"; "exception"; "fun"; "functor"; "if"; "in";
30
-
"include"; "let"; "of"; "open"; "rec"; "struct"; "then"; "type"; "val";
31
-
"while"; "with"; "and"; "assert"; "begin"; "class"; "constraint";
32
-
"done"; "downto"; "external"; "function"; "initializer"; "lazy";
33
-
"match"; "method"; "module"; "mutable"; "new"; "nonrec"; "object";
34
-
"private"; "sig"; "to"; "try"; "value"; "virtual"; "when";
35
-
]
9
+
module Extensions (Worker : Merlin_client.WORKER) = struct
36
10
37
-
let merlin_completion worker = fun ctx ->
38
-
let open Fut.Syntax in
39
-
let source = Utils.get_full_doc @@ Autocomplete.Context.state ctx in
40
-
let pos = Autocomplete.Context.pos ctx in
41
-
let+ { from; to_; entries } =
42
-
Merlin_client.query_completions worker source (`Offset pos)
43
-
in
44
-
let options =
45
-
let num_completions = List.length entries in
46
-
List.mapi (fun i Query_protocol.Compl.{ name; desc; _ } ->
47
-
let boost = num_completions - i in
48
-
Autocomplete.Completion.create ~label:name ~detail:desc ~boost ()) entries
49
-
in
50
-
Some (Autocomplete.Result.create ~filter:true ~from ~to_ ~options ())
11
+
module Merlin_client = Merlin_client.Make (Worker)
12
+
type worker = Merlin_client.worker
51
13
52
-
let autocomplete worker =
53
-
let override = [
54
-
Autocomplete.Source.from_list keywords;
55
-
Autocomplete.Source.create @@ merlin_completion worker]
56
-
in
57
-
let config = Autocomplete.config () ~override in
58
-
Autocomplete.create ~config ()
59
-
60
-
let tooltip_on_hover worker =
61
-
let open Tooltip in
62
-
hover_tooltip @@
63
-
fun ~view ~pos ~side:_ ->
14
+
let linter worker = fun view ->
64
15
let open Fut.Syntax in
65
16
let doc = Utils.get_full_doc @@ Editor.View.state view in
66
-
let pos = `Offset pos in
67
-
let+ result = Merlin_client.query_type worker doc pos in
68
-
match result with
69
-
| (loc, `String type_, _)::_ ->
70
-
let create _view =
71
-
let dom = El.div [El.txt' type_] in
72
-
Tooltip_view.create ~dom ()
17
+
let+ result = Merlin_client.query_errors worker doc in
18
+
List.map (fun Protocol.{ kind; loc; main; sub = _; source } ->
19
+
let from = loc.loc_start.pos_cnum in
20
+
let to_ = loc.loc_end.pos_cnum in
21
+
let source = Protocol.report_source_to_string source in
22
+
let severity = match kind with
23
+
| Report_error
24
+
| Report_warning_as_error _
25
+
| Report_alert_as_error _ -> Lint.Diagnostic.Error
26
+
| Report_warning _ -> Lint.Diagnostic.Warning
27
+
| Report_alert _ -> Lint.Diagnostic.Info
73
28
in
74
-
let pos = loc.loc_start.pos_cnum in
75
-
let end_ = loc.loc_end.pos_cnum in
76
-
Some (Tooltip.create ~pos ~end_ ~above:true ~arrow:true ~create ())
77
-
| _ -> None
29
+
Lint.Diagnostic.create ~source ~from ~to_ ~severity ~message:main ()
30
+
) result
31
+
|> Array.of_list
78
32
79
-
let ocaml = Jv.get Jv.global "__CM__mllike" |> Stream.Language.of_jv
80
-
let ocaml = Stream.Language.define ocaml
33
+
let keywords = List.map
34
+
(fun label ->
35
+
Autocomplete.Completion.create ~label ~type_:"keyword" ())
36
+
[
37
+
"as"; "do"; "else"; "end"; "exception"; "fun"; "functor"; "if"; "in";
38
+
"include"; "let"; "of"; "open"; "rec"; "struct"; "then"; "type"; "val";
39
+
"while"; "with"; "and"; "assert"; "begin"; "class"; "constraint";
40
+
"done"; "downto"; "external"; "function"; "initializer"; "lazy";
41
+
"match"; "method"; "module"; "mutable"; "new"; "nonrec"; "object";
42
+
"private"; "sig"; "to"; "try"; "value"; "virtual"; "when";
43
+
]
44
+
45
+
let merlin_completion worker = fun ctx ->
46
+
let open Fut.Syntax in
47
+
let source = Utils.get_full_doc @@ Autocomplete.Context.state ctx in
48
+
let pos = Autocomplete.Context.pos ctx in
49
+
let+ { from; to_; entries } =
50
+
Merlin_client.query_completions worker source (`Offset pos)
51
+
in
52
+
let options =
53
+
let num_completions = List.length entries in
54
+
List.mapi (fun i Query_protocol.Compl.{ name; desc; _ } ->
55
+
let boost = num_completions - i in
56
+
Autocomplete.Completion.create ~label:name ~detail:desc ~boost ()) entries
57
+
in
58
+
Some (Autocomplete.Result.create ~filter:true ~from ~to_ ~options ())
59
+
60
+
let autocomplete worker =
61
+
let override = [
62
+
Autocomplete.Source.from_list keywords;
63
+
Autocomplete.Source.create @@ merlin_completion worker]
64
+
in
65
+
let config = Autocomplete.config () ~override in
66
+
Autocomplete.create ~config ()
67
+
68
+
let tooltip_on_hover worker =
69
+
let open Tooltip in
70
+
hover_tooltip @@
71
+
fun ~view ~pos ~side:_ ->
72
+
let open Fut.Syntax in
73
+
let doc = Utils.get_full_doc @@ Editor.View.state view in
74
+
let pos = `Offset pos in
75
+
let+ result = Merlin_client.query_type worker doc pos in
76
+
match result with
77
+
| (loc, `String type_, _)::_ ->
78
+
let create _view =
79
+
let dom = El.div [El.txt' type_] in
80
+
Tooltip_view.create ~dom ()
81
+
in
82
+
let pos = loc.loc_start.pos_cnum in
83
+
let end_ = loc.loc_end.pos_cnum in
84
+
Some (Tooltip.create ~pos ~end_ ~above:true ~arrow:true ~create ())
85
+
| _ -> None
86
+
87
+
let linter worker = Lint.create (linter worker)
88
+
89
+
let all_extensions worker = [|
90
+
linter worker;
91
+
autocomplete worker;
92
+
tooltip_on_hover worker
93
+
|]
94
+
end
81
95
82
96
module type Config = sig
83
97
val worker_url : string
···
90
104
let _ = Merlin_client.add_cmis worker Config.cmis in
91
105
worker
92
106
107
+
open Extensions (Merlin_client.Webworker)
108
+
93
109
let autocomplete = autocomplete worker
94
110
let tooltip_on_hover = tooltip_on_hover worker
95
-
let linter = Lint.create (linter worker)
96
-
97
-
let all_extensions = [|
98
-
linter;
99
-
autocomplete;
100
-
tooltip_on_hover
101
-
|]
111
+
let linter = linter worker
112
+
let all_extensions = all_extensions worker
102
113
end
+20
src/extension/merlin_codemirror.mli
+20
src/extension/merlin_codemirror.mli
···
18
18
end
19
19
20
20
module Make : functor (Config : Config) -> sig
21
+
21
22
val autocomplete : Code_mirror.Extension.t
22
23
(** An extension providing completions when typing *)
23
24
···
29
30
30
31
val all_extensions : Code_mirror.Extension.t array
31
32
(** All the Merlin-specific extensions (does not include [ocaml]) *)
33
+
34
+
end
35
+
36
+
module Extensions (Worker : Merlin_client.WORKER) : sig
37
+
38
+
type worker = Merlin_client.Make(Worker).worker
39
+
40
+
val autocomplete : worker -> Code_mirror.Extension.t
41
+
(** An extension providing completions when typing *)
42
+
43
+
val tooltip_on_hover : worker -> Code_mirror.Extension.t
44
+
(** An extension providing type-information when hovering code *)
45
+
46
+
val linter : worker -> Code_mirror.Extension.t
47
+
(** An extension that highlights errors and warnings in the code *)
48
+
49
+
val all_extensions : worker -> Code_mirror.Extension.t array
50
+
(** All the Merlin-specific extensions (does not include [ocaml]) *)
51
+
32
52
end
+47
-51
src/worker/worker.ml
+47
-51
src/worker/worker.ml
···
204
204
Mconfig.dump (Mpipeline.final_config pipeline)
205
205
|> Json.pretty_to_string *)
206
206
207
-
let on_message marshaled_message =
208
-
let action : Protocol.action =
209
-
Marshal.from_bytes marshaled_message 0
210
-
in
211
-
let res =
212
-
match action with
213
-
| Complete_prefix (source, position) ->
214
-
let source = Msource.make source in
215
-
begin match Completion.at_pos source position with
216
-
| Some (from, to_, compl) ->
217
-
let entries = compl.entries in
218
-
Protocol.Completions { from; to_; entries; }
219
-
| None ->
220
-
Protocol.Completions { from = 0; to_ = 0; entries = []; }
221
-
end
222
-
| Type_enclosing (source, position) ->
223
-
let source = Msource.make source in
224
-
let query = Query_protocol.Type_enclosing (None, position, None) in
225
-
Protocol.Typed_enclosings (dispatch source query)
226
-
| Protocol.All_errors source ->
227
-
let source = Msource.make source in
228
-
let query = Query_protocol.Errors {
229
-
lexing = true;
230
-
parsing = true;
231
-
typing = true;
232
-
}
207
+
let on_message = function
208
+
| Protocol.Complete_prefix (source, position) ->
209
+
let source = Msource.make source in
210
+
begin match Completion.at_pos source position with
211
+
| Some (from, to_, compl) ->
212
+
let entries = compl.entries in
213
+
Protocol.Completions { from; to_; entries; }
214
+
| None ->
215
+
Protocol.Completions { from = 0; to_ = 0; entries = []; }
216
+
end
217
+
| Type_enclosing (source, position) ->
218
+
let source = Msource.make source in
219
+
let query = Query_protocol.Type_enclosing (None, position, None) in
220
+
Protocol.Typed_enclosings (dispatch source query)
221
+
| Protocol.All_errors source ->
222
+
let source = Msource.make source in
223
+
let query = Query_protocol.Errors {
224
+
lexing = true;
225
+
parsing = true;
226
+
typing = true;
227
+
}
228
+
in
229
+
let errors =
230
+
dispatch source query
231
+
|> List.map ~f:(fun (Location.{kind; main=_ ; sub; source; _} as error) ->
232
+
let of_sub sub =
233
+
Location.print_sub_msg Format.str_formatter sub;
234
+
String.trim (Format.flush_str_formatter ())
233
235
in
234
-
let errors =
235
-
dispatch source query
236
-
|> List.map ~f:(fun (Location.{kind; main=_ ; sub; source; _} as error) ->
237
-
let of_sub sub =
238
-
Location.print_sub_msg Format.str_formatter sub;
239
-
String.trim (Format.flush_str_formatter ())
240
-
in
241
-
let loc = Location.loc_of_report error in
242
-
let main =
243
-
Format.asprintf "@[%a@]" Location.print_main error |> String.trim
244
-
in
245
-
Protocol.{
246
-
kind;
247
-
loc;
248
-
main;
249
-
sub = List.map ~f:of_sub sub;
250
-
source;
251
-
})
236
+
let loc = Location.loc_of_report error in
237
+
let main =
238
+
Format.asprintf "@[%a@]" Location.print_main error |> String.trim
252
239
in
253
-
Protocol.Errors errors
254
-
| Add_cmis cmis ->
255
-
add_cmis cmis
256
-
in
257
-
let res = Marshal.to_bytes res [] in
258
-
Js_of_ocaml.Worker.post_message res
240
+
Protocol.{
241
+
kind;
242
+
loc;
243
+
main;
244
+
sub = List.map ~f:of_sub sub;
245
+
source;
246
+
})
247
+
in
248
+
Protocol.Errors errors
249
+
| Add_cmis cmis ->
250
+
add_cmis cmis
259
251
260
252
let run () =
261
-
Js_of_ocaml.Worker.set_onmessage on_message
253
+
Js_of_ocaml.Worker.set_onmessage @@ fun marshaled_message ->
254
+
let action : Protocol.action = Marshal.from_bytes marshaled_message 0 in
255
+
let res = on_message action in
256
+
let res = Marshal.to_bytes res [] in
257
+
Js_of_ocaml.Worker.post_message res