Merge pull request #1884 from voodoos/fix-printtyp-issue-with-cimpletion

Fix printtyp issue with completion

.github/workflows/ocaml-lsp-compat.yml

@@ -34,7 +34,7 @@ jobs:
         os:
           - ubuntu-latest
         ocaml-compiler:
-          - ocaml-base-compiler.5.3.0~alpha1
+          - ocaml-base-compiler.5.3.0
     # The type of runner that the job will run on
     runs-on: ${{ matrix.os }}
 
@@ -52,6 +52,6 @@ jobs:
       - name: Check that Merlin and OCaml-LSP are co-installable
         run: |
           opam --cli=2.1 pin --with-version=dev --no-action https://github.com/voodoos/ocaml-lsp.git#merlin-503-compat
-          opam --cli=2.1 pin --with-version=5.3-503 --no-action .
+          opam --cli=2.1 pin --with-version=5.4-503 --no-action .
           opam install ocaml-lsp-server --ignore-constraints-on=ocamlformat
 

src/analysis/completion.ml

@@ -57,12 +57,13 @@ let raw_info_printer : raw_info -> _ = function
       (Out_sig_item
          (Out_type.tree_of_type_declaration id tdecl Types.Trec_first))
   | `Type_scheme te ->
-    `Print (Out_type (Out_type.tree_of_typexp Type_scheme te))
+    `Print (Out_type (Type_utils.Printtyp.tree_of_typ_scheme te))
   | `Variant (label, arg) -> begin
     match arg with
     | None -> `String label
     | Some te ->
-      `Concat (label ^ " of ", Out_type (Out_type.tree_of_typexp Type_scheme te))
+      `Concat
+        (label ^ " of ", Out_type (Type_utils.Printtyp.tree_of_typ_scheme te))
   end
 
 (* List methods of an object.

src/analysis/type_utils.ml

@@ -134,6 +134,10 @@ module Printtyp = struct
     (select_by_verbosity ~default:type_scheme ~verbose:(verbose_type_scheme env))
       ppf ty
 
+  let tree_of_typ_scheme te =
+    Out_type.prepare_for_printing [ te ];
+    Out_type.tree_of_typexp Type_scheme te
+
   let type_declaration env id ppf =
     (select_by_verbosity ~default:type_declaration
        ~verbose:(verbose_type_declaration env))

src/analysis/type_utils.mli

@@ -40,6 +40,8 @@ module Printtyp : sig
 
   val type_scheme : Env.t -> Format.formatter -> Types.type_expr -> unit
 
+  val tree_of_typ_scheme : Types.type_expr -> Outcometree.out_type
+
   val modtype : Env.t -> Format.formatter -> Types.module_type -> unit
 
   val wrap_printing_env :

tests/test-dirs/completion/issue-lsp-503.t

@@ -0,0 +1,39 @@
+
+  $ cat >test.ml <<'EOF'
+  > [1;2]|>List.ma
+  > EOF
+
+We complete the name of the object
+
+  $ $MERLIN single complete-prefix -position 1:14 -prefix "List.ma" \
+  > -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": {
+      "entries": [
+        {
+          "name": "map",
+          "kind": "Value",
+          "desc": "('a -> 'b) -> 'a list -> 'b list",
+          "info": "",
+          "deprecated": false
+        },
+        {
+          "name": "mapi",
+          "kind": "Value",
+          "desc": "(int -> 'a -> 'b) -> 'a list -> 'b list",
+          "info": "",
+          "deprecated": false
+        },
+        {
+          "name": "map2",
+          "kind": "Value",
+          "desc": "('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list",
+          "info": "",
+          "deprecated": false
+        }
+      ],
+      "context": null
+    },
+    "notifications": []
+  }