Emit nested document symbols. (#655)

* Emit nested document symbols.

Fixes #654.

The change in #629 moved to a non-deprecated representation of document symbol.
The new representation is the "Ikea" version of the old one, where children symbol are not computed for you, but need to be provided.
This PR computes and emits the tree of symbols using the `children` field.

* indent

* Refactor code for indentation.

* Update CHANGELOG.md

* cleanup

CHANGELOG.md

@@ -45,6 +45,8 @@
 
 - Fix issue where jump to definition would go to the wrong place when there are aliased identifiers in submodules https://github.com/rescript-lang/rescript-vscode/pull/653
 
+- Fix issue where document symbols were not shown nested https://github.com/rescript-lang/rescript-vscode/pull/655
+
 ## v1.8.2
 
 #### :rocket: New Feature

analysis/src/DocumentSymbol.ml

@@ -26,6 +26,13 @@ let kindNumber = function
 
 let command ~path =
   let symbols = ref [] in
+  let addSymbol name loc kind =
+    let range = Utils.cmtLocToRange loc in
+    let symbol : Protocol.documentSymbolItem =
+      {name; range; kind = kindNumber kind; children = []}
+    in
+    symbols := symbol :: !symbols
+  in
   let rec exprKind (exp : Parsetree.expression) =
     match exp.pexp_desc with
     | Pexp_fun _ -> Function
@@ -41,43 +48,41 @@ let command ~path =
     | Ptype_variant constrDecls ->
       constrDecls
       |> List.iter (fun (cd : Parsetree.constructor_declaration) ->
-             symbols := (cd.pcd_name.txt, cd.pcd_loc, EnumMember) :: !symbols)
+             addSymbol cd.pcd_name.txt cd.pcd_loc EnumMember)
     | Ptype_record labelDecls ->
       labelDecls
       |> List.iter (fun (ld : Parsetree.label_declaration) ->
-             symbols := (ld.pld_name.txt, ld.pld_loc, Property) :: !symbols)
+             addSymbol ld.pld_name.txt ld.pld_loc Property)
     | _ -> ()
   in
   let processTypeDeclaration (td : Parsetree.type_declaration) =
-    symbols := (td.ptype_name.txt, td.ptype_loc, TypeParameter) :: !symbols;
+    addSymbol td.ptype_name.txt td.ptype_loc TypeParameter;
     processTypeKind td.ptype_kind
   in
   let processValueDescription (vd : Parsetree.value_description) =
-    symbols := (vd.pval_name.txt, vd.pval_loc, Variable) :: !symbols
+    addSymbol vd.pval_name.txt vd.pval_loc Variable
   in
   let processModuleBinding (mb : Parsetree.module_binding) =
-    symbols := (mb.pmb_name.txt, mb.pmb_loc, Module) :: !symbols
+    addSymbol mb.pmb_name.txt mb.pmb_loc Module
   in
   let processModuleDeclaration (md : Parsetree.module_declaration) =
-    symbols := (md.pmd_name.txt, md.pmd_loc, Module) :: !symbols
+    addSymbol md.pmd_name.txt md.pmd_loc Module
   in
   let processExtensionConstructor (et : Parsetree.extension_constructor) =
-    symbols := (et.pext_name.txt, et.pext_loc, Constructor) :: !symbols
+    addSymbol et.pext_name.txt et.pext_loc Constructor
   in
   let value_binding (iterator : Ast_iterator.iterator)
       (vb : Parsetree.value_binding) =
     (match vb.pvb_pat.ppat_desc with
     | Ppat_var {txt} | Ppat_constraint ({ppat_desc = Ppat_var {txt}}, _) ->
-      symbols := (txt, vb.pvb_loc, exprKind vb.pvb_expr) :: !symbols
+      addSymbol txt vb.pvb_loc (exprKind vb.pvb_expr)
     | _ -> ());
     Ast_iterator.default_iterator.value_binding iterator vb
   in
   let expr (iterator : Ast_iterator.iterator) (e : Parsetree.expression) =
     (match e.pexp_desc with
     | Pexp_letmodule ({txt}, modExpr, _) ->
-      symbols :=
-        (txt, {e.pexp_loc with loc_end = modExpr.pmod_loc.loc_end}, Module)
-        :: !symbols
+      addSymbol txt {e.pexp_loc with loc_end = modExpr.pmod_loc.loc_end} Module
     | Pexp_letexception (ec, _) -> processExtensionConstructor ec
     | _ -> ());
     Ast_iterator.default_iterator.expr iterator e
@@ -134,12 +139,57 @@ let command ~path =
     let parser = Res_driver.parsingEngine.parseInterface ~forPrinter:false in
     let {Res_driver.parsetree = signature} = parser ~filename:path in
     iterator.signature iterator signature |> ignore);
