oxcaml · liam923 · Jun 23, 2025 · Jun 25, 2025
diff --git a/merlin-lib.opam b/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"

diff --git a/src/analysis/dune b/src/analysis/dune
@@ -23,6 +23,7 @@
   ocaml_parsing
   ocaml_preprocess
   query_protocol
+  query_protocol_kernel
   ocaml_typing
   ocaml_utils
   str

diff --git a/src/commands/new_commands.ml b/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 \

diff --git a/src/commands/query_json.ml b/src/commands/query_json.ml
@@ -40,17 +40,7 @@ let dump (type a) : a t -> json =
   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.map ~f:(fun kind -> `String (Compl.In_kind.to_string kind)) kind)
   in
   function
   | Type_expr (expr, pos) ->
@@ -224,19 +214,12 @@ let dump (type a) : a t -> json =
     mk "signature-help" [ ("position", mk_position position) ]
   | Version -> mk "version" []
 
-let string_of_completion_kind = function
-  | `Value -> "Value"
-  | `Variant -> "Variant"
-  | `Constructor -> "Constructor"
-  | `Label -> "Label"
-  | `Module -> "Module"
-  | `Modtype -> "Signature"
-  | `Type -> "Type"
-  | `Method -> "Method"
-  | `MethodCall -> "#"
-  | `Exn -> "Exn"
-  | `Class -> "Class"
-  | `Keyword -> "Keyword"
+let string_of_completion_kind =
+  (* Merlin-jst: In upstream Merlin, the to_string logic lives here. But in Merlin-jst,
+     we've moved it to query_protocol_kernel so that it can be used in jsoo contexts *)
+  function
+  | #Compl.Out_kind.t as kind -> Compl.Out_kind.to_string kind
+  | #Outline_kind.t as kind -> Outline_kind.to_string kind
 
 let with_location ?(with_file = false) ?(skip_none = false) loc assoc =
   let with_file l =

diff --git a/src/frontend/kernel/completion_kind.ml b/src/frontend/kernel/completion_kind.ml
@@ -0,0 +1,88 @@
+module In = struct
+  type t =
+    [ `Constructor
+    | `Labels
+    | `Modules
+    | `Modules_type
+    | `Types
+    | `Values
+    | `Variants
+    | `Keywords ]
+  [@@deriving enumerate, equal]
+
+  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
+end
+
+module Out = struct
+  (* CR-someday: This module is necessary because ppx_string_conv doesn't currently
+     (v0.17.0) support polymorphic variants. *)
+  module For_deriving = struct
+    type t =
+      | Value [@rename "Value"]
+      | Constructor [@rename "Constructor"]
+      | Variant [@rename "Variant"]
+      | Label [@rename "Label"]
+      | Module [@rename "Module"]
+      | Modtype [@rename "Signature"]
+      | Type [@rename "Type"]
+      | MethodCall [@rename "#"]
+      | Keyword [@rename "Keyword"]
+    [@@deriving string]
+
+    let to_poly = function
+      | Value -> `Value
+      | Constructor -> `Constructor
+      | Variant -> `Variant
+      | Label -> `Label
+      | Module -> `Module
+      | Modtype -> `Modtype
+      | Type -> `Type
+      | MethodCall -> `MethodCall
+      | Keyword -> `Keyword
+
+    let of_poly = function
+      | `Value -> Value
+      | `Constructor -> Constructor
+      | `Variant -> Variant
+      | `Label -> Label
+      | `Module -> Module
+      | `Modtype -> Modtype
+      | `Type -> Type
+      | `MethodCall -> MethodCall
+      | `Keyword -> Keyword
+  end
+
+  type t =
+    [ `Value
+    | `Constructor
+    | `Variant
+    | `Label
+    | `Module
+    | `Modtype
+    | `Type
+    | `MethodCall
+    | `Keyword ]
+  [@@deriving enumerate, equal]
+
+  let to_string x = For_deriving.of_poly x |> For_deriving.to_string
+  let of_string s = For_deriving.of_string s |> For_deriving.to_poly
+end
diff --git a/src/frontend/kernel/completion_kind.mli b/src/frontend/kernel/completion_kind.mli
@@ -0,0 +1,28 @@
+module In : sig
+  type t =
+    [ `Constructor
+    | `Labels
+    | `Modules
+    | `Modules_type
+    | `Types
+    | `Values
+    | `Variants
+    | `Keywords ]
+  [@@deriving to_string, enumerate, equal]
+
+  val of_string_opt : string -> t option
+end
+
+module Out : sig
+  type t =
+    [ `Value
+    | `Constructor
+    | `Variant
+    | `Label
+    | `Module
+    | `Modtype
+    | `Type
+    | `MethodCall
+    | `Keyword ]
+  [@@deriving string, enumerate, equal]
+end
diff --git a/src/frontend/kernel/dune b/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)))
diff --git a/src/frontend/kernel/locate_context.ml b/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]
diff --git a/src/frontend/kernel/locate_context.mli b/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]
diff --git a/src/frontend/kernel/locate_type_multi_result.ml b/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]
diff --git a/src/frontend/kernel/locate_type_multi_result.mli b/src/frontend/kernel/locate_type_multi_result.mli
@@ -0,0 +1,19 @@
+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]
diff --git a/src/frontend/kernel/outline_kind.ml b/src/frontend/kernel/outline_kind.ml
@@ -0,0 +1,50 @@
+module For_deriving = struct
+  type t =
+    | Value [@rename "Value"]
+    | Constructor [@rename "Constructor"]
+    | Label [@rename "Label"]
+    | Module [@rename "Module"]
+    | Modtype [@rename "Signature"]
+    | Type [@rename "Type"]
+    | Exn [@rename "Exn"]
+    | Class [@rename "Class"]
+    | Method [@rename "Method"]
+  [@@deriving string]
+
+  let to_poly = function
+    | Value -> `Value
+    | Constructor -> `Constructor
+    | Label -> `Label
+    | Module -> `Module
+    | Modtype -> `Modtype
+    | Type -> `Type
+    | Exn -> `Exn
+    | Class -> `Class
+    | Method -> `Method
+
+  let of_poly = function
+    | `Value -> Value
+    | `Constructor -> Constructor
+    | `Label -> Label
+    | `Module -> Module
+    | `Modtype -> Modtype
+    | `Type -> Type
+    | `Exn -> Exn
+    | `Class -> Class
+    | `Method -> Method
+end
+
+type t =
+  [ `Value
+  | `Constructor
+  | `Label
+  | `Module
+  | `Modtype
+  | `Type
+  | `Exn
+  | `Class
+  | `Method ]
+[@@deriving equal, enumerate]
+
+let to_string x = For_deriving.of_poly x |> For_deriving.to_string
+let of_string s = For_deriving.of_string s |> For_deriving.to_poly
diff --git a/src/frontend/kernel/outline_kind.mli b/src/frontend/kernel/outline_kind.mli
@@ -0,0 +1,11 @@
+type t =
+  [ `Value
+  | `Constructor
+  | `Label
+  | `Module
+  | `Modtype
+  | `Type
+  | `Exn
+  | `Class
+  | `Method ]
+[@@deriving string, equal, enumerate]
diff --git a/src/frontend/kernel/query_protocol_kernel.ml b/src/frontend/kernel/query_protocol_kernel.ml
@@ -2,38 +2,7 @@
    is useful because it allows VSCode extensions (which run in javascript) to use the
    serializers/deserializers defined in this module. *)
 
-open struct
-  include 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
-end
-
-module Locate_type_multi_result = struct
-  open Ppx_yojson_conv_lib.Yojson_conv.Primitives
-
-  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]
-end
+module Completion_kind = Completion_kind
+module Locate_context = Locate_context
+module Locate_type_multi_result = Locate_type_multi_result
+module Outline_kind = Outline_kind