Fix completion-triggered doc queries

src/analysis/completion.ml

@@ -225,8 +225,8 @@ let make_candidate ~get_doc ~attrs ~exact ~prefix_path name ?loc ?path ty =
       | Some p, Some loc ->
         let namespace = (* FIXME: that's just terrible *)
           match kind with
-          | `Value -> Shape.Sig_component_kind.Value
-          | `Type -> Type
+          | `Value -> `Vals
+          | `Type -> `Type
           | _ -> assert false
         in
         begin match get_doc (`Completion_entry (namespace, p, loc)) with

src/analysis/completion.mli

@@ -52,7 +52,7 @@ val map_entry : ('a -> 'b) ->
 
 val branch_complete
   :  Mconfig.t
-  -> ?get_doc:([> `Completion_entry of Shape.Sig_component_kind.t 
+  -> ?get_doc:([> `Completion_entry of Namespaced_path.Namespace.t
                 * Path.t * Location.t ] -> [> `Found of string ])
   -> ?target_type:Types.type_expr
   -> ?kinds:Compl.kind list

src/analysis/locate.ml

@@ -839,7 +839,10 @@ let from_path ~config ~env ~local_defs ~namespace ml_or_mli path =
       match locate ~env ~ml_or_mli uid loc path namespace with
       | `Not_found _
       | `File_not_found _ as err -> err
-      | `Found (_, loc) -> find_source ~config loc (Path.name path)
+      | `Found (uid, loc) ->
+        match find_source ~config loc (Path.name path) with
+        | `Found (file, loc) -> `Found (uid, file, loc)
+        | `File_not_found _ as otherwise -> otherwise
 
 let from_string ~config ~env ~local_defs ~pos ?namespaces switch path =
   File_switching.reset ();
@@ -1012,7 +1015,19 @@ let get_doc ~config ~env ~local_defs ~comments ~pos =
   let_ref last_location Location.none @@ fun () ->
   match
     match path with
-    | `Completion_entry entry -> from_completion_entry ~env ~config entry
+    | `Completion_entry (namespace, path, _loc) ->
+      log ~title:"get_doc" "completion: looking for the doc of '%a'"
+        Logger.fmt (fun fmt -> Path.print fmt path) ;
+      let from_path = from_path ~config ~env ~local_defs ~namespace `MLI path in
+      begin match from_path with
+      | `Found (uid, _, pos) ->
+        let loc : Location.t =
+          { loc_start = pos; loc_end = pos; loc_ghost = true }
+        in
+        from_uid ~loc uid
+      | (`Builtin |`Not_in_env _|`File_not_found _|`Not_found _)
+        as otherwise -> otherwise
+      end
     | `User_input path ->
       log ~title:"get_doc" "looking for the doc of '%s'" path;
       let lid = Longident.parse path in
@@ -1021,14 +1036,16 @@ let get_doc ~config ~env ~local_defs ~comments ~pos =
         `Found { Location. loc_start=pos; loc_end=pos ; loc_ghost=true }
       | Some ctxt ->
         begin match from_string ~config ~env ~local_defs ~pos `MLI path with
-        | `Found (uid, _, id_loc) ->
+        | `Found (uid, _, pos) ->
           let loc : Location.t =
-            { loc_start = id_loc; loc_end = id_loc; loc_ghost = true }
+            { loc_start = pos; loc_end = pos; loc_ghost = true }
           in
           from_uid ~loc uid
         | `At_origin | `Missing_labels_namespace -> `No_documentation
         | `Builtin _ -> `Builtin
-        | (`Not_in_env _ | `Not_found _ |`File_not_found _ ) as otherwise -> otherwise  end
+        | (`Not_in_env _ | `Not_found _ |`File_not_found _ )
+          as otherwise -> otherwise
+        end
       end
   with
   | `Found_doc doc -> `Found doc

src/analysis/locate.mli

@@ -40,7 +40,7 @@ val from_path
   -> [ `ML | `MLI ]
   -> Path.t
   -> [> `File_not_found of string
-     | `Found of string option * Lexing.position
+     | `Found of Shape.Uid.t option * string option * Lexing.position
      | `Builtin
      | `Not_in_env of string
      | `Not_found of string * string option ]
@@ -69,7 +69,7 @@ val get_doc
   -> pos:Lexing.position
   -> [ `User_input of string
      | `Completion_entry of
-        Shape.Sig_component_kind.t * Path.t * Location.t ]
+        Namespaced_path.Namespace.t * Path.t * Location.t ]
   -> [> `File_not_found of string
       | `Found of string
       | `Builtin of string

src/frontend/query_commands.ml

@@ -395,7 +395,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a =
         | `Builtin -> `Builtin (Path.name path)
         | `Not_in_env _ as s -> s
         | `Not_found _ as s -> s
-        | `Found _ as s -> s
+        | `Found (_uid, file, pos) -> `Found (file, pos)
         | `File_not_found _ as s -> s
     end