Add jsx_tag_name

Author: nojaf

analysis/src/CompletionFrontEnd.ml

@@ -1351,14 +1351,27 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
               children
             | _ -> JSXChildrenItems []
           in
+          let compName_loc =
+            match compName with
+            | Parsetree.Lower {loc; _}
+            | Parsetree.QualifiedLower {loc; _}
+            | Parsetree.Upper {loc; _} ->
+              loc
+          in
+          let compName_lid = Ast_helper.longident_of_jsx_tag_name compName in
           let jsxProps =
-            CompletionJsx.extractJsxProps ~compName ~props ~children
+            CompletionJsx.extractJsxProps
+              ~compName:(Location.mkloc compName_lid compName_loc)
+              ~props ~children
+          in
+          let compNamePath =
+            flattenLidCheckDot ~jsx:true
+              {txt = compName_lid; loc = compName_loc}
           in
-          let compNamePath = flattenLidCheckDot ~jsx:true compName in
           if debug then
             Printf.printf "JSX <%s:%s %s> _children:%s\n"
               (compNamePath |> String.concat ".")
-              (Loc.toString compName.loc)
+              (Loc.toString compName_loc)
               (jsxProps.props
               |> List.map
                    (fun ({name; posStart; posEnd; exp} : CompletionJsx.prop) ->
@@ -1369,6 +1382,19 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
               (match jsxProps.childrenStart with
               | None -> "None"
               | Some childrenPosStart -> Pos.toString childrenPosStart);
+          (* If the tag name is an uppercase path and the cursor is right after a dot (e.g., <O.|),
+             prefer module member completion over JSX prop suggestions. *)
+          (match compName with
+          | Parsetree.Upper _ when blankAfterCursor = Some '.' ->
+            setResult
+              (Cpath
+                 (CPId
+                    {
+                      loc = compName_loc;
+                      path = compNamePath;
+                      completionContext = Module;
+                    }))
+          | _ -> ());
           let jsxCompletable =
             match expr.pexp_desc with
             | Pexp_jsx_element
@@ -1383,11 +1409,11 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
             | _ ->
               CompletionJsx.findJsxPropsCompletable ~jsxProps
                 ~endPos:(Loc.end_ expr.pexp_loc) ~posBeforeCursor
-                ~posAfterCompName:(Loc.end_ compName.loc)
+                ~posAfterCompName:(Loc.end_ compName_loc)
                 ~firstCharBeforeCursorNoWhite ~charAtCursor
           in
           if jsxCompletable <> None then setResultOpt jsxCompletable
-          else if compName.loc |> Loc.hasPos ~pos:posBeforeCursor then
+          else if compName_loc |> Loc.hasPos ~pos:posBeforeCursor then
             setResult
               (match compNamePath with
               | [prefix] when Char.lowercase_ascii prefix.[0] = prefix.[0] ->
@@ -1396,7 +1422,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor
                 Cpath
                   (CPId
                      {
-                       loc = compName.loc;
+                       loc = compName_loc;
                        path = compNamePath;
                        completionContext = Module;
                      }))

analysis/src/SemanticTokens.ml

@@ -265,7 +265,15 @@ let command ~debug ~emitter ~path =
       *)
       emitter (* --> <div... *)
       |> emitJsxTag ~debug ~name:"<" ~pos:(Loc.start e.pexp_loc);
-      emitter |> emitJsxOpen ~lid:lident.txt ~debug ~loc:lident.loc;
+      let lid = Ast_helper.longident_of_jsx_tag_name lident in
+      let loc =
+        match lident with
+        | Parsetree.Lower {loc; _}
+        | Parsetree.QualifiedLower {loc; _}
+        | Parsetree.Upper {loc; _} ->
+          loc
+      in
+      emitter |> emitJsxOpen ~lid ~debug ~loc;
       let closing_line, closing_column = Loc.end_ e.pexp_loc in
       emitter (* <foo ...props /> <-- *)
       |> emitJsxTag ~debug ~name:"/>" ~pos:(closing_line, closing_column - 2)
@@ -281,7 +289,15 @@ let command ~debug ~emitter ~path =
       (* opening tag *)
       emitter (* --> <div... *)
       |> emitJsxTag ~debug ~name:"<" ~pos:(Loc.start e.pexp_loc);
-      emitter |> emitJsxOpen ~lid:lident.txt ~debug ~loc:lident.loc;
+      let lid = Ast_helper.longident_of_jsx_tag_name lident in
+      let loc =
+        match lident with
+        | Parsetree.Lower {loc; _}
+        | Parsetree.QualifiedLower {loc; _}
+        | Parsetree.Upper {loc; _} ->
+          loc
+      in
+      emitter |> emitJsxOpen ~lid ~debug ~loc;
       emitter (* <foo ...props > <-- *)
       |> emitJsxTag ~debug ~name:">"
            ~pos:(Pos.ofLexing posOfGreatherthanAfterProps);
@@ -308,9 +324,15 @@ let command ~debug ~emitter ~path =
              emitter
              |> emitJsxTag ~debug ~name:"</"
                   ~pos:(Pos.ofLexing closing_less_than);
-             emitter
-             |> emitJsxClose ~debug ~lid:lident.txt
-                  ~pos:(Loc.start tag_name_end.loc);
+             let lid = Ast_helper.longident_of_jsx_tag_name tag_name_end in
+             let loc =
+               match tag_name_end with
+               | Parsetree.Lower {loc; _}
+               | Parsetree.QualifiedLower {loc; _}
+               | Parsetree.Upper {loc; _} ->
+                 loc
+             in
+             emitter |> emitJsxClose ~debug ~lid ~pos:(Loc.end_ loc);
              emitter (* <foo> ... </foo> <-- *)
              |> emitJsxTag ~debug ~name:">"
                   ~pos:(Pos.ofLexing final_greather_than))

