Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 22 additions & 15 deletions lsp/src/uri0.ml
Original file line number Diff line number Diff line change
Expand Up @@ -7,16 +7,21 @@ module Private = struct
let win32 = ref Sys.win32
end

type t = Uri_lexer.t =
type parsed = Uri_lexer.t =
{ scheme : string
; authority : string
; path : string
; query : string option
; fragment : string option
}

let query t = t.query
let fragment t = t.fragment
type t =
{ parsed : parsed
; original : string
}

let query t = t.parsed.query
let fragment t = t.parsed.fragment

let backslash_to_slash =
String.map ~f:(function
Expand All @@ -35,12 +40,7 @@ let is_drive_letter = function
| _ -> false
;;

let of_path path =
let path = if !Private.win32 then backslash_to_slash path else path in
Uri_lexer.of_path path
;;

let to_path { path; authority; scheme; _ } =
let to_path { parsed = { path; authority; scheme; _ }; _ } =
let len = String.length path in
let path =
if len = 0
Expand All @@ -56,8 +56,6 @@ let to_path { path; authority; scheme; _ } =
if !Private.win32 then slash_to_backslash path else path
;;

let of_string = Uri_lexer.of_string

let safe_chars =
let a = Array.make 256 false in
let always_safe =
Expand Down Expand Up @@ -92,7 +90,7 @@ let encode ?(allow_slash = false) s =
Buffer.contents buf
;;

let to_string { scheme; authority; path; query; fragment } =
let canonical_string { scheme; authority; path; query; fragment } =
let buff = Buffer.create 64 in
if not (String.is_empty scheme)
then (
Expand Down Expand Up @@ -141,8 +139,17 @@ let to_string { scheme; authority; path; query; fragment } =
Buffer.contents buff
;;

let of_string original = { parsed = Uri_lexer.of_string original; original }

let of_path path =
let path = if !Private.win32 then backslash_to_slash path else path in
let parsed = Uri_lexer.of_path path in
{ parsed; original = canonical_string parsed }
;;

let to_string t = t.original
let yojson_of_t t = `String (to_string t)
let t_of_yojson json = Json.Conv.string_of_yojson json |> of_string
let equal = ( = )
let compare (x : t) (y : t) = Stdlib.compare x y
let hash = Hashtbl.hash
let equal x y = String.equal x.original y.original
let compare x y = String.compare x.original y.original
let hash t = Hashtbl.hash t.original
6 changes: 6 additions & 0 deletions lsp/src/uri0.mli
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,15 @@ val hash : t -> int
(** Return the URI's filesystem path. Query and fragment components are ignored. *)
val to_path : t -> string

(** Construct a canonical file URI from a filesystem path. *)
val of_path : string -> t

(** Return the URI with the same spelling supplied to {!of_string} or decoded from JSON. *)
val to_string : t -> string

(** Parse a URI while preserving its exact spelling. *)
val of_string : string -> t

val query : t -> string option
val fragment : t -> string option

Expand Down
26 changes: 13 additions & 13 deletions lsp/test/uri_quickcheck_tests.ml
Original file line number Diff line number Diff line change
Expand Up @@ -114,8 +114,6 @@ let source ({ scheme; authority; path; query; fragment } : Case.t) =
^ suffix '#' fragment
;;

let canonical source = Uri.of_string source |> Uri.to_string

let uri_examples : Case.t list =
[ { scheme = File
; authority = []
Expand Down Expand Up @@ -163,29 +161,31 @@ let fail source label expected actual =
actual)
;;

let%expect_test "URI serialization reaches a fixed point" =
let%expect_test "URI string parsing preserves wire values" =
Test.run_exn
(module Case)
~examples:uri_examples
~f:(fun case ->
let source = source case in
let once = canonical source in
let twice = canonical once in
if not (String.equal once twice)
then fail source "URI serialization is not idempotent" once twice);
let serialized = Uri.of_string source |> Uri.to_string in
if not (String.equal source serialized)
then fail source "URI string parsing changed the URI" source serialized);
[%expect {| |}]
;;

let%expect_test "URI JSON serialization preserves canonical values" =
let%expect_test "URI JSON serialization preserves wire values" =
Test.run_exn
(module Case)
~examples:uri_examples
~f:(fun case ->
let source = source case |> canonical in
let uri = Uri.of_string source in
let round_trip = Uri.t_of_yojson (Uri.yojson_of_t uri) in
if not (Uri.equal uri round_trip)
then fail source "JSON round trip changed the URI" source (Uri.to_string round_trip));
let source = source case in
let serialized =
match Uri.t_of_yojson (`String source) |> Uri.yojson_of_t with
| `String serialized -> serialized
| _ -> assert false
in
if not (String.equal source serialized)
then fail source "JSON round trip changed the URI" source serialized);
[%expect {| |}]
;;

Expand Down
54 changes: 27 additions & 27 deletions lsp/test/uri_tests.ml
Original file line number Diff line number Diff line change
Expand Up @@ -80,9 +80,9 @@ let%expect_test "serialization disambiguates a path beginning with two slashes"
(Uri.to_string round_trip);
[%expect
{|
original: untitled:////Module.ml
serialized: untitled:////Module.ml
parsed serialization: untitled:////Module.ml
original: untitled:///%2FModule.ml
serialized: untitled:///%2FModule.ml
parsed serialization: untitled:///%2FModule.ml
|}]
;;

Expand Down Expand Up @@ -110,7 +110,7 @@ let%expect_test "serialization preserves a non-letter drive-like path" =
|}]
;;

let%expect_test "JSON URI serialization normalizes wire spelling" =
let%expect_test "JSON URI serialization preserves wire spelling" =
let encoded_slash = `String "file:///pro%2Fjects/test.ml" in
let literal_slash = `String "file:///pro/jects/test.ml" in
let print_normalized label input =
Expand All @@ -125,7 +125,7 @@ let%expect_test "JSON URI serialization normalizes wire spelling" =
print_normalized "literal slash" literal_slash;
[%expect
{|
encoded slash: "file:///pro%2Fjects/test.ml" -> "file:///pro/jects/test.ml"
encoded slash: "file:///pro%2Fjects/test.ml" -> "file:///pro%2Fjects/test.ml"
literal slash: "file:///pro/jects/test.ml" -> "file:///pro/jects/test.ml"
|}]
;;
Expand All @@ -139,7 +139,7 @@ let%expect_test "an unescaped Unicode URI query is preserved" =
[%expect
{|
query: search=😀&limit=1
serialized: file:///foo.ml?search%3D%F0%9F%98%80%26limit%3D1
serialized: file:///foo.ml?search=😀&limit=1
|}]
;;

Expand Down Expand Up @@ -319,7 +319,7 @@ let%expect_test "of_string -> to_path" =
|}]
;;

let%expect_test "of_string -> to_string" =
let%expect_test "JSON URI strings preserve their wire spelling" =
let test_of_string_to_string =
let test s =
let uri = Uri.t_of_yojson (`String s) in
Expand All @@ -343,28 +343,28 @@ let%expect_test "of_string -> to_string" =
[%expect
{|
Unix:
file://shares/pröjects/c%23/#l12 -> file://shares/pr%C3%B6jects/c%23/#l12
file://sh%c3%a4res/path -> file://sh%C3%A4res/path
untitled:c:/Users/jrieken/Code/abc.txt -> untitled:c%3A/Users/jrieken/Code/abc.txt
untitled:C:/Users/jrieken/Code/abc.txt -> untitled:c%3A/Users/jrieken/Code/abc.txt
/Users/jrieken/Code/_samples/18500/Mödel + Other Thîngß/model.js -> file:///Users/jrieken/Code/_samples/18500/M%C3%B6del%20%2B%20Other%20Th%C3%AEng%C3%9F/model.js
file:///c:/Source/Z%C3%BCrich%20or%20Zurich%20(%CB%88zj%CA%8A%C9%99r%C9%AAk,/Code/resources/app/plugins -> file:///c%3A/Source/Z%C3%BCrich%20or%20Zurich%20%28%CB%88zj%CA%8A%C9%99r%C9%AAk%2C/Code/resources/app/plugins
file:foo/bar -> file:///foo/bar
-> file:///
file://LöC%2FAL/host:8080/projects/ -> file://l%C3%B6c%2Fal/host%3A8080/projects/
file:///pro%2Fjects/ -> file:///pro/jects/
file://shares/pröjects/c%23/#l12 -> file://shares/pröjects/c%23/#l12
file://sh%c3%a4res/path -> file://sh%c3%a4res/path
untitled:c:/Users/jrieken/Code/abc.txt -> untitled:c:/Users/jrieken/Code/abc.txt
untitled:C:/Users/jrieken/Code/abc.txt -> untitled:C:/Users/jrieken/Code/abc.txt
/Users/jrieken/Code/_samples/18500/Mödel + Other Thîngß/model.js -> /Users/jrieken/Code/_samples/18500/Mödel + Other Thîngß/model.js
file:///c:/Source/Z%C3%BCrich%20or%20Zurich%20(%CB%88zj%CA%8A%C9%99r%C9%AAk,/Code/resources/app/plugins -> file:///c:/Source/Z%C3%BCrich%20or%20Zurich%20(%CB%88zj%CA%8A%C9%99r%C9%AAk,/Code/resources/app/plugins
file:foo/bar -> file:foo/bar
->
file://LöC%2FAL/host:8080/projects/ -> file://LöC%2FAL/host:8080/projects/
file:///pro%2Fjects/ -> file:///pro%2Fjects/
vscode://mount/test.ml -> vscode://mount/test.ml
Windows:
file://shares/pröjects/c%23/#l12 -> file://shares/pr%C3%B6jects/c%23/#l12
file://sh%c3%a4res/path -> file://sh%C3%A4res/path
untitled:c:/Users/jrieken/Code/abc.txt -> untitled:c%3A/Users/jrieken/Code/abc.txt
untitled:C:/Users/jrieken/Code/abc.txt -> untitled:c%3A/Users/jrieken/Code/abc.txt
/Users/jrieken/Code/_samples/18500/Mödel + Other Thîngß/model.js -> file:///Users/jrieken/Code/_samples/18500/M%C3%B6del%20%2B%20Other%20Th%C3%AEng%C3%9F/model.js
file:///c:/Source/Z%C3%BCrich%20or%20Zurich%20(%CB%88zj%CA%8A%C9%99r%C9%AAk,/Code/resources/app/plugins -> file:///c%3A/Source/Z%C3%BCrich%20or%20Zurich%20%28%CB%88zj%CA%8A%C9%99r%C9%AAk%2C/Code/resources/app/plugins
file:foo/bar -> file:///foo/bar
-> file:///
file://LöC%2FAL/host:8080/projects/ -> file://l%C3%B6c%2Fal/host%3A8080/projects/
file:///pro%2Fjects/ -> file:///pro/jects/
file://shares/pröjects/c%23/#l12 -> file://shares/pröjects/c%23/#l12
file://sh%c3%a4res/path -> file://sh%c3%a4res/path
untitled:c:/Users/jrieken/Code/abc.txt -> untitled:c:/Users/jrieken/Code/abc.txt
untitled:C:/Users/jrieken/Code/abc.txt -> untitled:C:/Users/jrieken/Code/abc.txt
/Users/jrieken/Code/_samples/18500/Mödel + Other Thîngß/model.js -> /Users/jrieken/Code/_samples/18500/Mödel + Other Thîngß/model.js
file:///c:/Source/Z%C3%BCrich%20or%20Zurich%20(%CB%88zj%CA%8A%C9%99r%C9%AAk,/Code/resources/app/plugins -> file:///c:/Source/Z%C3%BCrich%20or%20Zurich%20(%CB%88zj%CA%8A%C9%99r%C9%AAk,/Code/resources/app/plugins
file:foo/bar -> file:foo/bar
->
file://LöC%2FAL/host:8080/projects/ -> file://LöC%2FAL/host:8080/projects/
file:///pro%2Fjects/ -> file:///pro%2Fjects/
vscode://mount/test.ml -> vscode://mount/test.ml
|}]
;;
Expand Down
6 changes: 3 additions & 3 deletions ocaml-lsp-server/src/custom_requests/req_locate_types.ml
Original file line number Diff line number Diff line change
Expand Up @@ -159,12 +159,12 @@ let map_payload type_ result =
; result =
(match result with
| `Found (file, pos) ->
let uri = Option.map ~f:DocumentUri.of_string file
let uri = Option.map ~f:DocumentUri.of_path file
and pos = pos |> Position.of_lexical_position |> Option.value_exn in
`Found (uri, pos)
| (`Not_in_env _ | `Builtin _) as s -> s
| `Not_found (file, ty) -> `Not_found (DocumentUri.of_string file, ty)
| `File_not_found file -> `File_not_found (DocumentUri.of_string file))
| `Not_found (file, ty) -> `Not_found (DocumentUri.of_path file, ty)
| `File_not_found file -> `File_not_found (DocumentUri.of_path file))
}
;;

Expand Down
Loading