Add command for documentSymbol.

analysis/src/Cli.ml

@@ -30,7 +30,12 @@ Options:
 
   references: get references to item in Foo.res at line 10 column 2:
 
-  ./run.exe references src/Foo.res 10 2|}
+    ./run.exe references src/Foo.res 10 2
+
+  documentSymbol: get all symbols in Foo.res:
+
+    ./run.exe documentSymbol src/Foo.res 
+  |}
 
 let main () =
   match Array.to_list Sys.argv with
@@ -45,6 +50,7 @@ let main () =
   | [_; "references"; path; line; col] ->
     Commands.references ~path ~line:(int_of_string line)
       ~col:(int_of_string col)
+  | [_; "documentSymbol"; path] -> Commands.documentSymbol ~path
   | _ :: "dump" :: files -> Commands.dump files
   | [_; "test"; path] -> Commands.test ~path
   | args when List.mem "-h" args || List.mem "--help" args -> prerr_endline help

analysis/src/Commands.ml

@@ -170,6 +170,40 @@ let references ~path ~line ~col =
   in
   print_endline result
 
+let documentSymbol ~path =
+  let uri = Uri2.fromLocalPath path in
+  match ProcessCmt.fileForUri uri with
+  | Error _ -> print_endline Protocol.null
+  | Ok (file, _extra) ->
+    let open SharedTypes in
+    let rec getItems {topLevel} =
+      let fn {name = {txt}; extentLoc; item} =
+        let item, siblings =
+          match item with
+          | MValue v -> (v |> SharedTypes.variableKind, [])
+          | MType (t, _) -> (t.decl |> SharedTypes.declarationKind, [])
+          | Module (Structure contents) -> (Module, getItems contents)
+          | Module (Ident _) -> (Module, [])
+        in
+        if extentLoc.loc_ghost then siblings
+        else (txt, extentLoc, item) :: siblings
+      in
+      let x = topLevel |> List.map fn |> List.concat in
+      x
+    in
+    let allSymbols =
+      getItems file.contents
+      |> List.map (fun (name, loc, kind) ->
+             Protocol.stringifyDocumentSymbolItem
+               {
+                 name;
+                 location =
+                   {uri = Uri2.toString uri; range = Utils.cmtLocToRange loc};
+                 kind = SharedTypes.symbolKind kind;
+               })
+    in
+    print_endline ("[\n" ^ (allSymbols |> String.concat ",\n") ^ "\n]")
+
 let test ~path =
   Uri2.stripPath := true;
   match Files.readFile path with
@@ -202,6 +236,9 @@ let test ~path =
               ("References " ^ path ^ " " ^ string_of_int line ^ ":"
              ^ string_of_int col);
             references ~path ~line ~col