compiler/ml/ast_helper.ml

@@ -428,3 +428,18 @@ module Te = struct
       pext_attributes = attrs;
     }
 end
+
+(* Helpers for JSX *)
+let string_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : string =
+  match tag_name with
+  | Parsetree.Lower {name; _} -> name
+  | Parsetree.QualifiedLower {path; name; _} ->
+    String.concat "." (Longident.flatten path) ^ "." ^ name
+  | Parsetree.Upper {path; _} -> String.concat "." (Longident.flatten path)
+
+let longident_of_jsx_tag_name (tag_name : Parsetree.jsx_tag_name) : Longident.t
+    =
+  match tag_name with
+  | Parsetree.Lower {name; _} -> Longident.Lident name
+  | Parsetree.QualifiedLower {path; name; _} -> Longident.Ldot (path, name)
+  | Parsetree.Upper {path; _} -> path

compiler/ml/ast_helper.mli

@@ -212,13 +212,13 @@ module Exp : sig
   val jsx_unary_element :
     ?loc:loc ->
     ?attrs:attrs ->
-    Longident.t Location.loc ->
+    Parsetree.jsx_tag_name ->
     Parsetree.jsx_props ->
     expression
   val jsx_container_element :
     ?loc:loc ->
     ?attrs:attrs ->
-    Longident.t Location.loc ->
+    Parsetree.jsx_tag_name ->
     Parsetree.jsx_props ->
     Lexing.position ->
     Parsetree.jsx_children ->
@@ -301,6 +301,9 @@ module Te : sig
   val rebind : ?loc:loc -> ?attrs:attrs -> str -> lid -> extension_constructor
 end
 
+val string_of_jsx_tag_name : Parsetree.jsx_tag_name -> string
+val longident_of_jsx_tag_name : Parsetree.jsx_tag_name -> Longident.t
+
 (** {1 Module language} *)
 
 (** Module type expressions *)

compiler/ml/ast_iterator.ml

@@ -365,18 +365,18 @@ module E = struct
       iter_jsx_children sub children
     | Pexp_jsx_element
         (Jsx_unary_element
-           {jsx_unary_element_tag_name = name; jsx_unary_element_props = props})
+           {jsx_unary_element_tag_name = _name; jsx_unary_element_props = props})
       ->
-      iter_loc sub name;
+      (* jsx_tag_name contains a Location.t inside; attributes and visitors can
+         visit props and children as before *)
       iter_jsx_props sub props
     | Pexp_jsx_element
         (Jsx_container_element
            {
-             jsx_container_element_tag_name_start = name;
+             jsx_container_element_tag_name_start = _name;
              jsx_container_element_props = props;
              jsx_container_element_children = children;
            }) ->
-      iter_loc sub name;
       iter_jsx_props sub props;
       iter_jsx_children sub children
 end

compiler/ml/ast_mapper.ml

@@ -358,7 +358,8 @@ module E = struct
         (Jsx_unary_element
            {jsx_unary_element_tag_name = name; jsx_unary_element_props = props})
       ->
-      jsx_unary_element ~loc ~attrs (map_loc sub name) (map_jsx_props sub props)
+      (* pass through jsx_tag_name unchanged; it is not a loc *)
+      jsx_unary_element ~loc ~attrs name (map_jsx_props sub props)
     | Pexp_jsx_element
         (Jsx_container_element
            {
@@ -368,8 +369,7 @@ module E = struct
              jsx_container_element_children = children;
              jsx_container_element_closing_tag = closing_tag;
            }) ->
-      jsx_container_element ~loc ~attrs (map_loc sub name)
-        (map_jsx_props sub props) ote
+      jsx_container_element ~loc ~attrs name (map_jsx_props sub props) ote
         (map_jsx_children sub children)
         closing_tag
 end

compiler/ml/ast_mapper_from0.ml

