Source file merlin_codemirror.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
open Code_mirror
open Brr
module Utils = Utils
open Js_top_worker_rpc

let linter rpc view =
  let open Fut.Syntax in
  let doc = Utils.get_full_doc @@ View.EditorView.state view in
  let+ result = Js_top_worker_client_fut.W.query_errors rpc doc in
  match result with
  | Ok r ->
      List.map
        (fun Toplevel_api_gen.{ kind; loc; main; sub = _; source } ->
          let from = loc.loc_start.pos_cnum in
          let to_ = loc.loc_end.pos_cnum in
          let source_rpc =
            Rpcmarshal.marshal Toplevel_api_gen.typ_of_location_error_source
              source
          in
          let source =
            match source_rpc with
            | Rpc.String s -> s
            | _ -> failwith "Invalid source"
          in
          let severity =
            match kind with
            | Report_error | Report_warning_as_error _ | Report_alert_as_error _
              ->
                Lint.Diagnostic.Error
            | Report_warning _ -> Lint.Diagnostic.Warning
            | Report_alert _ -> Lint.Diagnostic.Info
          in
          Lint.Diagnostic.create ~source ~from ~to_ ~severity ~message:main ())
        r
      |> Array.of_list
  | Error _ -> [||]

let keywords =
  List.map
    (fun label -> Autocomplete.Completion.create ~label ~type_:"keyword" ())
    [
      "as";
      "do";
      "else";
      "end";
      "exception";
      "fun";
      "functor";
      "if";
      "in";
      "include";
      "let";
      "of";
      "open";
      "rec";
      "struct";
      "then";
      "type";
      "val";
      "while";
      "with";
      "and";
      "assert";
      "begin";
      "class";
      "constraint";
      "done";
      "downto";
      "external";
      "function";
      "initializer";
      "lazy";
      "match";
      "method";
      "module";
      "mutable";
      "new";
      "nonrec";
      "object";
      "private";
      "sig";
      "to";
      "try";
      "value";
      "virtual";
      "when";
    ]

let linter rpc = Lint.create (linter rpc)

let merlin_completion rpc ctx =
  let open Fut.Syntax in
  let source = Utils.get_full_doc @@ Autocomplete.Context.state ctx in
  let pos = Autocomplete.Context.pos ctx in
  let+ res =
    Js_top_worker_client_fut.W.complete_prefix rpc source (Offset pos)
  in
  match res with
  | Ok { from; to_; entries } ->
      let options =
        let num_completions = List.length entries in
        List.mapi
          (fun i Toplevel_api_gen.{ name; desc; _ } ->
            let boost = num_completions - i in
            Autocomplete.Completion.create ~label:name ~detail:desc ~boost ())
          entries
      in
      Some (Autocomplete.Result.create ~filter:true ~from ~to_ ~options ())
  | Error _ -> None

let autocomplete worker =
  let override =
    [
      Autocomplete.Source.from_list keywords;
      Autocomplete.Source.create @@ merlin_completion worker;
    ]
  in
  let config = Autocomplete.config () ~override in
  Autocomplete.create ~config ()

let tooltip_on_hover rpc =
  let open Tooltip in
  hover_tooltip @@ fun ~view ~pos ~side:_ ->
  let open Fut.Syntax in
  let doc = Utils.get_full_doc @@ View.EditorView.state view in
  let pos = Toplevel_api_gen.Offset pos in
  let+ result = Js_top_worker_client_fut.W.type_enclosing rpc doc pos in
  match result with
  | Ok ((loc, String type_, _) :: _) ->
      let create _view =
        let dom = El.div [ El.txt' type_ ] in
        Tooltip_view.create ~dom ()
      in
      let pos = loc.loc_start.pos_cnum in
      let end_ = loc.loc_end.pos_cnum in
      Some (Tooltip.create ~pos ~end_ ~above:true ~arrow:true ~create ())
  | _ -> None

let ocaml = Jv.get Jv.global "__CM__mllike" |> Stream.Language.of_jv
let ocaml = Stream.Language.define ocaml

module type Config = sig
  val worker_url : string
  val cmis : Js_top_worker_rpc.Toplevel_api_gen.cmis
end