forked from
jonmsterling.com/ocaml-forester
ocaml
Consolidate URI_scheme into URI
+69
-130
+1
-1
lib/compiler/Cache.ml
+1
-1
lib/compiler/Cache.ml
···
93
93
(dirs : Eio.Fs.dir_ty Eio.Path.t List.t) : Eio.Fs.dir_ty Eio.Path.t Seq.t =
94
94
let@ path = Seq.filter_map @~ Dir_scanner.scan_directories dirs in
95
95
let path_str = Eio.Path.native_exn path in
96
-
let uri = URI_scheme.path_to_uri ~base:config.url path_str in
96
+
let uri = URI.path_to_uri ~base:config.url path_str in
97
97
let last_modified = Eio.Path.(stat ~follow:true path).mtime in
98
98
(* "flipped" bind, by default returns the current path. IDK, I am being lazy. *)
99
99
let ( let* ) o f = match o with None -> Some path | Some v -> f v in
+1
-1
lib/compiler/Dir_scanner.ml
+1
-1
lib/compiler/Dir_scanner.ml
+3
-5
lib/compiler/Driver.ml
+3
-5
lib/compiler/Driver.ml
···
33
33
assert (Eio.Path.is_directory tree_dir);
34
34
let@ tree = Seq.iter @~ Phases.load tree_dir in
35
35
let lsp_uri = Tree.lsp_uri tree in
36
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in
36
+
let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in
37
37
URI.Tbl.replace forest.resolver uri (Lsp.Uri.to_path lsp_uri);
38
38
forest.={uri} <- Tree tree
39
-
(*lsp_documents ;*)
40
-
(*Logs.debug (fun m -> m "loaded %d trees" (Seq.length lsp_documents))*)
41
39
in
42
40
(Parse_all, forest)
43
41
| Parse_all ->
···
120
118
| Load_tree path ->
121
119
let doc = Imports.load_tree path in
122
120
let lsp_uri = Tree.lsp_uri doc in
123
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in
121
+
let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in
124
122
forest.={uri} <- Tree doc;
125
123
(Parse lsp_uri, forest)
126
124
| Parse uri ->
127
125
Logs.debug (fun m -> m "Reparsing");
128
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url uri in
126
+
let uri = URI.of_lsp_uri ~base:forest.config.url uri in
129
127
begin match Option.bind forest.={uri} Tree.to_doc with
130
128
| Some doc -> begin
131
129
match Parse.parse_document doc with
+6
-10
lib/compiler/Phases.ml
+6
-10
lib/compiler/Phases.ml
···
28
28
let@ uri, result =
29
29
List.partition_map
30
30
@~
31
-
let@ uri, Tree tree = List.filter_map @~ trees in
32
-
match tree with
33
-
| {phase; tree; _} -> begin
34
-
match phase with
35
-
| Parsed | Expanded | Evaluated -> None
36
-
| Loaded -> begin Some (uri, Parse.parse_document tree) end
37
-
end
31
+
let@ uri, tree = List.filter_map @~ trees in
32
+
match Tree.to_doc tree with
33
+
| Some document -> Some (uri, Parse.parse_document document)
34
+
| None -> None
38
35
in
39
36
match result with Ok tree -> Right (uri, tree) | Error e -> Left (uri, e)
40
37
41
38
let reparse (doc : Lsp.Text_document.t) (forest : State.t) =
42
39
Logs.debug (fun m -> m "reparsing");
43
40
let uri =
44
-
URI_scheme.lsp_uri_to_uri ~base:forest.config.url
45
-
@@ Lsp.Text_document.documentUri doc
41
+
URI.of_lsp_uri ~base:forest.config.url @@ Lsp.Text_document.documentUri doc
46
42
in
47
43
begin match Parse.parse_document doc with
48
44
| Ok code ->
···
103
99
match guess_uri (Error.tex_range tex_error) with
104
100
| None -> assert false
105
101
| Some uri ->
106
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url uri in
102
+
let uri = URI.of_lsp_uri ~base:forest.config.url uri in
107
103
forest.?{uri} <- [Error.of_tex_error tex_error]
108
104
end
109
105
end
+1
-1
lib/compiler/URI_util.ml
+1
-1
lib/compiler/URI_util.ml
···
29
29
@@
30
30
let@ uri = Seq.filter_map @~ addrs in
31
31
if URI.host config.url = URI.host uri then
32
-
let@ prefix', key = Option.bind @@ URI_scheme.split_addr uri in
32
+
let@ prefix', key = Option.bind @@ URI.split_addr uri in
33
33
if prefix = prefix' then Some key else None
34
34
else None
35
35
in
+1
-1
lib/compiler/test/Test_compiler.ml
+1
-1
lib/compiler/test/Test_compiler.ml
···
108
108
|> Driver.run_until_done Load_all_configured_dirs
109
109
in
110
110
let reparse_addr = "t8.tree" in
111
-
let reparse_uri = URI_scheme.path_to_uri ~base:config.url reparse_addr in
111
+
let reparse_uri = URI.path_to_uri ~base:config.url reparse_addr in
112
112
let vtx = T.Uri_vertex reparse_uri in
113
113
Alcotest.(check int)
114
114
"Number of vertices before reparsing" 8
-1
lib/core/Forester_core.ml
-1
lib/core/Forester_core.ml
+27
-1
lib/core/URI.ml
+27
-1
lib/core/URI.ml
···
97
97
98
98
let last_segment = String.split_on_char '/' >>> List.rev >>> List.hd
99
99
100
-
let of_document ~(base : t) =
100
+
let name (uri : t) : string option =
101
+
uri |> path_components
102
+
|> List.filter (fun x -> not (x = ""))
103
+
|> List.rev |> List.nth_opt @~ 0
104
+
105
+
let split_addr (uri : t) : (string option * int) option =
106
+
let@ name = Option.bind @@ name uri in
107
+
(* primitively check for address of form YYYY-MM-DD *)
108
+
let date_regex =
109
+
Str.regexp {|^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$|}
110
+
in
111
+
if Str.string_match date_regex name 0 then None
112
+
else
113
+
match String.rindex_opt name '-' with
114
+
| Some i ->
115
+
let prefix = String.sub name 0 i
116
+
and suffix = String.sub name (i + 1) (String.length name - i - 1) in
117
+
let@ key = Option.map @~ BaseN.Base36.int_of_string suffix in
118
+
(Some prefix, key)
119
+
| _ ->
120
+
let@ key = Option.map @~ BaseN.Base36.int_of_string name in
121
+
(None, key)
122
+
123
+
let of_lsp_uri ~(base : t) =
101
124
Lsp.Uri.to_path >>> Filename.chop_extension >>> last_segment
102
125
>>> named_uri ~base
126
+
127
+
let path_to_uri ~(base : t) =
128
+
last_segment >>> Filename.chop_extension >>> named_uri ~base
+4
lib/core/URI.mli
+4
lib/core/URI.mli
-41
lib/core/URI_scheme.ml
-41
lib/core/URI_scheme.ml
···
1
-
(*
2
-
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
-
*
4
-
* SPDX-License-Identifier: GPL-3.0-or-later
5
-
*)
6
-
7
-
open Forester_prelude
8
-
9
-
let name (uri : URI.t) : string option =
10
-
uri
11
-
|> URI.path_components
12
-
|> List.filter (fun x -> not (x = ""))
13
-
|> List.rev
14
-
|> List.nth_opt @~ 0
15
-
16
-
let split_addr (uri : URI.t) : (string option * int) option =
17
-
let@ name = Option.bind @@ name uri in
18
-
(* primitively check for address of form YYYY-MM-DD *)
19
-
let date_regex =
20
-
Str.regexp {|^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$|}
21
-
in
22
-
if Str.string_match date_regex name 0 then None
23
-
else
24
-
match String.rindex_opt name '-' with
25
-
| Some i ->
26
-
let prefix = String.sub name 0 i
27
-
and suffix = String.sub name (i + 1) (String.length name - i - 1) in
28
-
let@ key = Option.map @~ BaseN.Base36.int_of_string suffix in
29
-
(Some prefix, key)
30
-
| _ ->
31
-
let@ key = Option.map @~ BaseN.Base36.int_of_string name in
32
-
(None, key)
33
-
34
-
let lsp_uri_to_uri ~(base : URI.t) =
35
-
Lsp.Uri.to_path
36
-
>>> Filename.chop_extension
37
-
>>> URI.last_segment
38
-
>>> URI.named_uri ~base
39
-
40
-
let path_to_uri ~(base : URI.t) =
41
-
URI.last_segment >>> Filename.chop_extension >>> URI.named_uri ~base
-10
lib/core/URI_scheme.mli
-10
lib/core/URI_scheme.mli
···
1
-
(*
2
-
* SPDX-FileCopyrightText: 2024 The Forester Project Contributors
3
-
*
4
-
* SPDX-License-Identifier: GPL-3.0-or-later
5
-
*)
6
-
7
-
val lsp_uri_to_uri : base:URI.t -> Lsp.Uri.t -> URI.t
8
-
val split_addr : URI.t -> (string option * int) option
9
-
val path_to_uri : base:URI.t -> string -> URI.t
10
-
val name : URI.t -> string option
+5
-13
lib/core/test/Test_uri_util.ml
+5
-13
lib/core/test/Test_uri_util.ml
···
9
9
let test_split_addr_1 () =
10
10
let uri = URI.of_string_exn "forest://test/foo-bar" in
11
11
Alcotest.(check @@ option @@ pair (option string) int)
12
-
""
13
-
(URI_scheme.split_addr uri)
14
-
None
12
+
"" (URI.split_addr uri) None
15
13
16
14
let test_split_addr_2 () =
17
15
let uri = URI.of_string_exn "forest://test/foo-1234" in
18
16
Alcotest.(check @@ option @@ pair (option string) int)
19
-
""
20
-
(URI_scheme.split_addr uri)
17
+
"" (URI.split_addr uri)
21
18
(Some (Some "foo", 49360))
22
19
23
20
let test_split_addr_3 () =
24
21
let uri = URI.of_string_exn "forest://test/1976-02-11" in
25
22
Alcotest.(check @@ option @@ pair (option string) int)
26
-
""
27
-
(URI_scheme.split_addr uri)
28
-
None
23
+
"" (URI.split_addr uri) None
29
24
30
25
let test_split_addr_4 () =
31
26
let uri = URI.of_string_exn "forest://test/asdf" in
32
27
Alcotest.(check @@ option @@ pair (option string) int)
33
-
""
34
-
(URI_scheme.split_addr uri)
35
-
None
28
+
"" (URI.split_addr uri) None
36
29
37
30
let test_split_addr_5 () =
38
31
let uri = URI.of_string_exn "forest://test/ASDF" in
39
32
Alcotest.(check @@ option @@ pair (option string) int)
40
-
""
41
-
(URI_scheme.split_addr uri)
33
+
"" (URI.split_addr uri)
42
34
(Some (None, 503331))
43
35
44
36
let () =
+3
-5
lib/language_server/Call_hierarchy.ml
+3
-5
lib/language_server/Call_hierarchy.ml
···
31
31
in
32
32
match item with
33
33
| {uri; _} ->
34
-
let uri = URI_scheme.path_to_uri ~base:config.url (Lsp.Uri.to_path uri) in
34
+
let uri = URI.path_to_uri ~base:config.url (Lsp.Uri.to_path uri) in
35
35
let vertex = T.Uri_vertex uri in
36
36
let run_query = Forest.run_datalog_query forest.graphs in
37
37
let fwdlinks = run_query @@ Builtin_queries.fwdlinks_datalog vertex in
···
61
61
in
62
62
match item with
63
63
| {uri; _} ->
64
-
let uri = URI_scheme.path_to_uri ~base:config.url (Lsp.Uri.to_path uri) in
64
+
let uri = URI.path_to_uri ~base:config.url (Lsp.Uri.to_path uri) in
65
65
let vertex = T.Uri_vertex uri in
66
66
let run_query = Forest.run_datalog_query forest.graphs in
67
67
let backlinks = run_query @@ Builtin_queries.backlinks_datalog vertex in
···
78
78
let Lsp_state.{forest; _} = Lsp_state.get () in
79
79
match params with
80
80
| {position; textDocument; _} -> (
81
-
let uri =
82
-
URI_scheme.lsp_uri_to_uri ~base:forest.config.url textDocument.uri
83
-
in
81
+
let uri = URI.of_lsp_uri ~base:forest.config.url textDocument.uri in
84
82
match Imports.resolve_uri_to_code ~forest uri with
85
83
| Error _ -> None
86
84
| Ok tree ->
+3
-3
lib/language_server/Completion.ml
+3
-3
lib/language_server/Completion.ml
···
297
297
Some (`String content)
298
298
in
299
299
let@ uri = Option.bind @@ frontmatter.uri in
300
-
let@ uri_name = Option.bind @@ URI_scheme.name uri in
300
+
let@ uri_name = Option.bind @@ URI.name uri in
301
301
let title_text = render title in
302
302
Option.some
303
303
@@ L.CompletionItem.create ?documentation
···
330
330
({context; position; textDocument = {uri}; _} : L.CompletionParams.t) : _ =
331
331
Logs.debug (fun m ->
332
332
m "when computing completions for %s" (Lsp.Uri.to_string uri));
333
-
let triggerCharacter =
333
+
let _triggerCharacter =
334
334
match context with
335
335
| Some {triggerCharacter; _} -> triggerCharacter
336
336
| None -> None
···
338
338
let Lsp_state.{forest; _} = Lsp_state.get () in
339
339
let config = forest.config in
340
340
let base = config.url in
341
-
let uri = URI_scheme.lsp_uri_to_uri ~base uri in
341
+
let uri = URI.of_lsp_uri ~base uri in
342
342
let* tree = forest.={uri} in
343
343
let* code = Tree.to_code tree in
344
344
let completion_types = completion_types ~position tree in
+1
-3
lib/language_server/Definitions.ml
+1
-3
lib/language_server/Definitions.ml
···
16
16
17
17
let compute (params : L.DefinitionParams.t) =
18
18
let Lsp_state.{forest; _} = Lsp_state.get () in
19
-
let uri =
20
-
URI_scheme.lsp_uri_to_uri ~base:forest.config.url params.textDocument.uri
21
-
in
19
+
let uri = URI.of_lsp_uri ~base:forest.config.url params.textDocument.uri in
22
20
let@ tree = Option.bind forest.={uri} in
23
21
let@ nodes = Option.bind Tree.(Option.map nodes @@ to_code tree) in
24
22
let@ {value = str; _} =
+1
-1
lib/language_server/Diagnostics.ml
+1
-1
lib/language_server/Diagnostics.ml
···
22
22
let compute (document : Lsp.Text_document.t) =
23
23
let Lsp_state.{forest; _} = Lsp_state.get () in
24
24
let lsp_uri = Lsp.Text_document.documentUri document in
25
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in
25
+
let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in
26
26
match forest.?{uri} with
27
27
| [] ->
28
28
Eio.traceln "Clearing diagnostics for %s" (Lsp.Uri.to_path lsp_uri);
+2
-9
lib/language_server/Did_change.ml
+2
-9
lib/language_server/Did_change.ml
···
17
17
let compute (params : L.DidChangeTextDocumentParams.t) =
18
18
let Lsp_state.{forest; _} = Lsp_state.get () in
19
19
let lsp_uri = params.textDocument.uri in
20
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in
20
+
let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in
21
21
let@ tree = Option.iter @~ forest.={uri} in
22
22
match Tree.to_doc tree with
23
-
| None ->
24
-
Logs.debug (fun m ->
25
-
m
26
-
"Did_change.compute fatal error, could not find tree with uri %a \
27
-
from LSP uri %s"
28
-
URI.pp uri
29
-
(Lsp.Uri.to_string lsp_uri));
30
-
assert false
23
+
| None -> assert false
31
24
| Some doc ->
32
25
let updated =
33
26
Tree.of_doc
+1
-1
lib/language_server/Did_create_files.ml
+1
-1
lib/language_server/Did_create_files.ml
···
20
20
begin
21
21
let@ {uri} = List.iter @~ files in
22
22
let lsp_uri = L.DocumentUri.of_string uri in
23
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in
23
+
let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in
24
24
let path = Eio.Path.(env#fs / L.DocumentUri.to_path lsp_uri) in
25
25
let doc = Imports.load_tree path in
26
26
forest.={uri} <- Tree doc
+1
-1
lib/language_server/Did_open.ml
+1
-1
lib/language_server/Did_open.ml
···
18
18
let path = Lsp.Uri.to_path lsp_uri in
19
19
let Lsp_state.{forest; _} = Lsp_state.get () in
20
20
let document = Lsp.Text_document.make ~position_encoding:`UTF16 params in
21
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url lsp_uri in
21
+
let uri = URI.of_lsp_uri ~base:forest.config.url lsp_uri in
22
22
forest.={uri} <-
23
23
Tree {tree = document; source = Some (`File path); phase = Loaded};
24
24
Lsp_state.modify (fun ({forest; _} as lsp_state) ->
+1
-4
lib/language_server/Document_link.ml
+1
-4
lib/language_server/Document_link.ml
···
24
24
let config = forest.config in
25
25
let Lsp_state.{forest; _} = Lsp_state.get () in
26
26
let links =
27
-
let uri =
28
-
URI_scheme.lsp_uri_to_uri ~base:config.url params.textDocument.uri
29
-
in
30
-
(* match Imports.resolve_uri_to_code forest uri with *)
27
+
let uri = URI.of_lsp_uri ~base:config.url params.textDocument.uri in
31
28
match Option.bind forest.={uri} Tree.to_code with
32
29
| None -> []
33
30
| Some tree -> (
+1
-4
lib/language_server/Document_symbols.ml
+1
-4
lib/language_server/Document_symbols.ml
···
19
19
[> `DocumentSymbol of L.DocumentSymbol.t list] option =
20
20
let uri = params.textDocument.uri in
21
21
let Lsp_state.{forest; _} = Lsp_state.get () in
22
-
match
23
-
State.get_code forest
24
-
@@ URI_scheme.lsp_uri_to_uri ~base:forest.config.url uri
25
-
with
22
+
match State.get_code forest @@ URI.of_lsp_uri ~base:forest.config.url uri with
26
23
| None -> assert false
27
24
| Some {tree; _} ->
28
25
let symbols : L.DocumentSymbol.t list =
+1
-3
lib/language_server/Highlight.ml
+1
-3
lib/language_server/Highlight.ml
···
15
15
16
16
let compute (params : L.DocumentHighlightParams.t) =
17
17
let Lsp_state.{forest; _} = Lsp_state.get () in
18
-
let uri =
19
-
URI_scheme.lsp_uri_to_uri ~base:forest.config.url params.textDocument.uri
20
-
in
18
+
let uri = URI.of_lsp_uri ~base:forest.config.url params.textDocument.uri in
21
19
let@ tree = Option.map @~ State.get_code forest uri in
22
20
let@ Range.{range; value} = List.filter_map @~ Tree.nodes tree in
23
21
let@ range = Option.map @~ range in
+1
-3
lib/language_server/Hover.ml
+1
-3
lib/language_server/Hover.ml
···
21
21
let compute ({position; textDocument; _} : L.HoverParams.t) =
22
22
let Lsp_state.{forest; _} = Lsp_state.get () in
23
23
let render = Plain_text_client.string_of_content ~forest in
24
-
let uri =
25
-
URI_scheme.lsp_uri_to_uri ~base:forest.config.url textDocument.uri
26
-
in
24
+
let uri = URI.of_lsp_uri ~base:forest.config.url textDocument.uri in
27
25
let@ content =
28
26
Option.map
29
27
@~
+1
-3
lib/language_server/Inlay_hint.ml
+1
-3
lib/language_server/Inlay_hint.ml
···
49
49
let compute (params : L.InlayHintParams.t) : L.InlayHint.t list option =
50
50
let Lsp_state.{forest; _} = Lsp_state.get () in
51
51
let config = forest.config in
52
-
let uri =
53
-
URI_scheme.lsp_uri_to_uri ~base:config.url params.textDocument.uri
54
-
in
52
+
let uri = URI.of_lsp_uri ~base:config.url params.textDocument.uri in
55
53
let@ {tree = {nodes; _}; _} =
56
54
Option.map @~ Option.bind forest.={uri} Tree.to_syn
57
55
in
+1
-1
lib/language_server/Publish.ml
+1
-1
lib/language_server/Publish.ml
···
38
38
in
39
39
let source =
40
40
let Lsp_state.{forest; _} = Lsp_state.get () in
41
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url uri in
41
+
let uri = URI.of_lsp_uri ~base:forest.config.url uri in
42
42
let@ doc =
43
43
Option.map @~ Option.bind (State.find_opt forest uri) Tree.to_doc
44
44
in
+2
-4
lib/language_server/Semantic_tokens.ml
+2
-4
lib/language_server/Semantic_tokens.ml
···
267
267
let tokenize_document (identifier : L.TextDocumentIdentifier.t) :
268
268
L.SemanticTokens.t option =
269
269
let Lsp_state.{forest; _} = Lsp_state.get () in
270
-
let uri = URI_scheme.lsp_uri_to_uri ~base:forest.config.url identifier.uri in
270
+
let uri = URI.of_lsp_uri ~base:forest.config.url identifier.uri in
271
271
Result.to_option
272
272
@@
273
273
let@ tree = Result.map @~ Imports.resolve_uri_to_code ~forest uri in
···
283
283
let tokenize_document_delta (textDocument : L.TextDocumentIdentifier.t) :
284
284
L.SemanticTokensDelta.t option =
285
285
let Lsp_state.{forest; _} = Lsp_state.get () in
286
-
let uri =
287
-
URI_scheme.lsp_uri_to_uri ~base:forest.config.url textDocument.uri
288
-
in
286
+
let uri = URI.of_lsp_uri ~base:forest.config.url textDocument.uri in
289
287
Result.to_option
290
288
@@
291
289
let@ tree = Result.map @~ Imports.resolve_uri_to_code ~forest uri in