Source file Workspace_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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(*
 * 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 Forester_frontend

open struct
  module L = Lsp.Types
  module Unit_map = Forester_compiler.Expand.Unit_map
  let (let*) = Option.bind
end

let location_of_range loc =
  let* view = Option.map Range.view loc in
  match view with
  | `End_of_file {source; _}
  | `Range ({source; _}, _) ->
    match source with
    | `String _ | `File "" -> None
    | `File path ->
      let uri = Lsp.Uri.of_path path in
      Option.some @@ L.Location.{range = Lsp_shims.Loc.lsp_range_of_range loc; uri;}

let exports_to_symbols (exports : Tree.exports) =
  let@ path, (data, range) = List.filter_map @~ List.of_seq @@ Trie.to_seq exports in
  let@ location = Option.map @~ location_of_range range in
  match data with
  | Xmlns _ ->
    L.SymbolInformation.create
      ~kind: Namespace
      ~location
      ~name: (Format.asprintf "%a" Resolver.Scope.pp_path path)
      ()
  | Term syn ->
    let kind =
      match (List.hd syn).value with
      | Syn.Text _ -> L.SymbolKind.String
      | Syn.Verbatim _ -> String
      | Syn.Fun (_, _) -> Function
      | Syn.Object _ -> Object
      | Syn.Group (_, _)
      | Syn.Math (_, _)
      | Syn.Link _
      | Syn.Subtree (_, _)
      | Syn.Var _
      | Syn.Sym _
      | Syn.Put (_, _, _)
      | Syn.Default (_, _, _)
      | Syn.Get _
      | Syn.Xml_tag (_, _, _)
      | Syn.TeX_cs _
      | Syn.Unresolved_ident _
      | Syn.Prim _
      | Syn.Patch _
      | Syn.Call (_, _)
      | Syn.Results_of_query
      | Syn.Transclude
      | Syn.Embed_tex
      | Syn.Ref
      | Syn.Title
      | Syn.Parent
      | Syn.Taxon
      | Syn.Meta
      | Syn.Attribution (_, _)
      | Syn.Tag _
      | Syn.Date
      | Syn.Number
      | Syn.Dx_sequent (_, _)
      | Syn.Dx_query (_, _, _)
      | Syn.Dx_prop (_, _)
      | Syn.Dx_var _
      | Syn.Dx_const (_, _)
      | Syn.Dx_execute
      | Syn.Route_asset
      | Syn.Syndicate_current_tree_as_atom_feed
      | Syn.Syndicate_query_as_json_blob
      | Syn.Current_tree ->
        Constant
    in
    L.SymbolInformation.create
      ~kind
      ~location
      ~name: (Format.asprintf "%a" Resolver.Scope.pp_path path)
      ()

let compute (_params : L.WorkspaceSymbolParams.t) : _ =
  let Lsp_state.{forest; _} = Lsp_state.get () in
  let render = Plain_text_client.string_of_content ~forest in
  Option.some @@
    let@ _, item = List.concat_map @~ List.of_seq @@ State.to_seq forest in
    let title =
      match Tree.to_article item with
      | Some {frontmatter; _} ->
        render (State.get_expanded_title frontmatter forest)
      | None -> "untitled"
    in
    let units =
      List.concat @@
      Option.to_list @@
      Option.map exports_to_symbols @@ Tree.get_units item
    in
    let lsp_uri = Option.map Lsp.Text_document.documentUri @@ Tree.to_doc item in
    let file_symbol =
      Option.to_list @@
        let@ uri = Option.map @~ lsp_uri in
        let location =
          L.Location.{
            range = L.Range.{
              end_ = {character = 0; line = 0;};
              start = {character = 0; line = 0;};
            };
            uri;
          }
        in
        L.SymbolInformation.create ~kind: File ~location ~name: title ()
    in
    units @ file_symbol