-  let result =
-    !symbols
-    |> List.rev_map (fun (name, loc, kind) ->
-           let range = Utils.cmtLocToRange loc in
-           Protocol.stringifyDocumentSymbolItem
-             {name; range; selectionRange = range; kind = kindNumber kind})
-    |> String.concat ",\n"
-  in
-  print_endline ("[\n" ^ result ^ "\n]")
+  let isInside
+      ({
+         range =
+           {
+             start = {line = sl1; character = sc1};
+             end_ = {line = el1; character = ec1};
+           };
+       } :
+        Protocol.documentSymbolItem)
+      ({
+         range =
+           {
+             start = {line = sl2; character = sc2};
+             end_ = {line = el2; character = ec2};
+           };
+       } :
+        Protocol.documentSymbolItem) =
+    (sl1 > sl2 || (sl1 = sl2 && sc1 >= sc2))
+    && (el1 < el2 || (el1 = el2 && ec1 <= ec2))
+  in
+  let compareSymbol (s1 : Protocol.documentSymbolItem)
+      (s2 : Protocol.documentSymbolItem) =
+    let n = compare s1.range.start.line s2.range.start.line in
+    if n <> 0 then n
+    else
+      let n = compare s1.range.start.character s2.range.start.character in
+      if n <> 0 then n
+      else
+        let n = compare s1.range.end_.line s2.range.end_.line in
+        if n <> 0 then n
+        else compare s1.range.end_.character s2.range.end_.character
+  in
+  let rec addSymbolToChildren ~symbol children =
+    match children with
+    | [] -> [symbol]
+    | last :: rest ->
+      if isInside symbol last then
+        let newLast =
+          {last with children = last.children |> addSymbolToChildren ~symbol}
+        in
+        newLast :: rest
+      else symbol :: children
+  in
+  let rec addSortedSymbolsToChildren ~sortedSymbols children =
+    match sortedSymbols with
+    | [] -> children
+    | firstSymbol :: rest ->
+      children
+      |> addSymbolToChildren ~symbol:firstSymbol
+      |> addSortedSymbolsToChildren ~sortedSymbols:rest
+  in
+  let sortedSymbols = !symbols |> List.sort compareSymbol in
+  let symbolsWithChildren = [] |> addSortedSymbolsToChildren ~sortedSymbols in
+  print_endline (Protocol.stringifyDocumentSymbolItems symbolsWithChildren)

analysis/src/Protocol.ml

@@ -46,7 +46,7 @@ type documentSymbolItem = {
   name: string;
   kind: int;
   range: range;
-  selectionRange: range;
+  children: documentSymbolItem list;
 }
 type renameFile = {oldUri: string; newUri: string}
 type textEdit = {range: range; newText: string}
@@ -102,22 +102,54 @@ let stringifyCompletionItem c =
     | None -> null
     | Some doc -> stringifyMarkupContent doc)
 
-let stringifyHover value = Printf.sprintf {|{"contents": %s}|} (stringifyMarkupContent {kind = "markdown"; value})
+let stringifyHover value =
+  Printf.sprintf {|{"contents": %s}|}
+    (stringifyMarkupContent {kind = "markdown"; value})
 
 let stringifyLocation (h : location) =
   Printf.sprintf {|{"uri": "%s", "range": %s}|} (Json.escape h.uri)
     (stringifyRange h.range)
 
-let stringifyDocumentSymbolItem (i : documentSymbolItem) =
-  let range = stringifyRange i.range in
-  Printf.sprintf
-    {|{
-        "name": "%s",
-        "kind": %i,
-        "range": %s,
-        "selectionRange": %s
-}|}
-    (Json.escape i.name) i.kind range range
+let stringifyDocumentSymbolItems items =
+  let buf = Buffer.create 10 in
+  let stringifyName name = Printf.sprintf "\"%s\"" (Json.escape name) in
+  let stringifyKind kind = string_of_int kind in
+  let emitStr = Buffer.add_string buf in
+  let emitSep () = emitStr ",\n" in
+  let rec emitItem ~indent item =
+    let openBrace = Printf.sprintf "%s{\n" indent in
+    let closeBrace = Printf.sprintf "\n%s}" indent in
+    let indent = indent ^ "  " in
+    let emitField name s =
+      emitStr (Printf.sprintf "%s\"%s\": %s" indent name s)
+    in
+    emitStr openBrace;
+    emitField "name" (stringifyName item.name);
+    emitSep ();
+    emitField "kind" (stringifyKind item.kind);
+    emitSep ();
+    emitField "range" (stringifyRange item.range);
+    emitSep ();
+    emitField "selectionRange" (stringifyRange item.range);
+    if item.children <> [] then (
+      emitSep ();
+      emitField "children" "[\n";
+      emitBody ~indent (List.rev item.children);
+      emitStr "]");
+    emitStr closeBrace
+  and emitBody ~indent items =
+    match items with
+    | [] -> ()
+    | item :: rest ->
+      emitItem ~indent item;
+      if rest <> [] then emitSep ();
+      emitBody ~indent rest
+  in
+  let indent = "" in
+  emitStr "[\n";
+  emitBody ~indent (List.rev items);
+  emitStr "\n]";
+  Buffer.contents buf
 
 let stringifyRenameFile {oldUri; newUri} =
   Printf.sprintf {|{