+          | "doc" ->
+            print_endline ("DocumentSymbol " ^ path);
+            documentSymbol ~path
           | "com" ->
             print_endline
               ("Complete " ^ path ^ " " ^ string_of_int line ^ ":"

analysis/src/Protocol.ml

@@ -1,72 +1,67 @@
-type position = {
-  line: int;
-  character: int;
-}
+type position = {line : int; character : int}
 
-type range = {
-  start: position;
-  end_: position;
-}
+type range = {start : position; end_ : position}
 
-type markupContent = {
-  kind: string;
-  value: string;
-}
+type markupContent = {kind : string; value : string}
 
 type completionItem = {
-  label: string;
-  kind: int;
-  tags: int list;
-  detail: string;
-  documentation: markupContent option;
+  label : string;
+  kind : int;
+  tags : int list;
+  detail : string;
+  documentation : markupContent option;
 }
 
-type hover = {
-  contents: string;
-}
+type hover = {contents : string}
 
-type location = {
-  uri: string;
-  range: range;
-}
+type location = {uri : string; range : range}
+
+type documentSymbolItem = {name : string; kind : int; location : location}
 
 let null = "null"
 
-let array l = "[" ^ (String.concat ", " l) ^ "]"
+let array l = "[" ^ String.concat ", " l ^ "]"
 
 let stringifyPosition p =
-   Printf.sprintf {|{"line": %i, "character": %i}|} p.line p.character
+  Printf.sprintf {|{"line": %i, "character": %i}|} p.line p.character
 
 let stringifyRange r =
-   Printf.sprintf {|{"start": %s, "end": %s}|}
+  Printf.sprintf {|{"start": %s, "end": %s}|}
     (stringifyPosition r.start)
     (stringifyPosition r.end_)
 
-let stringifyMarkupContent (m: markupContent) =
-  Printf.sprintf {|{"kind": "%s", "value": "%s"}|}
-  m.kind (Json.escape m.value)
+let stringifyMarkupContent (m : markupContent) =
+  Printf.sprintf {|{"kind": "%s", "value": "%s"}|} m.kind (Json.escape m.value)
 
 let stringifyCompletionItem c =
-  Printf.sprintf {|{
+  Printf.sprintf
+    {|{
     "label": "%s",
     "kind": %i,
     "tags": %s,
     "detail": "%s",
     "documentation": %s
   }|}
-  (Json.escape c.label)
-  c.kind
-  (c.tags |> List.map string_of_int |> array)
-  (Json.escape c.detail)
-  (match c.documentation with
-  | None -> null
-  | Some doc -> stringifyMarkupContent doc)
+    (Json.escape c.label) c.kind
+    (c.tags |> List.map string_of_int |> array)
+    (Json.escape c.detail)
+    (match c.documentation with
+    | None -> null
+    | Some doc -> stringifyMarkupContent doc)
 
 let stringifyHover h =
-  Printf.sprintf {|{"contents": "%s"}|}
-  (Json.escape h.contents)
+  Printf.sprintf {|{"contents": "%s"}|} (Json.escape h.contents)
 
 let stringifyLocation h =
-  Printf.sprintf {|{"uri": "%s", "range": %s}|}
-  (Json.escape h.uri)
-  (stringifyRange h.range)
+  Printf.sprintf {|{"uri": "%s", "range": %s}|} (Json.escape h.uri)
+    (stringifyRange h.range)
+
+let stringifyDocumentSymbolItem i =
+  Printf.sprintf
+    {|{
+            "name": "%s",
+            "kind": %i,
+            "location": %s,
+          }|}
+    (Json.escape i.name) i.kind
+    (stringifyLocation i.location)

analysis/src/SharedTypes.ml

@@ -233,5 +233,49 @@ let locationToString ({Location.loc_start; loc_end}, loc) =
   Printf.sprintf "%d:%d-%d:%d %s" pos1.line pos1.character pos2.line
     pos2.character (locToString loc)
 
+type kinds =
+  | Module
+  | Enum
+  | Interface
+  | Function
+  | Variable
+  | Array
+  | Object
+  | Null
+  | EnumMember
+  | TypeParameter
+
+let rec variableKind t =
+  match t.Types.desc with
+  | Tlink t -> variableKind t
+  | Tsubst t -> variableKind t
+  | Tarrow _ -> Function
+  | Ttuple _ -> Array
+  | Tconstr _ -> Variable
+  | Tobject _ -> Object
+  | Tnil -> Null
+  | Tvariant _ -> EnumMember
+  | Tpoly _ -> EnumMember
+  | Tpackage _ -> Module
+  | _ -> Variable
+
+let symbolKind = function
+  | Module -> 2
+  | Enum -> 10
+  | Interface -> 11
+  | Function -> 12
+  | Variable -> 13
+  | Array -> 18
+  | Object -> 19
+  | Null -> 21
+  | EnumMember -> 22
+  | TypeParameter -> 26
+
+let declarationKind t =
+  match t.Types.type_kind with
+  | Type_open | Type_abstract -> TypeParameter
+  | Type_record _ -> Interface
+  | Type_variant _ -> Enum
+
 (* for debugging *)
 let _ = locationToString

analysis/tests/src/Complete.res

@@ -54,4 +54,4 @@ let zzz = 11
 //^com let comp = <O.Comp z
 
 
-
+//^doc

analysis/tests/src/expected/Complete.res.txt

@@ -454,3 +454,87 @@ Complete tests/src/Complete.res 52:2
     "documentation": null
   }]
 
+DocumentSymbol tests/src/Complete.res
+[
+{
+            "name": "MyList",
+            "kind": 2,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 0, "character": 7}, "end": {"line": 0, "character": 25}}},
+          },
+{
+            "name": "Dep",
+            "kind": 2,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 6, "character": 7}, "end": {"line": 11, "character": 1}}},
+          },
+{
+            "name": "customDouble",
+            "kind": 12,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 7, "character": 2}, "end": {"line": 8, "character": 30}}},
+          },
+{
+            "name": "Lib",
+            "kind": 2,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 15, "character": 7}, "end": {"line": 18, "character": 1}}},
+          },
+{
+            "name": "foo",
+            "kind": 12,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 16, "character": 2}, "end": {"line": 16, "character": 55}}},
+          },
+{
+            "name": "next",
+            "kind": 12,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 17, "character": 2}, "end": {"line": 17, "character": 48}}},
+          },
+{
+            "name": "op",
+            "kind": 13,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 26, "character": 0}, "end": {"line": 26, "character": 16}}},
+          },
+{
+            "name": "ForAuto",
+            "kind": 2,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 30, "character": 7}, "end": {"line": 34, "character": 1}}},
+          },
+{
+            "name": "t",
+            "kind": 26,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 31, "character": 2}, "end": {"line": 31, "character": 14}}},
+          },
+{
+            "name": "abc",
+            "kind": 12,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 32, "character": 2}, "end": {"line": 32, "character": 30}}},
+          },
+{
+            "name": "abd",
+            "kind": 12,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 33, "character": 2}, "end": {"line": 33, "character": 30}}},
+          },
+{
+            "name": "fa",
+            "kind": 13,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 36, "character": 0}, "end": {"line": 36, "character": 21}}},
+          },
+{
+            "name": "O",
+            "kind": 2,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 41, "character": 7}, "end": {"line": 47, "character": 1}}},
+          },
+{
+            "name": "Comp",
+            "kind": 2,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 42, "character": 9}, "end": {"line": 46, "character": 3}}},
+          },
+{
+            "name": "make",
+            "kind": 12,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 44, "character": 4}, "end": {"line": 45, "character": 57}}},
+          },
+{
+            "name": "zzz",
+            "kind": 13,
+            "location": {"uri": "Complete.res", "range": {"start": {"line": 49, "character": 0}, "end": {"line": 49, "character": 12}}},
+          }
+]
+

