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
open Code_mirror
open Brr

module Utils = Utils

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

module Extensions (Worker : Merlin_client.WORKER) = struct

  module Merlin_client = Merlin_client.Make (Worker)
  type worker = Merlin_client.worker

  let linter worker = fun view ->
    let open Fut.Syntax in
    let doc = Utils.get_full_doc @@ Editor.View.state view in
    let+ result = Merlin_client.query_errors worker doc in
    List.map (fun Protocol.{ kind; loc; main; sub = _; source } ->
      let from = loc.loc_start.pos_cnum in
      let to_ = loc.loc_end.pos_cnum in
      let source = Protocol.report_source_to_string 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 ()
    ) result
    |> Array.of_list

  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 merlin_completion worker = fun 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+ { from; to_; entries } =
      Merlin_client.query_completions worker source (`Offset pos)
    in
    let options =
      let num_completions = List.length entries in
      List.mapi (fun i Query_protocol.Compl.{ 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 ())

  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 worker =
    let open Tooltip in
    hover_tooltip @@
    fun ~view ~pos ~side:_ ->
      let open Fut.Syntax in
      let doc = Utils.get_full_doc @@ Editor.View.state view in
      let pos = `Offset pos in
      let+ result = Merlin_client.query_type worker doc pos in
      match result with
      | (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 linter worker = Lint.create (linter worker)

  let all_extensions worker = [|
    linter worker;
    autocomplete worker;
    tooltip_on_hover worker
  |]
end

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

module Make (Config : Config) = struct
  let worker =
    let worker = Merlin_client.make_worker Config.worker_url in
    let _ = Merlin_client.add_cmis worker Config.cmis in
    worker

  open Extensions (Merlin_client.Webworker)

  let autocomplete = autocomplete worker
  let tooltip_on_hover = tooltip_on_hover worker
  let linter = linter worker
  let all_extensions = all_extensions worker
end
Source file merlin_codemirror.ml

Source file `merlin_codemirror.ml`
