Refactor query_protocol

Author: liam923

merlin-lib.opam

@@ -19,6 +19,7 @@ depends: [
   "menhirSdk" {dev & = "20231231"}
   "yojson" {>= "2.0.0"}
   "ppx_yojson_conv" {>= "0.17.0"}
+  "ppx_jane" {>= "0.17.0"}
 ]
 synopsis:
   "Merlin's libraries"

src/analysis/dune

@@ -23,6 +23,7 @@
   ocaml_parsing
   ocaml_preprocess
   query_protocol
+  query_protocol_kernel
   ocaml_typing
   ocaml_utils
   str

src/commands/new_commands.ml

@@ -480,9 +480,8 @@ let all_commands =
                 "<%s> Which context to search for the identifier in" contexts)
              (Marg.param (Format.sprintf "<%s>" contexts)
                 (fun ctx (prefix, pos, kind, _) ->
-                  match Query_protocol.Locate_context.of_string ctx with
-                  | Some ctx -> (prefix, pos, kind, Some ctx)
-                  | None -> failwithf "invalid context %s." ctx)))
+                  let ctx = Query_protocol.Locate_context.of_string ctx in
+                  (prefix, pos, kind, Some ctx))))
         ]
       ~doc:
         "Finds the declaration of entity at the specified position, Or \

src/commands/query_json.ml

@@ -39,18 +39,7 @@ let dump (type a) : a t -> json =
       `Assoc [ ("line", `Int line); ("column", `Int col) ]
   in
   let kinds_to_json kind =
-    `List
-      (List.map
-         ~f:(function
-           | `Constructor -> `String "constructor"
-           | `Keywords -> `String "keywords"
-           | `Labels -> `String "label"
-           | `Modules -> `String "module"
-           | `Modules_type -> `String "module-type"
-           | `Types -> `String "type"
-           | `Values -> `String "value"
-           | `Variants -> `String "variant")
-         kind)
+    `List (List.map ~f:(fun kind -> `String (Compl.Kind.to_string kind)) kind)
   in
   function
   | Type_expr (expr, pos) ->

src/frontend/kernel/completion_kind.ml

@@ -0,0 +1,30 @@
+type t =
+  [ `Constructor
+  | `Labels
+  | `Modules
+  | `Modules_type
+  | `Types
+  | `Values
+  | `Variants
+  | `Keywords ]
+
+let to_string = function
+  | `Constructor -> "constructor"
+  | `Keywords -> "keywords"
+  | `Labels -> "label"
+  | `Modules -> "module"
+  | `Modules_type -> "module-type"
+  | `Types -> "type"
+  | `Values -> "value"
+  | `Variants -> "variant"
+
+let of_string_opt = function
+  | "t" | "type" | "types" -> Some `Types
+  | "v" | "val" | "value" | "values" -> Some `Values
+  | "variant" | "variants" | "var" -> Some `Variants
+  | "c" | "constr" | "constructor" -> Some `Constructor
+  | "l" | "label" | "labels" -> Some `Labels
+  | "m" | "mod" | "module" -> Some `Modules
+  | "mt" | "modtype" | "module-type" -> Some `Modules_type
+  | "k" | "kw" | "keyword" | "keywords" -> Some `Keywords
+  | _ -> None

src/frontend/kernel/completion_kind.mli

@@ -0,0 +1,12 @@
+type t =
+  [ `Constructor
+  | `Labels
+  | `Modules
+  | `Modules_type
+  | `Types
+  | `Values
+  | `Variants
+  | `Keywords ]
+
+val to_string : t -> string
+val of_string_opt : string -> t option

src/frontend/kernel/dune

@@ -2,4 +2,4 @@
  (name        query_protocol_kernel)
  (public_name merlin-lib.query_protocol_kernel)
  (libraries yojson)
- (preprocess (pps ppx_yojson_conv)))
+ (preprocess (pps ppx_jane ppx_yojson_conv)))

src/frontend/kernel/locate_context.ml

@@ -0,0 +1,11 @@
+type t =
+  | Expr [@rename "expr"]
+  | Module_path [@rename "module_path"]
+  | Module_type [@rename "module_type"]
+  | Patt [@rename "pattern"]
+  | Type [@rename "type"]
+  | Constant [@rename "constant"]
+  | Constructor [@rename "constructor"]
+  | Label [@rename "label"]
+  | Unknown [@rename "unknown"]
+[@@deriving string ~case_insensitive, enumerate]

src/frontend/kernel/locate_context.mli

@@ -0,0 +1,11 @@
+type t =
+  | Expr
+  | Module_path
+  | Module_type
+  | Patt
+  | Type
+  | Constant
+  | Constructor
+  | Label
+  | Unknown
+[@@deriving string, enumerate]

src/frontend/kernel/locate_type_multi_result.ml

@@ -0,0 +1,33 @@
+(* This module contains definitions that can be used in a js-of-ocaml environment. This
+   is useful because it allows VSCode extensions (which run in javascript) to use the
+   serializers/deserializers defined in this module. *)
+
+open Ppx_yojson_conv_lib.Yojson_conv.Primitives
+
+module Lexing = struct
+  include Lexing
+
+  type nonrec position = position =
+    { pos_fname : string; pos_lnum : int; pos_bol : int; pos_cnum : int }
+  [@@deriving yojson]
+end
+
+type node_data =
+  | Arrow
+  | Tuple
+  | Object
+  | Type_ref of
+      { type_ : string;
+        result :
+          [ `Found of string option * Lexing.position
+          | `Builtin of string
+          | `Not_in_env of string
+          | `File_not_found of string
+          | `Not_found of string * string option ]
+      }
+[@@deriving yojson]
+
+type type_tree = { data : node_data; children : type_tree list }
+[@@deriving yojson]
+
+type t = Success of type_tree | Invalid_context [@@deriving yojson]