server/src/server.ts

@@ -20,6 +20,7 @@ import { assert } from "console";
 import { fileURLToPath } from "url";
 import { ChildProcess } from "child_process";
 import { Location } from "vscode-languageserver";
+import { SymbolInformation } from "vscode-languageserver";
 
 // https://microsoft.github.io/language-server-protocol/specification#initialize
 // According to the spec, there could be requests before the 'initialize' request. Link in comment tells how to handle them.
@@ -297,6 +298,7 @@ function onMessage(msg: m.Message) {
           hoverProvider: true,
           definitionProvider: true,
           referencesProvider: true,
+          documentSymbolProvider: true,
           completionProvider: { triggerCharacters: [".", ">", "@", "~"] },
         },
       };
@@ -394,6 +396,20 @@ function onMessage(msg: m.Message) {
         // error: code and message set in case an exception happens during the definition request.
       };
       send(definitionResponse);
+    } else if (msg.method === p.DocumentSymbolRequest.method) {
+      // https://microsoft.github.io/language-server-protocol/specifications/specification-current/#textDocument_documentSymbol
+      let result:
+        | SymbolInformation[]
+        | null = utils.runAnalysisAfterSanityCheck(msg, (filePath) => [
+        "documentSymbol",
+        filePath,
+      ]);
+      let definitionResponse: m.ResponseMessage = {
+        jsonrpc: c.jsonrpcVersion,
+        id: msg.id,
+        result,
+      };
+      send(definitionResponse);
     } else if (msg.method === p.CompletionRequest.method) {
       let code = getOpenedFileContent(msg.params.textDocument.uri);
       let tmpname = utils.createFileInTempDir();