@@ -396,10 +396,23 @@ module E = struct
       when has_jsx_attribute () -> (
       let attrs = attrs |> List.filter (fun ({txt}, _) -> txt <> "JSX") in
       let props, children = extract_props_and_children sub args in
+      let jsx_tag : Pt.jsx_tag_name =
+        match tag_name.txt with
+        | Longident.Lident s
+          when String.length s > 0 && Char.lowercase_ascii s.[0] = s.[0] ->
+          Pt.Lower {name = s; loc = tag_name.loc}
+        | Longident.Lident _ ->
+          Pt.Upper {path = tag_name.txt; loc = tag_name.loc}
+        | Longident.Ldot (path, last)
+          when String.length last > 0
+               && Char.lowercase_ascii last.[0] = last.[0] ->
+          Pt.QualifiedLower {path; name = last; loc = tag_name.loc}
+        | _ -> Pt.Upper {path = tag_name.txt; loc = tag_name.loc}
+      in
       match children with
-      | None -> jsx_unary_element ~loc ~attrs tag_name props
+      | None -> jsx_unary_element ~loc ~attrs jsx_tag props
       | Some children ->
-        jsx_container_element ~loc ~attrs tag_name props Lexing.dummy_pos
+        jsx_container_element ~loc ~attrs jsx_tag props Lexing.dummy_pos
           children None)
     | Pexp_apply (e, l) ->
       let e =

compiler/ml/ast_mapper_to0.ml

@@ -495,7 +495,16 @@ module E = struct
              jsx_unary_element_tag_name = tag_name;
              jsx_unary_element_props = props;
            }) ->
-      let tag_ident = map_loc sub tag_name in
+      let tag_ident : Longident.t Location.loc =
+        let txt, loc =
+          match tag_name with
+          | Lower {name; loc} -> (Longident.Lident name, loc)
+          | QualifiedLower {path; name; loc} ->
+            (Longident.Ldot (path, name), loc)
+          | Upper {path; loc} -> (path, loc)
+        in
+        {txt; loc}
+      in
       let props = map_jsx_props sub props in
       let children_expr =
         let loc =
@@ -525,7 +534,16 @@ module E = struct
              jsx_container_element_props = props;
              jsx_container_element_children = children;
            }) ->
-      let tag_ident = map_loc sub tag_name in
+      let tag_ident : Longident.t Location.loc =
+        let txt, loc =
+          match tag_name with
+          | Lower {name; loc} -> (Longident.Lident name, loc)
+          | QualifiedLower {path; name; loc} ->
+            (Longident.Ldot (path, name), loc)
+          | Upper {path; loc} -> (path, loc)
+        in
+        {txt; loc}
+      in
       let props = map_jsx_props sub props in
       let children_expr = map_jsx_children sub loc children in
       apply ~loc ~attrs:(jsx_attr sub :: attrs) (ident tag_ident)

compiler/ml/depend.ml

@@ -294,7 +294,10 @@ let rec add_expr bv exp =
       (Jsx_unary_element
          {jsx_unary_element_tag_name = name; jsx_unary_element_props = props})
     ->
-    add bv name;
+    (* Conservatively add all module path segments referenced by the tag name *)
+    (match name with
+    | Lower _ -> ()
+    | QualifiedLower {path; _} | Upper {path; _} -> add_path bv path);
     and_jsx_props bv props
   | Pexp_jsx_element
       (Jsx_container_element
@@ -303,7 +306,9 @@ let rec add_expr bv exp =
            jsx_container_element_props = props;
            jsx_container_element_children = children;
          }) ->
-    add bv name;
+    (match name with
+    | Lower _ -> ()
+    | QualifiedLower {path; _} | Upper {path; _} -> add_path bv path);
     and_jsx_props bv props;
     add_jsx_children bv children
 

compiler/ml/parsetree.ml

@@ -325,20 +325,25 @@ and jsx_element =
   | Jsx_unary_element of jsx_unary_element
   | Jsx_container_element of jsx_container_element
 
+and jsx_tag_name =
+  | Lower of {name: string; loc: Location.t}
+  | QualifiedLower of {path: Longident.t; name: string; loc: Location.t}
+  | Upper of {path: Longident.t; loc: Location.t}
+
 and jsx_fragment = {
   (* > *) jsx_fragment_opening: Lexing.position;
   (* children *) jsx_fragment_children: jsx_children;
   (* </ *) jsx_fragment_closing: Lexing.position;
 }
 
 and jsx_unary_element = {
-  jsx_unary_element_tag_name: Longident.t loc;
+  jsx_unary_element_tag_name: jsx_tag_name;
   jsx_unary_element_props: jsx_props;
 }
 
 and jsx_container_element = {
   (* jsx_container_element_opening_tag_start: Lexing.position; *)
-  jsx_container_element_tag_name_start: Longident.t loc;
+  jsx_container_element_tag_name_start: jsx_tag_name;
   (* > *)
   jsx_container_element_opening_tag_end: Lexing.position;
   jsx_container_element_props: jsx_props;
@@ -376,7 +381,7 @@ and jsx_closing_container_tag = {
   (* </ *)
   jsx_closing_container_tag_start: Lexing.position;
   (* name *)
-  jsx_closing_container_tag_name: Longident.t loc;
+  jsx_closing_container_tag_name: jsx_tag_name;
   (* > *)
   jsx_closing_container_tag_end: Lexing.position;
 }