diff --git a/CHANGES.md b/CHANGES.md index 1d776ac1a..83169840b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,8 @@ - Fix a bad interaction between inferred interfaces and promotion code actions in watch mode (#753) +- Fix URI parsing (#739 fixes #471 and #459) + # 1.12.2 ## Fixes diff --git a/dune-project b/dune-project index b477b4d89..74beea9a5 100644 --- a/dune-project +++ b/dune-project @@ -48,6 +48,7 @@ possible and does not make any assumptions about IO. (description "An LSP server for OCaml.") (depends yojson + uri (re (>= 1.5.0)) (ppx_yojson_conv_lib (>= "v0.14")) dune-rpc diff --git a/lsp/src/dune b/lsp/src/dune index 35ffe9b25..56813b4bc 100644 --- a/lsp/src/dune +++ b/lsp/src/dune @@ -3,7 +3,7 @@ (library (name lsp) (public_name lsp) - (libraries jsonrpc ppx_yojson_conv_lib dyn uutf yojson) + (libraries jsonrpc ppx_yojson_conv_lib dyn uutf yojson uri) (lint (pps ppx_yojson_conv))) diff --git a/lsp/src/import.ml b/lsp/src/import.ml index 237c9a8ed..4f0755da1 100644 --- a/lsp/src/import.ml +++ b/lsp/src/import.ml @@ -18,6 +18,8 @@ module String = struct let index = index_opt + let is_empty s = length s = 0 + let rec check_prefix s ~prefix len i = i = len || (s.[i] = prefix.[i] && check_prefix s ~prefix len (i + 1)) @@ -32,6 +34,9 @@ module String = struct let prefix_len = length prefix in len >= prefix_len && check_prefix s ~prefix prefix_len 0 + let add_prefix_if_not_exists s ~prefix = + if is_prefix s ~prefix then s else prefix ^ s + let next_occurrence ~pattern text from = let plen = String.length pattern in let last = String.length text - plen in diff --git a/lsp/src/uri0.ml b/lsp/src/uri0.ml index 605bc10f1..f5e0a8156 100644 --- a/lsp/src/uri0.ml +++ b/lsp/src/uri0.ml @@ -1,3 +1,8 @@ +(* This module is based on the [vscode-uri] implementation: + https://github.com/microsoft/vscode-uri/blob/main/src/uri.ts. It only + supports scheme, authority and path. Query, port and fragment are not + implemented *) + open Import module Private = struct @@ -5,27 +10,100 @@ module Private = struct end type t = Uri_lexer.t = - { scheme : string option + { scheme : string ; authority : string ; path : string } -let t_of_yojson json = Json.Conv.string_of_yojson json |> Uri_lexer.of_string +let backslash_to_slash = + String.map ~f:(function + | '\\' -> '/' + | c -> c) + +let slash_to_backslash = + String.map ~f:(function + | '/' -> '\\' + | c -> c) + +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 path = + let len = String.length path in + if len = 0 then "/" + else + let buff = Buffer.create 64 in + (if (not (String.is_empty authority)) && len > 1 && scheme = "file" then ( + Buffer.add_string buff "//"; + Buffer.add_string buff authority; + Buffer.add_string buff path) + else if len < 3 then Buffer.add_string buff path + else + let c0 = path.[0] in + let c1 = path.[1] in + let c2 = path.[2] in + if + c0 = '/' + && ((c1 >= 'A' && c1 <= 'Z') || (c1 >= 'a' && c1 <= 'z')) + && c2 = ':' + then ( + Buffer.add_char buff (Char.lowercase_ascii c1); + Buffer.add_substring buff path 2 (String.length path - 2)) + else Buffer.add_string buff path); + Buffer.contents buff + in + if !Private.win32 then slash_to_backslash path else path + +let of_string = Uri_lexer.of_string + +let encode ?(allow_slash = false) s = + let allowed_chars = if allow_slash then "/" else "" in + Uri.pct_encode ~component:(`Custom (`Generic, allowed_chars, "")) s let to_string { scheme; authority; path } = - let b = Buffer.create 64 in - scheme - |> Option.iter (fun s -> - Buffer.add_string b s; - Buffer.add_char b ':'); - Buffer.add_string b "//"; - Buffer.add_string b authority; - if not (String.is_prefix path ~prefix:"/") then Buffer.add_char b '/'; - Buffer.add_string b path; - Buffer.contents b + let buff = Buffer.create 64 in + + if not (String.is_empty scheme) then ( + Buffer.add_string buff scheme; + Buffer.add_char buff ':'); + + if authority = "file" || scheme = "file" then Buffer.add_string buff "//"; + + (*TODO: implement full logic: + https://github.com/microsoft/vscode-uri/blob/96acdc0be5f9d5f2640e1c1f6733bbf51ec95177/src/uri.ts#L605 *) + (if not (String.is_empty authority) then + let s = String.lowercase_ascii authority in + Buffer.add_string buff (encode s)); + + (if not (String.is_empty path) then + let encode = encode ~allow_slash:true in + let encoded_colon = "%3A" in + let len = String.length path in + if len >= 3 && path.[0] = '/' && path.[2] = ':' then ( + let drive_letter = Char.lowercase_ascii path.[1] in + if drive_letter >= 'a' && drive_letter <= 'z' then ( + Buffer.add_char buff '/'; + Buffer.add_char buff drive_letter; + Buffer.add_string buff encoded_colon; + let s = String.sub path ~pos:3 ~len:(len - 3) in + Buffer.add_string buff (encode s))) + else if len >= 2 && path.[1] = ':' then ( + let drive_letter = Char.lowercase_ascii path.[0] in + if drive_letter >= 'a' && drive_letter <= 'z' then ( + Buffer.add_char buff drive_letter; + Buffer.add_string buff encoded_colon; + let s = String.sub path ~pos:2 ~len:(len - 2) in + Buffer.add_string buff (encode s))) + else Buffer.add_string buff (encode path)); + + Buffer.contents buff 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 @@ -35,23 +113,7 @@ let hash = Hashtbl.hash let to_dyn { scheme; authority; path } = let open Dyn in record - [ ("scheme", (option string) scheme) + [ ("scheme", string scheme) ; ("authority", string authority) ; ("path", string path) ] - -let to_path t = - let path = - t.path - |> String.replace_all ~pattern:"\\" ~with_:"/" - |> String.replace_all ~pattern:"%5C" ~with_:"/" - |> String.replace_all ~pattern:"%3A" ~with_:":" - |> String.replace_all ~pattern:"%20" ~with_:" " - |> String.replace_all ~pattern:"%3D" ~with_:"=" - |> String.replace_all ~pattern:"%3F" ~with_:"?" - in - if !Private.win32 then path else Filename.concat "/" path - -let of_path (path : string) = - let path = Uri_lexer.escape_path path in - { path; scheme = Some "file"; authority = "" } diff --git a/lsp/src/uri_lexer.mli b/lsp/src/uri_lexer.mli index e801b745e..fc3eb0e3d 100644 --- a/lsp/src/uri_lexer.mli +++ b/lsp/src/uri_lexer.mli @@ -1,9 +1,9 @@ type t = - { scheme : string option + { scheme : string ; authority : string ; path : string } val of_string : string -> t -val escape_path : string -> string +val of_path : string -> t diff --git a/lsp/src/uri_lexer.mll b/lsp/src/uri_lexer.mll index 89febf5d9..f09deb6ad 100644 --- a/lsp/src/uri_lexer.mll +++ b/lsp/src/uri_lexer.mll @@ -1,38 +1,45 @@ { type t = - { scheme : string option + { scheme : string ; authority : string ; path : string } } -rule path = parse -| '/'? { path1 (Buffer.create 12) lexbuf } -and path1 buf = parse -| '\\' { Buffer.add_char buf '/' ; path1 buf lexbuf } -| "%5" ['c' 'C'] { Buffer.add_char buf '/' ; path1 buf lexbuf } -| "%3" ['a' 'A'] { Buffer.add_char buf ':' ; path1 buf lexbuf } -| "%3" ['d' 'D'] { Buffer.add_char buf '=' ; path1 buf lexbuf } -| "%3" ['f' 'F'] { Buffer.add_char buf '?' ; path1 buf lexbuf } -| "%20" { Buffer.add_char buf ' ' ; path1 buf lexbuf } -| _ as c { Buffer.add_char buf c ; path1 buf lexbuf } -| eof { Buffer.contents buf } +rule uri = parse +([^':''/''?''#']+ as scheme ':') ? +("//" ([^'/''?''#']* as authority)) ? +([^'?''#']* as path) +{ + let open Import in + let scheme = scheme |> Option.value ~default:"file" in + let authority = + authority |> Option.map Uri.pct_decode |> Option.value ~default:"" + in + let path = + let path = path |> Uri.pct_decode in + match scheme with + | "http" | "https" | "file" -> + String.add_prefix_if_not_exists path ~prefix:"/" + | _ -> path + in + { scheme; authority; path; } +} -and uri = parse -| ([^ ':']+) as scheme ':' { uri1 (Some scheme) lexbuf } -| "" { uri1 None lexbuf } -and uri1 scheme = parse -| "//" ([^ '/']* as authority) { uri2 scheme authority lexbuf } -| "" { uri2 scheme "" lexbuf } -and uri2 scheme authority = parse -| "" { { scheme ; authority ; path = path lexbuf } } +and path = parse +| "" { { scheme = "file"; authority = ""; path = "/" } } +| "//" ([^ '/']* as authority) (['/']_* as path) { { scheme = "file"; authority; path } } +| "//" ([^ '/']* as authority) { { scheme = "file"; authority; path = "/" } } +| ("/" _* as path) { { scheme = "file"; authority = ""; path } } +| (_* as path) { { scheme = "file"; authority = ""; path = "/" ^ path } } -{ - let escape_path s = - let lexbuf = Lexing.from_string s in - path lexbuf +{ let of_string s = let lexbuf = Lexing.from_string s in uri lexbuf + + let of_path s = + let lexbuf = Lexing.from_string s in + path lexbuf } diff --git a/lsp/test/uri_tests.ml b/lsp/test/uri_tests.ml index 93119cb88..8d5888b81 100644 --- a/lsp/test/uri_tests.ml +++ b/lsp/test/uri_tests.ml @@ -21,10 +21,10 @@ let%expect_test "test uri parsing" = {| Unix: file:///Users/foo -> /Users/foo - file:///c:/Users/foo -> /c:/Users/foo + file:///c:/Users/foo -> c:/Users/foo Windows: - file:///Users/foo -> Users/foo - file:///c:/Users/foo -> c:/Users/foo |}] + file:///Users/foo -> \Users\foo + file:///c:/Users/foo -> c:\Users\foo |}] let uri_of_path = let test path = @@ -43,3 +43,233 @@ let%expect_test "uri of path" = Windows: /foo/bar.ml -> file:///foo/bar.ml foo/bar.mli -> file:///foo/bar.mli |}] + +let%expect_test "of_path -> to_string" = + let test_of_path_to_string = + let test path = + let uri = Uri.of_path path in + Printf.printf "%s -> %s\n" path (Uri.to_string uri) + in + fun paths -> run_with_modes (fun () -> List.iter test paths) + in + test_of_path_to_string + [ "c:/win/path" + ; "C:/win/path" + ; "c:/win/path/" + ; "/c:/win/path" + ; "c:\\win\\path" + ; "c:\\win/path" + ; "\\\\localhost\\c$\\GitDevelopment\\express" + ; "c:\\test with %\\path" + ; "c:\\test with %25\\path" + ; "c:\\test with %25\\c#code" + ; "\\\\shäres\\path\\c#\\plugin.json" + ; "\\\\shares\\" + ; "a.file" + ; "/Users/jrieken/Code/_samples/18500/Mödel + Other Thîngß/model.js" + ]; + [%expect + {| + Unix: + c:/win/path -> file:///c%3A/win/path + C:/win/path -> file:///c%3A/win/path + c:/win/path/ -> file:///c%3A/win/path/ + /c:/win/path -> file:///c%3A/win/path + c:\win\path -> file:///c%3A%5Cwin%5Cpath + c:\win/path -> file:///c%3A%5Cwin/path + \\localhost\c$\GitDevelopment\express -> file:///%5C%5Clocalhost%5Cc%24%5CGitDevelopment%5Cexpress + c:\test with %\path -> file:///c%3A%5Ctest%20with%20%25%5Cpath + c:\test with %25\path -> file:///c%3A%5Ctest%20with%20%2525%5Cpath + c:\test with %25\c#code -> file:///c%3A%5Ctest%20with%20%2525%5Cc%23code + \\shäres\path\c#\plugin.json -> file:///%5C%5Csh%C3%A4res%5Cpath%5Cc%23%5Cplugin.json + \\shares\ -> file:///%5C%5Cshares%5C + a.file -> file:///a.file + /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 + Windows: + c:/win/path -> file:///c%3A/win/path + C:/win/path -> file:///c%3A/win/path + c:/win/path/ -> file:///c%3A/win/path/ + /c:/win/path -> file:///c%3A/win/path + c:\win\path -> file:///c%3A/win/path + c:\win/path -> file:///c%3A/win/path + \\localhost\c$\GitDevelopment\express -> file://localhost/c%24/GitDevelopment/express + c:\test with %\path -> file:///c%3A/test%20with%20%25/path + c:\test with %25\path -> file:///c%3A/test%20with%20%2525/path + c:\test with %25\c#code -> file:///c%3A/test%20with%20%2525/c%23code + \\shäres\path\c#\plugin.json -> file://sh%C3%A4res/path/c%23/plugin.json + \\shares\ -> file://shares/ + a.file -> file:///a.file + /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 + |}] + +let%expect_test "of_path -> to_path" = + let test_of_path_to_path = + let test path = + let uri = Uri.of_path path in + Printf.printf "%s -> %s\n" path (Uri.to_path uri) + in + fun paths -> run_with_modes (fun () -> List.iter test paths) + in + test_of_path_to_path + [ "c:/win/path" + ; "c:/win/path/" + ; "C:/win/path" + ; "/c:/win/path" + ; "./c/win/path" + ; "c:\\win\\path" + ; "c:\\win/path" + ; "\\\\localhost\\c$\\GitDevelopment\\express" + ; "\\\\shares" + ; "\\\\shares\\" + ; "\\\\shäres\\path\\c#\\plugin.json" + ; "c:\\test with %\\path" + ; "c:\\test with %25\\c#code" + ; "hello" + ]; + [%expect + {| + Unix: + c:/win/path -> c:/win/path + c:/win/path/ -> c:/win/path/ + C:/win/path -> c:/win/path + /c:/win/path -> c:/win/path + ./c/win/path -> /./c/win/path + c:\win\path -> c:\win\path + c:\win/path -> c:\win/path + \\localhost\c$\GitDevelopment\express -> /\\localhost\c$\GitDevelopment\express + \\shares -> /\\shares + \\shares\ -> /\\shares\ + \\shäres\path\c#\plugin.json -> /\\shäres\path\c#\plugin.json + c:\test with %\path -> c:\test with %\path + c:\test with %25\c#code -> c:\test with %25\c#code + hello -> /hello + Windows: + c:/win/path -> c:\win\path + c:/win/path/ -> c:\win\path\ + C:/win/path -> c:\win\path + /c:/win/path -> c:\win\path + ./c/win/path -> \.\c\win\path + c:\win\path -> c:\win\path + c:\win/path -> c:\win\path + \\localhost\c$\GitDevelopment\express -> \\localhost\c$\GitDevelopment\express + \\shares -> \ + \\shares\ -> \ + \\shäres\path\c#\plugin.json -> \\shäres\path\c#\plugin.json + c:\test with %\path -> c:\test with %\path + c:\test with %25\c#code -> c:\test with %25\c#code + hello -> \hello + |}] + +let%expect_test "of_string -> to_path" = + let test_of_string_to_path = + let test s = + let uri = Uri.t_of_yojson (`String s) in + Printf.printf "%s -> %s\n" s (Uri.to_path uri) + in + fun s -> run_with_modes (fun () -> List.iter test s) + in + test_of_string_to_path + [ "file://%2Fhome%2Fticino%2Fdesktop%2Fcpluscplus%2Ftest.cpp" + ; "file://shares/pröjects/c%23/#l12" + ; "file:///_:/path" + ; "file:///c:/Source/Z%C3%BCrich%20or%20Zurich%20(%CB%88zj%CA%8A%C9%99r%C9%AAk,/Code/resources/app/plugins" + ; "shares/pröjects/c%23/#l12" + ; "/shares/pröjects/c%23/#l12" + ; "\\shares/pröjects/c%23/#l12" + ]; + [%expect + {| + Unix: + file://%2Fhome%2Fticino%2Fdesktop%2Fcpluscplus%2Ftest.cpp -> / + file://shares/pröjects/c%23/#l12 -> //shares/pröjects/c#/ + file:///_:/path -> /_:/path + file:///c:/Source/Z%C3%BCrich%20or%20Zurich%20(%CB%88zj%CA%8A%C9%99r%C9%AAk,/Code/resources/app/plugins -> c:/Source/Zürich or Zurich (ˈzjʊərɪk,/Code/resources/app/plugins + shares/pröjects/c%23/#l12 -> /shares/pröjects/c#/ + /shares/pröjects/c%23/#l12 -> /shares/pröjects/c#/ + \shares/pröjects/c%23/#l12 -> /\shares/pröjects/c#/ + Windows: + file://%2Fhome%2Fticino%2Fdesktop%2Fcpluscplus%2Ftest.cpp -> \ + file://shares/pröjects/c%23/#l12 -> \\shares\pröjects\c#\ + file:///_:/path -> \_:\path + file:///c:/Source/Z%C3%BCrich%20or%20Zurich%20(%CB%88zj%CA%8A%C9%99r%C9%AAk,/Code/resources/app/plugins -> c:\Source\Zürich or Zurich (ˈzjʊərɪk,\Code\resources\app\plugins + shares/pröjects/c%23/#l12 -> \shares\pröjects\c#\ + /shares/pröjects/c%23/#l12 -> \shares\pröjects\c#\ + \shares/pröjects/c%23/#l12 -> \\shares\pröjects\c#\ + |}] + +let%expect_test "of_string -> to_string" = + let test_of_string_to_string = + let test s = + let uri = Uri.t_of_yojson (`String s) in + Printf.printf "%s -> %s\n" s (Uri.to_string uri) + in + fun s -> run_with_modes (fun () -> List.iter test s) + in + test_of_string_to_string + [ "file://shares/pröjects/c%23/#l12" + ; "file://sh%c3%a4res/path" + ; "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" + ; "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://LöC%2FAL/host:8080/projects/" + ; "file:///pro%2Fjects/" + ]; + [%expect + {| + Unix: + file://shares/pröjects/c%23/#l12 -> file://shares/pr%C3%B6jects/c%23/ + 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/ + Windows: + file://shares/pröjects/c%23/#l12 -> file://shares/pr%C3%B6jects/c%23/ + 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/ + |}] + +let%expect_test "of_string -> to_path" = + let test_of_string_to_path = + let test s = + let uri = Uri.t_of_yojson (`String s) in + Printf.printf "%s -> %s\n" s (Uri.to_path uri) + in + fun s -> run_with_modes (fun () -> List.iter test s) + in + test_of_string_to_path + [ "file://%2Fhome%2Fticino%2Fdesktop%2Fcpluscplus%2Ftest.cpp" + ; "file://shares/pröjects/c%23/#l12" + ; "file:///_:/path" + ; "" + ; "file://LöC%2FAL/host:8080/projects/" + ]; + [%expect + {| + Unix: + file://%2Fhome%2Fticino%2Fdesktop%2Fcpluscplus%2Ftest.cpp -> / + file://shares/pröjects/c%23/#l12 -> //shares/pröjects/c#/ + file:///_:/path -> /_:/path + -> / + file://LöC%2FAL/host:8080/projects/ -> //LöC/AL/host:8080/projects/ + Windows: + file://%2Fhome%2Fticino%2Fdesktop%2Fcpluscplus%2Ftest.cpp -> \ + file://shares/pröjects/c%23/#l12 -> \\shares\pröjects\c#\ + file:///_:/path -> \_:\path + -> \ + file://LöC%2FAL/host:8080/projects/ -> \\LöC\AL\host:8080\projects\ + |}] diff --git a/ocaml-lsp-server.opam b/ocaml-lsp-server.opam index ebbcb7557..05a0e60cc 100644 --- a/ocaml-lsp-server.opam +++ b/ocaml-lsp-server.opam @@ -21,6 +21,7 @@ bug-reports: "https://github.com/ocaml/ocaml-lsp/issues" depends: [ "dune" {>= "3.0"} "yojson" + "uri" "re" {>= "1.5.0"} "ppx_yojson_conv_lib" {>= "v0.14"} "dune-rpc"