Source file Document_symbols.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
(*
 * SPDX-FileCopyrightText: 2024 The Forester Project Contributors AND The RedPRL Development Team
 *
 * SPDX-License-Identifier: GPL-3.0-or-later OR Apache-2.0 WITH LLVM-exception
 *
 *)

open Forester_prelude
open Forester_core
open Forester_compiler

open struct
  module L = Lsp.Types
  let pp_path = Resolver.Scope.pp_path
end

let compute (params : L.DocumentSymbolParams.t) =
  let uri = params.textDocument.uri in
  let Lsp_state.{forest; _} = Lsp_state.get () in
  match State.get_code forest @@ URI_scheme.lsp_uri_to_uri ~base: forest.config.url uri with
  | None ->
    URI.Tbl.iter (fun uri _ -> Logs.debug (fun m -> m "%a" URI.pp uri)) forest.index;
    Logs.debug (fun m -> m "%s" (Lsp.Uri.to_string uri));
    Logs.debug (fun m -> m "%a" URI.pp (URI_scheme.lsp_uri_to_uri ~base: forest.config.url uri));
    assert false
  | Some {nodes; _} ->
    let symbols =
      let@ {loc; value} = List.filter_map @~ nodes in
      let open Code in
      let range = Lsp_shims.Loc.lsp_range_of_range loc in
      let selectionRange = range in
      match value with
      | Subtree (addr, _) ->
        let name = Option.value ~default: "anonymous" addr in
        let range = Lsp_shims.Loc.lsp_range_of_range loc in
        (* TODO: What should the symbol kind of a subtree be? *)
        Option.some @@ L.DocumentSymbol.create ~name ~range ~selectionRange ~kind: Namespace ()
      | Object {self; _} ->
        let name = Option.value ~default: "anonymous" self in
        Option.some @@ L.DocumentSymbol.create ~name ~range ~selectionRange ~kind: Object ()
      | Def (name, _, _) ->
        let name = Format.asprintf "%a" pp_path name in
        Option.some @@ L.DocumentSymbol.create ~name ~range ~selectionRange ~kind: Function ()
      | Namespace (name, _) ->
        let name = Format.asprintf "%a" pp_path name in
        Option.some @@ L.DocumentSymbol.create ~name ~range ~selectionRange ~kind: Namespace ()
      | Ident path ->
        let name = Format.asprintf "%a" pp_path path in
        Option.some @@ L.DocumentSymbol.create ~name ~range ~selectionRange ~kind: Constructor ()
      | Let (path, _, _) ->
        let name = Format.asprintf "%a" pp_path path in
        Option.some @@ L.DocumentSymbol.create ~name ~range ~selectionRange ~kind: Constructor ()
      | Xml_ident (pfx, ident) ->
        let name =
          match pfx with
          | None -> Format.asprintf "<%s>" ident
          | Some pfx -> Format.asprintf "<%s:%s>" pfx ident
        in
        Option.some @@ L.DocumentSymbol.create ~name ~range ~selectionRange ~kind: Constructor ()
      | Hash_ident _ ->
        Option.some @@ L.DocumentSymbol.create ~name: "(hash)" ~range ~selectionRange ~kind: Constant ()
      | Text _
      | Verbatim _
      | Group (_, _)
      | Math (_, _)
      | Open _
      | Scope _
      | Put (_, _)
      | Default (_, _)
      | Get _
      | Fun (_, _)
      | Patch _
      | Call (_, _)
      | Import (_, _)
      | Decl_xmlns (_, _)
      | Alloc _
      | Dx_sequent (_, _)
      | Dx_query (_, _, _)
      | Dx_prop (_, _)
      | Dx_var _
      | Dx_const_content _
      | Dx_const_uri _
      | Comment _
      | Error _ ->
        None
    in
    Some (`DocumentSymbol symbols)