Skip to content

Commit 16cdeb0

Browse files
voodoosvoodoos
authored
Merge pull request #7 from art-w/extend
Allow protocol extensions
2 parents 335da8c + cc20cc4 commit 16cdeb0

File tree

5 files changed

+235
-193
lines changed

5 files changed

+235
-193
lines changed

‎src/client/merlin_client.ml‎

Lines changed: 81 additions & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -1,77 +1,91 @@
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
35

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+
}
1215

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
1518

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
20+
21+
let make_worker worker =
22+
let queue = Queue.create () in
23+
{ worker; queue }
24+
25+
(* todo share that with worker *)
26+
type action = Completion | Type_enclosing | Errors
27+
28+
type errors = Protocol.error list
3129

32-
(* todo share that with worker *)
33-
type action = Completion | Type_enclosing | Errors
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
3435

35-
type errors = Protocol.error list
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
3643

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
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
4251

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
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
5159

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
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
6068

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
69+
module Webworker = struct
70+
include Brr_webworkers.Worker
6971

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
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

‎src/extension/merlin_codemirror.ml‎

Lines changed: 86 additions & 75 deletions
Original file line numberDiff line numberDiff line change
@@ -3,81 +3,95 @@ open Brr
33

44
module Utils = Utils
55

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
24-
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-
]
6+
let ocaml = Jv.get Jv.global "__CM__mllike" |> Stream.Language.of_jv
7+
let ocaml = Stream.Language.define ocaml
368

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 ())
9+
module Extensions (Worker : Merlin_client.WORKER) = struct
5110

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 ()
11+
module Merlin_client = Merlin_client.Make (Worker)
12+
type worker = Merlin_client.worker
5913

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 ->
6415
let open Fut.Syntax in
6516
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
7328
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
7832

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
8195

8296
module type Config = sig
8397
val worker_url : string
@@ -90,13 +104,10 @@ module Make (Config : Config) = struct
90104
let _ = Merlin_client.add_cmis worker Config.cmis in
91105
worker
92106

107+
open Extensions (Merlin_client.Webworker)
108+
93109
let autocomplete = autocomplete worker
94110
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
102113
end

‎src/extension/merlin_codemirror.mli‎

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module type Config = sig
1818
end
1919

2020
module Make : functor (Config : Config) -> sig
21+
2122
val autocomplete : Code_mirror.Extension.t
2223
(** An extension providing completions when typing *)
2324

@@ -29,4 +30,23 @@ module Make : functor (Config : Config) -> sig
2930

3031
val all_extensions : Code_mirror.Extension.t array
3132
(** 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+
3252
end

0 commit comments

Comments
 (0)