diff --git a/lsp/src/uri0.ml b/lsp/src/uri0.ml index e69f8d0ca..73853bb6d 100644 --- a/lsp/src/uri0.ml +++ b/lsp/src/uri0.ml @@ -7,7 +7,7 @@ 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 @@ -15,8 +15,13 @@ type t = Uri_lexer.t = ; 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 @@ -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 @@ -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 = @@ -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 ( @@ -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 diff --git a/lsp/src/uri0.mli b/lsp/src/uri0.mli index 44452925d..7099d5053 100644 --- a/lsp/src/uri0.mli +++ b/lsp/src/uri0.mli @@ -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 diff --git a/lsp/test/uri_quickcheck_tests.ml b/lsp/test/uri_quickcheck_tests.ml index 3d998bed2..4fdc7f817 100644 --- a/lsp/test/uri_quickcheck_tests.ml +++ b/lsp/test/uri_quickcheck_tests.ml @@ -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 = [] @@ -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 {| |}] ;; diff --git a/lsp/test/uri_tests.ml b/lsp/test/uri_tests.ml index bffa16f73..5f4bf47cf 100644 --- a/lsp/test/uri_tests.ml +++ b/lsp/test/uri_tests.ml @@ -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 |}] ;; @@ -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 = @@ -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" |}] ;; @@ -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 |}] ;; @@ -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 @@ -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 |}] ;; diff --git a/ocaml-lsp-server/src/custom_requests/req_locate_types.ml b/ocaml-lsp-server/src/custom_requests/req_locate_types.ml index a4d1e4f05..a8564e770 100644 --- a/ocaml-lsp-server/src/custom_requests/req_locate_types.ml +++ b/ocaml-lsp-server/src/custom_requests/req_locate_types.ml @@ -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)) } ;;